'#Reference {598F2120-CC50-11D5-874F-9DA8AFB50846}#1.0#0#C:\Program Files\Objective Imaging\Oasis\OICal.dll#OICal 1.0 Type Library
'#Reference {D805C200-531D-11D4-8735-444553540000}#1.0#0#C:\Program Files\Objective Imaging\OASIS\OIAutoX.dll#OIAutoX 1.0 Type Library

' Pro-Series Turboscan Auto-Pro Macro Examples
' Copyright (c) 2005 Objective Imaging Ltd.

Option Explicit

Declare Function IpTurboGetMapControl Lib "Captoi32" () As OIMap
Declare Function IpTurboGetCalControl Lib "Captoi32" () As OICalibration
Declare Function IpTurboGetSystemControl Lib "Captoi32" () As OISystem

' Variable to hold the Turboscan map object and trap events
Private WithEvents m_oiMap As OIMap

' Variable to hold the Turboscan calibration object
Private m_oiCal As OICalibration

' Variable to hold the Turboscan automation system object
Private m_oiSys As OISystem

Private m_dStep As Double

' Set module variables to Turboscan controls
Sub SetTurboControls()

	If m_oiMap Is Nothing Then 	
		Set m_oiMap = IpTurboGetMapControl()
	End If
	If m_oiCal Is Nothing Then
		Set m_oiCal = IpTurboGetCalControl()
	End If
	If m_oiSys Is Nothing Then
		Set m_oiSys = IpTurboGetSystemControl()
	End If

End Sub

Sub TileShifter()

	'Shift in 1 um increments
	m_dStep = 1

	Begin Dialog UserDialog 400,133,"Shift tiles",.ShiftFunc ' %GRID:10,7,1,1
		PushButton 130,14,100,21,"Up",.PushButton1
		PushButton 130,70,100,21,"Down",.PushButton2
		PushButton 30,42,100,21,"Left",.PushButton3
		PushButton 230,42,110,21,"Right",.PushButton4
		OKButton 270,112,100,21
	End Dialog
	Dim dlg As UserDialog
	Dialog dlg

End Sub

Rem See DialogFunc help topic for more information.
Private Function ShiftFunc(DlgItem$, Action%, SuppValue?) As Boolean
	Select Case Action%
	Case 1 ' Dialog box initialization
	Case 2 ' Value changing or button pressed
		If( DlgItem$ = "PushButton1" ) Then
			ShiftY -m_dStep
			ShiftFunc = True ' Prevent button press from closing the dialog box
		End If
		If( DlgItem$ = "PushButton2" ) Then
			ShiftY m_dStep
			ShiftFunc = True ' Prevent button press from closing the dialog box
		End If
		If( DlgItem$ = "PushButton3" ) Then
			ShiftX -m_dStep
			ShiftFunc = True ' Prevent button press from closing the dialog box
		End If
		If( DlgItem$ = "PushButton4" ) Then
			ShiftX m_dStep
			ShiftFunc = True ' Prevent button press from closing the dialog box
		End If
		If( DlgItem$ = "Text3" ) Then
			m_dStep = CDbl(SuppValue)
			ShiftFunc = True ' Prevent button press from closing the dialog box
		End If

	Case 3 ' TextBox or ComboBox text changed

	Case 4 ' Focus changed
	Case 5 ' Idle
		Rem Wait .1 : ShiftFunc = True ' Continue getting idle actions
	Case 6 ' Function key
	End Select

End Function
Sub ShiftY(ByVal microns As Double)
Dim i As Long

	SetTurboControls
	For i=1 To m_oiMap.Mosaic.Tiles.Count
		m_oiMap.Mosaic.Tiles(i).YPos = m_oiMap.Mosaic.Tiles(i).YPos + m_oiMap.Mosaic.Tiles(i).Row*microns
	Next i
	m_oiMap.DrawMap
End Sub
Sub ShiftX( ByVal microns As Double )
Dim i As Long

	SetTurboControls
	For i=1 To m_oiMap.Mosaic.Tiles.Count
		m_oiMap.Mosaic.Tiles(i).XPos = m_oiMap.Mosaic.Tiles(i).XPos + m_oiMap.Mosaic.Tiles(i).Col*microns
	Next i
	m_oiMap.DrawMap

End Sub

