pshell_config/x11ma
0
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
27152efce82e1ae9fe928cefdbeb274e4e2ed846
x11ma/script/test/X11MA_main_functions.ipm
gac-x11ma 8cf5c6ac04
2020-01-15 15:21:28 +01:00

3296 lines
84 KiB
Plaintext
Raw Blame History

Attribute VB_Name = "Module1"
'Option Explicit
'#uses "X11MA_beamline.ipm"
'#uses "X11MA_LEEM.ipm"
'#uses "X11MA_LJ.ipm"
'#uses "epics.ipm"
'#uses "sls_log.ipm"
'#uses "sls_plot.ipm"
Rem global variables
Rem for saving
Global autopath As String
Global autoname As String
Global autonum As Integer
Global configpath As String
Global autoexpo(2) As Long
Global autoaver(2) As Long
Global autosave As Long
Global autoenergy(2) As Double
Global autocontrast As Single
Global autoseq As Long
Global sensi_image As String
Global autoscale As Single
Global autocycles As Long
Rem for stack
Global energym(20)As Double
Global estepm(20) As Double
Global stackfilepath As String
Global estepmCheck(20) As Integer
Rem for beamline
Global setEnergy As Double
Global rbkEnergy As Double
Global avrbkenergy As Double
Global Polarisation As Double
Global Polarisationstring As String
'Global linearMode As Double
Global activeID As Single
Global opID As Single
Global polswitchmode As Single
Global polstring(5) As String
Global linrotstring As String
Global switchstring(3) As String
Global linrotstringID1(19) As String
Global linrotstringID2(19) As String
Global linrotalphadegID1(19) As Single
'Global linrotID1 As Single
'Global linrotID2 As Single
Global polID1 As Single
Global polID2 As Single
Global pol As Single
Global ID1offset As Double
Global ID2offset As Double
Global IDswitching As String
Global ID1rbkEnergy As Double
Global ID2rbkEnergy As Double
Global ID1alpha As Double
Global ID2alpha As Double
Global ID1harmonic As Double
Global ID2harmonic As Double
Rem for linear rot scan
Global E1,E2,E3 As Double
Global E4 As Double
Global E5 As Double
Global E6 As Double
Global E7 As Double
Global E8 As Double
Global E9 As Double
Global E10 As Double
Global setRotstep As Single
Global ID1_linrot_gap (631,19) As Double
Global ID1_linrot_shift (631,19) As Double
Global ID1_linrot_offset(90) As Double
Global ID2_linrot_gap (631,19) As Double
Global ID2_linrot_shift (631,19) As Double
Global ID2_linrot_offset(90) As Double
Rem for XMCD (small one)
Global setXMCDMag As Double
Global rbkXMCDMag As Double
Rem for Strassbourg XMCD
Global rbkTBTMag As Double
Global setTBTMag As Double
Global Const maxTBT = 7.0
Global TBTTemperature As Double
Global timer0 As Double
Global L2edge As Double
Global L3edge As Double
Global En1 As Double
Global En2 As Double
Global En3 As Double
Global En4 As Double
Global En5 As Double
Global CE1 As Double
Global CE2 As Double
Global CE3 As Double
Global CE4 As Double
Global CE5 As Double
Global Saturation_Field As Double
Global Measurement_Field As Double
Rem for measurment
Global noint As Integer
Global KeithleyMode As Integer
Global KeithleyNo As Double
Global VG10 As Integer
Global do_checkbeamline As Integer
Global do_checkring As Integer
Global KeithleyDelay As Integer
Global ScanDelay As Integer
Global noADC As Integer
Rem for LEEM200
Global startvoltage As Double
Global objective As Double
Global LEEMtemp As Double
Rem for girder
Global x_from As Double
Global x_to As Double
Global x_d As Double
Rem for time_scan
Global timespan As Single
Global MCP_Delay As Double
Global MCP_Delay_Fine As Double
Global PulsePicker_Delay As Double
Global PulsePicker_Delay_Fine As Double
Global Laser_Initial_Delay As Double
Rem for Phasebump
Global Phstart As Double
Global Phend As Double
Global Phstep As Double
Global Phset As Double
Rem for calculating focus
Global calcstartSV As Double
Global calcstartOB As Double
Global calcSV As Double
Global calcOB As Double
Sub mkdirs(path As String)
Dim d As String
Dim c As String
On Error Resume Next
d=""
For i=1 To Len(path)
c=Mid(path,i,1)
If c = "\" And i <> 3 Then
MkDir d
End If
d=d+c
Next i
MkDir d
On Error GoTo 0
End Sub
Sub init_def
Polstring(1)="circ +"
Polstring(2)="circ -"
Polstring(3)="lin hor"
Polstring(4)="lin vert"
Polstring(5)="lin rot"
linrotstringID1(0)="" ' for circ or ver or hor
linrotstringID1(1)=" 0"
linrotstringID1(2)=" 5"
linrotstringID1(3)=" 10"
linrotstringID1(4)=" 15"
linrotstringID1(5)=" 20"
linrotstringID1(6)=" 25"
linrotstringID1(7)=" 30"
linrotstringID1(8)=" 35"
linrotstringID1(9)=" 40"
linrotstringID1(10)=" 45"
linrotstringID1(11)=" 50"
linrotstringID1(12)=" 55"
linrotstringID1(13)=" 60"
linrotstringID1(14)=" 65"
linrotstringID1(15)=" 70"
linrotstringID1(16)=" 75"
linrotstringID1(17)=" 80"
linrotstringID1(18)=" 85"
linrotstringID1(19)=" 90"
linrotstringID2(0)="" ' for circ or ver or hor
linrotstringID2(1)=" 0"
linrotstringID2(2)=" 5"
linrotstringID2(3)=" 10"
linrotstringID2(4)=" 15"
linrotstringID2(5)=" 20"
linrotstringID2(6)=" 25"
linrotstringID2(7)=" 30"
linrotstringID2(8)=" 35"
linrotstringID2(9)=" 40"
linrotstringID2(10)=" 45"
linrotstringID2(11)=" 50"
linrotstringID2(12)=" 55"
linrotstringID2(13)=" 60"
linrotstringID2(14)=" 65"
linrotstringID2(15)=" 70"
linrotstringID2(16)=" 75"
linrotstringID2(17)=" 80"
linrotstringID2(18)=" 85"
linrotstringID2(19)=" 90"
ID1_linrot_offset(0)= 0
ID1_linrot_offset(5)= 1
ID1_linrot_offset(10)= 2
ID1_linrot_offset(15)= 2.5
ID1_linrot_offset(20)= 2.5
ID1_linrot_offset(25)= 2.5
ID1_linrot_offset(30)= 2.5
ID1_linrot_offset(35)= 2.5
ID1_linrot_offset(40)= 2.5
ID1_linrot_offset(45)= 2.5
ID1_linrot_offset(50)= 2.5
ID1_linrot_offset(55)= 2.5
ID1_linrot_offset(60)= 2.5
ID1_linrot_offset(65)= 2.5
ID1_linrot_offset(70)= 2.5
ID1_linrot_offset(75)= 2
ID1_linrot_offset(80)= 1
ID1_linrot_offset(85)= 0
ID1_linrot_offset(90)= 0
ID2_linrot_offset(0)= 0
ID2_linrot_offset(5)= 5
ID2_linrot_offset(10)= 8
ID2_linrot_offset(15)= 10
ID2_linrot_offset(20)= 11
ID2_linrot_offset(25)= 12
ID2_linrot_offset(30)= 12
ID2_linrot_offset(35)= 12
ID2_linrot_offset(40)= 12
ID2_linrot_offset(45)= 11
ID2_linrot_offset(50)= 10
ID2_linrot_offset(55)= 9
ID2_linrot_offset(60)= 8
ID2_linrot_offset(65)= 7
ID2_linrot_offset(70)= 6
ID2_linrot_offset(75)= 4
ID2_linrot_offset(80)= 3
ID2_linrot_offset(85)= 0
ID2_linrot_offset(90)= 0
switchstring(1)="normal"
switchstring(2)="tune/detune"
switchstring(3)="chopper"
'Rem default is measure Keithley1+2+Norm
'KeithleyNo=2
Current_job=0
Jobsrunning=False
noint=1
noADC=100
End Sub
Sub getbeamline
rbkEnergy=getEnergy()
Select Case opID
Case 1
polID1=getPolID1()
pol=polID1
If pol=5 Then linrotstring=CStr(ID1alpha) Else linrotstring=""
'ID1rbkEnergy=getID1rbkEnergy()
Case 2
polID2=getPolID2()
pol=polID2
If pol=5 Then linrotstring=CStr(ID2alpha) Else linrotstring=""
'ID2rbkEnergy=getID2rbkEnergy()
Case 3
polID1=getPolID1()
polID2=getPolID2()
'ID1rbkEnergy=getID1rbkEnergy()
'ID2rbkEnergy=getID2rbkEnergy()
If activeID=1 Then pol=polID1
If activeID=2 Then pol=polID2
If activeID=3 Then pol=polID1
If pol=5 Then
If activeID=1 Then linrotstring=CStr(ID1alpha) Else linrotstring=""
If activeID=2 Then linrotstring=CStr(ID2alpha) Else linrotstring=""
If activeID=3 Then linrotstring=CStr(ID1alpha) Else linrotstring=""
End If
Case Else
polID1=getPolID1()
polID2=getPolID2()
'ID1rbkEnergy=getID1rbkEnergy()
'ID2rbkEnergy=getID2rbkEnergy()
pol=polID1
End Select
End Sub
Function checkRing() As Integer
Rem 0 Ring ok
Rem 1 Ring FB off
Rem 2 Ring down
Rem 3 cancel was pressed
Dim ID1status As Integer
Dim ID2status As Integer
Dim Ringstatus As Integer
Dim status As Boolean
Dim oldRingstatus As Integer
If do_checkring=1 Then
ID1status=getID1control
ID2status=getID2control
Ringstatus=getRingstatus
status=False
oldRingstatus=Ringstatus
checkRing=0
If Ringstatus=5 Then
write_logfile(1,"FB off")
addKeyVal "status","FB off"
checkRing=1
End If
If Ringstatus=0 Then
write_logfile(1,"Machine down")
addKeyVal "status","M down"
checkRing=2
End If
If checkRing>0 Then
Do
ID1status=getID1control
ID2status=getID2control
Ringstatus=getRingstatus
If oldRingstatus<>Ringstatus Then
Select Case Ringstatus
Case 0
write_logfile(1,"Machine down")
checkRing=2
addKeyVal "status","M down"
oldRingstatus=Ringstatus
Case 1
write_logfile(1,"Inj. Stopped")
checkRing=2
oldRingstatus=Ringstatus
Case 2
write_logfile(1,"Accumulating.")
checkRing=2
oldRingstatus=Ringstatus
Case 3
write_logfile(1,"Accumulating")
checkRing=2
oldRingstatus=Ringstatus
Case 4
write_logfile(1,"Top-up ready, Gap still open")
checkRing=2
oldRingstatus=Ringstatus
Case 5
write_logfile(1,"Light-Available, no OFB")
checkRing=2
oldRingstatus=Ringstatus
Case 6
write_logfile(1,"Light Available")
checkRing=2
oldRingstatus=Ringstatus
End Select
End If
If Ringstatus =6 And ID1status=1 And ID2status=1 Then
status=True
End If
If cancelmacro() = 0 Then
status=True
checkRing=3
End If
sleep(1)
Loop While status=False
Select Case checkRing
Case 2
write_logfile(1,"wait 120 s")
addKeyVal "status","waiting"
sleep(120)
write_logfile(0,"continue")
Case 1
write_logfile(1,"wait 10 s")
addKeyVal "status","waiting"
sleep(10)
write_logfile(0,"continue")
End Select
End If
End If
End Function
Sub getLEEM
startvoltage=getStartvoltage()
objective=getObjective()
LEEMtemp=getLEEMtemp()
End Sub
Sub getXMCD
rbkXMCDMag=getXMCDMag()
End Sub
Sub getTBT
rbkTBTMag=getTBTrdkField()
End Sub
Sub updatelog
Rem updates the infos in the log window
addKeyVal "Energy",Format(rbkEnergy,"0.000")
addKeyVal "Polarization",Polstring(pol)+" "+linrotstring
addKeyVal "activeID",Format(activeID)
addKeyVal "IDswitching",switchstring(polswitchmode)
addKeyVal "Objective", Format(objective,"0.0")
addKeyVal "SV", Format(startvoltage,"0.00")
End Sub
Function write_logfile(a As Integer, message As String)
addMessage a,message
If FileExists(autopath) Then
Open autopath+"logfile.log" For Append As #5
Else
Open "C:\IpWin5\X11MAconfig\logfile.log" For Append As #5
End If
Print #5, Format(Date())+" "+Format(Time())+" "+message
Close #5
End Function
Sub startMacro(n As String)
Rem sets log window active
Dim value As Double
addMessage 0,"" ' otherwise program crashes when log window not open
'write on log
write_logfile(0,"start macro "+n)
'addMessage 0,"start macro "+n
addKeyVal "Status",n+" running"
updatelog
'active log
setRunning 1
End Sub
Sub stopMacro
Rem set log window passive
Dim value As Double
'write on log
write_logfile(0,"stop macro")
'addMessage 0,"stop macro"
addKeyVal "Status","Macro done"
addKeyVal "Energy","done"
addKeyVal "Polarization","done"
addKeyVal "activeID","done"
addKeyVal "IDswitching","done"
addKeyVal "Objective","done"
addKeyVal "SV","done"
'active log
setRunning 0
End Sub
Function cancelmacro() As Integer
Rem if macro stoped by canelbutton, writes macro stoped
cancelmacro=isRunning()
If cancelmacro =0 Then
Begin Dialog UserDialog 10,10,130,63,"Message" ' %GRID:10,7,1,1
Text 20,7,90,14,"Macro stoped",.Text1
OKButton 10,28,90,21
End Dialog
Dim scanstoped As UserDialog
Dialog scanstoped
'MsgBox "Scan canceled"
'info on X11MA log window
stopMacro
End If
End Function
Function checkbeamline() As Integer
Rem 0 beamline ok
Rem 1 beamline error
Rem 2
Rem 3 cancel was pressed
Dim ID1status As Integer
Dim ID2status As Integer
Dim ID1error As Integer
Dim ID2error As Integer
Dim ID1error_old As Integer
Dim ID2error_old As Integer
Dim status As Boolean
Dim message(5) As String
If do_checkbeamline = 1 Then
ID1error_old=0
ID2error_old=0
checkbeamline=0
message(5)= "Interlock"
message(4)= "Moving timeout"
message(3)= "Operator control"
message(2)= "Feedforward error"
message(1)= "Encoder error"
message(0)= "PLC error"
Do
Select Case opID
Case 1
ID1status=getID1status
ID2status=0
If ID1status = 0 Then status = True
Case 2
ID1status=0
ID2status=getID2status
If ID2status = 0 Then status = True
Case 3
ID1status=getID1status
ID2status=getID2status
If (ID1status = 0) And (ID2status = 0) Then status = True
End Select
If ID1status >= 1 Then
ID1error=getID1error
If ID1error<>ID1error_old Then
checkbeamline=1
status = False
ID1error_old=ID1error
For bit=5 To 0 Step -1
ID1test=ID1error/(2^bit)
If ID1test >= 1 Then
write_logfile(1,"ID1 "+message(bit))
ID1error=ID1error-(2^bit)
End If
Next bit
End If
End If
If ID2status >= 1 Then
ID2error=getID2error
If ID2error<>ID2error_old Then
checkbeamline=1
status = False
ID2error_old=ID2error
For bit=5 To 0 Step -1
ID2test=ID2error/(2^bit)
If ID2test >= 1 Then
write_logfile(1,"ID2 "+message(bit))
ID2error=ID2error-(2^bit)
End If
Next bit
End If
End If
If cancelmacro() = 0 Then
status=True
checkbeamline=3
End If
sleep(1)
Loop While status=False
End If
End Function
Sub loadstackfile
Rem load setting (energy and steps) for stack from *_stack.txt
Dim Iname As String *255
Dim i As Integer
Dim selectfile As Integer
'Selectfile = IpStGetName("Select file","C:\IpWin4\X11MAconfig","*stack.txt",Iname)
Selectfile = IpStGetName("Select file",configpath,"*.scn",Iname)
If Selectfile = 0 Then Exit Sub
Open Iname For Input As#1
For i = 1 To 20
Input #1, energym(i)
Input #1, estepm(i)
Input #1, estepmCheck(i)
If EOF(1) Then
Close
Exit Sub
End If
Next i
Close #1
End Sub
Sub savestackfile
Rem save setting (energy and steps) for stack in *_stack.txt
Dim Iname As String *200
Dim selectfile As Integer
Dim i As Integer
Selectfile = IpStGetName("save as *.scn",configpath,"*.scn",Iname)
If Selectfile = 0 Then Exit Sub
tt= InStrRev(Iname,".")
If tt = 0 Then
tt=InStr(Iname,vbNullChar)
Iname=Left(Iname,tt-1)+".scn"
Else
Iname=Left(Iname,tt-1)+".scn"
End If
Open Iname For Output As#1
For i = 1 To 20
Write #1, energym(i)
Write #1, estepm(i)
Write #1, estepmCheck(i)
Next i
Close #1
End Sub
Sub saveX11MAstack
Rem saves actual settings of stack
Dim i As Integer
Open "C:\IPWin5\X11MAconfig\X11MA_stack.scn" For Output As#1
For i = 1 To 20
Write #1, energym(i)
Write #1, estepm(i)
Write #1, estepmCheck(i)
Next i
Close #1
End Sub
Sub loadX11MAstack
Rem load last settings of stack
Dim i As Integer
Open "C:\IPWin5\X11MAconfig\X11MA_stack.scn" For Input As#1
For i = 1 To 20
Input #1, energym(i)
Input #1, estepm(i)
Input #1, estepmCheck(i)
If EOF(1) Then
Close
Exit Sub
End If
Next i
Close #1
End Sub
Sub saveX11MA_PEEMconfig
Rem saves setting for automatic saving of images
Open "C:\IPWin5\X11MAconfig\X11MA_PEEM.txt" For Output As#3
Write #3, autopath
Write #3, autoname
Write #3, autoexpo(1)
Write #3, autoexpo(2)
Write #3, autoaver(1)
Write #3, autoaver(2)
Write #3, autosave
Write #3, autoenergy(1)
Write #3, autoenergy(2)
Write #3, autocontrast
Write #3, configpath
Write #3, sensi_image
Write #3, opID
Write #3, polswitchmode
Write #3, ID1offset
Write #3, ID2offset
Write #3, noint
Write #3, KeithleyMode
Write #3, VG10
Write #3, L3edge
Write #3, L2edge
Write #3, E1
Write #3, E2
Write #3, E3
Write #3, E4
Write #3, E5
Write #3, E6
Write #3, E7
Write #3, E8
Write #3, E9
Write #3, E10
Write #3, setRotstep
Write #3, do_checkbeamline
Write #3, do_checkring
Close #3
End Sub
Sub loadX11MA_PEEMconfig
Rem load settings for automatic saving of images
Open "C:\IPWin5\X11MAconfig\X11MA_PEEM.txt" For Input As#3
Input #3, autopath
Input #3, autoname
Input #3, autoexpo(1)
Input #3, autoexpo(2)
Input #3, autoaver(1)
Input #3, autoaver(2)
Input #3, autosave
Input #3, autoenergy(1)
Input #3, autoenergy(2)
Input #3, autocontrast
Input #3, configpath
Input #3, sensi_image
Input #3, opID
Input #3, polswitchmode
Input #3, ID1offset
Input #3, ID2offset
Input #3, noint
Input #3, KeithleyMode
Input #3, VG10
Input #3, L3edge
Input #3, L2edge
Input #3, E1
Input #3, E2
Input #3, E3
Input #3, E4
Input #3, E5
Input #3, E6
Input #3, E7
Input #3, E8
Input #3, E9
Input #3, E10
Input #3, setRotstep
Input #3, do_checkbeamline
Input #3, do_checkring
Close #3
End Sub
Sub saveX11MA_XMCDconfig
Rem saves setting for automatic saving of images
Open "C:\IPWin5\X11MAconfig\X11MA_XMCD.txt" For Output As#3
Write #3, autopath
Write #3, autoname
'Write #3, autoexpo(1)
'Write #3, autoexpo(2)
'Write #3, autoaver(1)
'Write #3, autoaver(2)
Write #3, autosave
'Write #3, autoenergy(1)
'Write #3, autoenergy(2)
'Write #3, autocontrast
Write #3, configpath
'Write #3, sensi_image
Write #3, opID
Write #3, polswitchmode
Write #3, ID1offset
Write #3, ID2offset
Close #3
End Sub
Sub loadX11MA_XMCDconfig
Rem load settings for automatic saving of images
Open "C:\IPWin5\X11MAconfig\X11MA_XMCD.txt" For Input As#3
Input #3, autopath
Input #3, autoname
'Input #3, autoexpo(1)
'Input #3, autoexpo(2)
'Input #3, autoaver(1)
'Input #3, autoaver(2)
Input #3, autosave
'Input #3, autoenergy(1)
'Input #3, autoenergy(2)
'Input #3, autocontrast
Input #3, configpath
'Input #3, sensi_image
Input #3, opID
Input #3, polswitchmode
Input #3, ID1offset
Input #3, ID2offset
Close #3
End Sub
'Function find_next_file_Backup(prefix As String, suffix As String)
' f = Dir$(prefix + "_*." + suffix)
' mx = 0
' Do While f <> ""
' nb = CInt(Mid(f, Len(f) - (Len(suffix) + 3), 3))
' If nb > mx Then mx = nb
' f = Dir$
' Loop
' mx = mx + 1
' t=Left(prefix,InStrRev(prefix,"\"))
' mkdirs("C:\cache"+Right(t,Len(t)-2))
' f = Dir$("C:\cache"+Right(prefix,Len(prefix)-2) + "_*." + suffix)
' mx2 = 0
' Do While f <> ""
' nb = CInt(Mid(f, Len(f) - (Len(suffix) + 3), 3))
' If nb > mx2 Then mx2 = nb
' f = Dir$
' Loop
' mx2 = mx2 + 1
' If mx2 > mx Then mx=mx2
' find_next_file = prefix + "_" + Format(mx, "000") + "." + suffix
'End Function
Function find_next_file(prefix As String, suffix As String)
f = Dir$(prefix + "_*." + suffix)
mx = 0
Do While f <> ""
'nb = CInt(Mid(f, Len(f) - (Len(suffix) + 3), 3))
nb= CInt( Mid( Right ( f, Len(f) - InStr(f,"_") ), 1, 3 ) ) ' Changed by Loic in case of problem comment this line and uncomment the line up
If nb > mx Then mx = nb
f = Dir$
Loop
mx = mx + 1
t=Left(prefix,InStrRev(prefix,"\"))
mkdirs("C:\cache"+Right(t,Len(t)-2))
f = Dir$("C:\cache"+Right(prefix,Len(prefix)-2) + "_*." + suffix)
mx2 = 0
Do While f <> ""
'nb = CInt(Mid(f, Len(f) - (Len(suffix) + 3), 3))
nb= CInt( Mid( Right ( f, Len(f) - InStr(f,"_") ), 1, 3 ) ) ' Changed by Loic in case of problem comment this line and uncomment the line up
If nb > mx2 Then mx2 = nb
f = Dir$
Loop
mx2 = mx2 + 1
If mx2 > mx Then mx=mx2
autonum=CInt(mx)
find_next_file = prefix + "_" + Format(mx, "000") + "." + suffix
End Function
Sub imageinfo(inftxt As String)
Rem save infos of beamline in image
Rem I:E photonenergy scan
Rem I:S startvoltage scan (photoemission)
Rem I:M "manual" scan
Rem I:O objective scan
Rem I:I single image
Rem I:T time resovled
IpWsChangeDescription(INF_TITLE,"E:"+Format(setEnergy,"0.000")+" P:"+Polstring(pol)+" "+linrotstring+" I:"+inftxt)
IpWsChangeDescription(INF_DESCRIPTION,"Polarisation "+Polarisationstring)
IpWsChangeDescription(INF_Artist,"SV:"+Format(startvoltage,"0.000")+" OB:"+Format(objective,"0.00")+" ST:"+Format(LEEMtemp,"0.0"))
End Sub
Function SelectImage_X11MA(message As String, Image1 As Integer) As Boolean
Rem ask user to select one image with message, returns true if successful
Dim pt As pointapi
selectImage_X11MA = False
Image1 = IpDocClick(message+" select",pt)
If Image1 < 0 Then Exit Function
selectImage_X11MA = True
End Function
Function Select2Images_X11MA(Image1 As Integer, Image2 As Integer) As Boolean
Rem Asks user to select two images
Rem Returns True if successful
Dim pt As pointapi
Select2Images_X11MA = False
Image1 = IpDocClick("Select first image", pt)
If Image1 < 0 Then Exit Function
Image2 = IpDocClick("Select second image", pt)
If Image2 < 0 Then Exit Function
Select2Images_X11MA = True
End Function
Function Divide2Images(ByVal Image1 As Integer, ByVal Image2 As Integer, ByVal Scale As Single, ByVal Enhance As Single, ByVal DoFlatten As Boolean) As Integer
Rem Divides Image1 / Image2 (*Gray), scales Image1 by Scale or autoscales if Scale = 0.0,
Rem Enhances contrast by Enhance, flattens if DoFLatten = True
Rem Returns ID
Dim tmp As Integer
Dim Gray As Single
tmp = ScaleImage(Image1, Image2, Scale, True)
Gray = (GetWhiteValue(Image2) + 1) / 2
ret = IpOpImageArithmetics(Image2, Gray, OPA_DIV, False)
'If DoFlatten Then ret = Flatten(tmp, False)
ret = EnhanceImageContrast(tmp, Enhance, 0)
Divide2Images = tmp
End Function
Function Add2Images(ByVal Image1 As Integer, ByVal Image2 As Integer, ByVal Scale As Single, ByVal Enhance As Single, ByVal DoFlatten As Boolean) As Integer
Dim tmp As Integer
Dim Gray As Single
tmp = IpOpNumberArithmetics(1.0, OPA_MULT, 1)
Gray = (GetWhiteValue(Image2) + 1) / 2
ret = IpOpImageArithmetics(Image2, 0, OPA_ADD, False)
'If DoFlatten Then ret = Flatten(tmp, False)
ret = IpAppSelectDoc(tmp)
Add2Images = tmp
End Function
Function Subtract2Images(ByVal Image1 As Integer, ByVal Image2 As Integer, ByVal Scale As Single, ByVal Enhance As Single, ByVal DoFlatten As Boolean) As Integer
Rem Subtracts Image1 - Image2 (+Gray), scales Image1 by Scale or autoscales if Scale = 0.0,
Rem Enhances contrast by Enhance
Rem Returns ID
Dim tmp As Integer
Dim Gray As Single
tmp = ScaleImage(Image1, Image2, Scale, True)
Gray = (GetWhiteValue(Image2) + 1) / 2
ret = IpOpImageArithmetics(Image2, Gray, OPA_SUB, False)
'If DoFlatten Then ret = Flatten(tmp, False)
ret = EnhanceImageContrast(tmp, Enhance, 0)
Subtract2Images = tmp
End Function
Function Subtract2ImagesNoGray(ByVal Image1 As Integer, ByVal Image2 As Integer, ByVal Scale As Single, ByVal Enhance As Single, ByVal DoFlatten As Boolean) As Integer
Rem Subtracts Image1 - Image2 scales Image1 by Scale or autoscales if Scale = 0.0,
Rem Enhances contrast by Enhance
Rem Returns ID
Dim tmp As Integer
Dim Gray As Single
tmp = ScaleImage(Image1, Image2, Scale, True)
ret = IpOpImageArithmetics(Image2, 0, OPA_SUB, False)
'If DoFlatten Then ret = Flatten(tmp, False)
ret = EnhanceImageContrast(tmp, Enhance, 0)
Subtract2ImagesNoGray = tmp
End Function
Function ScaleImage(ByVal Image As Integer, ByVal Reference As Integer, ByVal Scale As Single, ByVal New_Image As Boolean) As Integer
Rem Scales Image to same brightness as Reference if Scale < 0.01 and Reference >= 0, else uses fixed value Scale
Rem Creates new image if New_Image = True
Rem Returns ID
ReDim stats(10) As Single
If (Scale < 0.0001) And (Reference >= 0) Then
ret = IpAppSelectDoc(Reference)
ret = IpHstCreate()
ret = IpHstGet(GETSTATS, 0, stats(0))
ret = IpHstDestroy()
Scale = stats(2) / ((GetWhiteValue(Reference) + 1) / 2)
ret = IpAppSelectDoc(Image)
ret = IpHstCreate()
ret = IpHstGet(GETSTATS, 0, stats(0))
ret = IpHstDestroy()
Scale = Scale / (stats(2) / ((GetWhiteValue(Image) + 1) / 2))
Else
ret = IpAppSelectDoc(Image)
End If
ScaleImage = IpOpNumberArithmetics(Scale, OPA_MULT, New_Image)
End Function
Function Asymmetry2Images(ByVal Image1 As Integer, ByVal Image2 As Integer, ByVal Scale As Single, ByVal Enhance As Single, ByVal DoFlatten As Boolean) As Integer
Rem Calculates asymmetry (Image1-Image2+Gray)/(Image1+Image2-Gray), scales Image1 by Scale or autoscales if Scale = 0.0,
Rem Enhances contrast by Enhance, flattens if DoFLatten = True
Rem Returns ID
Dim tmp1 As Integer
Dim tmp2 As Integer
Dim tmp3 As Integer
Dim range(2) As Single
Dim Info As IPDOCINFO
ret = IpDocGet(GETDOCINFO, Image1, Info)
tmp2 = ScaleImage(Image1, Image2, Scale, True)
tmp1 = IpWsConvertImage(IMC_FLOAT, CONV_DIRECT, 0, 0, 0, 0)
CloseImage(tmp2)
ret = IpAppSelectDoc(Image2)
tmp2 = IpWsConvertImage(IMC_FLOAT, CONV_DIRECT, 0, 0, 0, 0)
tmp3 = IpOpImageArithmetics(tmp1, 0, OPA_ADD, True)
ret = IpAppSelectDoc(tmp1)
tmp1 = IpOpImageArithmetics(tmp2, 0, OPA_SUB, False)
tmp1 = IpOpImageArithmetics(tmp3, 100*Enhance, OPA_DIV, False)
CloseImage(tmp2)
CloseImage(tmp3)
range(0)=-100
range(1)=100
IpDrSet(DR_FRANGE, 1, range(0))
tmp2 = IpWsConvertImage(Info.Class, CONV_SCALE, 0, 0, 0, 0)
If DoFlatten Then ret = Flatten(tmp2, False)
CloseImage(tmp1)
Asymmetry2Images = tmp2
End Function
Function EnhanceImageContrast(ByVal Image As Integer, ByVal Factor As Single, ByVal New_Image As Boolean) As Integer
Rem Enhances contrast of Image by Factor
Rem Creates new image if New_Image = True
Rem Returns ID
Dim Gray As Single
ReDim stats(10) As Single
If (Factor > 0.01) And (Factor < 100) Then
ret = IpAppSelectDoc(Image)
Gray = (GetWhiteValue(Image) + 1) / 2
ret = IpHstGet(GETSTATS, 0, stats(0))
ret = IpHstDestroy()
IpOpNumberArithmetics(Gray-stats(0), OPA_ADD, 0)
If Factor >= 1.0 Then
EnhanceImageContrast = IpOpNumberArithmetics(Gray * (1.0 - 1.0/Factor), OPA_SUB, New_Image)
ret = IpOpNumberArithmetics(Factor, OPA_MULT, 0)
Else
ret = IpOpNumberArithmetics(Factor, OPA_MULT, 0)
EnhanceImageContrast = IpOpNumberArithmetics(Gray * (1.0 - Factor), OPA_Add, New_Image)
End If
Else
EnhanceImageContrast = -1
End If
End Function
Function GetWhiteValue(Image As Integer) As Single
Rem Returns pixel value corresponding to White for Image
Dim Info As IPDOCINFO
ret = IpDocGet(GETDOCINFO, Image, Info)
If Info.Class = IMC_GRAY16 Then
GetWhiteValue = 65535.0
ElseIf Info.Class = IMC_GRAY12 Then
GetWhiteValue = 4095.0
Else
GetWhiteValue = 255.0
End If
End Function
Function definescan(lolimit As Integer, uplimit As Integer) As Boolean
Rem ask user for the region of the scan, returns True when done
Dim doneinput As Boolean
definescan = True
loadX11MAstack
Do
'define scan
Begin Dialog UserDialog 1000,100,390,320,"define spectrum" ' %GRID:10,8,1,1
Text 220,0,60,16,"Step",.Text3
TextBox 120,16,90,16,.energy1
TextBox 120,40,90,16,.energy2
TextBox 120,64,90,16,.energy3
TextBox 120,88,90,16,.energy4
TextBox 120,112,90,16,.energy5
TextBox 120,136,90,16,.energy6
TextBox 120,160,90,16,.energy7
TextBox 120,184,90,16,.energy8
TextBox 120,208,90,16,.energy9
TextBox 120,232,90,16,.energy10
TextBox 220,24,60,16,.Step1
TextBox 220,56,60,16,.Step2
TextBox 220,80,60,16,.Step3
TextBox 220,104,60,16,.Step4
TextBox 220,128,60,16,.Step5
TextBox 220,152,60,16,.Step6
TextBox 220,176,60,16,.Step7
TextBox 220,200,60,16,.Step8
TextBox 220,224,60,16,.Step9
CheckBox 290,24,90,16,CheckBox1,.CheckBox1
CheckBox 290,56,90,16,CheckBox2,.CheckBox2
CheckBox 290,80,90,16,CheckBox3,.CheckBox3
CheckBox 290,104,90,16,CheckBox4,.CheckBox4
CheckBox 290,128,90,16,CheckBox5,.CheckBox5
CheckBox 290,152,90,16,CheckBox6,.CheckBox6
CheckBox 290,176,90,16,CheckBox7,.CheckBox7
CheckBox 290,200,90,16,CheckBox8,.CheckBox8
CheckBox 290,224,90,16,CheckBox9,.CheckBox9
Text 290,0,80,16,"Click to use",.Text1
Text 130,0,80,16,"Energy",.Text2
PushButton 380,312,10,8,"enterkey",.PushButton1
OKButton 130,288,90,24
CancelButton 250,288,90,24
PushButton 90,256,100,24,"load setings",.PushButton2
PushButton 220,256,90,24,"save settings",.PushButton3
End Dialog
Dim dlg As UserDialog
dlg.energy1=Format(energym(1))
dlg.energy2=Format(energym(2))
dlg.energy3=Format(energym(3))
dlg.energy4=Format(energym(4))
dlg.energy5=Format(energym(5))
dlg.energy6=Format(energym(6))
dlg.energy7=Format(energym(7))
dlg.energy8=Format(energym(8))
dlg.energy9=Format(energym(9))
dlg.energy10=Format(energym(10))
dlg.step1=Format(estepm(1))
dlg.step2=Format(estepm(2))
dlg.step3=Format(estepm(3))
dlg.step4=Format(estepm(4))
dlg.step5=Format(estepm(5))
dlg.step6=Format(estepm(6))
dlg.step7=Format(estepm(7))
dlg.step8=Format(estepm(8))
dlg.step9=Format(estepm(9))
dlg.CheckBox1=Format(estepmCheck(1))
dlg.CheckBox2=Format(estepmCheck(2))
dlg.CheckBox3=Format(estepmCheck(3))
dlg.CheckBox4=Format(estepmCheck(4))
dlg.CheckBox5=Format(estepmCheck(5))
dlg.CheckBox6=Format(estepmCheck(6))
dlg.CheckBox7=Format(estepmCheck(7))
dlg.CheckBox8=Format(estepmCheck(8))
dlg.CheckBox9=Format(estepmCheck(9))
r=Dialog(dlg,1)
doneinput=True
If r = 0 Then
definescan=False
Exit Function
End If
If r=1 Then
doneinput=False
End If
' "internal save" input
n=0
n=n+string2double(dlg.energy1,energym(1))
n=n+string2double(dlg.step1,estepm(1))
estepmCheck(1)=CInt(dlg.CheckBox1)
n=n+string2double(dlg.energy2,energym(2))
n=n+string2double(dlg.step2,estepm(2))
estepmCheck(2)=CInt(dlg.CheckBox2)
n=n+string2double(dlg.energy3,energym(3))
n=n+string2double(dlg.step3,estepm(3))
estepmCheck(3)=CInt(dlg.CheckBox3)
n=n+string2double(dlg.energy4,energym(4))
n=n+string2double(dlg.step4,estepm(4))
estepmCheck(4)=CInt(dlg.CheckBox4)
n=n+string2double(dlg.energy5,energym(5))
n=n+string2double(dlg.step5,estepm(5))
estepmCheck(5)=CInt(dlg.CheckBox5)
n=n+string2double(dlg.energy6,energym(6))
n=n+string2double(dlg.step6,estepm(6))
estepmCheck(6)=CInt(dlg.CheckBox6)
n=n+string2double(dlg.energy7,energym(7))
n=n+string2double(dlg.step7,estepm(7))
estepmCheck(7)=CInt(dlg.CheckBox7)
n=n+string2double(dlg.energy8,energym(8))
n=n+string2double(dlg.step8,estepm(8))
estepmCheck(8)=CInt(dlg.CheckBox8)
n=n+string2double(dlg.energy9,energym(9))
n=n+string2double(dlg.step9,estepm(9))
estepmCheck(9)=CInt(dlg.CheckBox9)
n=n+string2double(dlg.energy10,energym(10))
If n<> 0 Then
Begin Dialog UserDialog 260,77 ' %GRID:10,7,1,1
Text 50,7,170,21,"type in numbers!",.Text1
OKButton 70,35,110,21
End Dialog
Dim scanerror5 As UserDialog
Dialog scanerror5
doneinput=False
End If
If r = 2 Then
loadstackfile
doneinput=False
End If
If r= 3 Then
savestackfile
doneinput=False
End If
noregion = 0
For i = 1 To 9
If estepmCheck(i) = 1 Then
noregion=noregion+1
'If estepm(i)<=0 Then definescan=False
If energym(i)<lolimit Or energym(i)>uplimit Then definescan=False
If energym(i+1)<lolimit Or energym(i+1)>uplimit Then definescan=False
End If
Next i
If noregion = 0 Then
Begin Dialog UserDialog 260,77 ' %GRID:10,7,1,1
Text 50,7,170,21,"No energy range selected",.Text1
OKButton 70,35,110,21
End Dialog
Dim scanerror3 As UserDialog
Dialog scanerror3
doneinput=False
End If
If definescan = False Then
Begin Dialog UserDialog 260,77 ' %GRID:10,7,1,1
Text 50,7,170,21,"wrong energy or step size",.Text1
OKButton 70,35,110,21
End Dialog
Dim scanerror4 As UserDialog
Dialog scanerror4
doneinput=False
End If
Loop While doneinput=False
saveX11MAstack
End Function
Function definescan_otf(lolimit As Integer, uplimit As Integer) As Boolean
Rem ask user for the region of the otf scan, returns True when done
Dim doneinput As Boolean
definescan_otf = True
loadX11MAstack
Do
'define scan
Begin Dialog UserDialog 1000,100,390,112,"define spectrum" ' %GRID:10,8,1,1
Text 230,8,120,16,"Time (minutes)",.Text3
TextBox 30,24,90,16,.energy1
TextBox 130,24,90,16,.energy2
TextBox 240,24,60,16,.Step1
Text 30,8,80,16,"Start Energy",.Text2
Text 130,8,80,16,"End Energy",.Text4
PushButton 380,104,10,8,"enterkey",.PushButton1
OKButton 140,88,90,24
CancelButton 240,88,90,24
PushButton 90,56,100,24,"load setings",.PushButton2
PushButton 210,56,90,24,"save settings",.PushButton3
End Dialog
Dim dlg As UserDialog
dlg.energy1=Format(energym(1))
dlg.energy2=Format(energym(2))
dlg.step1=Format(estepm(1))
r=Dialog(dlg,1)
doneinput=True
If r = 0 Then
definescan_otf=False
Exit Function
End If
If r=1 Then
doneinput=False
End If
' "internal save" input
n=0
n=n+string2double(dlg.energy1,energym(1))
n=n+string2double(dlg.step1,estepm(1))
n=n+string2double(dlg.energy2,energym(2))
If n<> 0 Then
Begin Dialog UserDialog 260,77 ' %GRID:10,7,1,1
Text 50,7,170,21,"type in numbers!",.Text1
OKButton 70,35,110,21
End Dialog
Dim scanerror5 As UserDialog
Dialog scanerror5
doneinput=False
End If
If r = 2 Then
loadstackfile
doneinput=False
End If
If r= 3 Then
savestackfile
doneinput=False
End If
noregion = 1
If estepm(1)<=0 Then definescan_otf=False
If energym(1)<lolimit Or energym(i)>uplimit Then definescan_otf=False
If energym(2)<lolimit Or energym(i+1)>uplimit Then definescan_otf=False
If definescan_otf = False Then
Begin Dialog UserDialog 260,77 ' %GRID:10,7,1,1
Text 50,7,170,21,"wrong energy or step size",.Text1
OKButton 70,35,110,21
End Dialog
Dim scanerror4 As UserDialog
Dialog scanerror4
doneinput=False
End If
Loop While doneinput=False
saveX11MAstack
End Function
Function ExpandName(s As String, n As Integer, ext As String) As String
Rem Expands filename s with number n and extension ext and adds ".TIF"
Rem Returns new filename
Dim t As String
t = s
If n<10 Then
t = t + "00"
Else
If n<100 Then t = t + "0"
End If
ExpandName = t + Mid$(Str$(n),2) + ext + ".TIF"
End Function
Function FileExists(f As String) As Boolean
Rem Tests whether filename f already exists
Rem Returns True if f exists
Dim p As String
Dim n As String
Dim x As Integer
Dim Iname As String * 255
Dim i As Integer
x = 0
i = InStrRev(f, "\")
p = Left(f, i)
n = Mid(f, i+1)
FileExists = IpStSearchDir(p, n, x, Iname)
End Function
Sub ini_switchID
ID1os=getID1offset
ID2os=getID2offset
If ID1os=ID1offset Then activeID=1 Else activeID=2
PHS_mode(3)
End Sub
Sub switchID
If activeID = 1 Then
Rem detuneID1
putID1offset(ID1offset-40)
Rem tuneID2
putID2offset(ID2offset)
activeID=2
Else
Rem detuneID2
putID2offset(ID2offset-40)
Rem tuneID1
putID1offset(ID1offset)
activeID=1
End If
End Sub
Function nextpol As Single
Select Case polswitchmode
Case 1 'Normal
If pol=1 Then nextpol=2 'circ+ -> circ-
If pol=2 Then nextpol=1 'circ+ -> circ-
If pol=3 Then nextpol=4 'lin hor -> lin vert
If pol=4 Then nextpol=3 'lin vert -> lin hor
If pol=5 Then nextpol=5 'lin rot -> lin rot
Case 2 'tune/detuned
If activeID=1 Then nextpol=polID2
If activeID=2 Then nextpol=polID1
End Select
End Function
Sub switchpol_new
Dim newpol As Single
Dim v As Double
Dim chop As Double
newpol=nextpol
Select Case opID
Case 1 'ID1 only
putPolID1(newpol)
Case 2 'ID2 only
putPolID2(newpol)
Case 3 'ID1+ID2
If polswitchmode=1 Then 'normal
putPolID1(newpol)
putPolID2(newpol)
End If
If polswitchmode = 2 Then 'tune/detuned
If activeID = 1 Then
Rem detuneID1
putID1offset(ID1offset-40)
Rem tuneID2
putID2offset(ID2offset)
activeID=2
Else
Rem detuneID2
putID2offset(ID2offset-40)
Rem tuneID1
putID1offset(ID1offset)
activeID=1
End If
End If
If polswitchmode = 3 Then 'chopper
If activeID = 1 Then
chop=1
activeID = 2
putChopper(chop)
Else
chop=0
activeID = 1
putChopper(chop)
End If
End If
Case Else 'Error
Begin Dialog UserDialog 1000,100,260,77 ' %GRID:10,7,1,1
Text 50,7,170,21,"go to config beamline",.Text1
OKButton 70,35,110,21
End Dialog
Dim scanerror5 As UserDialog
Dialog scanerror5
End Select
sleep_f(1)
End Sub
'Set all the ID's in use in detuned mode
Sub set_IDs_in_detune
Select Case opID
Case 1 'ID1 only
putID1offset(ID1offset-40)
Case 2 'ID2 only
putID2offset(ID2offset-40)
Case 3 'ID1+ID2
If polswitchmode=1 Then 'normal
putID1shift(0)
putID2shift(0)
Else 'tune/detuned
If activeID = 1 Then
putID1offset(ID1offset-40)
Else
putID2offset(ID2offset-40)
End If
End If
End Select
sleep_f(1)
End Sub
Sub correct_sensi
Dim image1 As Integer
Dim image2 As Integer
If selectImage_X11MA("select image",image1) Then
IpWsLoad(sensi_image, "TIF")
ret = IpDocGet(GETACTDOC, 0, Image2)
ret=Divide2Images(image1,image2,0,1,False)
ret=IpDocCloseEx(Image2)
End If
End Sub
Sub config_beamline
Dim ListopID(4) As String
Dim Listswitchmode(3) As String
Dim ListactiveID(3) As String
Dim Listharmonic(5) As String
Dim doneinput As Boolean
ListopID(1)="ID1"
ListopID(2)="ID2"
ListopID(3)="ID1+ID2"
ListopID(4)="open gap"
Listswitchmode(1)="Normal"
Listswitchmode(2)="tune/detune"
Listswitchmode(3)="chopper"
ListactiveID(1)="ID1"
ListactiveID(2)="ID2"
ListactiveID(3)="ID1+ID2"
Listharmonic(1)="1"
Listharmonic(3)="3"
loadX11MA_PEEMconfig
getbeamline
Do
Begin Dialog UserDialog 800,100,830,238,"config_beamline" ' %GRID:10,7,1,1
OKButton 80,203,90,21
CancelButton 190,203,90,21
Text 390,210,70,14,"offset ID1",.Text1
TextBox 470,203,90,21,.ID1offset
Text 610,210,70,14,"offset ID2",.Text2
TextBox 690,203,90,21,.ID2offset
ComboBox 80,21,90,70,ListopID(),.ListopID
Text 30,21,50,14,"use ID:",.Text3
Text 220,21,70,14,"switching mode:",.Text4
ComboBox 290,21,90,70,Listswitchmode(),.Listswitchmode
Text 430,21,50,14,"ID1:",.Text5
ComboBox 480,21,90,70,Polstring(),.PolID1
Text 650,21,30,14,"ID2:",.Text6
ComboBox 690,21,90,70,Polstring(),.PolID2
TextBox 480,91,90,21,.ID1alpha
TextBox 690,91,90,21,.ID2alpha
Text 410,91,70,14,"Alpha ID1",.Text7
Text 610,91,70,14,"Alpha ID2",.Text8
ComboBox 480,119,90,70,Listharmonic(),.harmonicID1
ComboBox 690,119,90,70,Listharmonic(),.harmonicID2
Text 380,126,90,14,"harmonic ID1",.Text9
Text 600,119,90,14,"harmonic ID2",.Text10
'ListBox 480,91,90,56,linrotstringID1(),.linrotID1
'ListBox 670,91,90,56,linrotstringID2(),.linrotID2
End Dialog
Dim dlg As UserDialog
dlg.ID1offset=Format(ID1offset)
dlg.ID2offset=Format(ID2offset)
dlg.ListopID=ListopID(opID)
dlg.Listswitchmode=Listswitchmode(polswitchmode)
dlg.PolID1=Polstring(polID1)
dlg.PolID2=Polstring(polID2)
dlg.ID1alpha=Format(ID1alpha)
dlg.ID2alpha=Format(ID2alpha)
dlg.harmonicID1=Format(getID1harmonic)
dlg.harmonicID2=Format(getID2harmonic)
If JobsRunning=False Then
r=Dialog(dlg)
Else
r=-1
dlg.ListopID = Jobs(Current_job,2)
dlg.Listswitchmode = Jobs(Current_job,3)
dlg.PolID1 = Jobs(Current_job,4)
dlg.PolID2 = Jobs(Current_job,5)
dlg.ID1alpha = Jobs(Current_job,6)
dlg.ID2alpha = Jobs(Current_job,7)
dlg.ID1offset = Jobs(Current_job,8)
dlg.ID2offset = Jobs(Current_job,9)
dlg.harmonicID1 = Jobs(Current_job,10)
dlg.harmonicID2 = Jobs(Current_job,11)
End If
If r=0 Then
stopMacro
Exit Sub
End If
ID1offset=CDbl(dlg.ID1offset)
ID2offset=CDbl(dlg.ID2offset)
ID1alpha=CDbl(dlg.ID1alpha)
ID2alpha=CDbl(dlg.ID2alpha)
Rem find new harmonic
For i = 1 To 5
If dlg.harmonicID1=Listharmonic(i) Then ID1harmonic = i
If dlg.harmonicID2=Listharmonic(i) Then ID2harmonic = i
Next i
Rem set harmonic
putID1harmonic(ID1harmonic)
putID2harmonic(ID2harmonic)
If r=-1 Then
doneinput=True
End If
' putIDmotors(0) 'off
For i=1 To 5
If dlg.PolID1=Polstring(i) Then putpolID1(i)
sleep_f(1)
If dlg.PolID2=Polstring(i) Then putpolID2(i)
sleep_f(1)
Next i
'sleep(2)
Rem ID1 as active ID
If dlg.ListopID=ListopID(1) Then
PHS_mode(1)
sleep_f(1)
activeID=1
opID=1
polswitchmode=1
putID2offset(ID2offset)
sleep_f(1)
putID1offset(ID1offset)
sleep(1)
Rem set harmonic
putID1harmonic(ID1harmonic)
opengapID2
End If
Rem ID2 as active ID
If dlg.ListopID=ListopID(2) Then
PHS_mode(2)
sleep_f(1)
activeID=2
opID=2
polswitchmode=1
putID2offset(ID2offset)
sleep_f(1)
putID1offset(ID1offset)
sleep(1)
Rem set harmonic
putID2harmonic(ID2harmonic)
opengapID1
End If
Rem ID1+ID2 as active IDs
If dlg.ListopID=ListopID(3) Then
PHS_mode(3)
sleep_f(1)
activeID=3
opID=3
polswitchmode=1
putID2offset(ID2offset)
sleep_f(1)
putID1offset(ID1offset)
sleep_f(1)
Rem set harmonic
putID1harmonic(ID1harmonic)
putID2harmonic(ID2harmonic)
End If
Rem open gaps
If dlg.ListopID=ListopID(4) Then
' putIDmotors(2)
opengapID1
sleep_f(1)
opengapID2
stopmacro
write_logfile(0,"open gaps")
Exit Sub
End If
'sleep(5)
Rem normal switching
If dlg.Listswitchmode=Listswitchmode(1) Then
polswitchmode=1
End If
Rem tune/detune switching
If dlg.Listswitchmode=Listswitchmode(2) Then
polswitchmode=2
activeID = 1
opID=3
putID2offset(ID2offset-40)
sleep_f(1)
putID1offset(ID1offset)
End If
Rem chopper
If dlg.Listswitchmode=Listswitchmode(3) Then
polswitchmode=3
activeID = 1
opID=3
putID2offset(ID2offset)
sleep_f(1)
putID1offset(ID1offset)
End If
'putlinrotmodeID1(0)
'putlinrotmodeID2(0)
Rem linear rot mode ID1
If dlg.PolID1=Polstring(5) And opID=1 Then
'putpolID1(3) 'set to linear mode for feedforward table
putpolID1(5) 'set to linear mode for feedforward table
sleep(3)
'putID1alpha(ID1alpha)
'PHS_mode(0)
opID=1
activeID =1
'putlinrotmodeID1(dlg.linrotID1+1)
'linrotID1=dlg.linrotID1
'If setEnergy=0 Then setEnergy=rbkEnergy
'putlinrotID1(setEnergy)
putID1offset(ID1_linrot_offset(ID1alpha))
End If
Rem linear rot mode ID2
If dlg.PolID2=Polstring(5) And opID=2 Then
'putpolID2(3) 'set to linear mode for feedforward table
putpolID2(5) 'set to linear mode for feedforward table
sleep(3)
'putID2alpha(ID2alpha)
'PHS_mode(0)
opID=2
activeID =2
'putlinrotmodeID2(dlg.linrotID2+1)
'linrotID1=dlg.linrotID1
'If setEnergy=0 Then setEnergy=rbkEnergy
'putlinrotID2(setEnergy)
putID2offset(ID2_linrot_offset(ID2alpha))
End If
Rem linear rot mode ID1+ID2
If dlg.PolID1=Polstring(5) And dlg.PolID2=Polstring(5) Then
'putpolID1(3) 'set to linear mode for feedforward table
putpolID1(5) 'set to linear mode for feedforward table
sleep(3)
'putID1alpha(ID1alpha)
'PHS_mode(0)
opID=3
activeID =3
'putlinrotmodeID1(dlg.linrotID1+1)
'linrotID1=dlg.linrotID1
'If setEnergy=0 Then setEnergy=rbkEnergy
'putlinrotID1(setEnergy)
putID1offset(ID1_linrot_offset(ID1alpha))
'putpolID2(3) 'set to linear mode for feedforward table
putpolID2(5) 'set to linear mode for feedforward table
sleep(3)
'putID2alpha(ID2alpha)
'PHS_mode(0)
'putlinrotmodeID2(dlg.linrotID2+1)
'linrotID1=dlg.linrotID1
'If setEnergy=0 Then setEnergy=rbkEnergy
'putlinrotID2(setEnergy)
putID2offset(ID2_linrot_offset(ID2alpha))
End If
If dlg.ListopID="" Or dlg.Listswitchmode="" Then
Begin Dialog UserDialog 1000,100,260,77 ' %GRID:10,7,1,1
Text 50,7,170,21,"Select mode and ID",.Text1
OKButton 70,35,110,21
End Dialog
Dim scanerror3 As UserDialog
Dialog scanerror3
doneinput=False
End If
Loop While doneinput=False
' putIDmotors(2) 'auto
saveX11MA_PEEMconfig
Rem write logfile
getbeamline
write_logfile(0,"activeID :"+CStr(activeID)+" Polarization :"+Polstring(pol)+" "+linrotstring+" IDswitching :"+switchstring(polswitchmode))
End Sub
Sub config_measure
Dim ListKeithleyMode(10) As String
Dim ListKeithleyNo(5) As String
Dim ListKeithley_set_mode(10) As String
ListKeithleyMode(0) = "use GBIP, without injection test, no average of energy readback"
ListKeithleyMode(1) = "use GBIP, pause while injection, no average of energy readback"
ListKeithleyMode(2) = "use GBIP, without injection test, average of energy readback"
ListKeithleyMode(3) = "use A/D, without injection test, no average of energy readback"
ListKeithleyMode(4) = "use A/D, without injection test, average of energy readback"
ListKeithleyMode(5) = "use A/D, pause while injection, average of energy readback"
ListKeithleyMode(6) = "use A/D, pause while injection, no average of energy readback"
ListKeithleyMode(7) = "trigger Keithley extern, injection test"
ListKeithleyMode(8) = "trigger analog ADC, injection test, no average of energy readback"
ListKeithleyNo(0) = "Keithely1"
ListKeithleyNo(1) = "Keithely2"
ListKeithleyNo(2) = "Keithely1+2+norm"
ListKeithleyNo(3) = "Keithely1+2+3"
ListKeithleyNo(4) = "Keithely1+2+norm+4Analog"
ListKeithley_set_mode(0) = "def setting"
ListKeithley_set_mode(1) = "pull curr fast"
ListKeithley_set_mode(2) = "pull curr medi"
ListKeithley_set_mode(3) = "pull curr slow"
ListKeithley_set_mode(4) = "trig setting"
ListKeithley_set_mode(5) = "trigger extern"
ListKeithley_set_mode(6) = "trigger TLIN"
ListKeithley_set_mode(7) = "trigger BUS"
ListKeithley_set_mode(8) = "pol volt medi"
ListKeithley_set_mode(9) = "not running"
loadX11MA_PEEMconfig
getbeamline
Do
Begin Dialog UserDialog 800,100,970,189,"config_measure" ' %GRID:10,7,1,1
ListBox 140,14,480,70,ListKeithleyMode(),.KeithleyMode
Text 30,14,90,14,"Keithley Mode",.Text1
Text 110,105,130,14,"no of reading",.Text2
Text 90,126,140,14,"(10 about 1 sec)",.Text3
TextBox 250,105,90,21,.noint
OKButton 400,147,90,21
CancelButton 520,147,90,21
CheckBox 400,91,270,14,"Check beamline status",.do_checkbeamline
CheckBox 400,112,160,14,"Check ring status",.do_checkring
ListBox 670,14,260,70,ListKeithleyNo(),.KeithleyNo
Text 140,154,90,14,"Integration time ADC",.Text4
TextBox 250,147,90,21,.noADC
TextBox 790,98,130,21,.Keithley1_set
TextBox 790,126,130,21,.Keithley2_set
TextBox 790,154,130,21,.Keithley3_set
Text 720,105,60,14,"Keithley1",.Text5
Text 720,133,60,14,"Keithley2",.Text6
Text 720,154,60,14,"Keithley3",.Text7
End Dialog
Dim dlg As UserDialog
dlg.noint=Format(noint)
dlg.noADC=Format(noADC)
dlg.KeithleyMode=KeithleyMode
dlg.KeithleyNo=KeithleyNo
dlg.Keithley1_set=ListKeithley_set_mode(get_keithley1_mode)
dlg.Keithley2_set=ListKeithley_set_mode(get_keithley2_mode)
dlg.Keithley3_set=ListKeithley_set_mode(get_keithley3_mode)
dlg.do_checkbeamline=do_checkbeamline
dlg.do_checkring=do_checkring
r=Dialog(dlg)
If r=0 Then
stopMacro
Exit Sub
End If
If r=-1 Then
doneinput=True
End If
noint=CInt(dlg.noint)
KeithleyMode=CInt(dlg.KeithleyMode)
KeithleyNo=CInt(dlg.KeithleyNo)
do_checkbeamline=CInt(dlg.do_checkbeamline)
do_checkring=CInt(dlg.do_checkring)
noADC=CInt(dlg.noADC)
Rem put integration time to ADC
putADC_integration(noADC)
Loop While doneinput=False
saveX11MA_PEEMconfig
End Sub
Function string2double(ByRef n As String, ByRef d As Double) As Integer
Rem returns 0 if okay, 1 if error
On Error GoTo nostring
d=CDbl(n)
GoTo yesString
nostring:
string2double=1
GoTo done
yesstring:
string2double=0
done:
On Error GoTo 0
End Function
Function string2long(ByRef n As String, ByRef d As Long) As Integer
Rem returns 0 if okay, 1 if error
On Error GoTo nostring
d=CDbl(n)
GoTo yesString
nostring:
string2long=1
GoTo done
yesstring:
string2long=0
done:
On Error GoTo 0
End Function
Sub wronginput
Begin Dialog UserDialog 1000,100,260,77 ' %GRID:10,7,1,1
Text 50,7,170,21,"type in numbers!",.Text1
OKButton 70,35,110,21
End Dialog
Dim scanerror5 As UserDialog
Dialog scanerror5
End Sub
Sub wrongvalue
Begin Dialog UserDialog 1000,100,260,77 ' %GRID:10,7,1,1
Text 50,7,170,21,"value out of range",.Text1
OKButton 70,35,110,21
End Dialog
Dim scanerror3 As UserDialog
Dialog scanerror3
End Sub
Function date2name As String
Dim n As String
n=""
n=Format(Date,"yy")
n=n+Format(Date,"mm")
n=n+Format(Date,"dd")
date2name=n
End Function
Function averKeithley(t As Integer,ByRef Keithley1 As Double,ByRef Keithley2 As Double,ByRef Keithleynorm As Double) As Integer
Rem 1: okay
Rem 2: injection
Dim Keithley(3) As Double
Dim Analog(4) As Double
'Dim Injection_test As Single
Dim rEnergy As Double
'KeithleyMode = 0 ' use GBIP non test
'KeithleyMode = 1 'use GBIP break while injection
'KeithleyMode = 2 ' use GBIP, without injection test, user energy readback
'KeithleyMode = 3 ' use A/D signal no injection test
'KeithleyMode = 4 ' use A/D signal without injection test, use energy readback
'KeithleyMode = 5 ' use A/D signal with injection test, use energy readback
'KeithleyMode = 6 ' use A/D signal with injection test, no average of energy
'KeithleyMode = 7 ' new hardware trigger
'KeithleyMode = 8 ' new trigger for analog
'KeithleyNo = 0 ' read Keithley1
'KeithleyNo = 1 ' read Keithley2
'KeithleyNo = 2 ' read Keithley1+2+Norm this is the default
'KeithleyNo = 3 ' read Keithley1+2+3
'KeithleyNo = 4 ' read Keithley1+2+Norm + 4 analog only in XFMR
Rem one empty read due to keithley bufferproblem
'keithley_read(2,keithley(1),keithley(2),keithley(3))
Select Case KeithleyMode
Case 0
Rem one empty read due to keithley bufferproblem
keithley_read(KeithleyNo,keithley(1),keithley(2),keithley(3))
Keithley1=0.0
Keithley2=0.0
Keithleynorm=0.0
averKeithley=0
addKeyVal "Status","measuring"
For i=1 To t
keithley_read(KeithleyNo,keithley(1),keithley(2),keithley(3))
Keithley1=Keithley1+keithley(1)
Keithley2=Keithley2+keithley(2)
Keithleynorm=Keithleynorm+keithley(3)
Next i
Keithley1=Keithley1/t
Keithley2=Keithley2/t
Keithleynorm=Keithleynorm/t
averKeithley=1
avrbkenergy=getEnergy
Case 1
keithley_read(KeithleyNo,keithley(1),keithley(2),keithley(3))
Keithley1=0.0
Keithley2=0.0
Keithleynorm=0.0
averKeithley=0
addKeyVal "Status","measuring"
For i=1 To t
If injection() = 0 Then
keithley_read(KeithleyNo,keithley(1),keithley(2),keithley(3))
Keithley1=Keithley1+keithley(1)
Keithley2=Keithley2+keithley(2)
Keithleynorm=Keithleynorm+keithley(3)
Else
addKeyVal "Status","injection"
Do While True
If cancelmacro() = 0 Then Exit Function
If injection()= 0 Then Exit Do
Loop
sleep_f(2)
keithley_read(KeithleyNo,keithley(1),keithley(2),keithley(3))
Keithley1=0.0
Keithley2=0.0
Keithleynorm=0.0
averKeithley=0
i=0
averKeithley=2
addKeyVal "Status","measuring"
End If
Next i
Keithley1=Keithley1/t
Keithley2=Keithley2/t
Keithleynorm=Keithleynorm/t
averKeithley=1
avrbkenergy=getEnergy
Case 2
keithley_read(KeithleyNo,keithley(1),keithley(2),keithley(3))
Keithley1=0.0
Keithley2=0.0
Keithleynorm=0.0
averKeithley=0
rEnergy=0
addKeyVal "Status","measuring"
For i=1 To t
keithley_read(KeithleyNo,keithley(1),keithley(2),keithley(3))
Keithley1=Keithley1+keithley(1)
Keithley2=Keithley2+keithley(2)
Keithleynorm=Keithleynorm+keithley(3)
rEnergy=rEnergy+getEnergy
Next i
Keithley1=Keithley1/t
Keithley2=Keithley2/t
Keithleynorm=Keithleynorm/t
avrbkenergy=rEnergy/t
averKeithley=1
Case 3
Keithley1=0.0
Keithley2=0.0
Keithleynorm=0.0
averKeithley=0
addKeyVal "Status","measuring"
For i=1 To t
keithley_analog(KeithleyNo,keithley(1),keithley(2),keithley(3), analog(1), analog(2), analog(3), analog(4))
Keithley1=Keithley1+keithley(1)
Keithley2=Keithley2+keithley(2)
Keithleynorm=Keithleynorm+keithley(3)
sleep_f(1)
Next i
Keithley1=Keithley1/t
Keithley2=Keithley2/t
Keithleynorm=Keithleynorm/t
averKeithley=1
avrbkenergy=getEnergy
Case 4
Keithley1=0.0
Keithley2=0.0
Keithleynorm=0.0
averKeithley=0
rEnergy=0
addKeyVal "Status","measuring"
For i=1 To t
keithley_analog(KeithleyNo,keithley(1),keithley(2),keithley(3), analog(1), analog(2), analog(3), analog(4))
Keithley1=Keithley1+keithley(1)
Keithley2=Keithley2+keithley(2)
Keithleynorm=Keithleynorm+keithley(3)
rEnergy=rEnergy+getEnergy
sleep_f(1)
Next i
Keithley1=Keithley1/t
Keithley2=Keithley2/t
Keithleynorm=Keithleynorm/t
avrbkenergy=rEnergy/t
averKeithley=1
Case 5
Keithley1=0.0
Keithley2=0.0
Keithleynorm=0.0
averKeithley=0
rEnergy=0
addKeyVal "Status","measuring"
For i=1 To t
If injection() = 0 Then
keithley_analog(KeithleyNo,keithley(1),keithley(2),keithley(3), analog(1), analog(2), analog(3), analog(4))
Keithley1=Keithley1+keithley(1)
Keithley2=Keithley2+keithley(2)
Keithleynorm=Keithleynorm+keithley(3)
rEnergy=rEnergy+getEnergy
sleep_f(1)
Else
addKeyVal "Status","injection"
Do While True
If cancelmacro() = 0 Then Exit Function
If injection()= 0 Then Exit Do
Loop
sleep_f(2)
keithley_analog(KeithleyNo,keithley(1),keithley(2),keithley(3), analog(1), analog(2), analog(3), analog(4))
Keithley1=0.0
Keithley2=0.0
Keithleynorm=0.0
rEnergy=0
averKeithley=0
i=0
averKeithley=2
addKeyVal "Status","measuring"
End If
Next i
Keithley1=Keithley1/t
Keithley2=Keithley2/t
Keithleynorm=Keithleynorm/t
avrbkenergy=rEnergy/t
averKeithley=1
Case 6
Keithley1=0.0
Keithley2=0.0
Keithleynorm=0.0
averKeithley=0
addKeyVal "Status","measuring"
For i=1 To t
If injection() = 0 Then
keithley_analog(KeithleyNo,keithley(1),keithley(2),keithley(3), analog(1), analog(2), analog(3), analog(4))
Keithley1=Keithley1+keithley(1)
Keithley2=Keithley2+keithley(2)
Keithleynorm=Keithleynorm+keithley(3)
sleep_f(1)
Else
addKeyVal "Status","injection"
Do While True
If cancelmacro() = 0 Then Exit Function
If injection()= 0 Then Exit Do
Loop
sleep_f(2)
keithley_analog(KeithleyNo,keithley(1),keithley(2),keithley(3), analog(1), analog(2), analog(3), analog(4))
Keithley1=0.0
Keithley2=0.0
Keithleynorm=0.0
averKeithley=0
i=0
averKeithley=2
addKeyVal "Status","measuring"
End If
Next i
Keithley1=Keithley1/t
Keithley2=Keithley2/t
Keithleynorm=Keithleynorm/t
averKeithley=1
avrbkenergy=getEnergy
Case 7
Keithley1=0.0
Keithley2=0.0
Keithleynorm=0.0
averKeithley=0
addKeyVal "Status","measuring"
For i=1 To t
If injection() = 0 Then
Rem start trigger
keithley1_trigger_doinit
keithley2_trigger_doinit
sleep_f(2)
keithley1_new_trigger
'keithley2_new_trigger
sleep_f(1)
Rem wait for result
tstart=Int(Timer())+30
Do While True
If cancelmacro() = 0 Then Exit Function
'If injection()= 0 Then Exit Do
If keithley1_new_done = 0 And keithley2_new_done = 0 Then Exit Do
Rem timeout
tnow=Int(Timer())
If tstart < tnow Then
write_logfile(1,"timeout Keithley at: "+Format(setEnergy))
keithley2_new_trigger
'keithley1_new_fetch
'keithley2_new_fetch
Exit Do
End If
Loop
Rem read keithley
sleep_f(2)
keithley_new_read(KeithleyNo,keithley(1),keithley(2),keithley(3))
Rem calculate
Keithley1=Keithley1+keithley(1)
Keithley2=Keithley2+keithley(2)
Keithleynorm=Keithleynorm+keithley(3)
Else
addKeyVal "Status","injection"
Do While True
If cancelmacro() = 0 Then Exit Function
If injection()= 0 Then Exit Do
Loop
sleep_f(2)
keithley_new_read(KeithleyNo,keithley(1),keithley(2),keithley(3))
Keithley1=0.0
Keithley2=0.0
Keithleynorm=0.0
averKeithley=0
i=0
averKeithley=2
addKeyVal "Status","measuring"
End If
Next i
Keithley1=Keithley1/t
Keithley2=Keithley2/t
Keithleynorm=Keithleynorm/t
averKeithley=1
avrbkenergy=getEnergy
Case 8
Keithley1=0.0
Keithley2=0.0
Keithleynorm=0.0
averKeithley=0
Analog1=0.0
Analog2=0.0
Analog3=0.0
Analog4=0.0
addKeyVal "Status","measuring"
For i=1 To t
'If injection() = 0 Then
Rem start trigger
Do
addKeyVal "Status","measuring"
averKeithley=0
keithley_analog_trigger
sleep_f(1)
Rem wait for result
Do While True
If cancelmacro() = 0 Then Exit Function
If injection()= 1 Then
averKeithley=2
addKeyVal "Status","injection"
Keithley1=0.0
Keithley2=0.0
Keithleynorm=0.0
Analog1=0.0
Analog2=0.0
Analog3=0.0
Analog4=0.0
'i=0
sleep_f(5)
End If
If keithley_analog_done = 0 Then Exit Do
Loop
Loop While averKeithley=2
Rem read ADC signals
keithley_analog(KeithleyNo,keithley(1),keithley(2),keithley(3), analog(1), analog(2), analog(3), analog(4))
Keithley1=Keithley1+keithley(1)
Keithley2=Keithley2+keithley(2)
Keithleynorm=Keithleynorm+keithley(3)
Analog1=Analog1+Analog(1)
Analog2=Analog2+Analog(2)
Analog3=Analog3+Analog(3)
Analog4=Analog4+Analog(4)
'sleep_f(1)
'Else
' addKeyVal "Status","injection"
' Rem signal for FMR that injection
' putChopper(1)
' Do While True
' If cancelmacro() = 0 Then Exit Function
' If injection()= 0 Then Exit Do
' Loop
' sleep_f(2)
' keithley_analog(KeithleyNo,keithley(1),keithley(2),keithley(3), analog(1), analog(2), analog(3), analog(4))
' Keithley1=0.0
' Keithley2=0.0
' Keithleynorm=0.0
' Analog1=0.0
' Analog2=0.0
' Analog3=0.0
' Analog4=0.0
' averKeithley_XFMR=0
' i=0
' averKeithley_XFMR=2
' addKeyVal "Status","measuring"
' Rem signal for FMR that injection done
' putChopper(0)
'End If
Next i
Keithley1=Keithley1/t
Keithley2=Keithley2/t
Keithleynorm=Keithleynorm/t
Analog1=Analog1/t
Analog2=Analog2/t
Analog3=Analog3/t
Analog4=Analog4/t
averKeithley=1
avrbkenergy=getEnergy
End Select
End Function
Function averKeithley_XFMR(t As Integer,ByRef Keithley1 As Double,ByRef Keithley2 As Double,ByRef Keithleynorm As Double, ByRef Analog1 As Double, ByRef Analog2 As Double, ByRef Analog3 As Double, ByRef Analog4 As Double) As Integer
Rem 1: okay
Rem 2: injection
Dim Keithley(3) As Double
Dim Analog(4) As Double
'Dim Injection_test As Single
Dim rEnergy As Double
'KeithleyMode = 0 ' use GBIP non test
'KeithleyMode = 1 'use GBIP break while injection
'KeithleyMode = 2 ' use GBIP, without injection test, user energy readback
'KeithleyMode = 3 ' use A/D signal no injection test
'KeithleyMode = 4 ' use A/D signal without injection test, use energy readback
'KeithleyMode = 5 ' use A/D signal with injection test, use energy readback
'KeithleyMode = 6 ' use A/D signal with injection test, no average of energy
'KeithleyMode = 7 ' new hardware trigger
'KeithleyMode = 8 ' new trigger for analog
'KeithleyNo = 0 ' read Keithley1
'KeithleyNo = 1 ' read Keithley2
'KeithleyNo = 2 ' read Keithley1+2+Norm this is the default
'KeithleyNo = 3 ' read Keithley1+2+3
'KeithleyNo = 4 ' read Keithley1+2+Norm + 4 analog only in XFMR
Rem one empty read due to keithley bufferproblem
'keithley_read(2,keithley(1),keithley(2),keithley(3))
Select Case KeithleyMode
Case 0
Rem one empty read due to keithley bufferproblem
keithley_read_XFMR(KeithleyNo,keithley(1),keithley(2),keithley(3), analog(1), analog(2), analog(3), analog(4))
Keithley1=0.0
Keithley2=0.0
Keithleynorm=0.0
averKeithley_XFMR=0
Analog1=0.0
Analog2=0.0
Analog3=0.0
Analog4=0.0
addKeyVal "Status","measuring"
For i=1 To t
keithley_read_XFMR(KeithleyNo,keithley(1),keithley(2),keithley(3), analog(1), analog(2), analog(3), analog(4))
Keithley1=Keithley1+keithley(1)
Keithley2=Keithley2+keithley(2)
Keithleynorm=Keithleynorm+keithley(3)
Analog1=Analog1+Analog(1)
Analog2=Analog2+Analog(2)
Analog3=Analog3+Analog(3)
Analog4=Analog4+Analog(4)
Next i
Keithley1=Keithley1/t
Keithley2=Keithley2/t
Keithleynorm=Keithleynorm/t
Analog1=Analog1/t
Analog2=Analog2/t
Analog3=Analog3/t
Analog4=Analog4/t
averKeithley_XFMR=1
avrbkenergy=getEnergy
Case 1
keithley_read_XFMR(KeithleyNo,keithley(1),keithley(2),keithley(3), analog(1), analog(2), analog(3), analog(4))
Keithley1=0.0
Keithley2=0.0
Keithleynorm=0.0
averKeithley_XFMR=0
Analog1=0.0
Analog2=0.0
Analog3=0.0
Analog4=0.0
addKeyVal "Status","measuring"
For i=1 To t
If injection() = 0 Then
keithley_read_XFMR(KeithleyNo,keithley(1),keithley(2),keithley(3), analog(1), analog(2), analog(3), analog(4))
Keithley1=Keithley1+keithley(1)
Keithley2=Keithley2+keithley(2)
Keithleynorm=Keithleynorm+keithley(3)
Analog1=Analog1+Analog(1)
Analog2=Analog2+Analog(2)
Analog3=Analog3+Analog(3)
Analog4=Analog4+Analog(4)
Else
addKeyVal "Status","injection"
Rem signal for FMR that injection
putChopper(1)
Do While True
If cancelmacro() = 0 Then Exit Function
If injection()= 0 Then Exit Do
Loop
sleep_f(2)
keithley_read_XFMR(KeithleyNo,keithley(1),keithley(2),keithley(3), analog(1), analog(2), analog(3), analog(4))
Keithley1=0.0
Keithley2=0.0
Keithleynorm=0.0
Analog1=0.0
Analog2=0.0
Analog3=0.0
Analog4=0.0
averKeithley_XFMR=0
i=0
averKeithley_XFMR=2
addKeyVal "Status","measuring"
Rem signal for FMR that injection stopped
putChopper(1)
End If
Next i
Keithley1=Keithley1/t
Keithley2=Keithley2/t
Keithleynorm=Keithleynorm/t
Analog1=Analog1/t
Analog2=Analog2/t
Analog3=Analog3/t
Analog4=Analog4/t
averKeithley_XFMR=1
avrbkenergy=getEnergy
Case 2
keithley_read_XFMR(KeithleyNo,keithley(1),keithley(2),keithley(3), analog(1), analog(2), analog(3), analog(4))
Keithley1=0.0
Keithley2=0.0
Keithleynorm=0.0
averKeithley_XFMR=0
Analog1=0.0
Analog2=0.0
Analog3=0.0
Analog4=0.0
rEnergy=0
addKeyVal "Status","measuring"
For i=1 To t
keithley_read_XFMR(KeithleyNo,keithley(1),keithley(2),keithley(3), analog(1), analog(2), analog(3), analog(4))
Keithley1=Keithley1+keithley(1)
Keithley2=Keithley2+keithley(2)
Keithleynorm=Keithleynorm+keithley(3)
rEnergy=rEnergy+getEnergy
Analog1=Analog1+Analog(1)
Analog2=Analog2+Analog(2)
Analog3=Analog3+Analog(3)
Analog4=Analog4+Analog(4)
Next i
Keithley1=Keithley1/t
Keithley2=Keithley2/t
Keithleynorm=Keithleynorm/t
Analog1=Analog1/t
Analog2=Analog2/t
Analog3=Analog3/t
Analog4=Analog4/t
avrbkenergy=rEnergy/t
averKeithley_XFMR=1
Case 3
Keithley1=0.0
Keithley2=0.0
Keithleynorm=0.0
averKeithley_XFMR=0
Analog1=0.0
Analog2=0.0
Analog3=0.0
Analog4=0.0
addKeyVal "Status","measuring"
For i=1 To t
keithley_analog(KeithleyNo,keithley(1),keithley(2),keithley(3), analog(1), analog(2), analog(3), analog(4))
Keithley1=Keithley1+keithley(1)
Keithley2=Keithley2+keithley(2)
Keithleynorm=Keithleynorm+keithley(3)
Analog1=Analog1+Analog(1)
Analog2=Analog2+Analog(2)
Analog3=Analog3+Analog(3)
Analog4=Analog4+Analog(4)
sleep_f(1)
Next i
Keithley1=Keithley1/t
Keithley2=Keithley2/t
Keithleynorm=Keithleynorm/t
Analog1=Analog1/t
Analog2=Analog2/t
Analog3=Analog3/t
Analog4=Analog4/t
averKeithley_XFMR=1
avrbkenergy=getEnergy
Case 4
Keithley1=0.0
Keithley2=0.0
Keithleynorm=0.0
averKeithley_XFMR=0
Analog1=0.0
Analog2=0.0
Analog3=0.0
Analog4=0.0
rEnergy=0
addKeyVal "Status","measuring"
For i=1 To t
keithley_analog(KeithleyNo,keithley(1),keithley(2),keithley(3), analog(1), analog(2), analog(3), analog(4))
Keithley1=Keithley1+keithley(1)
Keithley2=Keithley2+keithley(2)
Keithleynorm=Keithleynorm+keithley(3)
Analog1=Analog1+Analog(1)
Analog2=Analog2+Analog(2)
Analog3=Analog3+Analog(3)
Analog4=Analog4+Analog(4)
rEnergy=rEnergy+getEnergy
sleep_f(1)
Next i
Keithley1=Keithley1/t
Keithley2=Keithley2/t
Keithleynorm=Keithleynorm/t
Analog1=Analog1/t
Analog2=Analog2/t
Analog3=Analog3/t
Analog4=Analog4/t
avrbkenergy=rEnergy/t
averKeithley_XFMR=1
Case 5
Keithley1=0.0
Keithley2=0.0
Keithleynorm=0.0
averKeithley_XFMR=0
Analog1=0.0
Analog2=0.0
Analog3=0.0
Analog4=0.0
rEnergy=0
addKeyVal "Status","measuring"
For i=1 To t
If injection() = 0 Then
keithley_analog(KeithleyNo,keithley(1),keithley(2),keithley(3), analog(1), analog(2), analog(3), analog(4))
Keithley1=Keithley1+keithley(1)
Keithley2=Keithley2+keithley(2)
Keithleynorm=Keithleynorm+keithley(3)
Analog1=Analog1+Analog(1)
Analog2=Analog2+Analog(2)
Analog3=Analog3+Analog(3)
Analog4=Analog4+Analog(4)
rEnergy=rEnergy+getEnergy
sleep_f(1)
Else
addKeyVal "Status","injection"
Rem signal for FMR that injection
putChopper(1)
Do While True
If cancelmacro() = 0 Then Exit Function
If injection()= 0 Then Exit Do
Loop
sleep_f(2)
keithley_analog(KeithleyNo,keithley(1),keithley(2),keithley(3), analog(1), analog(2), analog(3), analog(4))
Keithley1=0.0
Keithley2=0.0
Keithleynorm=0.0
Analog1=0.0
Analog2=0.0
Analog3=0.0
Analog4=0.0
rEnergy=0
averKeithley_XFMR=0
i=0
averKeithley_XFMR=2
addKeyVal "Status","measuring"
Rem signal for FMR that injection done
putChopper(0)
End If
Next i
Keithley1=Keithley1/t
Keithley2=Keithley2/t
Keithleynorm=Keithleynorm/t
Analog1=Analog1/t
Analog2=Analog2/t
Analog3=Analog3/t
Analog4=Analog4/t
avrbkenergy=rEnergy/t
averKeithley_XFMR=1
Case 6
Keithley1=0.0
Keithley2=0.0
Keithleynorm=0.0
averKeithley_XFMR=0
Analog1=0.0
Analog2=0.0
Analog3=0.0
Analog4=0.0
addKeyVal "Status","measuring"
For i=1 To t
If injection() = 0 Then
keithley_analog(KeithleyNo,keithley(1),keithley(2),keithley(3), analog(1), analog(2), analog(3), analog(4))
Keithley1=Keithley1+keithley(1)
Keithley2=Keithley2+keithley(2)
Keithleynorm=Keithleynorm+keithley(3)
Analog1=Analog1+Analog(1)
Analog2=Analog2+Analog(2)
Analog3=Analog3+Analog(3)
Analog4=Analog4+Analog(4)
sleep_f(1)
Else
addKeyVal "Status","injection"
Rem signal for FMR that injection
putChopper(1)
Do While True
If cancelmacro() = 0 Then Exit Function
If injection()= 0 Then Exit Do
Loop
sleep_f(2)
keithley_analog(KeithleyNo,keithley(1),keithley(2),keithley(3), analog(1), analog(2), analog(3), analog(4))
Keithley1=0.0
Keithley2=0.0
Keithleynorm=0.0
Analog1=0.0
Analog2=0.0
Analog3=0.0
Analog4=0.0
averKeithley_XFMR=0
i=0
averKeithley_XFMR=2
addKeyVal "Status","measuring"
Rem signal for FMR that injection done
putChopper(0)
End If
Next i
Keithley1=Keithley1/t
Keithley2=Keithley2/t
Keithleynorm=Keithleynorm/t
Analog1=Analog1/t
Analog2=Analog2/t
Analog3=Analog3/t
Analog4=Analog4/t
averKeithley_XFMR=1
avrbkenergy=getEnergy
Case 7
Keithley1=0.0
Keithley2=0.0
Keithleynorm=0.0
averKeithley_XFMR=0
Analog1=0.0
Analog2=0.0
Analog3=0.0
Analog4=0.0
addKeyVal "Status","measuring"
For i=1 To t
If injection() = 0 Then
Rem start trigger
keithley1_trigger_doinit
keithley2_trigger_doinit
sleep_f(1)
keithley1_new_trigger
keithley2_new_trigger
sleep_f(1)
Rem wait for result
Do While True
If cancelmacro() = 0 Then Exit Function
'If injection()= 0 Then Exit Do
If keithley1_new_done = 0 And keithley2_new_done = 0 Then Exit Do
Loop
Rem read keithley
keithley_new_read(KeithleyNo,keithley(1),keithley(2),keithley(3))
Rem calculate
Keithley1=Keithley1+keithley(1)
Keithley2=Keithley2+keithley(2)
Keithleynorm=Keithleynorm+keithley(3)
Else
addKeyVal "Status","injection"
Do While True
If cancelmacro() = 0 Then Exit Function
If injection()= 0 Then Exit Do
Loop
sleep_f(2)
keithley_new_read(KeithleyNo,keithley(1),keithley(2),keithley(3))
Keithley1=0.0
Keithley2=0.0
Keithleynorm=0.0
averKeithley_XFMR=0
i=0
averKeithley_XFMR=2
addKeyVal "Status","measuring"
End If
Next i
Keithley1=Keithley1/t
Keithley2=Keithley2/t
Keithleynorm=Keithleynorm/t
averKeithley_XFMR=1
avrbkenergy=getEnergy
Case 8
Keithley1=0.0
Keithley2=0.0
Keithleynorm=0.0
averKeithley_XFMR=0
Analog1=0.0
Analog2=0.0
Analog3=0.0
Analog4=0.0
addKeyVal "Status","measuring"
For i=1 To t
'If injection() = 0 Then
Rem start trigger
Do
addKeyVal "Status","measuring"
averKeithley_XFMR=0
keithley_analog_trigger
sleep_f(1)
Rem wait for result
Do While True
If cancelmacro() = 0 Then Exit Function
If injection()= 1 Then
averKeithley_XFMR=2
addKeyVal "Status","injection"
Keithley1=0.0
Keithley2=0.0
Keithleynorm=0.0
Analog1=0.0
Analog2=0.0
Analog3=0.0
Analog4=0.0
'i=0
sleep_f(5)
End If
If keithley_analog_done = 0 Then Exit Do
Loop
Loop While averKeithley_XFMR=2
Rem read ADC signals
keithley_analog(KeithleyNo,keithley(1),keithley(2),keithley(3), analog(1), analog(2), analog(3), analog(4))
Keithley1=Keithley1+keithley(1)
Keithley2=Keithley2+keithley(2)
Keithleynorm=Keithleynorm+keithley(3)
Analog1=Analog1+Analog(1)
Analog2=Analog2+Analog(2)
Analog3=Analog3+Analog(3)
Analog4=Analog4+Analog(4)
'sleep_f(1)
'Else
' addKeyVal "Status","injection"
' Rem signal for FMR that injection
' putChopper(1)
' Do While True
' If cancelmacro() = 0 Then Exit Function
' If injection()= 0 Then Exit Do
' Loop
' sleep_f(2)
' keithley_analog(KeithleyNo,keithley(1),keithley(2),keithley(3), analog(1), analog(2), analog(3), analog(4))
' Keithley1=0.0
' Keithley2=0.0
' Keithleynorm=0.0
' Analog1=0.0
' Analog2=0.0
' Analog3=0.0
' Analog4=0.0
' averKeithley_XFMR=0
' i=0
' averKeithley_XFMR=2
' addKeyVal "Status","measuring"
' Rem signal for FMR that injection done
' putChopper(0)
'End If
Next i
Keithley1=Keithley1/t
Keithley2=Keithley2/t
Keithleynorm=Keithleynorm/t
Analog1=Analog1/t
Analog2=Analog2/t
Analog3=Analog3/t
Analog4=Analog4/t
averKeithley_XFMR=1
avrbkenergy=getEnergy
End Select
End Function
'Function averKeithley3(t As Integer,ByRef Keithley1 As Double,ByRef Keithley2 As Double,ByRef Keithleynorm As Double) As Integer
Rem 1: okay
Rem 2: injection
Rem read 3 Keithleys
'Dim Keithley(3) As Double
'Dim Injection_test As Single
'Dim rEnergy As Double
'KeithleyMode = 0 ' use GBIP non test
'KeithleyMode = 1 'use GBIP break while injection
'KeithleyMode = 2 ' use GBIP, without injection test, user energy readback
'KeithleyMode = 3 ' use A/D signal no injection test
'KeithleyMode = 4 ' use A/D signal without injection test, use energy readback
'KeithleyMode = 5 ' use A/D signal with injection test, use energy readback
'KeithleyMode = 6 ' use A/D signal with injection test, no average of energy
'KeithleyMode = 7 ' new hardware trigger
Rem one empty read due to keithley bufferproblem
'keithley_read(3,keithley(1),keithley(2),keithley(3))
' Select Case KeithleyMode
' Case 0
' Rem one empty read due to keithley bufferproblem
' keithley_read(3,keithley(1),keithley(2),keithley(3))
' Keithley1=0.0
' Keithley2=0.0
' Keithleynorm=0.0
' averKeithley3=0
' addKeyVal "Status","measuring"
' For i=1 To t
' keithley_read(3,keithley(1),keithley(2),keithley(3))
' Keithley1=Keithley1+keithley(1)
' Keithley2=Keithley2+keithley(2)
' Keithleynorm=Keithleynorm+keithley(3)
' Next i
' Keithley1=Keithley1/t
' Keithley2=Keithley2/t
' Keithleynorm=Keithleynorm/t
' averKeithley3=1
' avrbkenergy=getEnergy
'
' Case 1
' keithley_read(3,keithley(1),keithley(2),keithley(3))
' Keithley1=0.0
' Keithley2=0.0
' Keithleynorm=0.0
' averKeithley3=0
' addKeyVal "Status","measuring"
' For i=1 To t
' If injection() = 0 Then
' keithley_read(3,keithley(1),keithley(2),keithley(3))
' Keithley1=Keithley1+keithley(1)
' Keithley2=Keithley2+keithley(2)
' Keithleynorm=Keithleynorm+keithley(3)
' Else
' addKeyVal "Status","injection"
' Do While True
' If cancelmacro() = 0 Then Exit Function
' If injection()= 0 Then Exit Do
' Loop
' sleep_f(2)
' keithley_read(3,keithley(1),keithley(2),keithley(3))
' Keithley1=0.0
' Keithley2=0.0
' Keithleynorm=0.0
' averKeithley3=0
' i=0
' averKeithley3=2
' addKeyVal "Status","measuring"
' End If
' Next i
' Keithley1=Keithley1/t
' Keithley2=Keithley2/t
' Keithleynorm=Keithleynorm/t
' averKeithley3=1
' avrbkenergy=getEnergy
' Case 2
' keithley_read(3,keithley(1),keithley(2),keithley(3))
' Keithley1=0.0
' Keithley2=0.0
' Keithleynorm=0.0
' averKeithley3=0
' rEnergy=0
' addKeyVal "Status","measuring"
' For i=1 To t
' keithley_read(3,keithley(1),keithley(2),keithley(3))
' Keithley1=Keithley1+keithley(1)
' Keithley2=Keithley2+keithley(2)
' Keithleynorm=Keithleynorm+keithley(3)
' rEnergy=rEnergy+getEnergy
' Next i
' Keithley1=Keithley1/t
' Keithley2=Keithley2/t
' Keithleynorm=Keithleynorm/t
' avrbkenergy=rEnergy/t
' averKeithley3=1
' Case 3
' Keithley1=0.0
' Keithley2=0.0
' Keithleynorm=0.0
' averKeithley3=0
' addKeyVal "Status","measuring"
' For i=1 To t
' keithley_analog(3,keithley(1),keithley(2),keithley(3))
' Keithley1=Keithley1+keithley(1)
' Keithley2=Keithley2+keithley(2)
' Keithleynorm=Keithleynorm+keithley(3)
' sleep_f(1)
' Next i
' Keithley1=Keithley1/t
' Keithley2=Keithley2/t
' Keithleynorm=Keithleynorm/t
' averKeithley3=1
' avrbkenergy=getEnergy
' Case 4
' Keithley1=0.0
' Keithley2=0.0
' Keithleynorm=0.0
' averKeithley3=0
' rEnergy=0
' addKeyVal "Status","measuring"
' For i=1 To t
' keithley_analog(3,keithley(1),keithley(2),keithley(3))
' Keithley1=Keithley1+keithley(1)
' Keithley2=Keithley2+keithley(2)
' Keithleynorm=Keithleynorm+keithley(3)
' rEnergy=rEnergy+getEnergy
' sleep_f(1)
' Next i
' Keithley1=Keithley1/t
' Keithley2=Keithley2/t
' Keithleynorm=Keithleynorm/t
' avrbkenergy=rEnergy/t
' averKeithley3=1
'
' Case 5
' Keithley1=0.0
' Keithley2=0.0
' Keithleynorm=0.0
' averKeithley3=0
' rEnergy=0
' addKeyVal "Status","measuring"
' For i=1 To t
' If injection() = 0 Then
' keithley_analog(3,keithley(1),keithley(2),keithley(3))
' Keithley1=Keithley1+keithley(1)
' Keithley2=Keithley2+keithley(2)
' Keithleynorm=Keithleynorm+keithley(3)
' rEnergy=rEnergy+getEnergy
' sleep_f(1)
' Else
' addKeyVal "Status","injection"
' Do While True
' If cancelmacro() = 0 Then Exit Function
' If injection()= 0 Then Exit Do
' Loop
' sleep_f(2)
' keithley_read(3,keithley(1),keithley(2),keithley(3))
' Keithley1=0.0
' Keithley2=0.0
' Keithleynorm=0.0
' rEnergy=0
' averKeithley3=0
' i=0
' averKeithley3=2
' addKeyVal "Status","measuring"
' End If
' Next i
' Keithley1=Keithley1/t
' Keithley2=Keithley2/t
' Keithleynorm=Keithleynorm/t
' avrbkenergy=rEnergy/t
' averKeithley3=1
'
' Case 6
' Keithley1=0.0
' Keithley2=0.0
' Keithleynorm=0.0
' averKeithley3=0
' addKeyVal "Status","measuring"
' For i=1 To t
' If injection() = 0 Then
' keithley_analog(3,keithley(1),keithley(2),keithley(3))
' Keithley1=Keithley1+keithley(1)
' Keithley2=Keithley2+keithley(2)
' Keithleynorm=Keithleynorm+keithley(3)
' sleep_f(1)
' Else
' addKeyVal "Status","injection"
' Do While True
' If cancelmacro() = 0 Then Exit Function
' If injection()= 0 Then Exit Do
' Loop
' sleep_f(2)
' keithley_read(3,keithley(1),keithley(2),keithley(3))
' Keithley1=0.0
' Keithley2=0.0
' Keithleynorm=0.0
' averKeithley3=0
' i=0
' averKeithley3=2
' addKeyVal "Status","measuring"
' End If
' Next i
' Keithley1=Keithley1/t
' Keithley2=Keithley2/t
' Keithleynorm=Keithleynorm/t
' averKeithley3=1
' avrbkenergy=getEnergy
'
' Case 7
' Keithley1=0.0
' Keithley2=0.0
' Keithleynorm=0.0
' averKeithley3=0
' addKeyVal "Status","measuring"
'
' Rem start trigger
' put_keithley1_new_busy
' put_keithley2_new_busy
' keithley_new_trigger
'
' Rem wait for result
' Do While True
' If cancelmacro() = 0 Then Exit Function
' 'If injection()= 0 Then Exit Do
' If keithley1_new_done = 1 And keithley2_new_done Then Exit Do
' Loop
'
' Rem read keithley
' keithley_new_read(3,keithley(1),keithley(2),keithley(3))
'
' Keithley1=keithley(1)
' Keithley2=keithley(2)
' Keithleynorm=Keithley1/Keithley2
' averKeithley3=1
' avrbkenergy=getEnergy
'
' End Select
'End Function
Sub AverageSeq()
Rem Calculates multiple images from image stack in selected areas AOI1, AOI2, ...
Dim images As Integer
Dim anz As Integer
'startMacro("average Sequenz")
'LoadConfig
ret = SelectImage_X11MA ("Select Sequence", images)
ret = IpSeqGet(SEQ_NUMFRAMES,anz)
ret = IPSeqAverage(0,anz)
'stopMacro
End Sub
Function AddSeq() As Integer
Rem adds the images of a sequence into on image
Dim tmp As Integer
Dim Image1 As Integer
Dim Image2 As Integer
Dim images As Integer
Dim anz As Integer
Seq1 = SelectImage_X11MA ("Select Sequence", images)
ret = IpSeqGet(SEQ_NUMFRAMES,anz)
Image1 = IpSeqExtractFrames (0,1)
ret = IpAppSelectDoc(Image1)
For n = 0 To anz
ret = IpAppSelectDoc(Seq1)
Image2 = IpSeqExtractFrames (n,1)
ret = IpAppSelectDoc(Image1)
Image3 = IpOpImageArithmetics(Image2, 0, OPA_ADD, 1)
IpDocCloseEx(Image1)
IpDocCloseEx(Image2)
Image1=Image3
Next n
End Function
Function AddSeq_smart() As Integer
Rem adds the images of a sequence into one image until the max intensity is 2500, then into a next image etc
Dim tmp As Integer
Dim Image1 As Integer
Dim Image2 As Integer
Dim Image3 As Integer
Dim Image_result(100) As Integer
Dim images As Integer
Dim Seq1 As Integer
Dim anz As Integer
Dim max(10) As Single
Dim result As Integer
result = 0
Seq1 = SelectImage_X11MA ("Select Sequence", images)
ret = IpSeqGet(SEQ_NUMFRAMES,anz)
Image1 = IpSeqExtractFrames (0,1)
ret = IpAppSelectDoc(Image1)
For n = 0 To anz
ret = IpAppSelectDoc(Seq1)
Image2 = IpSeqExtractFrames (n,1)
ret = IpAppSelectDoc(Image1)
Image3 = IpOpImageArithmetics(Image2, 0, OPA_ADD, 1)
IpDocCloseEx(Image1)
IpDocCloseEx(Image2)
ret = IpAppSelectDoc(Image3)
IpHstCreate()
ret = IpHstGet(GETSTATS, 0, max(0))
IpHstDestroy()
Image1=Image3
If max(4) > 2500 Then
Image_Result(result)=Image1
result=result + 1
ret = IpAppSelectDoc(Seq1)
Image1 = IpSeqExtractFrames (n,1)
ret = IpAppSelectDoc(Image1)
n=n+1
End If
Next n
Image_Result(result)=Image1
For n = 0 To result-2
ret = IpAppSelectDoc(Image_Result(n+1))
ret = IpWsCopyFrames(0,1)
ret = IpDocCloseEx(Image_Result(n+1))
ret = IpAppSelectDoc(Image_Result(0))
ret = IpWsPasteFrames(-1)
Next n
ret = IpAppSelectDoc(Image_Result(0))
ret = IpSeqGet(SEQ_NUMFRAMES,anz)
ret = IPSeqAverage(0,anz)
End Function
Sub CalcMultShiftsSeq()
Rem Calculates multiple images from image stack in selected areas AOI1, AOI2, ...
Dim n As Integer
Dim tmp As Integer
Dim refimage As Integer
Dim i As Integer
Dim ab As Integer
Dim Iname As String * 255
Dim s As String
Dim t As String *255
Dim ext As String
Dim r As RECT
Dim deltax As Integer
Dim deltay As Integer
Dim resultt As String
Dim anz As Integer
Dim Image As Integer
startMacro("CalcMultShifts")
message ="Select Sequence uses active AOI"
Image = selectImage(message)
If Image <0 Then
Exit Sub
End If
ret = IpAoiManager(AOIADD,"RAOI")
IpSeqGet (SEQ_NUMFRAMES, anz)
IpSeqSet (SEQ_ACTIVEFRAME, 0)
IpAoiShow(FRAME_NONE)
IpSeqSet (SEQ_APPLY, 0) ' current frame
refimage = IpWsDuplicate()
If refimage < 0 Then
Exit Sub
End If
ret = IpStGetName("Save As",Path,"*.DAT", Iname)
If ret = 0 Then
Exit Sub
End If
t = Iname
i = InStr(1,t,".DAT")
If i = 0 Then t = t + ".DAT"
Open t For Output As #1
resultt = "0" + Chr(9) + "0" + Chr(9) + "0"
Print #1, resultt
For i = 1 To (anz-1)
IpAppSelectDoc(Image)
'ret = IpAoiManager(AOISET,"AOI")
IpSeqSet (SEQ_ACTIVEFRAME, i)
IpAoiShow(FRAME_NONE)
IpSeqSet (SEQ_APPLY, 0) ' current frame
tmp = IpWsDuplicate()
ret = FastAutoAlign(refimage, tmp, deltax, deltay, 1)
'ret = FastAutoAlign(refimage, tmp, deltax, deltay, 0)
ret = IpDocClose()
resultt = Str(i) + Chr(9) + Str(deltax) + Chr(9) + Str (deltay)
Print #1, resultt
Next i
Close #1
IpAppSelectDoc(Image)
ret = IpSeqSet(SEQ_APPLY, 1) ' set back to apply for all
stopMacro
End Sub
Sub CalcMultShiftsSeqRef()
Rem Calculates multiple images from image stack in selected areas AOI1, AOI2, ...
Dim n As Integer
Dim tmp As Integer
Dim refimage As Integer
Dim i As Integer
Dim ab As Integer
Dim Iname As String * 255
Dim s As String
Dim t As String *255
Dim ext As String
Dim r As RECT
Dim deltax As Integer
Dim deltay As Integer
Dim resultt As String
Dim anz As Integer
Dim Image As Integer
startMacro("CalcMultShifts")
message ="Select Sequence uses active AOI"
Image = selectImage(message)
If Image <0 Then
Exit Sub
End If
ret = IpAoiManager(AOIADD,"RAOI")
IpSeqGet (SEQ_NUMFRAMES, anz)
IpSeqSet (SEQ_ACTIVEFRAME, 0)
'IpAoiShow(FRAME_NONE)
'IpSeqSet (SEQ_APPLY, 0) ' current frame
'refimage = IpWsDuplicate()
message ="Select Reference image"
refimage = selectImage(message)
If refimage <0 Then
Exit Sub
End If
If refimage < 0 Then
Exit Sub
End If
ret = IpStGetName("Save As",Path,"*.DAT", Iname)
If ret = 0 Then
Exit Sub
End If
t = Iname
i = InStr(1,t,".DAT")
If i = 0 Then t = t + ".DAT"
Open t For Output As #1
'resultt = "0" + Chr(9) + "0" + Chr(9) + "0"
'Print #1, resultt
For i = 0 To (anz-1)
IpAppSelectDoc(Image)
'ret = IpAoiManager(AOISET,"AOI")
IpSeqSet (SEQ_ACTIVEFRAME, i)
IpAoiShow(FRAME_NONE)
IpSeqSet (SEQ_APPLY, 0) ' current frame
tmp = IpWsDuplicate()
ret = FastAutoAlign(refimage, tmp, deltax, deltay, 1)
'ret = FastAutoAlign(refimage, tmp, deltax, deltay, 0)
ret = IpDocClose()
resultt = Str(i) + Chr(9) + Str(deltax) + Chr(9) + Str (deltay)
Print #1, resultt
Next i
Close #1
IpAppSelectDoc(Image)
ret = IpSeqSet(SEQ_APPLY, 1) ' set back to apply for all
stopMacro
End Sub
Sub setIDalpha(ByVal v As Double)
Select Case opID
Case 1
putID1alpha(v)
sleep_f(1)
putID1offset(ID1_linrot_offset(v))
Case 2
putID2alpha(v)
sleep_f(1)
putID2offset(ID2_linrot_offset(v))
Case 3
putID1alpha(v)
sleep_f(1)
putID1offset(ID1_linrot_offset(v))
putID2alpha(v)
sleep_f(1)
putID2offset(ID2_linrot_offset(v))
End Select
End Sub
Function checkVG10() As Integer
Rem check whether VG10 is open, open it when closed
Rem returns 1 when it is closed
Dim statusVG10 As Single
checkVG10=0
statusVG10 = getVG10()
If statusVG10 = 0 Then
checkVG10=1
putVG10(0)
sleep(1)
putVG10(1)
write_logfile(1,"VG10 was closed")
sleep(1)
End If
End Function
Function focus_algo(ByVal startOb As Double, ByVal startSV As Double, ByVal SV As Double) As Double
Rem function for focus change with changing startvoltage
Rem fit from Eletra
Rem focus = startfocus + A * startvoltage^pow
Const y0 As Double = 1650
Const A As Double = 5.9924
Const pow As Double = 0.34653
'focus_algo = startOb + A * SV ^ pow
focus_algo = startOb + A * (SV ^ pow - startSV ^ pow)
End Function
Reference in New Issue View Git Blame Copy Permalink