pshell_config/x11ma
0
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
8aefd82ba7fbea545f132fbbd7315fe6d1bddf32
x11ma/script/test/X11MA_main_macros.ipm.tex.py
gac-x11ma e4d933c4be Eiger fixes
2021-03-12 12:19:10 +01:00

3608 lines
92 KiB
Python
Executable File
Raw Blame History

'Option Explicit
'#uses "X11MA_main_functions.ipm"
'#uses "X11MA_beamline.ipm"
'#uses "X11MA_stuff.ipm"
'#uses "X11MA_special.ipm"
'#uses "X11MA_LEEM.ipm"
'#uses "X11MA_Joerg.ipm"
'#uses "X11MA_LJ.ipm"
'#uses "X11MA_TBT.ipm"
'#uses "X11MA_HMF.ipm"
'#uses "X11MA_laser.ipm"
'#uses "epics.ipm"
'#uses "sls_log.ipm"
'#uses "sls_plot.ipm"
'#uses "sls_focus.ipm"
'#uses "picomotor.ipm"
Rem this is the very first CVS test
Sub Main_Users_Macros
Begin Dialog UserDialog 1530,620,165,260,"Macros",.DialogFunc_Macros ' %GRID:10,7,1,1
PushButton 5,5,150,20,"C&onfiguration",.Pushbutton1
PushButton 5,30,150,20,"&Config Beamline",.Pushbutton2
PushButton 5,55,150,20,"&Beamline",.Pushbutton3
PushButton 5,80,150,20,"&Jobs List",.Pushbutton4
PushButton 5,105,150,20,"&Two Images",.Pushbutton5
PushButton 5,130,150,20,"&Absorption Spectrum",.Pushbutton6
PushButton 5,155,150,20,"&Load Periodic Files",.Pushbutton7
PushButton 5,180,150,20,"&Save Images",.Pushbutton8
PushButton 5,205,150,20,"&Image Operation",.Pushbutton9
CancelButton 30,230,100,21
End Dialog
Dim dlg As UserDialog
ret = Dialog (dlg,1)
End Sub
Function DialogFunc_Macros%(DlgItem$, Action%, SuppValue%)
Select Case Action%
Case 2 ' Value changing or button pressed
DialogFunc_Macros% = True
If DlgItem$ = "Pushbutton1" Then
configuration
ElseIf DlgItem$ = "Pushbutton2" Then
config_beamline
ElseIf DlgItem$ = "Pushbutton3" Then
beamline
ElseIf DlgItem$ = "Pushbutton4" Then
jobs_list
ElseIf DlgItem$ = "Pushbutton5" Then
two_images
ElseIf DlgItem$ = "Pushbutton6" Then
absorption_spectrum
ElseIf DlgItem$ = "Pushbutton7" Then
Load_Periodic_Files
ElseIf DlgItem$ = "Pushbutton8" Then
Saveimage
ElseIf DlgItem$ = "Pushbutton9" Then
Image_Operation
ElseIf DlgItem$ = "Cancel" Then
DialogFunc_Macros% = False
End If
DlgFocus "Pushbutton1"
End Select
End Function
Sub saveimage
Rem save selected image with automatic name
Dim filename As String
Dim image1 As Integer
startMacro("save image")
filename = find_next_file(autopath+"i"+autoname,"tif")
If selectImage_X11MA(filename,image1) Then
ret = IpAppSelectDoc(image1)
ret = IpWsSaveAs(Filename, "TIF")
End If
stopMacro
End Sub
Sub configuration
Rem define path and name and user etc
Dim autopathget As String *255
Dim doneinput As Boolean
'startMacro("Configuration")
addMessage 0,"" ' otherwise program crashes when log window not open
addMessage 0,"start macro "+n
addKeyVal "Status",n+" running"
init_def
'temp for lin rot
'sp_load_linrot
loadX11MA_PEEMconfig
loadX11MA_TIMINGconfig
getbeamline
startMacro("config")
setEnergy=rbkEnergy
Do
Begin Dialog UserDialog 1000,100,540,252 ' %GRID:10,7,1,1
Text 10,7,70,21,"data path",.Text1
TextBox 90,7,350,21,.autopath
PushButton 450,7,80,21,"Browse",.PushButton1
Text 10,70,80,21,"data Name",.Text2
TextBox 90,70,100,21,.autoname
OKButton 160,217,90,21
CancelButton 260,217,90,21
Text 70,35,340,21,"suggestion: H:\X11MA\public\ folder must exist!",.Text4
Text 10,112,80,14,"config path",.Text5
TextBox 90,112,350,21,.configpath
PushButton 450,112,80,21,"Browse",.PushButton2
Text 10,147,70,14,"group",.Text6
TextBox 90,147,230,21,.TextBox1
PushButton 530,245,10,7,enterkey,.PushButton3
PushButton 220,70,180,21,"suggest name (yymmdd)",.PushButton4
PushButton 60,182,120,21,"config beamline",.PushButton5
PushButton 220,182,150,21,"config measurement",.PushButton6
End Dialog
Dim dlg As UserDialog
dlg.autopath=autopath
dlg.autoname=autoname
dlg.configpath = configpath
r=Dialog (dlg,3)
If r=0 Then
addMessage 0,"stop macro"
addKeyVal "Status","Macro done"
stopMacro
Exit Sub
End If
If r=1 Then
IpStGetName("browse",dlg.autopath,"*.*",autopathget)
autopath= Left(autopathget,InStrRev(autopathget,"\"))
doneinput=False
End If
If r=2 Then
IpStGetName("browse",dlg.configpath,"*.*",autopathget)
configpath=Left(autopathget,InStrRev(autopathget,"\"))
doneinput=False
End If
If r=4 Then
autoname=date2name
doneinput=False
End If
If r=5 Then
config_beamline
doneinput=False
End If
If r=6 Then
config_measure
doneinput=False
End If
If r=-1 Then
If FileExists(autopath)=True Then
doneinput=True
Else
doneinput=False
Begin Dialog UserDialog 1000,100,210,98 ' %GRID:10,7,1,1
Text 40,21,170,21,"data path does not exist",.Text1
OKButton 70,49,90,21
End Dialog
Dim dlg1 As UserDialog
Dialog dlg1
End If
If FileExists(configpath)=True Then
doneinput=True
Else
doneinput=False
Begin Dialog UserDialog 1000,100,210,98 ' %GRID:10,7,1,1
Text 40,21,170,21,"config path does not exist",.Text1
OKButton 70,49,90,21
End Dialog
Dim dlg2 As UserDialog
Dialog dlg2
End If
End If
Loop While doneinput =False
autopath=dlg.autopath
autoname=dlg.autoname
configpath=dlg.configpath
saveX11MA_PEEMconfig
addMessage 0,"stop macro"
addKeyVal "Status","Macro done"
stopMacro
End Sub
Sub beamline
Rem displays beamline status and allows to change values
Dim doneinput As Boolean
Dim stest As Integer
getbeamline
startMacro("beamline")
'circular mode
If Pol = 1 Or Pol = 2 Then
Do
Begin Dialog UserDialog 1000,100,560,161,"beamline" ' %GRID:10,7,1,1
Text 20,21,100,21,"Energy",.Text1
Text 20,56,100,21,"Polarisation",.Text2
TextBox 140,21,80,21,.rbkEnergy
TextBox 140,56,80,21,.Polarisation
CancelButton 150,119,90,21
PushButton 260,21,100,21,"set Energy",.PushButton1
PushButton 240,56,150,21,"switch pol",.PushButton2
PushButton 240,84,150,21,"change to linear pol",.PushButton3
PushButton 550,154,10,7,"enterkey",.PushButton4
End Dialog
Dim dlg As UserDialog
dlg.rbkEnergy=Format(rbkenergy,"Standard")
dlg.Polarisation=Polstring(pol)
If jobsrunning=False Then
r=Dialog(dlg,4)
Else
If Jobs(Current_Job,1)="5" Then
r=1
dlg.rbkEnergy = Jobs(Current_Job,2)
ElseIf Jobs(Current_Job,1)="6" Then
r=2
ElseIf Jobs(Current_Job,1)="8" Then
r=3
End If
End If
doneinput= False
If r=0 Then
stopMacro
Exit Sub
End If
If r=-1 Then
doneinput=True
End If
stest=string2double(dlg.rbkenergy,setEnergy)
If stest <> 0 Then
wronginput
doneinput=False
End If
If r=1 And stest = 0 Then
If setEnergy>89.9 And setEnergy<2000 Then
putEnergy(setEnergy)
doneinput=True
Else
wrongvalue
doneinput=False
End If
End If
If r=2 Then
addKeyVal "Status","switch circ pol"
'switchcirc
switchPol_new
doneinput=True
End If
If r=3 Then
addKeyVal "Status","switch to linear"
Select Case opID
Case 1
putPolID1(3)
Case 2
putPolID2(3)
Case 3
putPolID1(3)
putPolID2(3)
End Select
'putlinearMode(0)
'putPol(0)
doneinput=True
End If
If r=4 Then
doneinput=False
End If
Loop While doneinput=False
End If
If Pol = 3 Or Pol = 4 Then
Do
Begin Dialog UserDialog 1000,100,430,161,"beamline" ' %GRID:10,7,1,1
Text 20,21,100,21,"Energy",.Text1
Text 20,56,100,21,"Polarisation",.Text2
TextBox 140,21,80,21,.rbkEnergy
TextBox 140,56,80,21,.Polarisation
CancelButton 150,126,90,21
PushButton 260,21,100,21,"set Energy",.PushButton1
PushButton 240,56,150,21,"switch hor/vert",.PushButton2
PushButton 240,84,150,21,"change to circ",.PushButton3
PushButton 420,161,10,7,"enterkey",.PushButton4
End Dialog
Dim dlg1 As UserDialog
dlg1.rbkEnergy=Format(rbkenergy,"Standard")
dlg1.Polarisation=Polstring(pol)
If jobsrunning=False Then
r=Dialog(dlg1)
Else
If Jobs(Current_Job,1)="5" Then
r=1
dlg.rbkEnergy = Jobs(Current_Job,2)
ElseIf Jobs(Current_Job,1)="6" Then
r=2
ElseIf Jobs(Current_Job,1)="7" Then
r=3
End If
End If
If r=0 Then
stopMacro
Exit Sub
End If
If r=-1 Then
doneinput=True
End If
stest=string2double(dlg1.rbkenergy,setEnergy)
If stest <> 0 Then
wronginput
doneinput=False
End If
If r=1 And stest = 0 Then
If setEnergy>89.9 And setEnergy<2000 Then
putEnergy(setEnergy)
doneinput=True
Else
wrongvalue
doneinput=False
End If
End If
If r=2 Then
addKeyVal "Status","switch linear pol"
'switchlinear
switchPol_new
doneinput=True
End If
If r=3 Then
addKeyVal "Status","switch to circ"
Select Case opID
Case 1
putPolID1(1)
Case 2
putPolID2(1)
Case 3
putPolID1(1)
putPolID2(1)
End Select
doneinput=True
End If
Loop While doneinput = False
End If
If Pol = 5 Then
Do
Begin Dialog UserDialog 1000,100,430,161,"beamline" ' %GRID:10,7,1,1
Text 20,21,100,21,"Energy",.Text1
Text 20,56,100,21,"Polarisation",.Text2
TextBox 140,21,80,21,.rbkEnergy
TextBox 140,56,80,21,.Polarisation
CancelButton 140,126,90,21
PushButton 260,21,100,21,"set Energy",.PushButton1
'PushButton 240,56,150,21,"switch hor/vert",.PushButton2
'PushButton 240,84,150,21,"change to circ",.PushButton3
PushButton 420,161,10,7,"enterkey",.PushButton4
End Dialog
Dim dlg2 As UserDialog
dlg2.rbkEnergy=Format(rbkenergy,"Standard")
dlg2.Polarisation=Polstring(pol)
If jobsrunning=False Then
r=Dialog(dlg2)
Else
r=1
dlg.rbkEnergy = Jobs(Current_Job,2)
End If
If r=0 Then
stopMacro
Exit Sub
End If
If r=-1 Then
doneinput=True
End If
stest=string2double(dlg2.rbkenergy,setEnergy)
If stest <> 0 Then
wronginput
doneinput=False
End If
If r=1 And stest = 0 Then
If setEnergy>89.9 And setEnergy<2000 Then
putEnergy(setEnergy)
doneinput=True
Else
wrongvalue
doneinput=False
End If
End If
'If r=2 Then
' addKeyVal "Status","switch linear pol"
' 'switchlinear
' switchPol_new
' doneinput=True
'End If
'If r=3 Then
' addKeyVal "Status","switch to circ"
' Select Case opID
' Case 1
' putPolID1(1)
' Case 2
' putPolID2(1)
' Case 3
' putPolID1(1)
' putPolID2(1)
' End Select
' doneinput=True
'End If
Loop While doneinput = False
End If
sleep_f(1)
'check if done movement
Do While True
If cancelmacro() = 0 Then Exit Sub
If donemove() = 1 Then
Exit Do
End If
DoEvents
Loop
' Done
Begin Dialog UserDialog 1000,100,130,63,"Done" ' %GRID:10,7,1,1
Text 20,7,90,14,"Done",.Text1
OKButton 10,28,90,21
End Dialog
Dim scanfinished As UserDialog
If jobsrunning=False Then
Dialog scanfinished
End If
stopMacro
End Sub
Sub LEEM2000
Dim doneinput As Boolean
Dim stest As Integer
getLEEM
startMacro("LEEM2000")
Do
Begin Dialog UserDialog 1000,100,400,203 ' %GRID:10,7,1,1
Text 40,35,90,14,"Objective",.Text1
Text 40,63,90,14,"Start Voltage",.Text2
TextBox 140,35,90,21,.objective
TextBox 140,63,90,21,.SV
OKButton 80,119,90,21
CancelButton 190,119,90,21
PushButton 250,35,50,21,"set",.PushButton1
PushButton 250,63,50,21,"set",.PushButton2
PushButton 390,196,10,7,"Enterkey",.PushButton3
TextBox 140,91,90,21,.LEEMtemp
Text 40,91,90,14,"sample temp",.Text3
End Dialog
Dim dlg As UserDialog
dlg.objective=Format(objective,"0.000")
dlg.sv=Format(startvoltage,"0.000")
dlg.LEEMtemp=Format(LEEMtemp,"0.000")
r=Dialog(dlg,3)
If r = 0 Then
Stopmacro
Exit Sub
End If
If r= -1 Then
doneinput=True
End If
If r = 3 Then
doneinput=False
End If
If r= 1 Then
stest=string2double(dlg.objective,objective)
If stest<>0 Then
wronginput
doneinput=False
Else
If objective >1500 And objective <2000 Then
putObjective(objective)
doneinput=False
Else
wrongvalue
doneinput=False
End If
End If
End If
If r= 2 Then
stest=string2double(dlg.sv,startvoltage)
If stest<>0 Then
wronginput
doneinput=False
Else
If startvoltage > -5 And startvoltage <2000 Then
putStartVoltage(startvoltage)
doneinput=False
Else
wrongvalue
doneinput=False
End If
End If
End If
Loop While doneinput=False
stopmacro
End Sub
Sub two_images()
Dim image(3) As Integer
Dim imagetext As String *100
Dim doninput As Boolean
Dim stest1 As Integer
Dim poltmp(2) As Integer
Dim path(3) As String
Dim pathtmp As String
Dim nbimage As Integer
Dim origin_filename As String
Dim file(3) As String
Dim Polstringfolder(5) As String
Polstringfolder(1)="circ_plus"
Polstringfolder(2)="circ_minus"
Polstringfolder(3)="lin_hor"
Polstringfolder(4)="lin_vert"
Polstringfolder(5)="lin_rot"
nbimage = 1
'info on X11MA log window
getbeamline
loadX11MA_PEEMconfig
startMacro("two images")
Do
Begin Dialog UserDialog 1000,100,560,301 ' %GRID:10,7,1,1
Text 150,21,90,14,"first image",.Text1
Text 240,21,90,14,"second image",.Text2
Text 50,42,90,14,"exposure(sec)",.Text3
TextBox 150,42,60,21,.expo1
TextBox 250,42,60,21,.expo2
Text 80,77,60,14,"average",.Text4
TextBox 150,77,60,21,.aver1
TextBox 250,77,60,21,.aver2
TextBox 150,140,70,21,.pol1
TextBox 250,140,70,21,.pol2
TextBox 150,182,70,21,.energy1
TextBox 250,182,70,21,.energy2
PushButton 20,140,110,21,"two pol",.PushButton1
PushButton 20,182,110,21,"two energies",.PushButton2
CancelButton 180,259,90,21
Text 330,133,70,14,"circ+/circ-",.Text7
Text 330,189,60,14,"1/2",.Text8
Text 450,63,90,14,"contrast",.Text9
TextBox 350,63,90,21,.contrast
CheckBox 260,105,100,14,"autosave",.save
Text 330,147,70,14,"vert/hor",.Text10
Text 360,21,90,14,"div",.Text11
PushButton 550,245,10,7,"Enterkey",.PushButton3
CheckBox 370,105,140,14,"as sequence",.seq
TextBox 150,105,50,21,.cycles
Text 10,105,140,14,"No of measurements:",.Text5
PushButton 30,224,90,21,"take image",.PushButton4
Text 140,224,230,14,"with out changing pol or energy",.Text6
End Dialog
Dim dlg As UserDialog
dlg.expo1=Format(autoexpo(1))/1000
dlg.expo2=Format(autoexpo(2))/1000
dlg.aver1=Format(autoaver(1))
dlg.aver2=Format(autoaver(2))
dlg.pol1=Format(Polarisationstring)
dlg.energy1=Format(autoenergy(1))
dlg.energy2=Format(autoenergy(2))
dlg.contrast=Format(autocontrast)
dlg.save=Format(autosave)
dlg.pol1=Polstring(pol)
dlg.pol2=Polstring(nextpol)
dlg.seq=Format(autoseq)
dlg.cycles="1"
'If Polarisation=0 And linearMode = 1 Then dlg.pol2=Format(Polarisationstring="Linear hor") Else dlg.pol2=Format("Linear vert")
'If Polarisation=1 Then dlg.pol2=Format("CIRC -")
'If Polarisation=2 Then dlg.pol2=Format("CIRC +")
If JobsRunning=False Then
r= Dialog (dlg,3)
Else
If Jobs(Current_Job,1)="1" Then
r = 1
dlg.expo1 = Jobs(Current_Job,2)
dlg.expo2 = Jobs(Current_Job,3)
dlg.aver1 = Jobs(Current_Job,4)
dlg.aver2 = Jobs(Current_Job,5)
dlg.pol1 = Jobs(Current_Job,6)
dlg.pol2 = Jobs(Current_Job,7)
dlg.contrast = Jobs(Current_Job,8)
dlg.save = CInt(Jobs(Current_Job,9))
dlg.seq = CInt(Jobs(Current_Job,10))
dlg.cycles = Jobs(Current_Job,11)
ElseIf Jobs(Current_Job,1)="2" Then
r = 2
dlg.expo1 = Jobs(Current_Job,2)
dlg.expo2 = Jobs(Current_Job,3)
dlg.aver1 = Jobs(Current_Job,4)
dlg.aver2 = Jobs(Current_Job,5)
dlg.energy1 = Jobs(Current_Job,6)
dlg.energy2 = Jobs(Current_Job,7)
dlg.contrast = Jobs(Current_Job,8)
dlg.save = CInt(Jobs(Current_Job,9))
dlg.seq = CInt(Jobs(Current_Job,10))
dlg.cycles = Jobs(Current_Job,11)
End If
End If
If r=1 Or r= 2 Or r = 4 Then doneinput=True Else doneinput=False
If r = 0 Then
stopMacro
Exit Sub
End If
autoexpo(1)=CLng(dlg.expo1)*1000
autoexpo(2)=CLng(dlg.expo2)*1000
autoaver(1)=CLng(dlg.aver1)
autoaver(2)=CLng(dlg.aver2)
autosave=CLng(dlg.save)
Rem check whether this ok
If JobsRunning=True Then
autoenergy(1)=CDbl(dlg.energy1)
autoenergy(2)=CDbl(dlg.energy2)
End If
autocontrast=CSng(dlg.contrast)
autoseq=CLng(dlg.seq)
cycles=CDbl(dlg.cycles)
stest=0
stest=string2double(dlg.energy1,autoenergy(1))
stest=stest+string2double(dlg.energy2,autoenergy(2))
If r=2 Then
If stest <> 0 Then
wronginput
doneinput=False
End If
If stest = 0 Then
If setEnergy>89.9 And setEnergy<2000 Then
doneinput=True
Else
wrongvalue
doneinput=False
End If
End If
End If
Loop While doneinput=False
saveX11MA_PEEMconfig
origin_filename = find_next_file(autopath+"i"+autoname,"tif")
For Rounds=1 To cycles
If cycles<>1 Then
write_logfile(0,"")
write_logfile(0,"nround = "+Format(Rounds)+" / "+Format(cycles))
End If
setEnergy=autoenergy(1)
If r =2 Then putEnergy(setEnergy)
sleep_f(1)
Do While True
If cancelmacro() = 0 Then Exit Sub
If donemove() = 1 Then Exit Do
DoEvents
Loop
For i = 1 To 2
getbeamline
getLEEM
Rem check status of machine
If checkRing = 3 Then
Close
Exit Sub
End If
Rem check status of the beamline
If checkbeamline = 3 Then
Close
Exit Sub
End If
setEnergy=rbkEnergy
If autoseq = 1 Then
Rem how to record a sequence, needs to be correct implemented
Rem set to Image as sequence
'ret = IpAcqControl(818, -4, IPNULL)
Rem set exposure time
'ipDVal = 1000.000000
'ret = IpAcqControl(84, 1, ipDVal)
'ret = IpAcqControl(803, 0, IPNULL)
Rem set delay between images and than measure as seq
'ret = IpAcqTimed("", "", 0, 20, 2)
'ret = IpAcqControl(803, 0, IPNULL)
Rem seq with minimal time
'ret = IpAcqMultiSnap(0, 10, ACQ_SEQUENCE)
Rem new version
If autoaver(i)=1 Then
IpAcqControl(803,0,IPNULL)
IpAcqControl(820,0,IPNULL)
IpAcqControl(825,0,IPNULL)
Else
IpAcqControl(803,1,IPNULL)
IpAcqControl(804,autoaver(i),IPNULL)
IpAcqControl(805,autoaver(i),IPNULL)
End If
IpAcqControl(49,1,autoexpo(i))
ret = IpAcqMultiSnap(0, cycles, ACQ_SEQUENCE)
ret = IpDocGet(GETACTDOC, 0, image(i))
imageinfo("I")
Rounds=cycles
Rem set back to New image
IpAcqSnap(ACQ_NEW)
Rem old version
'IpAcqControl(803,0,IPNULL)
'IpAcqControl(820,0,IPNULL)
'IpAcqControl(825,0,IPNULL)
'IpAcqControl(49,1,autoexpo(i))
'IpAcqSnap(ACQ_NEW)
'ret = IpDocGet(GETACTDOC, 0, image(i))
'imageinfo("I")
Rem apply to whole sequenz
'ret = IpSeqSet(SEQ_APPLY, 1)
'For n=2 To autoaver(i)
' IpAcqSnap(ACQ_SEQUENCE_APPEND)
'Next n
Else
If autoaver(i)=1 Then
IpAcqControl(803,0,IPNULL)
IpAcqControl(820,0,IPNULL)
IpAcqControl(825,0,IPNULL)
Else
IpAcqControl(803,1,IPNULL)
IpAcqControl(804,autoaver(i),IPNULL)
IpAcqControl(805,autoaver(i),IPNULL)
End If
IpAcqControl(49,1,autoexpo(i))
IpAcqSnap(ACQ_NEW)
ret = IpDocGet(GETACTDOC, 0, image(i))
If r=1 Then
poltmp(i) = pol
ElseIf r=2 Then
poltmp(i) = autoenergy(i)
End If
imageinfo("I")
End If
If r=4 Then i = 2
If i=1 Then
If r = 1 Then switchPol_new 'switchcirc
'If r = 1 And Polarisation=0 Then switchlinear
'sleep(45)'temp fix!!!!!!!!!!!!!!!!!!!!!!!
setEnergy=autoenergy(2)
If r =2 Then putEnergy(setEnergy)
sleep_f(1)
End If
Do While True
If cancelmacro() = 0 Then Exit Sub
If donemove() = 1 Then Exit Do
DoEvents
Loop
sleep_f(1)
Next i
' Creates the names of the folder
filename = Left ( origin_filename, InStrRev(origin_filename,"_") )
ttt = Right ( origin_filename, Len(origin_filename) - InStrRev(origin_filename,"\") )
ttt2 = Right ( ttt, Len(ttt) - InStrRev(ttt,"_") )
ttt3 = Left ( ttt2, 3)
nb = CInt( ttt3 )
If r=1 Then
If pol=2 Or pol=3 Then
path(1) = filename + Format(nb,"000") + "\"
path(2) = filename + Format(nb+1,"000") + "\"
file(1) = Right( filename, Len(filename)-InStrRev(filename,"\") ) + Format(nb,"000") + ".tif"
file(2) = Right( filename, Len(filename)-InStrRev(filename,"\") ) + Format(nb+1,"000") + ".tif"
Else
path(2) = filename + Format(nb,"000") + "\"
path(1) = filename + Format(nb+1,"000") + "\"
file(2) = Right( filename, Len(filename)-InStrRev(filename,"\") ) + Format(nb,"000") + ".tif"
file(1) = Right( filename, Len(filename)-InStrRev(filename,"\") ) + Format(nb+1,"000") + ".tif"
End If
ElseIf r=2 Then
path(1) = filename + Format(nb,"000") + "\"
path(2) = filename + Format(nb+1,"000") + "\"
file(1) = Right( filename, Len(filename)-InStrRev(filename,"\") ) + Format(nb,"000") + ".tif"
file(2) = Right( filename, Len(filename)-InStrRev(filename,"\") ) + Format(nb+1,"000") + ".tif"
ElseIf r=4 Then
path(1) = filename + Format(nb,"000") + "\"
file(1) = Right( filename, Len(filename)-InStrRev(filename,"\") ) + Format(nb,"000") + ".tif"
End If
If r=1 Or r=2 Then
path(3) = filename + Format(nb+2,"000") + "\"
file(3) = Right( filename, Len(filename)-InStrRev(filename,"\") ) + Format(nb+2,"000") + ".tif"
'Creates the folders
If (cycles<>1 And Rounds=1) Or autoseq = 1 Then
MkDir( path(1) )
MkDir( path(2) )
MkDir( path(3) )
End If
Else
' Creates the folders
If (cycles<>1 And Rounds=1) Or autoseq = 1 Then
MkDir( path(1) )
End If
End If
If r= 1 Then
If pol=2 Or pol=3 Then
ret=Divide2Images(image(1),image(2),0,autocontrast,False)
Else
ret=Divide2Images(image(2),image(1),0,autocontrast,False)
End If
ret = IpDocGet(GETACTDOC, 0, image(3))
IpWsChangeDescription(INF_TITLE,"div")
End If
If r= 2 Then
ret=Divide2Images(image(1),image(2),0,autocontrast,False)
ret = IpDocGet(GETACTDOC, 0, image(3))
IpWsChangeDescription(INF_TITLE,"div")
End If
If dlg.save=1 Then
If r = 4 Then
filename = find_next_file(autopath+"i"+autoname,"tif")
If ( Rounds=1 And cycles<>1 ) Then
ret = IpAppSelectDoc(image(1))
ret = IpWsSaveAs(Filename, "TIF")
End If
If cycles <>1 Then
filename = path(1) + Left( file(1), Len(file(1))-4) + "#" + Format(nbimage,"000") + ".tif"
End If
ret = IpAppSelectDoc(image(1))
ret = IpWsSaveAs(Filename, "TIF")
write_logfile(0,filename+" "+imagetext)
write_logfile(0,"SV:"+Format(startvoltage,"0.000")+" OB:"+Format(objective,"0.00")+" ST:"+Format(LEEMtemp,"0.0"))
nbimage = nbimage +1
Else
For i = 1 To 3
filename = find_next_file(autopath + "i" + autoname, "tif")
If ( Rounds=1 And cycles<>1 ) Then
ret = IpAppSelectDoc(image(i))
ret = IpWsSaveAs(Filename, "TIF")
End If
If cycles <>1 Then
filename = path(i) + Left( file(i), Len(file(i))-4) + "#" + Format(nbimage,"000") + ".tif"
End If
ret = IpAppSelectDoc(image(i))
ret = IpWsSaveAs(Filename, "TIF")
ret = IpDocGetStr(INF_TITLE,DOCSEL_ACTIVE,imagetext)
write_logfile(0,filename+" "+imagetext)
nbimage = nbimage +1
Next i
End If
'"SV:"+Format(startvoltage,"0.000")+" OB:"+Format(objective,"0.00")
Else
objective = getObjective()
temp = getLEEMtemp()
write_logfile(0 , "Temp : " + Format(temp,"0.00") + " OB : " + Format(objective,"0.00") + " StigmaA : " + " StigmaB : " )
End If
If cycles <>1 Then
If r=1 Or r=2 Then
IpDocCloseEx(image(1))
IpDocCloseEx(image(2))
IpDocCloseEx(image(3))
Else
IpDocCloseEx(image(1))
End If
End If
Next rounds
'Auto average and save
If ( cycles<>1 And dlg.save=1 And r <> 4) Then
image(1) = Open_All_Images_In_Folder( path(1) )
IpAppSelectDoc( image(1) )
pathtmp = Left ( path(1) , Len( path(1) )- 1 ) + ".tif"
IpWsSaveAs(pathtmp,"tif")
image(2) = Open_All_Images_In_Folder( path(2) )
IpAppSelectDoc( image(2) )
pathtmp = Left ( path(2) , Len( path(2) )- 1 ) + ".tif"
IpWsSaveAs(pathtmp,"tif")
image(3) = Open_All_Images_In_Folder( path(3) )
IpAppSelectDoc( image(3) )
pathtmp = Left ( path(3) , Len( path(3) )- 1 ) + ".tif"
IpWsSaveAs(pathtmp,"tif")
End If
If ( cycles<>1 And dlg.save=1 And r = 4) Then
image(1) = Open_All_Images_In_Folder( path(1) )
IpAppSelectDoc( image(1) )
pathtmp = Left ( path(1) , Len( path(1) )- 1 ) + ".tif"
IpWsSaveAs(pathtmp,"tif")
End If
IpAcqControl(803,0,IPNULL)
IpAcqControl(820,0,IPNULL)
IpAcqControl(825,0,IPNULL)
stopMacro
End Sub
Sub absorption_spectrum()
Dim fv(10) As Double
Dim Keithley(3) As Double
Dim Analog(4) As Double
Dim mystats(10) As Single
Dim win(10) As Variant
Dim estep(10) As Double
Dim energy(10) As Double
Dim region As Integer
Dim messagetext As String
Dim stackimages As String
Dim stackfolder As String
Dim logfilepath As String
Dim imageno As Integer
Dim Doneinput As Boolean
i=1
n=0
'info on X11MA log window
getbeamline
startMacro("Stack")
loadX11MA_PEEMconfig
Do
'get user input
Begin Dialog UserDialog 1000,100,710,266,"absorption spectrum" ' %GRID:10,7,1,1
Text 130,35,90,14,"Save spectrum",.Text1
Text 130,70,90,14,"Save images",.Text2
PushButton 700,140,10,7,"Enterkey",.PushButton1
OKButton 530,147,90,21
CancelButton 430,147,90,21
Text 240,35,60,14,"path+name",.Text4
TextBox 330,35,360,21,.path
CheckBox 20,35,90,14,"savespectrum",.savespectrum
CheckBox 20,70,90,14,"saveimages",.saveimages
Text 230,63,90,14,"log message",.Text3
Text 50,7,310,14,"create: ""Zone1"","" Zone2"","" Zone3"" AOI ",.Text5
Text 40,84,110,14,"create ""Save"" AOI",.Text6
CheckBox 20,112,110,14,"with Io",.Izero
TextBox 330,63,360,21,.logmessage
Text 20,140,100,14,"exposure time",.Text7
TextBox 120,140,90,21,.expo1
Text 30,175,90,14,"average",.Text8
TextBox 120,175,90,21,.aver1
Text 20,210,90,14,"No of scans",.Text9
TextBox 120,210,90,21,.cycles
CheckBox 240,210,170,14,"switch pol after scan",.spae
End Dialog
Dim scaninfo As UserDialog
scaninfo.path=find_next_file(autopath+"s"+autoname,"dat")
scaninfo.expo1=Format(autoexpo(1))/1000
scaninfo.aver1=Format(autoaver(1))
scaninfo.cycles="1"
If Jobsrunning=False Then
r=Dialog(scaninfo)
Else
scaninfo.savespectrum = CInt(Jobs(Current_job,2))
scaninfo.saveimages = CInt(Jobs(Current_job,3))
scaninfo.Izero = CInt(Jobs(Current_job,4))
scaninfo.expo1 = Jobs(Current_job,5)
scaninfo.aver1 = Jobs(Current_job,6)
scaninfo.cycles = Jobs(Current_job,7)
scaninfo.spae = CInt(Jobs(Current_job,8))
scaninfo.path = find_next_file(autopath+"s"+autoname,"dat")
energym(1) = CDbl(Jobs(Current_job,9))
energym(2) = CDbl(Jobs(Current_job,10))
energym(3) = CDbl(Jobs(Current_job,11))
energym(4) = CDbl(Jobs(Current_job,12))
energym(5) = CDbl(Jobs(Current_job,13))
energym(6) = CDbl(Jobs(Current_job,14))
energym(7) = CDbl(Jobs(Current_job,15))
energym(8) = CDbl(Jobs(Current_job,16))
energym(9) = CDbl(Jobs(Current_job,17))
energym(10) = CDbl(Jobs(Current_job,18))
estepm(1) = CDbl(Jobs(Current_job,19))
estepm(2) = CDbl(Jobs(Current_job,20))
estepm(3) = CDbl(Jobs(Current_job,21))
estepm(4) = CDbl(Jobs(Current_job,22))
estepm(5) = CDbl(Jobs(Current_job,23))
estepm(6) = CDbl(Jobs(Current_job,24))
estepm(7) = CDbl(Jobs(Current_job,25))
estepm(8) = CDbl(Jobs(Current_job,26))
estepm(9) = CDbl(Jobs(Current_job,27))
estepmCheck(1) = CInt(Jobs(Current_job,28))
estepmCheck(2) = CInt(Jobs(Current_job,29))
estepmCheck(3) = CInt(Jobs(Current_job,30))
estepmCheck(4) = CInt(Jobs(Current_job,31))
estepmCheck(5) = CInt(Jobs(Current_job,32))
estepmCheck(6) = CInt(Jobs(Current_job,33))
estepmCheck(7) = CInt(Jobs(Current_job,34))
estepmCheck(8) = CInt(Jobs(Current_job,35))
estepmCheck(9) = CInt(Jobs(Current_job,36))
r=-1
End If
If r = 0 Then
'info on X11MA log window
stopMacro
Exit Sub
End If
If r=-1 Then doneinput=True
autoexpo(1)=CLng(scaninfo.expo1)*1000
autoaver(1)=CLng(scaninfo.aver1)
autoexpo(2)=CLng(scaninfo.expo1)*1000
autoaver(2)=CLng(scaninfo.aver1)
cycles=CDbl(scaninfo.cycles)
stackfilepath=scaninfo.path
'when images are saved, spectrum needs to be saved otherwise trouble with naming
If scaninfo.saveimages Then scaninfo.savespectrum =1
' check whether file exist already
If scaninfo.saveimages = 1 And FileExists(stackfilepath) = True Then
Begin Dialog UserDialog 140,70 ' %GRID:10,7,1,1
Text 20,14,90,14,"filename exist",.Text1
OKButton 20,35,90,21
End Dialog
Dim scanerror1 As UserDialog
Dialog scanerror1
Doneinput=False
'stopMacro
'Exit Sub
End If
If scaninfo.savespectrum = 1 And FileExists(stackfilepath) = True Then
Begin Dialog UserDialog 140,70 ' %GRID:10,7,1,1
Text 20,14,90,14,"filename exist",.Text1
OKButton 20,35,90,21
End Dialog
Dim scanerror2 As UserDialog
Dialog scanerror2
doneinput=False
'info on X11MA log window
'stopMacro
'Exit Sub
End If
Loop While doneinput=False
saveX11MA_PEEMconfig
If Jobsrunning=False Then
If definescan(89.9,1800) = False Then
If scaninfo.savespectrum=1 Then Close
stopMacro
Exit Sub
End If
End If
'creat scan settings
noregion=0
For i = 1 To 9
If estepmCheck(i) = 1 Then
noregion=noregion+1
energy(noregion)=energym(noregion)
estep(noregion)=estepm(noregion)
energy(noregion+1)=energym(noregion+1)
End If
Next i
For Rounds=1 To cycles
write_logfile(0,"")
write_logfile(0,"nround = "+Format(Rounds))
stackfilepath=find_next_file(autopath+"s"+autoname,"dat")
'message on log
write_logfile(0,"")
messagetextstep="steps : "
For i = 1 To noregion
messagetextstep=messagetextstep+" "+Format(estep(i))
Next i
write_logfile(0,messagetextstep)
messagetextenergy ="Energies: "+Format(energy(1))+" "
For i = 1 To noregion
messagetextenergy=messagetextenergy+Format(energy(i+1))+" "
Next i
write_logfile(0,messagetextenergy)
write_logfile(0,"Polarisation : "+Polstring(pol)+" "+linrotstring)
If scaninfo.savespectrum = 1 Then
write_logfile(0,"filename: "+Format(stackfilepath))
Else
write_logfile(0,"spectrum not saved")
End If
addKeyVal "status","stack"
' get the beamline status
getbeamline
getLEEM
Rem check status of machine
If checkRing = 3 Then
Close
Exit Sub
End If
Rem check status of the beamline
If checkbeamline = 3 Then
Close
Exit Sub
End If
'write header of data file
If scaninfo.savespectrum = 1 Then
Open stackfilepath For Output As #1
Print #1, "Energy rbkenergy Io zone1 zone2 zone3 zone4 zone5"
End If
Rem make dir for saved images
If scaninfo.saveimages = 1 Then
ls=Len(stackfilepath)
stackfolder=Left$(stackfilepath,ls-4)
MkDir (stackfolder)
ls=Len(stackfolder)
ps=InStrRev(stackfolder,"\")
stackimages=stackfolder+Right$(stackfolder,ls-ps+1)
End If
Rem logfile for stack
If scaninfo.savespectrum = 1 Then
logfilepath=find_next_file(autopath+"l"+autoname,"log")
Open logfilepath For Output As #2
Print #2, scaninfo.logmessage
Print #2,"filename: "+Format(stackfilepath)
Print #2, messagetextenergy
Print #2, messagetextstep
If scaninfo.saveimages = 1 Then
Print #2, "images saved in "+stackfolder
Else
Print #2, "images not saved"
End If
If scaninfo.Izero = 1 Then
Print #2, "with Izero"
Else
Print #2, "without Io"
End If
Print #2, "Polarisation : "+Polstring(pol)+" "+linrotstring
Print #2, "SV:"+Format(startvoltage,"0.000")+" OB:"+Format(objective,"0.00")+" ST:"+Format(LEEMtemp,"0.0")
Print #2, "start at: "+Format(Time)
End If
'creat plot
Dim title As String
If scaninfo.savespectrum = 1 Then
title=stackfilepath
Else
title="spectrum not saved"
End If
win(0)=createPlot(title)
setLabel win(0),0,"Zone1"
setLabel win(0),1,"Zone2"
setLabel win(0),2,"Zone3"
setLabel win(0),3,"Zone4"
setLabel win(0),4,"Zone5"
If scaninfo.Izero = 1 Then
title="Izero"
win(1)=createPlot(title)
setLabel win(1),0,"Izero"
End If
'start scan
'CCD settings
'swith off accumulate
'IpAcqControl(803,0,IPNULL)
'IpAcqControl(820,0,IPNULL)
'IpAcqControl(825,0,IPNULL)
If autoaver(1)=1 Then
IpAcqControl(803,0,IPNULL)
IpAcqControl(820,0,IPNULL)
IpAcqControl(825,0,IPNULL)
Else
IpAcqControl(803,1,IPNULL)
IpAcqControl(804,autoaver(1),IPNULL)
IpAcqControl(805,autoaver(1),IPNULL)
End If
IpAcqControl(49,1,autoexpo(1))
'save settings
'ret=IpAcqSettings("c:\IPWIN4\configs\new.vpf", 1)
'set ID1 motors "on"
'putID1motors(1)
sleep_f(1)
setEnergy=energy(1)
'curstep=0
imageno = 1
region=1
Do While True
Do While True
'set energy
putEnergy(setEnergy)
'sleep_f(1)
'write on log
addKeyVal "status","Stack set energy"
'check if done movement
Do While True
If cancelmacro() = 0 Then
If scaninfo.savespectrum = 1 Then
getLEEM
Print#2, "spectrum canceld at "+Format(setEnergy)
Print #2, "SV:"+Format(startvoltage,"0.000")+" OB:"+Format(objective,"0.00")+" ST:"+Format(LEEMtemp,"0.0")
write_logfile(0,"spectrum canceld at "+Format(setEnergy))
Close
End If
Exit Sub
End If
If donemove() = 1 Then
'IpAcqSettings("c:\IPWIN4\X11MAconfig\new.vpf", 0)
Exit Do
End If
DoEvents
Loop
'get readback energy and update log window
getbeamline
Rem check status of machine
If checkRing = 3 Then
Close
Exit Sub
End If
Rem check status of the beamline
If checkbeamline = 3 Then
Close
Exit Sub
End If
updatelog
'write on log
addKeyVal "status","Stack take image"
'trigger Keithley1
'If scaninfo.Izero = 1 Then Keithley_trigger(0)
' Get an image from CCD
ipacqsnap(ACQ_CURRENT)
'check whether Keithley done
'If scaninfo.Izero = 1 Then
' Do While True
' If cancelmacro() = 0 Then
' If scaninfo.savespectrum = 1 Then Close
' 'set ID1 motors "Auto"
' 'putID1motors(2)
' Exit Sub
' End If
' If keithley_done() = 1 Then
' Exit Do
' End If
' DoEvents
' Loop
'End If
'read keithley1
If scaninfo.Izero = 1 Then
keithley_read(0,keithley(1),keithley(2),keithley(3))
addValue win(1),0,setEnergy,keithley(1)
updateGraph win(1)
End If
' save image
If scaninfo.saveimages = 1 Then
'which part of image is saved
ret = IpAoiManager(AOISET, "Save")
' If ret = -2 Then no AOI called Save exist take whole image
'new number
Filename=ExpandName(stackimages+"#", imageno, "")
imageinfo("E")
'save image
ret=IpWsSaveAs(Filename, "TIF")
imageno = imageno + 1
End If
' Loop for predefined Area Of Interest (AOI)
For j=1 To 5
' Set the active AOI as ZoneX
ret = IpAoiManager(AOISET, "Zone"+Format(j))
' Get statistics about this AOI
ret = IpHstGet(GETSTATS, 0, mystats(0))
' Store the data in the array
fv(j)=mystats(0)
' Plot the data
addValue win(0),j-1,setEnergy,fv(j)
Next j
'update graph
updateGraph win(0)
'save spectrum
If scaninfo.savespectrum = 1 Then
Print#1, setEnergy;" ";rbkenergy;" ";keithley(1);" ";fv(1);" ";fv(2);" ";fv(3);" ";fv(4);" ";fv(5)
End If
'next energy
setEnergy=setEnergy+estep(region)
If setEnergy >= energy(region+1) Then
Exit Do
End If
Loop
'next region
region=region+1
If region>noregion Then
Exit Do
End If
Loop
getbeamline
getLEEM
If scaninfo.savespectrum = 1 Then
Print #2, "spectrum finished at: "+Format(Time)
Print #2, "SV:"+Format(startvoltage,"0.000")+" OB:"+Format(objective,"0.00")+" ST:"+Format(LEEMtemp,"0.0")
Close
End If
If scaninfo.spae = 1 Then switchpol_new
sleep(3)
Next rounds
'CCD settings
'load settings
'ret=IpAcqSettings("c:\IPWIN4\X11MAconfigs\new.vpf", 0)
'IpAcqSettings("c:\IPWIN4\configs\new.vpf", 1)
'set to "New image" so far the only way I found
'takes new image and close it
IpAcqSnap(ACQ_NEW)
IpDocClose()
'set ID1 motors "Auto"
'putID1motors(2)
If Jobsrunning=False Then
' scan finished
Begin Dialog UserDialog 10,10,130,63,"Scan finished" ' %GRID:10,7,1,1
Text 20,7,90,14,"Scan finished",.Text1
OKButton 10,28,90,21
End Dialog
Dim scanfinished As UserDialog
Dialog scanfinished
End If
'info on X11MA log window
stopMacro
End Sub
Sub absorption_spectrum_OTF()
Rem combine on the fly and PEEM measurement
Rem first try 23.12.2012
Dim fv(10) As Double
Dim Keithley(3) As Double
Dim Analog(4) As Double
Dim mystats(10) As Single
Dim win(10) As Variant
Dim estep(10) As Double
Dim energy(10) As Double
Dim region As Integer
Dim messagetext As String
Dim stackimages As String
Dim stackfolder As String
Dim logfilepath As String
Dim imageno As Integer
Dim Doneinput As Boolean
' for otf
Dim otf_start As Double
Dim otf_end As Double
Dim otf_time As Double
Dim otf_expo As Double
Dim otf_num As Integer
Dim image(3) As Integer
i=1
n=0
'info on X11MA log window
getbeamline
startMacro("OTF measurement")
loadX11MA_PEEMconfig
Do
'get user input
Begin Dialog UserDialog 1000,100,710,266,"absorption spectrum" ' %GRID:10,7,1,1
Text 130,35,90,14,"Save spectrum",.Text1
Text 130,70,90,14,"Save images",.Text2
PushButton 700,140,10,7,"Enterkey",.PushButton1
OKButton 530,147,90,21
CancelButton 430,147,90,21
Text 240,35,60,14,"path+name",.Text4
TextBox 330,35,360,21,.path
CheckBox 20,70,90,14,"saveimages",.saveimages
Text 230,63,90,14,"log message",.Text3
Text 40,84,110,14,"create ""Save"" AOI",.Text6
TextBox 330,63,360,21,.logmessage
Text 20,140,100,14,"exposure time",.Text7
TextBox 120,140,90,21,.expo1
Text 30,175,90,14,"average",.Text8
TextBox 120,175,90,21,.aver1
Text 20,210,90,14,"No of scans",.Text9
TextBox 120,210,90,21,.cycles
CheckBox 240,210,170,14,"switch pol after scan",.spae
Text 220,140,90,14,"in msec!",.Text10
Text 30,7,390,14,"""OTF entough distr"" must be running on beamline PC ",.Text5
CheckBox 20,105,260,14,"Display image during otf (cost time)",.display
End Dialog
Dim scaninfo As UserDialog
scaninfo.path=find_next_file(autopath+"s"+autoname,"dat")
scaninfo.expo1=Format(autoexpo(1)) 'for otf it is in msec
scaninfo.aver1=Format(autoaver(1))
scaninfo.cycles="1"
If Jobsrunning=False Then
r=Dialog(scaninfo)
Else
'scaninfo.savespectrum = CInt(Jobs(Current_job,2))
scaninfo.saveimages = CInt(Jobs(Current_job,3))
'scaninfo.Izero = CInt(Jobs(Current_job,4))
scaninfo.expo1 = Jobs(Current_job,5)
scaninfo.aver1 = Jobs(Current_job,6)
scaninfo.cycles = Jobs(Current_job,7)
scaninfo.spae = CInt(Jobs(Current_job,8))
scaninfo.path = find_next_file(autopath+"s"+autoname,"dat")
energym(1) = CDbl(Jobs(Current_job,9))
energym(2) = CDbl(Jobs(Current_job,10))
energym(3) = CDbl(Jobs(Current_job,11))
energym(4) = CDbl(Jobs(Current_job,12))
energym(5) = CDbl(Jobs(Current_job,13))
energym(6) = CDbl(Jobs(Current_job,14))
energym(7) = CDbl(Jobs(Current_job,15))
energym(8) = CDbl(Jobs(Current_job,16))
energym(9) = CDbl(Jobs(Current_job,17))
energym(10) = CDbl(Jobs(Current_job,18))
estepm(1) = CDbl(Jobs(Current_job,19))
estepm(2) = CDbl(Jobs(Current_job,20))
estepm(3) = CDbl(Jobs(Current_job,21))
estepm(4) = CDbl(Jobs(Current_job,22))
estepm(5) = CDbl(Jobs(Current_job,23))
estepm(6) = CDbl(Jobs(Current_job,24))
estepm(7) = CDbl(Jobs(Current_job,25))
estepm(8) = CDbl(Jobs(Current_job,26))
estepm(9) = CDbl(Jobs(Current_job,27))
estepmCheck(1) = CInt(Jobs(Current_job,28))
estepmCheck(2) = CInt(Jobs(Current_job,29))
estepmCheck(3) = CInt(Jobs(Current_job,30))
estepmCheck(4) = CInt(Jobs(Current_job,31))
estepmCheck(5) = CInt(Jobs(Current_job,32))
estepmCheck(6) = CInt(Jobs(Current_job,33))
estepmCheck(7) = CInt(Jobs(Current_job,34))
estepmCheck(8) = CInt(Jobs(Current_job,35))
estepmCheck(9) = CInt(Jobs(Current_job,36))
r=-1
End If
If r = 0 Then
'info on X11MA log window
stopMacro
Exit Sub
End If
If r=-1 Then doneinput=True
Rem for otf time is in msec, normaly it is s
autoexpo(1)=CLng(scaninfo.expo1)
autoaver(1)=CLng(scaninfo.aver1)
'autoexpo(2)=CLng(scaninfo.expo1)*1000
'autoaver(2)=CLng(scaninfo.aver1)
cycles=CDbl(scaninfo.cycles)
stackfilepath=scaninfo.path
'when images are saved, spectrum needs to be saved otherwise trouble with naming
'If scaninfo.saveimages Then scaninfo.savespectrum =1
' check whether file exist already
If scaninfo.saveimages = 1 And FileExists(stackfilepath) = True Then
Begin Dialog UserDialog 140,70 ' %GRID:10,7,1,1
Text 20,14,90,14,"filename exist",.Text1
OKButton 20,35,90,21
End Dialog
Dim scanerror1 As UserDialog
Dialog scanerror1
Doneinput=False
'stopMacro
'Exit Sub
End If
'If scaninfo.savespectrum = 1 And FileExists(stackfilepath) = True Then
'Begin Dialog UserDialog 140,70 ' %GRID:10,7,1,1
' Text 20,14,90,14,"filename exist",.Text1
' OKButton 20,35,90,21
' End Dialog
' Dim scanerror2 As UserDialog
' Dialog scanerror2
' doneinput=False
' 'info on X11MA log window
' 'stopMacro
' 'Exit Sub
'End If
Loop While doneinput=False
saveX11MA_PEEMconfig
If Jobsrunning=False Then
If definescan(89.9,1800) = False Then
If scaninfo.saveimages=1 Then Close
stopMacro
Exit Sub
End If
End If
'creat scan settings
noregion=0
For i = 1 To 9
If estepmCheck(i) = 1 Then
noregion=noregion+1
energy(noregion)=energym(noregion)
estep(noregion)=estepm(noregion)
energy(noregion+1)=energym(noregion+1)
End If
Next i
Rem calculate the number of images needed for
otf_num=CLng(estep(1)*1000*60/autoexpo(1))
If otf_num>1000 Then otf_num=1000
For Rounds=1 To cycles
' set energy to start energy and wait until reached
setEnergy=energy(1)
putEnergy(setEnergy)
'write on log
addKeyVal "status","Stack set energy"
'check if done movement
Do While True
If cancelmacro() = 0 Then
If scaninfo.saveimages = 1 Then
getLEEM
Print#2, "spectrum canceld at "+Format(setEnergy)
Print #2, "SV:"+Format(startvoltage,"0.000")+" OB:"+Format(objective,"0.00")+" ST:"+Format(LEEMtemp,"0.0")
write_logfile(0,"spectrum canceld at "+Format(setEnergy))
Close
End If
Exit Sub
End If
If donemove() = 1 Then
'IpAcqSettings("c:\IPWIN4\X11MAconfig\new.vpf", 0)
Exit Do
End If
DoEvents
Loop
Rem convert name to otf names
'OTF_autonum=autonum
OTF_autonum=0
OTF_autoname=CDbl(autoname)
Rem settings to otf application of Juray
For w=1 To 2
putOTF_Estart(energy(1))
putOTF_Eend(energy(2))
putOTF_time(estep(1))
putOTF_autoname(OTF_autoname)
putOTF_autonum(OTF_autonum)
sleep(1)
putOTF_autonum(OTF_autonum)
sleep(1)
Next w
write_logfile(0,"")
write_logfile(0,"nround = "+Format(Rounds))
stackfilepath=find_next_file(autopath+"s"+autoname,"dat")
'message on log
write_logfile(0,"")
messagetextstep="time (minutes): "
For i = 1 To noregion
messagetextstep=messagetextstep+" "+Format(estep(i))
Next i
write_logfile(0,messagetextstep)
messagetextenergy ="Energies: "+Format(energy(1))+" "
For i = 1 To noregion
messagetextenergy=messagetextenergy+Format(energy(i+1))+" "
Next i
write_logfile(0,messagetextenergy)
write_logfile(0,"Polarisation : "+Polstring(pol)+" "+linrotstring)
If scaninfo.saveimages = 1 Then
write_logfile(0,"filename: "+Format(stackfilepath))
Else
write_logfile(0,"spectrum not saved")
End If
write_logfile(0,"OTF scan, Number of images: "+Format(otf_num)+", Exposure (msec):"+Format(autoexpo(1)))
addKeyVal "status","stack"
' get the beamline status
getbeamline
getLEEM
'write header of data file
If scaninfo.saveimages = 1 Then
Open stackfilepath For Output As #1
Print #1, "currently empty file"
End If
Rem make dir for saved images
If scaninfo.saveimages = 1 Then
ls=Len(stackfilepath)
stackfolder=Left$(stackfilepath,ls-4)
MkDir (stackfolder)
ls=Len(stackfolder)
ps=InStrRev(stackfolder,"\")
stackimages=stackfolder+Right$(stackfolder,ls-ps+1)
End If
Rem logfile for stack
If scaninfo.saveimages = 1 Then
logfilepath=find_next_file(autopath+"l"+autoname,"log")
Open logfilepath For Output As #2
Print #2, scaninfo.logmessage
Print #2,"filename: "+Format(stackfilepath)
Print #2, messagetextenergy
Print #2, messagetextstep
If scaninfo.saveimages = 1 Then
Print #2, "images saved in "+stackfolder
Else
Print #2, "images not saved"
End If
'If scaninfo.Izero = 1 Then
' Print #2, "with Izero"
'Else
' Print #2, "without Io"
'End If
Print #2, "Polarisation : "+Polstring(pol)+" "+linrotstring
Print #2, "SV:"+Format(startvoltage,"0.000")+" OB:"+Format(objective,"0.00")+" ST:"+Format(LEEMtemp,"0.0")
Print #2, "OTF scan, Number of images: "+Format(otf_num)+", Exposure (msec):"+Format(autoexpo(1))
Print #2, "start at: "+Format(Time)
End If
'start scan
'CCD settings
'swith off accumulate
'IpAcqControl(803,0,IPNULL)
'IpAcqControl(820,0,IPNULL)
'IpAcqControl(825,0,IPNULL)
If autoaver(1)=1 Then
IpAcqControl(803,0,IPNULL)
IpAcqControl(820,0,IPNULL)
IpAcqControl(825,0,IPNULL)
Else
IpAcqControl(803,1,IPNULL)
IpAcqControl(804,autoaver(1),IPNULL)
IpAcqControl(805,autoaver(1),IPNULL)
End If
IpAcqControl(49,1,autoexpo(1))
' Set CCD to Sequence
ret = IpAcqControl(818, -4, IPNULL)
' set CCD to Display sequence during acquire, but this takes time
' ret = IpAcqControl(806, 1, IPNULL)
' set CCD to not Display the sequence during the acuire
ret = IpAcqControl(806, 0, IPNULL)
If scaninfo.display = 1 Then ret = IpAcqControl(806, 1, IPNULL)
sleep_f(1)
' wait until set energy reached
'write on log
addKeyVal "status","Stack set energy"
'check if done movement
Do While True
If cancelmacro() = 0 Then
If scaninfo.saveimages = 1 Then
getLEEM
Print#2, "spectrum canceld at "+Format(setEnergy)
Print #2, "SV:"+Format(startvoltage,"0.000")+" OB:"+Format(objective,"0.00")+" ST:"+Format(LEEMtemp,"0.0")
write_logfile(0,"spectrum canceld at "+Format(setEnergy))
Close
End If
Exit Sub
End If
If donemove() = 1 Then
'IpAcqSettings("c:\IPWIN4\X11MAconfig\new.vpf", 0)
Exit Do
End If
DoEvents
Loop
'get readback energy and update log window
getbeamline
Rem check status of machine
If checkRing = 3 Then
Close
Exit Sub
End If
Rem check status of the beamline
If checkbeamline = 3 Then
Close
Exit Sub
End If
updatelog
'write on log
addKeyVal "status","OTF PEEM"
' start otf and wait a little
startOTF
sleep(2)
'start movie
ret = IpAcqMultiSnap(0, otf_num, ACQ_SEQUENCE)
'get image id for later saving the right one
ret = IpDocGet(GETACTDOC, 0, image(1))
Rem while otf is running
Do While True
If cancelmacro() = 0 Then
Print#2, "spectrum canceld at "+Format(setEnergy)
write_logfile(0,"spectrum canceld at "+Format(setEnergy))
Exit Sub
End If
Rem stuff
'get readback energy and update log window
'sleep_f(1)
If getOTF_done() = 0 Then
Exit Do
End If
DoEvents
Loop
'curstep=0
imageno = 1
region=1
' save image
If scaninfo.saveimages = 1 Then
' select seq image
ret = IpAppSelectDoc(image(1))
' apply to all images
ret = IpSeqSet(SEQ_APPLY, 1)
'which part of image is saved
ret = IpAoiManager(AOISET, "Save")
' If ret = -2 Then no AOI called Save exist take whole image
'new number
Filename=ExpandName(stackimages+"#", imageno, "")
imageinfo("E")
'save image
ret=IpWsSaveAs(Filename, "TIF")
imageno = imageno + 1
End If
getbeamline
getLEEM
If scaninfo.saveimages = 1 Then
Print #2, "spectrum finished at: "+Format(Time)
Print #2, "SV:"+Format(startvoltage,"0.000")+" OB:"+Format(objective,"0.00")+" ST:"+Format(LEEMtemp,"0.0")
Close
End If
If scaninfo.spae = 1 Then switchpol_new
sleep(3)
Next rounds
'CCD settings
'load settings
'ret=IpAcqSettings("c:\IPWIN4\X11MAconfigs\new.vpf", 0)
'IpAcqSettings("c:\IPWIN4\configs\new.vpf", 1)
'set to "New image" so far the only way I found
'takes new image and close it
'IpAcqSnap(ACQ_NEW)
'IpDocClose()
' set to New image
ret = IpAcqControl(818, -1, IPNULL)
'set ID1 motors "Auto"
'putID1motors(2)
If Jobsrunning=False Then
' scan finished
Begin Dialog UserDialog 10,10,130,63,"Scan finished" ' %GRID:10,7,1,1
Text 20,7,90,14,"Scan finished",.Text1
OKButton 10,28,90,21
End Dialog
Dim scanfinished As UserDialog
Dialog scanfinished
End If
'info on X11MA log window
stopMacro
End Sub
Sub Photoemission_spectrum()
Dim fv(10) As Double
Dim Keithley(3) As Double
Dim Analog(4) As Double
Dim mystats(10) As Single
Dim win(10) As Variant
Dim estep(10) As Double
Dim energy(10) As Double
Dim region As Integer
Dim messagetext As String
Dim stackimages As String
Dim stackfolder As String
Dim logfilepath As String
Dim imageno As Integer
Dim Doneinput As Boolean
Dim startObjective As Double
Dim startstartVoltage As Double
i=1
n=0
'info on X11MA log window
getbeamline
startMacro("Stack")
loadX11MA_PEEMconfig
Do
'get user input
Begin Dialog UserDialog 1000,100,710,266,"photoemission spectrum" ' %GRID:10,7,1,1
Text 130,35,90,14,"Save spectrum",.Text1
Text 130,70,90,14,"Save images",.Text2
PushButton 700,140,10,7,"Enterkey",.PushButton1
OKButton 530,147,90,21
CancelButton 430,147,90,21
Text 240,35,60,14,"path+name",.Text4
TextBox 330,35,360,21,.path
CheckBox 20,35,90,14,"savespectrum",.savespectrum
CheckBox 20,70,90,14,"saveimages",.saveimages
Text 230,63,90,14,"log message",.Text3
Text 50,7,310,14,"create: ""Zone1"","" Zone2"","" Zone3"" AOI ",.Text5
Text 40,84,110,14,"create ""Save"" AOI",.Text6
CheckBox 20,112,110,14,"with Io",.Izero
TextBox 330,63,360,21,.logmessage
Text 20,140,100,14,"exposure time",.Text7
TextBox 120,140,90,21,.expo1
Text 30,175,90,14,"average",.Text8
TextBox 120,175,90,21,.aver1
Text 20,210,90,14,"No of scans",.Text9
TextBox 120,210,90,21,.cycles
CheckBox 240,210,170,14,"switch pol after scan",.spae
CheckBox 130,112,130,14,"use focus algo",.focusalgo
End Dialog
Dim scaninfo As UserDialog
scaninfo.path=find_next_file(autopath+"s"+autoname,"dat")
scaninfo.expo1=Format(autoexpo(1))/1000
scaninfo.aver1=Format(autoaver(1))
scaninfo.cycles="1"
r=Dialog(scaninfo)
If r = 0 Then
'info on X11MA log window
stopMacro
Exit Sub
End If
If r=-1 Then doneinput=True
autoexpo(1)=CLng(scaninfo.expo1)*1000
autoaver(1)=CLng(scaninfo.aver1)
cycles=CDbl(scaninfo.cycles)
stackfilepath=scaninfo.path
'when images are saved, spectrum needs to be saved otherwise trouble with naming
If scaninfo.saveimages Then scaninfo.savespectrum =1
' check whether file exist already
If scaninfo.saveimages = 1 And FileExists(stackfilepath) = True Then
Begin Dialog UserDialog 140,70 ' %GRID:10,7,1,1
Text 20,14,90,14,"filename exist",.Text1
OKButton 20,35,90,21
End Dialog
Dim scanerror1 As UserDialog
Dialog scanerror1
Doneinput=False
'stopMacro
'Exit Sub
End If
If scaninfo.savespectrum = 1 And FileExists(stackfilepath) = True Then
Begin Dialog UserDialog 140,70 ' %GRID:10,7,1,1
Text 20,14,90,14,"filename exist",.Text1
OKButton 20,35,90,21
End Dialog
Dim scanerror2 As UserDialog
Dialog scanerror2
doneinput=False
'info on X11MA log window
'stopMacro
'Exit Sub
End If
Loop While doneinput=False
saveX11MA_PEEMconfig
If definescan(-5,2000) = False Then
If scaninfo.savespectrum=1 Then Close
stopMacro
Exit Sub
End If
'creat scan settings
noregion=0
For i = 1 To 9
If estepmCheck(i) = 1 Then
noregion=noregion+1
energy(noregion)=energym(noregion)
estep(noregion)=estepm(noregion)
energy(noregion+1)=energym(noregion+1)
End If
Next i
'Get the current Objective current And startvoltage value
getLEEM
startObjective=objective
startstartVoltage=startVoltage
For Rounds=1 To cycles
write_logfile(0,"")
write_logfile(0,"nround = "+Format(Rounds))
stackfilepath=find_next_file(autopath+"s"+autoname,"dat")
'message on log
write_logfile(0,"")
messagetextstep="steps : "
For i = 1 To noregion
messagetextstep=messagetextstep+" "+Format(estep(i))
Next i
write_logfile(0,messagetextstep)
messagetextenergy ="StartVoltage: "+Format(energy(1))+" "
For i = 1 To noregion
messagetextenergy=messagetextenergy+Format(energy(i+1))+" "
Next i
write_logfile(0,messagetextenergy)
write_logfile(0,"Polarisation : "+Polstring(pol)+" "+linrotstring)
If scaninfo.savespectrum = 1 Then
write_logfile(0,"filename: "+Format(stackfilepath))
Else
write_logfile(0,"spectrum not saved")
End If
addKeyVal "status","stack"
' get the beamline status
getbeamline
getLEEM
Rem check status of machine
If checkRing = 3 Then
Close
Exit Sub
End If
Rem check status of the beamline
If checkbeamline = 3 Then
Close
Exit Sub
End If
'write header of data file
If scaninfo.savespectrum = 1 Then
Open stackfilepath For Output As #1
Print #1, "SV Objective rbkenergy Io zone1 zone2 zone3 zone4 zone5"
End If
Rem make dir for saved images
If scaninfo.saveimages = 1 Then
ls=Len(stackfilepath)
stackfolder=Left$(stackfilepath,ls-4)
MkDir (stackfolder)
ls=Len(stackfolder)
ps=InStrRev(stackfolder,"\")
stackimages=stackfolder+Right$(stackfolder,ls-ps+1)
End If
Rem logfile for stack
If scaninfo.savespectrum = 1 Then
logfilepath=find_next_file(autopath+"l"+autoname,"log")
Open logfilepath For Output As #2
Print #2, scaninfo.logmessage
Print #2,"filename: "+Format(stackfilepath)
Print #2, messagetextenergy
Print #2, messagetextstep
If scaninfo.saveimages = 1 Then
Print #2, "images saved in "+stackfolder
Else
Print #2, "images not saved"
End If
If scaninfo.Izero = 1 Then
Print #2, "with Izero"
Else
Print #2, "without Io"
End If
Print #2, "Polarisation : "+Polstring(pol)+" "+linrotstring
Print #2, "SV:"+Format(startvoltage,"0.000")+" OB:"+Format(objective,"0.00")+" ST:"+Format(LEEMtemp,"0.0")
Print #2, "start at: "+Format(Time)
End If
'creat plot
Dim title As String
If scaninfo.savespectrum = 1 Then
title=stackfilepath
Else
title="spectrum not saved"
End If
win(0)=createPlot(title)
setLabel win(0),0,"Zone1"
setLabel win(0),1,"Zone2"
setLabel win(0),2,"Zone3"
setLabel win(0),3,"Zone4"
setLabel win(0),4,"Zone5"
If scaninfo.Izero = 1 Then
title="Izero"
win(1)=createPlot(title)
setLabel win(1),0,"Izero"
End If
'start scan
'CCD settings
'swith off accumulate
'IpAcqControl(803,0,IPNULL)
'IpAcqControl(820,0,IPNULL)
'IpAcqControl(825,0,IPNULL)
If autoaver(1)=1 Then
IpAcqControl(803,0,IPNULL)
IpAcqControl(820,0,IPNULL)
IpAcqControl(825,0,IPNULL)
Else
IpAcqControl(803,1,IPNULL)
IpAcqControl(804,autoaver(1),IPNULL)
IpAcqControl(805,autoaver(1),IPNULL)
End If
IpAcqControl(49,1,autoexpo(1))
'save settings
'ret=IpAcqSettings("c:\IPWIN4\configs\new.vpf", 1)
'set ID1 motors "on"
'putID1motors(1)
sleep_f(1)
startVoltage=energy(1)
'curstep=0
imageno = 1
region=1
Do While True
Do While True
'write on log
addKeyVal "status","Stack set SV"
'set SV
putStartVoltage(startvoltage)
sleep_f(1)
If scaninfo.focusalgo = 1 Then
putObjective(focus_algo(startObjective,startStartVoltage,startvoltage))
sleep_f(1)
End If
'sleep_f(1)
'check if done movement
Do While True
If cancelmacro() = 0 Then
If scaninfo.savespectrum = 1 Then
getLEEM
Print#2, "spectrum canceld at "+Format(setEnergy)
Print #2, "SV:"+Format(startvoltage,"0.000")+" OB:"+Format(objective,"0.00")+" ST:"+Format(LEEMtemp,"0.0")
write_logfile(0,"spectrum canceld at "+Format(setEnergy))
Close
End If
Rem Objective and StartVoltage back to its start values
putObjective(startObjective)
putStartVoltage(startStartVoltage)
Exit Sub
End If
Exit Do
'If donemove() = 1 Then
' 'IpAcqSettings("c:\IPWIN4\X11MAconfig\new.vpf", 0)
' Exit Do
'End If
'DoEvents
Loop
'get readback energy and update log window
getbeamline
getLEEM
Rem check status of machine
If checkRing = 3 Then
Close
Exit Sub
End If
Rem check status of the beamline
If checkbeamline = 3 Then
Close
Exit Sub
End If
updatelog
'write on log
addKeyVal "status","Stack take image"
'trigger Keithley1
'If scaninfo.Izero = 1 Then Keithley_trigger(0)
' Get an image from CCD
ipacqsnap(ACQ_CURRENT)
'check whether Keithley done
'If scaninfo.Izero = 1 Then
' Do While True
' If cancelmacro() = 0 Then
' If scaninfo.savespectrum = 1 Then Close
' Rem Objective and StartVoltage back to its start values
' putObjective(startObjective)
' putStartVoltage(startStartVoltage)
' Exit Sub
' End If
' If keithley_done() = 1 Then
' Exit Do
' End If
' DoEvents
' Loop
'End If
'read keithley1
If scaninfo.Izero = 1 Then
keithley_read(0,keithley(1),keithley(2),keithley(3))
addValue win(1),0,startVoltage,keithley(1)
updateGraph win(1)
End If
' save image
If scaninfo.saveimages = 1 Then
'which part of image is saved
ret = IpAoiManager(AOISET, "Save")
'new number
Filename=ExpandName(stackimages+"#", imageno, "")
imageinfo("S")
'save image
ret=IpWsSaveAs(Filename, "TIF")
imageno = imageno + 1
End If
' Loop for predefined Area Of Interest (AOI)
For j=1 To 5
' Set the active AOI as ZoneX
ret = IpAoiManager(AOISET, "Zone"+Format(j))
' Get statistics about this AOI
ret = IpHstGet(GETSTATS, 0, mystats(0))
' Store the data in the array
fv(j)=mystats(0)
' Plot the data
addValue win(0),j-1,startVoltage,fv(j)
Next j
'update graph
updateGraph win(0)
'save spectrum
If scaninfo.savespectrum = 1 Then
Print#1, startVoltage;" ";objective;" ";rbkenergy;" ";keithley(1);" ";fv(1);" ";fv(2);" ";fv(3);" ";fv(4);" ";fv(5)
End If
'next energy
startVoltage=startVoltage+estep(region)
If startVoltage >= energy(region+1) Then
Exit Do
End If
Loop
'next region
region=region+1
If region>noregion Then
Exit Do
End If
Loop
getbeamline
getLEEM
If scaninfo.savespectrum = 1 Then
Print #2, "spectrum finished at: "+Format(Time)
Print #2, "SV:"+Format(startvoltage,"0.000")+" OB:"+Format(objective,"0.00")+" ST:"+Format(LEEMtemp,"0.0")
Close
End If
Rem Objective and StartVoltage back to its start values
putObjective(startObjective)
putStartVoltage(startStartVoltage)
If scaninfo.spae = 1 Then switchpol_new
sleep(3)
Next rounds
'CCD settings
'load settings
'ret=IpAcqSettings("c:\IPWIN4\X11MAconfigs\new.vpf", 0)
'IpAcqSettings("c:\IPWIN4\configs\new.vpf", 1)
'set to "New image" so far the only way I found
'takes new image and close it
IpAcqSnap(ACQ_NEW)
IpDocClose()
'set ID1 motors "Auto"
'putID1motors(2)
' scan finished
Begin Dialog UserDialog 10,10,130,63,"Scan finished" ' %GRID:10,7,1,1
Text 20,7,90,14,"Scan finished",.Text1
OKButton 10,28,90,21
End Dialog
Dim scanfinished As UserDialog
Dialog scanfinished
'info on X11MA log window
stopMacro
End Sub
Sub focus_series()
Dim image(3) As Integer
Dim imagetext As String *100
Dim doninput As Boolean
Dim stest1 As Integer
Dim startObj As Double
Dim endObj As Double
Dim stepObj As Double
Dim setObj As Double
Dim stackimages As String
Dim stackfolder As String
Dim logfilepath As String
Dim imageno As Integer
Dim focusreturn As Long
Dim win(10) As Variant
Dim oldObj As Double
Dim aoirect As RECT
Dim focusleft As Long
Dim focusright As Long
Dim imagetitle As String * 100
Dim imageartist As String * 100
Dim imagedescription As String * 100
Dim focusvalue(2) As Long
Dim focusavg(2) As Long
Dim focusmin(2) As Long
Dim focusmax(2) As Long
Dim focusno As Integer
Dim focustest(2) As Single
Dim focuspar As Long
Dim focuspars(2) As String
Dim optfocus(2) As Double
focuspars(0)="0"
focuspars(1)="1"
focuspars(2)="2"
focusno = 0
focusavg(0)=0
focusavg(1)=0
focusavg(2)=0
focusmin(0)=0
focusmin(1)=0
focusmin(2)=0
focusmax(0)=0
focusmin(1)=0
focusmin(2)=0
'info on X11MA log window
getbeamline
getLEEM
oldObj=objective
ret = IpAoiManager(AOIADD,"RAOI")
focuspar=0
loadX11MA_PEEMconfig
startMacro("focus series")
Do
Begin Dialog UserDialog 1000,100,650,280 ' %GRID:10,7,1,1
Text 150,21,90,14,"first image",.Text1
Text 240,21,90,14,"second image",.Text2
Text 50,42,90,14,"exposure(sec)",.Text3
TextBox 150,42,60,21,.expo1
TextBox 250,42,60,21,.expo2
Text 80,77,60,14,"average",.Text4
TextBox 150,77,60,21,.aver1
TextBox 250,77,60,21,.aver2
TextBox 150,154,70,21,.pol1
TextBox 250,154,70,21,.pol2
TextBox 150,189,70,21,.energy1
TextBox 250,189,70,21,.energy2
PushButton 20,154,110,21,"two pol",.PushButton1
PushButton 20,189,110,21,"two energies",.PushButton2
CancelButton 180,259,90,21
Text 330,154,70,14,"circ+/circ-",.Text7
Text 330,189,60,14,"1/2",.Text8
Text 450,63,90,14,"contrast",.Text9
TextBox 350,63,90,21,.contrast
CheckBox 420,147,100,14,"autosave",.save
Text 330,168,70,14,"vert/hor",.Text10
Text 360,21,90,14,"div",.Text11
PushButton 530,266,10,7,"Enterkey",.PushButton3
CheckBox 420,168,140,14,"as sequence",.seq
PushButton 30,224,90,21,"take image",.PushButton4
Text 140,224,230,14,"with out changing pol or energy",.Text6
TextBox 140,119,90,21,.startObj
TextBox 240,119,90,21,.endObj
TextBox 340,119,90,21,.stepObj
Text 150,105,90,14,"start",.Text12
Text 260,105,90,14,"end",.Text13
Text 350,105,90,14,"step",.Text14
Text 10,119,130,14,"scan Objective",.Text15
Text 410,189,120,14,"currently always",.Text5
Text 410,203,120,14,"autosave and not",.Text16
Text 410,217,90,14,"as sequence",.Text17
ListBox 460,119,90,21,focuspars(),.ListBox1
End Dialog
Dim dlg As UserDialog
dlg.expo1=Format(autoexpo(1))/1000
dlg.expo2=Format(autoexpo(2))/1000
dlg.aver1=Format(autoaver(1))
dlg.aver2=Format(autoaver(2))
dlg.pol1=Format(Polarisationstring)
dlg.energy1=Format(autoenergy(1))
dlg.energy2=Format(autoenergy(2))
dlg.contrast=Format(autocontrast)
dlg.save=Format(autosave)
dlg.pol1=Polstring(pol)
dlg.pol2=Polstring(nextpol)
dlg.seq=Format(autoseq)
dlg.startObj=Format(objective-2)
dlg.endObj=Format(objective+2)
dlg.stepObj=Format(0.5)
dlg.ListBox1 = 0
'If Polarisation=0 And linearMode = 1 Then dlg.pol2=Format(Polarisationstring="Linear hor") Else dlg.pol2=Format("Linear vert")
'If Polarisation=1 Then dlg.pol2=Format("CIRC -")
'If Polarisation=2 Then dlg.pol2=Format("CIRC +")
r= Dialog (dlg,3)
If r=1 Or r= 2 Or r = 4 Then doneinput=True Else doneinput=False
If r = 0 Then
stopMacro
Exit Sub
End If
autoexpo(1)=CLng(dlg.expo1)*1000
autoexpo(2)=CLng(dlg.expo2)*1000
autoaver(1)=CLng(dlg.aver1)
autoaver(2)=CLng(dlg.aver2)
autosave=CLng(dlg.save)
'autoenergy(1)=CDbl(dlg.energy1)
'autoenergy(2)=CDbl(dlg.energy2)
autocontrast=CSng(dlg.contrast)
autoseq=CLng(dlg.seq)
startObj=CDbl(dlg.startObj)
endObj=CDbl(dlg.endObj)
stepObj=CDbl(dlg.stepObj)
stest=string2long(focuspars(dlg.ListBox1),focuspar)
Rem currently only with autosave and not as sequence!
dlg.save= 1
dlg.seq = 0
If startObj<1500 Or startObj>1800 Then
doneinput=False
Else
doneinput=True
End If
If endObj<1500 Or endObj>1800 Then
doneinput=False
Else
doneinput=True
End If
If stepObj<0.001 Or stepObj>50 Then
doneinput=False
Else
doneinput=True
End If
stest=0
stest=string2double(dlg.energy1,autoenergy(1))
stest=stest+string2double(dlg.energy2,autoenergy(2))
If r=2 Then
If stest <> 0 Then
wronginput
doneinput=False
End If
If stest = 0 Then
If setEnergy>89.9 And setEnergy<2000 Then
doneinput=True
Else
wrongvalue
doneinput=False
End If
End If
End If
Loop While doneinput=False
Rem make dir for saved images
If dlg.save=1 Then
stackfilepath=find_next_file(autopath+"f"+autoname,"dat")
Rem for foucus values
Open stackfilepath For Output As #1
Print #1, "Objective FocusValueA FocusValueB FocusValueC"
ls=Len(stackfilepath)
stackfolder=Left$(stackfilepath,ls-4)
MkDir (stackfolder)
ls=Len(stackfolder)
ps=InStrRev(stackfolder,"\")
stackimages=stackfolder+Right$(stackfolder,ls-ps+1)
End If
Dim title As String
If dlg.save=1 Then
title=stackfilepath
Else
title="spectrum not saved"
End If
win(0)=createPlot(title+" a")
setLabel win(0),0,"1"
setLabel win(0),1,"2"
setLabel win(0),2,"3"
win(1)=createPlot(title+" b")
setLabel win(1),0,"Zone1"
win(2)=createPlot(title+" c")
setLabel win(2),0,"Zone1"
saveX11MA_PEEMconfig
imageno = 1
For setObj= startObj To endObj Step StepObj
write_logfile(0,"")
'write_logfile(0,"nround = "+Format(Rounds))
putObjective(setObj)
sleep_f(5)
setEnergy=autoenergy(1)
If r =2 Then putEnergy(setEnergy)
sleep_f(1)
Do While True
If cancelmacro() = 0 Then
Close
Exit Sub
End If
If donemove() = 1 Then Exit Do
DoEvents
Loop
For i = 1 To 2
getbeamline
getLEEM
Rem check status of machine
If checkRing = 3 Then
Close
Exit Sub
End If
Rem check status of the beamline
If checkbeamline = 3 Then
Close
Exit Sub
End If
setEnergy=rbkEnergy
If autoseq = 1 Then
IpAcqControl(803,0,IPNULL)
IpAcqControl(820,0,IPNULL)
IpAcqControl(825,0,IPNULL)
IpAcqControl(49,1,autoexpo(i))
IpAcqSnap(ACQ_NEW)
ret = IpDocGet(GETACTDOC, 0, image(i))
imageinfo("I")
Rem apply to whole sequenz
ret = IpSeqSet(SEQ_APPLY, 1)
For n=2 To autoaver(i)
IpAcqSnap(ACQ_SEQUENCE_APPEND)
Next n
Else
If autoaver(i)=1 Then
IpAcqControl(803,0,IPNULL)
IpAcqControl(820,0,IPNULL)
IpAcqControl(825,0,IPNULL)
Else
IpAcqControl(803,1,IPNULL)
IpAcqControl(804,autoaver(i),IPNULL)
IpAcqControl(805,autoaver(i),IPNULL)
End If
IpAcqControl(49,1,autoexpo(i))
IpAcqSnap(ACQ_NEW)
ret = IpDocGet(GETACTDOC, 0, image(i))
imageinfo("I")
End If
If r=4 Then i = 2
If i=1 Then
If r = 1 Then switchPol_new 'switchcirc
'If r = 1 And Polarisation=0 Then switchlinear
setEnergy=autoenergy(2)
If r =2 Then putEnergy(setEnergy)
sleep_f(1)
End If
Do While True
If cancelmacro() = 0 Then
Close
Exit Sub
End If
If donemove() = 1 Then Exit Do
DoEvents
Loop
sleep_f(1)
Next i
If r= 1 Then
If pol=2 Or pol=3 Then
ret=Divide2Images(image(1),image(2),0,autocontrast,False)
Else
ret=Divide2Images(image(2),image(1),0,autocontrast,False)
End If
ret = IpDocGet(GETACTDOC, 0, image(3))
imageinfo("I")
IpWsChangeDescription(INF_TITLE,"div")
End If
If r= 2 Then
ret=Divide2Images(image(1),image(2),0,autocontrast,False)
ret = IpDocGet(GETACTDOC, 0, image(3))
imageinfo("I")
IpWsChangeDescription(INF_TITLE,"div")
End If
If dlg.save=1 Then
If r= 4 Then
i = 1
Else
i =3
End If
Filename=ExpandName(stackimages+"#", imageno, "")
ret = IpAppSelectDoc(image(i))
ret = IpDocGetStr(INF_TITLE,DOCSEL_ACTIVE,imagetitle)
ret = IpDocGetStr(INF_DESCRIPTION,DOCSEL_ACTIVE,imagedescription)
ret = IpDocGetStr(INF_ARTIST,DOCSEL_ACTIVE,imageartist)
Rem convert to 16 bit
ret = IpWsConvertImage(IMC_GRAY16, CONV_SCALE , 0, 0, 0, 0)
IpWsChangeDescription(INF_TITLE,imagetitle)
IpWsChangeDescription(INF_DESCRIPTION,imagedescription)
IpWsChangeDescription(INF_Artist,imageartist)
Rem save image
ret=IpWsSaveAs(Filename, "TIF")
Rem close 12 bit image
ret = IpAppSelectDoc(image(i))
ret = IpDocClose()
imageno = imageno + 1
write_logfile(0,filename+" "+imagetext)
write_logfile(0,"SV:"+Format(startvoltage,"0.000")+" OB:"+Format(objective,"0.00")+" ST:"+Format(LEEMtemp,"0.0"))
End If
Rem analyse image
ret = IpAoiManager(AOISET,"RAOI")
ret = IpAoiGet(GETBOUNDS, 0, aoirect)
If aoirect.Left = 0 And aoirect.Right = 0 Then
focusleft = 100
focusright = 200
Else
focusleft = aoirect.Left
focusright = aoirect.Right
End If
write_logfile(0,Format(focusLeft)+" "+Format(focusRight))
focusreturn = focus(Filename,focusleft,focusleft,focusright,focusright,focuspar,focusvalue(0),focusvalue(1),focusvalue(2))
' focusvalue=100
addValue win(0),0,setObj,focusvalue(0)
addValue win(0),1,setObj,focusvalue(1)
addValue win(0),2,setObj,focusvalue(2)
updateGraph win(0)
addValue win(1),0,setObj,focusvalue(1)
updateGraph win(1)
addValue win(2),0,setObj,focusvalue(2)
updateGraph win(2)
Print#1, setObj;" ";focusvalue(0);" ";focusvalue(1);" ";focusvalue(2)
For i = 0 To 2
If focusno = 0 Then
focusavg(i)=focusvalue(i)
focusmax(i)=focusvalue(i)
focusmin(i)=focusvalue(i)
optfocus(i)=setObj
Else
focusavg(i)=focusavg(i)+focusvalue(i)
If focusvalue(i)>focusmax(i) Then
focusmax(i)=focusvalue(i)
optfocus(i)=setObj
End If
If focusvalue(i)<focusmin(i) Then focusmin(i)=focusvalue(i)
End If
Next i
focusno = focusno+1
Next setObj
Rem which is the best
For i = 0 To 2
If focusavg(i) <> 0 Then
focusavg(i)=focusavg(i)/focusno
focustest(i)=(focusavg(i)-focusmin(i))/(focusmax(i)-focusmin(i))
write_logfile(0,"curve "+Format(i)+" quality: "+Format(focustest(i),"0.00")+" Obj :"+Format(optfocus(i),"0.0"))
End If
Next i
write_logfile(0,"use the curve with the smallest quality value")
IpAcqControl(803,0,IPNULL)
IpAcqControl(820,0,IPNULL)
IpAcqControl(825,0,IPNULL)
Close
ret = IpAoiManager(AOIDELETE,"RAOI")
putObjective(oldObj)
sleep_f(5)
Begin Dialog UserDialog 10,10,130,63,"finished" ' %GRID:10,7,1,1
Text 20,7,90,14,"Focus_series finished",.Text1
OKButton 10,28,90,21
End Dialog
Dim scanfinished As UserDialog
Dialog scanfinished
stopMacro
End Sub
Sub calculate_focus_SV_Ob
'Dim startSV As Double
'Dim startOB As Double
'Dim calcSV As Double
'Dim calcOB As Double
startMacro("calculate focus")
Do
Begin Dialog UserDialog 1000,100,620,203 ' %GRID:10,7,1,1
Text 20,35,120,14,"at startvoltage"
TextBox 140,35,90,21,.calcstartSV
Text 260,42,90,14,"OBJ focus is",.Text2
Text 20,98,90,14,"new start voltage",.Text3
TextBox 360,35,90,21,.calcstartOB
TextBox 120,98,90,21,.calcSV
Text 290,105,90,14,"new OBJ",.Text4
TextBox 370,98,80,21,.calcOB
PushButton 210,126,90,21,"calculate",.PushButton1
CancelButton 360,161,90,21
PushButton 470,98,110,21,"set new SV/OB",.PushButton2
PushButton 470,35,100,21,"current SV/OB",.PushButton3
End Dialog
Dim dlg As UserDialog
dlg.calcstartSV=Format(calcstartSV)
dlg.calcstartOB=Format(calcstartOb)
dlg.calcSV=Format(calcSV)
dlg.calcOB=Format(focus_algo(calcstartOb,calcstartSV,calcSV),"0.0")
r=Dialog(dlg)
If r = 0 Then
'info on X11MA log window
stopMacro
Exit Sub
End If
calcstartSV=CDbl(dlg.calcstartSV)
calcstartOB=CDbl(dlg.calcstartOB)
calcSV=CDbl(dlg.calcSV)
If r= 1 Then
calcOB = focus_algo(calcstartOb,calcstartSV,calcSV)
write_logfile(0,"calc input SV: "+Format(calcstartSV))
write_logfile(0,"calc input OB: "+Format(calcstartOB))
write_logfile(0,"for SV: "+Format(calcSV))
write_logfile(0,"calc OB: "+Format(calcOB,"0.0"))
write_logfile(0,"")
End If
If r= 2 Then
If calcOB >1500 And calcOB <2000 Then
putObjective(calcOB)
Else
wrongvalue
doneinput=False
End If
If calcSV > -5 And calcSV <2000 Then
putStartVoltage(calcSV)
doneinput=False
Else
wrongvalue
doneinput=False
End If
End If
If r= 3 Then
getLEEM
calcstartSV=startvoltage
calcstartOB=objective
End If
Loop While doneinput=False
stopMacro
End Sub
Sub image_operation
Dim image1 As Integer
Dim image2 As Integer
Dim iname As String *255
start1:
Begin Dialog UserDialog 1000,100,830,301 ' %GRID:10,7,1,1
CancelButton 210,266,90,21
PushButton 40,21,90,21,"divide",.PushButton1
PushButton 40,56,90,21,"subtract",.PushButton2
PushButton 50,203,90,21,"correct",.PushButton3
PushButton 40,84,90,21,"Add",.PushButton4
PushButton 20,168,140,21,"average Sequence",.PushButton5
PushButton 190,168,180,21,"add sequence (into one)",.PushButton6
PushButton 400,168,200,21,"Arantxa's add seq tool",.PushButton7
TextBox 180,42,90,21,.contrast
Text 180,14,90,28,"contrast enhancement",.Text1
TextBox 160,203,240,21,.sensi_image
PushButton 410,203,90,21,"browse",.PushButton8
TextBox 310,42,90,21,.scale
Text 300,7,120,35,"scaling factor for the second image (0 = autoscale) ",.Text2
PushButton 40,119,90,21,"Asymmetry",.PushButton9
PushButton 640,77,120,21,"enhance contrast",.PushButton10
Text 480,21,170,35,"calc Magnetisation from two images (under construction must 8bit Tiff)",.Text3
PushButton 660,28,90,21,"calc Mag",.PushButton11
Text 500,70,120,28,"enhance contrast of single image",.Text4
End Dialog
Dim dlg As UserDialog
dlg.contrast=Format(autocontrast)
dlg.scale=Format(autoscale)
dlg.sensi_image=Format(sensi_image)
r= Dialog (dlg)
If r = 0 Then Exit Sub
If r = 8 Then
Selectfile = IpStGetName("Select file",configpath,"*.*",Iname)
If Selectfile = 0 Then Exit Sub
sensi_image=Iname
GoTo start1
End If
autocontrast=CSng(dlg.contrast)
autoscale=CSng(dlg.scale)
sensi_image=dlg.sensi_image
saveX11MA_PEEMconfig
If r = 1 Then
If Select2Images_X11MA(image1,image2) Then
ret=Divide2Images(image1,image2,autoscale,autocontrast,False)
End If
End If
If r = 2 Then
If Select2Images_X11MA(image1,image2) Then
ret=subtract2Images(image1,image2,autoscale,autocontrast,False)
End If
End If
If r=3 Then
correct_sensi
'If selectImage_X11MA("select image",image1) Then
' IpWsLoad(sensi_image, "TIF")
' ret = IpDocGet(GETACTDOC, 0, Image2)
' ret=Divide2Images(image1,image2,0,1,False)
'End If
End If
If r = 4 Then
If Select2Images_X11MA(image1,image2) Then
ret=Add2Images(image1,image2,0,autocontrast,False)
End If
End If
If r= 5 Then
AverageSeq
End If
If r = 6 Then
AddSeq()
End If
If r = 7 Then
AddSeq_smart()
End If
If r = 9 Then
If Select2Images_X11MA(image1,image2) Then
ret=Asymmetry2Images(image1,image2,autoscale,autocontrast,False)
End If
End If
If r = 10 Then
If SelectImage_X11MA("Select image",image1) Then
ret=EnhanceImageContrast(image1,autocontrast,True)
End If
End If
If r = 11 Then
If Select2Images_X11MA(image1,image2) Then
ret=CalculateMagnetizationAngle(image1,image2)
End If
End If
End Sub
Sub CalcMultSpectra()
Rem Calculates multiple images from image stack in selected areas AOI1, AOI2, ...
Dim n As Integer
Dim tmp As Integer
Dim More As Integer
Dim aoinum As Integer
Dim i As Integer
ReDim stats(10) As Single
Dim Iname As String * 255
Dim s As String
Dim t As String
Dim r As RECT
Dim aoitype As Integer
Dim numpoints As Integer
Dim p() As pointapi
Dim imagetitle As String * 100
Dim imageartist As String * 100
Dim resultt As String
Dim result(500,20) As Double
Dim win(10) As Variant
startMacro("calcMultSpectra")
'LoadConfig
More = IpStGetName("Select first image",Path,"*.TIF", Iname)
If More = 0 Then
Exit Sub
End If
i = InStrRev(Iname, "\")
Path = Left$(Iname, i)
i = InStrRev(Iname, "#")
s = Left$(Iname, i)
ret = IpStGetInt("# of AOIs",aoinum,1,1,20)
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
IpAoiShow(FRAME_NONE)
ret = IpWsDuplicate()
For i = 1 To aoinum
ret = IpAoiManager(AOISET,"AOI"+Mid$(Str$(i),2))
ret = IpAoiGet(GETTYPE, 0, aoitype)
If aoitype = AOI_BOX Then
ret = IpAoiGet(GETBOUNDS, 0, r)
ret = IpAnCreateObj(GO_OBJ_RECT)
ret = IpAnMove(0, r.Left, r.top)
ret = IpAnMove(5, r.Right, r.bottom)
ret = IpAnCreateObj(GO_OBJ_TEXT)
ret = IpAnMove(0, r.Left, r.top)
ret = IpAnSet(GO_ATTR_TEXTAUTOSIZE, 1)
ret = IpAnSet(GO_ATTR_USEASDEFAULT, 1)
ret = IpAnText(Mid$(Str$(i),2))
ElseIf aoitype = AOI_ELLIPSE Then
ret = IpAoiGet(GETBOUNDS, 0, r)
ret = IpAnCreateObj(GO_OBJ_ELLIPSE)
ret = IpAnMove(0, r.Left, r.top)
ret = IpAnMove(5, r.Right, r.bottom)
ret = IpAnCreateObj(GO_OBJ_TEXT)
ret = IpAnMove(0, r.Left, r.top)
ret = IpAnSet(GO_ATTR_TEXTAUTOSIZE, 1)
ret = IpAnSet(GO_ATTR_USEASDEFAULT, 1)
ret = IpAnText(Mid$(Str$(i),2))
ElseIf aoitype = AOI_POLYGON Then
ret = IpAoiGet(GETNUMPTS, 0, numpoints)
ReDim p(numpoints) As pointapi
ret = IpAoiGet(GETPOINTS, numpoints, p(0))
ret = IpAnCreateObj(GO_OBJ_POLY)
ret = IpAnPolyAddPtArray(p(0), numpoints)
ret = IpAnCreateObj(GO_OBJ_TEXT)
ret = IpAnMove(0, p(0).x, p(0).y)
ret = IpAnSet(GO_ATTR_TEXTAUTOSIZE, 1)
ret = IpAnSet(GO_ATTR_USEASDEFAULT, 1)
ret = IpAnText(Mid$(Str$(i),2))
End If
Next i
IpAoiShow(FRAME_NONE)
IpAnBurn()
n = 1
t = ExpandName(s, n, "")
tmp = IpWsLoad(t, "TIF")
Do While tmp >= 0
ret = IpHstCreate()
t = Str$(n)
ret = IpDocGetStr(INF_TITLE,DOCSEL_ACTIVE,imagetitle)
ret = IpDocGetStr(INF_ARTIST,DOCSEL_ACTIVE,imageartist)
tt=InStrRev(imagetitle,"I")
ttt=Mid(imagetitle,tt+2,1)
Select Case ttt
Case "E"
tttt=InStr(imagetitle,"P")
imagetitle=Mid(imagetitle,3,tttt-4)
result(n,0)=CDbl(imagetitle)
Case "V"
tttt=InStr(imageartist,"O")
imageartist=Mid(imageartist,4,tttt-5)
'imageartist=Left(imageartist,tt-1)
result(n,0)=CDbl(imageartist)
Case Else
result(n,0)=CDbl(n)
End Select
resultt=Str$(result(n,0))
For i = 1 To aoinum
ret = IpAoiManager(AOISET,"AOI"+Mid$(Str$(i),2))
ret = IpHstUpdate()
ret = IpHstGet(GETSTATS, 0, stats(0))
ret = IpDocGetStr(NF_TITLE,DOCSEL_ACTIVE,imageenergy)
result(n,i)=stats(0)
resultt = resultt + Chr$(9) + Str$(stats(0))
Next i
ret = IpHstDestroy()
ret = IpDocClose()
Print #1,resultt
n = n + 1
t = ExpandName(s, n, "")
tmp = IpWsLoad(t, "TIF")
Loop
Dim titel As String
title="Spectra"
win(0)=createPlot(title)
For i = 1 To aoinum
setLabel win(0),i-1,"AOI"+Format(i)
Next i
For j=1 To n-1
For i = 1 To aoinum
addValue win(0),i-1,result(j,0),result(j,i)
Next i
Next j
updateGraph win(0)
Close #1
stopMacro
End Sub
Sub CalcMultSpectraSeq()
Rem Calculates multiple images from image stack in selected areas AOI1, AOI2, ...
Dim n As Integer
Dim tmp As Integer
Dim More As Integer
Dim aoinum As Integer
Dim i As Integer
ReDim stats(10) As Single
Dim Iname As String * 255
Dim t As String
Dim r As RECT
Dim aoitype As Integer
Dim numpoints As Integer
Dim p() As pointapi
Dim imagetitle As String * 100
Dim imageartist As String * 100
Dim resultt As String
Dim result(500,20) As Double
Dim win(10) As Variant
Dim images As Integer
Dim anz As Integer
startMacro("calcMultSpectraSeq")
'LoadConfig
ret = SelectImage_X11MA ("Select Sequence", images)
ret = IpStGetInt("# of AOIs",aoinum,1,1,20)
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
IpSeqGet (SEQ_NUMFRAMES, anz)
IpSeqSet (SEQ_ACTIVEFRAME, 0)
IpAoiShow(FRAME_NONE)
IpSeqSet (SEQ_APPLY, 0) ' current frame
ret = IpWsDuplicate()
For i = 1 To aoinum
ret = IpAoiManager(AOISET,"AOI"+Mid$(Str$(i),2))
ret = IpAoiGet(GETTYPE, 0, aoitype)
If aoitype = AOI_BOX Then
ret = IpAoiGet(GETBOUNDS, 0, r)
ret = IpAnCreateObj(GO_OBJ_RECT)
ret = IpAnMove(0, r.Left, r.top)
ret = IpAnMove(5, r.Right, r.bottom)
ret = IpAnCreateObj(GO_OBJ_TEXT)
ret = IpAnMove(0, r.Left, r.top)
ret = IpAnSet(GO_ATTR_TEXTAUTOSIZE, 1)
ret = IpAnSet(GO_ATTR_USEASDEFAULT, 1)
ret = IpAnText(Mid$(Str$(i),2))
ElseIf aoitype = AOI_ELLIPSE Then
ret = IpAoiGet(GETBOUNDS, 0, r)
ret = IpAnCreateObj(GO_OBJ_ELLIPSE)
ret = IpAnMove(0, r.Left, r.top)
ret = IpAnMove(5, r.Right, r.bottom)
ret = IpAnCreateObj(GO_OBJ_TEXT)
ret = IpAnMove(0, r.Left, r.top)
ret = IpAnSet(GO_ATTR_TEXTAUTOSIZE, 1)
ret = IpAnSet(GO_ATTR_USEASDEFAULT, 1)
ret = IpAnText(Mid$(Str$(i),2))
ElseIf aoitype = AOI_POLYGON Then
ret = IpAoiGet(GETNUMPTS, 0, numpoints)
ReDim p(numpoints) As pointapi
ret = IpAoiGet(GETPOINTS, numpoints, p(0))
ret = IpAnCreateObj(GO_OBJ_POLY)
ret = IpAnPolyAddPtArray(p(0), numpoints)
ret = IpAnCreateObj(GO_OBJ_TEXT)
ret = IpAnMove(0, p(0).x, p(0).y)
ret = IpAnSet(GO_ATTR_TEXTAUTOSIZE, 1)
ret = IpAnSet(GO_ATTR_USEASDEFAULT, 1)
ret = IpAnText(Mid$(Str$(i),2))
End If
Next i
IpAoiShow(FRAME_NONE)
IpAnBurn()
IpAppSelectDoc (images)
For j = 0 To (anz-1)
IpSeqSet (SEQ_ACTIVEFRAME, j)
ret = IpHstCreate()
t = Str$(n)
ret = IpDocGetStr(INF_TITLE,DOCSEL_ACTIVE,imagetitle)
ret = IpDocGetStr(INF_ARTIST,DOCSEL_ACTIVE,imageartist)
tt=InStrRev(imagetitle,"I")
ttt=Mid(imagetitle,tt+2,1)
Select Case ttt
Case "E"
tttt=InStr(imagetitle,"P")
imagetitle=Mid(imagetitle,3,tttt-4)
result(n,0)=CDbl(imagetitle)
Case "V"
tttt=InStr(imageartist,"O")
imageartist=Mid(imageartist,4,tttt-5)
'imageartist=Left(imageartist,tt-1)
result(n,0)=CDbl(imageartist)
Case Else
result(n,0)=CDbl(n)
End Select
resultt=Str$(result(n,0))
For i = 1 To aoinum
ret = IpAoiManager(AOISET,"AOI"+Mid$(Str$(i),2))
ret = IpHstUpdate()
ret = IpHstGet(GETSTATS, 0, stats(0))
ret = IpDocGetStr(NF_TITLE,DOCSEL_ACTIVE,imageenergy)
result(n,i)=stats(0)
resultt = resultt + Chr$(9) + Str$(stats(0))
Next i
ret = IpHstDestroy()
Print #1,resultt
Next j
Dim titel As String
title="Spectra"
win(0)=createPlot(title)
For i = 1 To aoinum
setLabel win(0),i-1,"AOI"+Format(i)
Next i
For j=1 To n-1
For i = 1 To aoinum
addValue win(0),i-1,result(j,0),result(j,i)
Next i
Next j
updateGraph win(0)
Close #1
stopMacro
End Sub
Sub FastAlign2Images()
Rem Atomatically aligns 2 shifted images by maximizing the cross correlation within the current AOI in the first image
Dim Image1 As Integer
Dim Image2 As Integer
Dim DeltaX As Integer
Dim DeltaY As Integer
Dim s As String
If Not Select2Images(Image1, Image2) Then Exit Sub
ret = IpAppUpdateDoc(DOCSEL_NONE)
ret = FastAutoAlign(Image1, Image2, DeltaX, DeltaY, 0)
ret = IpAppUpdateDoc(DOCSEL_ALL)
s = "Displacement = " + Str(DeltaX) + "," + Str(DeltaY)
ret = IpMacroStop(s, MS_MODAL)
End Sub
Sub Flicker()
Rem Repeatedly switches between two images
Dim im1 As Integer
Dim im2 As Integer
Dim i As Integer
getbeamline
startmacro("Flicker")
If Not Select2Images(im1, im2) Then
Exit Sub
End If
ret = IpAppSelectDoc(im1)
ret = IpDocMove(0,0)
ret = IpAppSelectDoc(im2)
ret = IpDocMove(0,0)
Do
For i = 1 To 10
ret = IpAppSelectDoc(im1)
Wait 1
ret = IpAppSelectDoc(im2)
Wait 1
If cancelmacro() = 0 Then Exit Sub
Next i
Loop Until IpMacroStop("Continue?",MS_MODAL+MS_OKCAN+ MS_QUEST) = 2
stopmacro
End Sub
Sub ConvertFolder()
Rem Convert all images in folder to 8/16 bit TIFF
Dim X As Integer
Dim DStat As Integer
Dim Iname As String * 255
Dim tmp1 As Integer, tmp2 As Integer, mode As Integer
Dim More As Integer
Dim i As Integer
Dim imagetitle As String * 100
Dim imageartist As String * 100
Dim imagedescription As String * 100
LoadConfig
More = IpStGetName("Select arbitrary image in folder", Path,"*.TIF", Iname)
If More = 0 Then Exit Sub
i = InStrRev(Iname, "\")
Path = Left$(Iname, i)
ret = IpStGetInt("0 -> 8 Bit, 1 -> 16 Bit", mode, 1, 0, 1)
DStat = IpStSearchDir(Path,"*.TIF", X, Iname)
Do While DStat = 1
tmp1 = IpWsLoad(Iname, "TIF")
ret = IpDocGetStr(INF_TITLE,DOCSEL_ACTIVE,imagetitle)
ret = IpDocGetStr(INF_DESCRIPTION,DOCSEL_ACTIVE,imagedescription)
ret = IpDocGetStr(INF_ARTIST,DOCSEL_ACTIVE,imageartist)
if mode =1 then
tmp2 = IpWsConvertToGray16()
else
tmp2 = IpWsConvertToGray()
end if
ret = IpAppSelectDoc(tmp1)
ret = IpDocClose()
ret = IpAppSelectDoc(tmp2)
IpWsChangeDescription(INF_TITLE,imagetitle)
IpWsChangeDescription(INF_DESCRIPTION,imagedescription)
IpWsChangeDescription(INF_Artist,imageartist)
ret = IpWsSaveAs(Iname,"TIF")
ret = IpDocClose()
X = X + 1
DStat = IpStSearchDir(Path, "*.TIF", X, Iname)
Loop
end sub
Sub MoveAndDivide()
Rem Shifts images relative to each other
Dim image1 As Integer
Dim image2 As Integer
Dim img1 As Integer
Dim img2 As Integer
Dim i1 As Integer
Dim i2 As Integer
Dim div As Integer
Static dx As Integer
Static dy As Integer
Dim dinfo As IPDOCINFO
Dim sx As Integer
Dim sy As Integer
LoadConfig
If Not Select2Images(image1, image2) Then Exit Sub
ret = IpDocGet(GETDOCINFO, image1, dinfo)
sx = dinfo.width
sy = dinfo.height
ret = IpDocGet(GETDOCINFO, image2, dinfo)
If (sx<>dinfo.width) Or (sy<>dinfo.height) Then
ret = IpMacroStop("Image size different", MS_MODAL+MS_EXCLAM)
Exit Sub
End If
img1 = ConvertToGray16(image1, True)
img2 = ConvertToGray16(image2, True)
ret = IpStGetInt("Delta X", dx, dx, -1000, 1000)
If ret = 1 Then ret = IpStGetInt("Delta Y", dy, dy, -1000, 1000)
If ret = 0 Then GoTo exsub
Do
i1 = img1
i2 = img2
ret = Crop2Images(i1, i2, dx, dy, 1)
div = fAutoArith(i1, i2, True)
ret = IpStGetInt("Delta X", dx, dx, -1000, 1000)
If ret = 1 Then ret = IpStGetInt("Delta Y", dy, dy, -1000, 1000)
If ret = 0 Then Exit Do
CloseImage(i1)
CloseImage(i2)
CloseImage(div)
Loop
exsub:
If img1 <> image1 Then CloseImage(img1)
If img2 <> image2 Then CloseImage(img2)
End Sub
Sub Cross_Correlation()
Rem Calculates cross correlation of two images
Dim image1 As Integer
Dim image2 As Integer
Dim s As String
Dim dinfo As IPDOCINFO
Dim sx As Integer
Dim sy As Integer
LoadConfig
If Not Select2Images(image1, image2) Then
Exit Sub
End If
ret = IpDocGet(GETDOCINFO, image1, dinfo)
sx = dinfo.width
sy = dinfo.height
ret = IpDocGet(GETDOCINFO, image2, dinfo)
If (sx<>dinfo.width) Or (sy<>dinfo.height) Then
ret = IpMacroStop("Image size different", MS_MODAL+MS_EXCLAM)
Exit Sub
End If
s = "Cross correlation factor ="+Str$(Correlation(image1, image2, 0, 0))
ret = IpMacroStop(s, MS_MODAL)
End Sub
Sub usekeithley
Dim keithley(3) As Double
startMacro("keithley")
'keithley_trigger(0)
'sleep_f(1)
'Do While True
' If cancelmacro() = 0 Then Exit Sub
' If keithley_done() = 1 Then
' Exit Do
' End If
' DoEvents
'Loop
'keithley_read(0,keithley(0),keithley(1),keithley(2))
averKeithley(10,keithley(0),keithley(1),keithley(2))
keithleys=CStr(keithley(0))
MsgBox keithleys
stopmacro
End Sub
Sub set_laser_delay
Dim delay As Single
ipstgetfloat ("Delay:", delay, getPsDelay,0,1000,1)
Putpsdelay(delay)
End Sub
Sub Optical_Shutter_Pulses
Dim c As Integer
r = ipstgetint ("Number of laser pulses:", c, 1,-1,1000)
If r = 1 Then
sp_OpticalShutterPulses(c)
End If
End Sub
'Sub test
' startMacro("test")
' Do While True
' addMessage 0,Format(injection)
' If cancelmacro() = 0 Then
' Exit Sub
' End If
' DoEvents
' Loop
'End Sub
'Sub chopper
'Dim chop As Double
' getbeamline
' startMacro("Stack")
' chop=0
' Do While True
' If cancelmacro() = 0 Then Exit Sub
' putChopper(chop)
' chop=chop+1
' If chop =2 Then chop=0
' sleep_f(1)
' DoEvents
' Loop
' stopMacro
'End Sub
'Sub test_pc1()
' Dim i As Integer'
' ret = IpPcShow(1)
' ret = IpPcSetDivisions(255)
' For i = 0 To 127
' ret = IpPcSetColor(i, 255 - 2*i, 0, 0)
' Next i
' For i = 0 To 127
' ret = IpPcSetColor(i+128, 0,0, 2*i)
' Next i
'End Sub
'Sub test_pc2()
' Dim i As Integer
'
' ret = IpPcShow(1)
' ret = IpPcSetDivisions(255)
' For i = 0 To 127
' ret = IpPcSetColor(i, 255, 2*i, 2*i)
' Next i
' ret = IpPcSetColor(128, 255, 255, 255)
' For i = 0 To 127
' ret = IpPcSetColor(i+128, (127-i)*2, (127-i)*2, 255)
' Next i
'End Sub
'Sub test_pc3()
' Dim i As Integer
' ret = IpPcShow(1)
' ret = IpPcSetDivisions(255)
' For i = 0 To 126
' ret = IpPcSetColor(i, 0, 0, 2*i)
' Next i
' ret = IpPcSetColor(127, 0, 0, 255)
' For i = 0 To 127
' ret = IpPcSetColor(i+128, i*2, i*2, 255)
' Next i
'End Sub
'Sub test_add1()
' ret = IpAppSelectDoc(8)
' ret = IpWsCopy()
' ret = IpAppSelectDoc(10)
' ret = IpWsPaste(0, 0)
' ret = IpAppSelectDoc(9)
' ret = IpWsCopy()
' ret = IpAppSelectDoc(10)
' ret = IpWsPaste(158, 0)
' ret = IpSeqPlay(SEQ_NEXT)
' ret = IpAppSelectDoc(8)
' ret = IpSeqPlay(SEQ_NEXT)
' ret = IpAppSelectDoc(9)
' ret = IpSeqPlay(SEQ_NEXT)
' ret = IpAppSelectDoc(8)
' ret = IpWsCopy()
' ret = IpAppSelectDoc(10)
' ret = IpWsPaste(0, 0)
' ret = IpAppSelectDoc(9)
' ret = IpWsCopy()
' ret = IpAppSelectDoc(10)
' ret = IpWsPaste(159, -1)
'End Sub
Sub testtest()
ret = IpAcqControl(818, -1, IPNULL)
End Sub
Reference in New Issue View Git Blame Copy Permalink