Sub LoadPattern_Run_Transfer()

	' get hold of the turbscan objects
	SetTurboControls

	' load a pattern from disk
	m_oiMap.ScanPattern.Load( "c:\IPWIN60\MyPattern.pat" )

	' run a turboscan
	ret = IpAcqControl(1002,IPNULL,IPNULL) 'Clear Mosaic
	ret = IpAcqControl(1000,1,IPNULL) 'Run Scan

	' transfer the full res mosaic
	ipArray(0) = 1
	ret = IpAcqControl(1001,0,ipArray(0)) 'Transfer mosaic


End Sub
'Load a workspace from disk
Sub LoadWorkspace()
Dim f$ 

	' Show dialog to get filename
	f$ = GetFilePath$(,"sws",,"Load Workspace",0)
	
	' Load the workspace if OK was selected
	If Len(f$)>0 Then
		SetTurboControls
		m_oiMap.LoadWorkspace f$
	End If
End Sub

' Save a workspace to disk
Sub SaveWorkspace()
Dim f$ 

	' Show dialog to get filename
	f$ = GetFilePath$(,"sws",,"Save Workspace",5)
	
	' Save the workspace if OK was selected
	If Len(f$)>0 Then
		SetTurboControls
		m_oiMap.SaveWorkspace f$
	End If
End Sub

' Display the Turboscan dialog for selecting a lens
Sub ShowLensSelectDlg()
	SetTurboControls
	m_oiCal.ShowSelectLensDlg 0,0
End Sub

' Select the first lens from code
Sub SelectFirstLens()
	SetTurboControls
	m_oiCal.SelectObjective 1, True
End Sub

' Trap event of user click on the mosaic
Private Sub m_oiMap_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Long, ByVal Y As Long)
Dim xpos As Double, ypos As Double
	
	' Convert screen coordinates to stage coordinates
	xpos = m_oiMap.ScreenToStageX(X)
	ypos = m_oiMap.ScreenToStageY(Y)
	
	' Display position
	Debug.Print "MouseDown at stage position " + Format$(xpos, "0.0") + ", " + Format$(ypos,"0.0") 
End Sub
Private Sub m_oiMap_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Long, ByVal Y As Long)
Dim xpos As Double, ypos As Double
	
	' Convert screen coordinates to stage coordinates
	xpos = m_oiMap.ScreenToStageX(X)
	ypos = m_oiMap.ScreenToStageY(Y)
	
	' Display position
	Debug.Print "MouseUp at stage position " + Format$(xpos, "0.0") + ", " + Format$(ypos,"0.0") 

End Sub
' Set the user selection
' Note that you need to have the "Select" tool on in the Turboscan window
' to see the selection
Sub SetMosaicSelection()
Dim dSel(4) As Double

	dSel(0) = 40000 'xmin, microns
	dSel(1) = 40000 'ymin, microns
	dSel(2) = 60000 'xmax, microns
	dSel(3) = 60000 'ymax, microns
	ret = IpAcqControl(1009,0,dSel(0))
End Sub

Sub CreatePatternInSelection()
	SetTurboControls
	m_oiMap.CreatePatternInSelection(0)
End Sub

' Setup the shading corrector from code
Sub SetShading()
	
	' Turn on live preview
	ret = IpAcqShow(ACQ_LIVE, 1)
	
	MsgBox "Move to a blank field for shading correction..."
	
	' Set the shading
	ret = IpAcqControl(1011, IPNULL, IPNULL )
	
End Sub

'Run a scan
Sub StandardScan()
	ret = IpAcqControl(1002,IPNULL,IPNULL) 'Clear Mosaic
	ret = IpAcqControl(1000,2,IPNULL) 'Run Scan
End Sub
'Run a scan
Sub TurboScan()
	ret = IpAcqControl(1002,IPNULL,IPNULL) 'Clear Mosaic
	ret = IpAcqControl(1000,1,IPNULL) 'Run Scan
End Sub

Sub LoopThroughTiles()
Dim i As Long

	SetTurboControls
	For i=1 To m_oiMap.Mosaic.Tiles.Count
		ret = IpAcqControl( 1013, i, IPNULL )
		ModifyContrast
		ret = IpWsCopy()
		ret = IpAcqControl( 1014, i, IPNULL )
		ret = IpDocClose()
	Next i
	m_oiMap.DrawMap

End Sub

' Move the stage
Sub MoveStage()
Dim dX As Double, dY As Double, dZ As Double

	SetTurboControls

	' read the current position
	m_oiSys.Stage.ReadXYZ dX, dY, dZ

	' move 1000 um to the right, 1000 um up in Y
	m_oiSys.Stage.MoveToXY dX + 1000, dY - 1000, 1

	m_oiSys.Stage.InitializeXY


