-
Notifications
You must be signed in to change notification settings - Fork 2
/
Copy pathcl.bas
144 lines (105 loc) · 3.62 KB
/
cl.bas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
Attribute VB_Name = "CodeCL"
' (c) Copyright 1995-2025 by John J. Donovan
Option Explicit
Dim CLDataRow As Integer
Dim CLOldSample(1 To 1) As TypeSample
Sub CLDisplaySpectra(tCLDarkSpectra As Boolean, tForm As Form, datarow As Integer, sample() As TypeSample)
' Display current spectrum from the interface
' tCLDarkSpectra = false normal CL spectrum
' tCLDarkSpectra = true dark CL spectrum
ierror = False
On Error GoTo CLDisplaySpectraError
' Check for data
If datarow% = 0 Then Exit Sub
' Save
CLOldSample(1) = sample(1)
CLDataRow% = datarow%
' Check for data
If sample(1).CLSpectraNumberofChannels%(datarow%) < 1 Then Exit Sub
' Call graphics routines
Call CLDisplaySpectra_PE(tCLDarkSpectra, tForm, datarow%, sample())
If ierror Then Exit Sub
Exit Sub
' Errors
CLDisplaySpectraError:
MsgBox Error$, vbOKOnly + vbCritical, "CLDisplaySpectra"
Call IOStatusAuto(vbNullString)
ierror = True
Exit Sub
End Sub
Sub CLInitDisplay(tForm As Form, tCaption As String, datarow As Integer, sample() As TypeSample)
' Init spectrum display
ierror = False
On Error GoTo CLInitDisplayError
Dim astring As String
' Load form caption
If tCaption$ <> vbNullString Then
tForm.Caption = "CL Spectrum Display" & " [" & tCaption$ & "]"
End If
' Load label
astring$ = sample(1).Name$
If sample(1).Linenumber&(datarow%) > 0 Then
astring$ = sample(1).Name$ & ", Line " & Format$(sample(1).Linenumber&(datarow%)) ' PFE
Else
astring$ = sample(1).CLSpectraKilovolts!(datarow%) & " keV, " & sample(1).Name$ ' Standard
End If
tForm.LabelSpectrumName.Caption = astring$
' Call graphics routines
Call CLInitDisplay_PE(tForm)
If ierror Then Exit Sub
Exit Sub
' Errors
CLInitDisplayError:
MsgBox Error$, vbOKOnly + vbCritical, "CLInitDisplay"
Call IOStatusAuto(vbNullString)
ierror = True
Exit Sub
End Sub
Sub CLWriteDiskEMSA(method As Integer, datarow As Integer, sample() As TypeSample, tfilename As String, tForm As Form)
' Write an EMSA format spectrum file based on sample and datarow
' method = 0 do not ask user to confirm filename
' method = 1 ask user to confirm file name
ierror = False
On Error GoTo CLWriteDiskEMSAError
' Add extension
If tfilename$ = vbNullString Then tfilename$ = UserDataDirectory$ & "\untitled"
' Confirm filename
If method% = 1 Then
Call IOGetFileName(Int(1), "EMSA", tfilename$, tForm)
If ierror Then Exit Sub
Else
tfilename$ = tfilename$ & "_CL.emsa"
End If
' Export spectrum
Call EMSAWriteSpectrum(Int(1), datarow%, sample(), tfilename$) ' mode = 1 for CL spectra
If ierror Then Exit Sub
' If no error, save UserData directory
UserDataDirectory$ = MiscGetPathOnly$(tfilename$)
Exit Sub
' Errors
CLWriteDiskEMSAError:
MsgBox Error$, vbOKOnly + vbCritical, "CLWriteDiskEMSA"
ierror = True
Exit Sub
End Sub
Sub CLReadDiskEMSA(datarow As Integer, sample() As TypeSample, tfilename As String, tForm As Form)
' Read an EMSA format spectrum file based on sample and datarow
ierror = False
On Error GoTo CLReadDiskEMSAError
' Add extension
If tfilename$ = vbNullString Then tfilename$ = UserDataDirectory$ & "\untitled"
' Confirm filename
Call IOGetFileName(Int(2), "EMSA", tfilename$, tForm)
If ierror Then Exit Sub
' Export spectrum
Call EMSAReadSpectrum(Int(1), datarow%, sample(), tfilename$) ' mode = 1 for CL
If ierror Then Exit Sub
' If no error, save UserData directory
UserDataDirectory$ = MiscGetPathOnly$(tfilename$)
Exit Sub
' Errors
CLReadDiskEMSAError:
MsgBox Error$, vbOKOnly + vbCritical, "CLReadDiskEMSA"
ierror = True
Exit Sub
End Sub