End Sub

' Step the stage
Sub StepStage()
Dim dXStep As Double, dYStep As Double
Dim lWait As Long

	SetTurboControls

	dXStep = 100.0 ' microns
	dYStep = 50.0 ' microns
	lWait = 1 ' wait for move to complete before continuing
	
	m_oiSys.Stage.StepXY dXStep, dYStep, lWait 
	
End Sub

' Read the current position
Sub ReadXYZ()
Dim dX As Double, dY As Double, dZ As Double

	SetTurboControls
	
	m_oiSys.Stage.ReadXYZ dX, dY, dZ
	Debug.Print "Stage X = "; dX 
	Debug.Print "Stage Y = "; dY 
	Debug.Print "Focus Z = "; dZ 
End Sub

'Step the focus
Sub StepFocus()
Dim dZStep As Double
Dim lWait As Long

	SetTurboControls

	dZStep = 10.0 'microns
	lWait = 1	
	m_oiSys.Focus.StepZ dZStep, lWait	
	
End Sub

' Example showing how the mosaic can be broken into a grid for easy
' transfer and analysis in IPP
Sub TransferMosaicGrid()

	Dim nRows As Integer, nCols As Integer
	Dim row As Integer, col As Integer
	Dim lArray(2) As Long

	'How many rows and columns to you want the Mosaic divided into?
	nCols = 5
	nRows = 4
	
	'Show a User Dialog to allow changes
	'Remove between "Start" and "End" if you don't want user interaction
	'--Start
	Begin Dialog UserDialog 270,168,"Mosaic Grid Transfer" ' %GRID:10,7,1,1
		CancelButton 160,140,90,21
		OKButton 60,140,90,21
		GroupBox 20,7,230,119,"Divde Mosaic into:",.GroupBox1
		TextBox 140,77,80,21,.TextBox2
		Text 50,77,80,21,"Rows:",.Text1
		TextBox 140,42,80,21,.TextBox1
		Text 50,42,80,21,"Columns:",.Text2
	End Dialog
	Dim dlg As UserDialog
	dlg.TextBox1 = Str$(nCols)
	dlg.TextBox2 = Str$(nRows)
	Dialog dlg
	nCols = Val(dlg.TextBox1)
	nRows = Val(dlg.TextBox2)
	'--End
	
	'Divide the Mosaic into a number of rows and columns
	lArray(0) = nRows
	lArray(1) = nCols
	IpAcqControl(1010,0,lArray(0)) 'Set Mosaic grid rows and cols
	
	'Loop through each location the Mosaic grid
	For row = 1 To nRows
		For col = 1 To nCols
		
			'Specify the current row (Y) and column	(X)
			lArray(0) = row
			lArray(1) = col
			IpAcqControl(1010,1,lArray(0))
			
			'Send the selection to IPP
			lArray(0) = -1 'Full mosaic transfer
			lArray(1) = 1 'Use selection
			ret = IpAcqControl(1001,0,lArray(0)) 'Transfer mosaic
			
			'Here is the call to do whatever it is you need to do with the
			'chunk of the Mosaic image transferred over
			Call ProcessImage()
	
			'Wait for a sec to show result
			'TODO: remove if not needed
			Wait 1
	
			'Let's close all the documents to avoid clogging up
			'the memory
			ret = IpAppCloseAll()
		Next col
	Next row

End Sub

'User function to process/analyze the image
Sub ProcessImage()

	'Do a Sobel filter for show.  
	'TODO: Replace this with processing and measurement you need
	ret = IpFltSobel()
	
End Sub


Sub ModifyContrast()
	ret = IpLutSetAttr(LUT_GAMMA, 62)
	ret = IpLutSetAttr(LUT_BRIGHTNESS, 57)
	ret = IpLutSetAttr(LUT_CONTRAST, 61)
	ret = IpLutSetAttr(LUT_GAMMA, 51)
	ret = IpLutApply()
End Sub


Sub TransferFullMosaic()
	ipArray(0) = 1
	ret = IpAcqControl(1001,0,ipArray(0)) 'Transfer mosaic
End Sub


Sub SelectTurboDriver()
	ret = IpAcqSelectDriver("Pro-Series Turboscan", 0)
End Sub
Sub SelectSimDriver()
		ret = IpAcqSelectDriver("Digital Simulation", 0)
End Sub

Sub SelectQImagingDriver()
	ret = IpAcqSelectDriver("QImaging Digital Camera", 0)
End Sub