'**********************************************************************
' Filename: 1969_intensity_over_moving_aois.ipm
'
' Free for use as demonstration/utility code.
'
'----------------------------------------------------------------------
' PROBLEM SOLVED:
' This macro prompts for AOIs, and either propagates them through
' the stack (static AOIs) or prompts for AOI relocation on each
' frame of a sequence and sends the intensity data for each AOI
' per frame to the Output window.
'
'----------------------------------------------------------------------
' WHO WOULD USE THIS:
'
' Anyone who wants to analyze multiple AOI's through a time lapse
' sequence.
' AOI's may remain stationary throughout the sequence or may move
' as the region of interest moves.
'
'----------------------------------------------------------------------
' SYSTEM REQUIREMENTS:
'
' Image-Pro 5.x or higher. (Developed and tested on IPP5.0, but
' may work with v4.x. Feedback welcome).
'
'----------------------------------------------------------------------
'HISTORY OF CHANGES:
'Macro Version: 2.0
'Created: 12.15.2003
'Modified: 12.24.2003
'Author: Paul T. Jantzen, with the assistance of Kevin Ryan
' and predicated on the demands of numerous dealers.
' Supercedes Solution #553, written by:
' Dietrich Ruehlmann, Ph.D.
' http://members.tripod.co.uk/druehlmann/
'Application: IPWin
'Version: 5.x+ (perhaps 4.x)
'Change History:
' 1.0: Solution #553 Created DR
' 1.0.1: 07.31.2000 DR
' I changed a few things from the original solution 553,
' a region analysis over a t-stack. It now handles >1000
' 512x470 frames in reasonably good speed and coughs the
' data into Excel (which then becomes slow). It also
' analyses quickly the mean data and the highest data point.
' Pretty simple and not elegant but it does the trick. Enjoy.
' 1.0.2: 29 November 2003 PTJ
' Modified to provide for movement of AOIs through
' the time sequence/stack
' 1.0.3: 05 December 2003
' Debugged by Vern Roseman
' 1.1: 16 December 2003
' Rewritten to incorporate coding suggestions from KR
' 2.0: 24 December 2003
' Completed to include support for irregular AOIs, added
' improvements from Lou Feng
'TBD:
' Manual AOI relocation via arrow keys
'
'**********************************************************************
Sub multiple_AOIs_over_time()
Dim arrType() As Integer
Dim arrShape() As Variant
Dim i As Integer, j As Integer, k As Integer, l As Integer, m As Integer
Dim AOIRect As RECT, AoiLst(0 To 3) As Integer
Dim AOIpts() As POINTAPI, annotPts() As POINTAPI, aoiPtsPoly() As POINTAPI
Dim aoiType As Integer, numPts As Integer
Dim numFrames As Integer
Dim numAOIs As Integer, MoveAOIs As Integer
Dim ROIname As String * 25, ROItext() As String * 25, numAOIsStr2 As String
Dim ROIpencolor As Long
Dim ROIcolorcode As Integer
ret = IpBlbDelete()
Call AnnotateDelete()
ret = IpOutputClear()
DebugClear
IpOutputShow(1)
ret=IpSeqGet(SEQ_NUMFRAMES, numFrames) ' Get number of frames in sequence
If numFrames = 1 Then ' If not a sequence, exit script
ret = IpMacroStop("Not a sequence image", 0)
Exit Sub
End If
Begin Dialog UserDialog 400,105,"Measure intensities in ROI's" ' %GRID:10,7,1,1
Text 10,14,290,14,"How many ROI's would you like to measure?",.Text1
TextBox 310,7,70,21,.numAOIsStr
OptionGroup .MoveOptions
OptionButton 10,63,130,14,"Moving ROIs",.MoveAOIsButton
OptionButton 10,42,130,14,"Static ROIs",.StaticROIButton
OKButton 300,70,90,21
CancelButton 180,70,90,21
End Dialog
Dim dlgInitial As UserDialog
dlgInitial.numAOIsStr = Str(2) ' change the (2) to whatever number
ret = Dialog(dlgInitial) ' of AOI's are desired as a starting number
If ret = 0 Then Exit Sub ' not cause the error message when CANCEL button pushed
MoveAOIs = dlgInitial.MoveOptions
numAOIs = Val(dlgInitial.numAOIsStr)
ReDim arrType(0 To numAOIs) As Integer
ReDim arrShape(0 To numAOIs) As Variant
ReDim numPolyArrPts(0 To numAOIs) As Integer
ReDim aoiOffset(-1 To numFrames, 0 To numAOIs) As POINTAPI
ReDim ROIText(numAOIs) As String * 25
ret = IpSeqPlay(SEQ_FFRA) 'Go to the first frame
For i=0 To numAOIs - 1
ROIname = "ROI #" & (i + 1)
Begin Dialog UserDialog 400,105,"Draw and name the ROI" ' %GRID:10,7,1,1
Text 30,7,250,21,"Please draw and name ROI #" & (i + 1),.Text1
TextBox 30,42,230,21,.ROIname
OKButton 280,77,110,21
CancelButton 160,77,100,21
End Dialog
Dim dlgDrawAndName As UserDialog
dlgDrawAndName.ROIname = "ROI #" & (i + 1)
ret = Dialog(dlgDrawAndName)
If ret = 0 Then Exit Sub ' not cause the error message when CANCEL button pushed
ROItext(i) = dlgDrawAndName.ROIname
ret = IpAoiGet(GETTYPE, 0, aoiType)
arrType(i) = aoiType
If aoiType = AOI_BOX Then
ret = IpAoiGet(GETBOUNDS, 0, aoirect)
aoilst(0) = aoirect.Left
aoilst(1) = aoirect.Right
aoilst(2) = aoirect.top
aoilst(3) = aoirect.bottom
' ret = IpAoiCreateBox(aoirect)
arrShape(i) = aoiLst
IpAnCreateObj(GO_OBJ_RECT) ' create annotation object representing ROI
IpAnMove(0 , aoirect.Left , aoirect.top)
IpAnMove(5 , aoirect.Right , aoirect.bottom)
ret = IpAnCreateObj(GO_OBJ_TEXT)
ret = IpAnMove(0, aoirect.Left, aoirect.top - 25)
ret = IpAnSet(GO_ATTR_FONTSIZE, 28)
ret = IpAnSet(GO_ATTR_TEXTAUTOSIZE, 1)
ret = IpAnSet(GO_ATTR_TEXTCOLOR, 255)
ret = IpAnText(IpTrim(ROItext(i)))
ret = IpAnMove(5, aoirect.Right, aoirect.bottom)
ElseIf aoiType = AOI_ELLIPSE Then
ret = IpAoiGet(GETBOUNDS, 0, aoirect)
aoilst(0) = aoirect.Left
aoilst(1) = aoirect.Right
aoilst(2) = aoirect.top
aoilst(3) = aoirect.bottom
' ret = IpAoiCreateEllipse(aoirect)
arrShape(i) = aoiLst
IpAnCreateObj(GO_OBJ_ELLIPSE) ' create annotation object representing ROI
IpAnMove(0 , aoirect.Left , aoirect.top)
IpAnMove(5 , aoirect.Right , aoirect.bottom)
ret = IpAnCreateObj(GO_OBJ_TEXT)
ret = IpAnMove(0, aoirect.Left, aoirect.top - 25)
ret = IpAnSet(GO_ATTR_FONTSIZE, 28)
ret = IpAnSet(GO_ATTR_TEXTAUTOSIZE, 1)
ret = IpAnSet(GO_ATTR_TEXTCOLOR, 255)
ret = IpAnText(IpTrim(ROItext(i)))
ret = IpAnMove(5, aoirect.Right, aoirect.bottom)
ElseIf aoiType = AOI_POLYGON Then
ret = IpAoiGet(GETNUMPTS, 0, numPts)
ReDim aoiPts(numPts-1)
ret = IpAoiGet(GETPOINTS, numPts-1, aoiPts(0))
numPolyArrPts(i) = numPts
arrShape(i) = aoiPts
ret = IpAnCreateObj(GO_OBJ_POLY) ' create annotation object representing ROI
ret = IpAnPolyAddPtArray(aoiPts(0), numPts)
ret = IpAnSet(GO_ATTR_CONNECT, 1)
Dim PolyAOItext As RECT
PolyAOItext.Left = aoiPts(0).x
PolyAOItext.top = aoiPts(0).y
PolyAOItext.Right = aoiPts(0).x + 100
PolyAOItext.bottom = aoiPts(0).y + 100
ret = IpAnCreateObj(GO_OBJ_TEXT)
ret = IpAnMove(0, PolyAOItext.Left, PolyAOItext.top)
ret = IpAnSet(GO_ATTR_FONTSIZE, 28)
ret = IpAnSet(GO_ATTR_TEXTAUTOSIZE, 1)
ret = IpAnSet(GO_ATTR_TEXTCOLOR, 255)
ret = IpAnText(IpTrim(ROItext(i)))
ret = IpAnMove(5, PolyAOItext.Right, PolyAOItext.bottom)
End If
Next i
ret = IpAOIShow(FRAME_NONE)
Call AnnotateDelete()
'*****************************************************************
' moving the AOIs on subsequent frames
If moveAOIs = 0 Then
For k = 0 To numFrames - 1
If k = 0 Then
ret = IpSeqPlay(SEQ_FFRA) 'Go to the first frame
Else
ret = IpSeqPlay(SEQ_NEXT) 'Go to the next frame
End If
For i = 0 To NumAOIs - 1 'moving the AOIs
aoiOffset(-1 , i).x = 0
aoiOffset(-1 , i).y = 0
' regenerate ROI from last position
If arrType(i) = AOI_BOX Then ' AOI_BOX = 1
aoirect.Left = arrShape(i)(0) + aoiOffset(k - 1 , i).x
aoirect.Right = arrShape(i)(1) + aoiOffset(k - 1 , i).x
aoirect.top = arrShape(i)(2) + aoiOffset(k - 1 , i).y
aoirect.bottom = arrShape(i)(3) + aoiOffset(k - 1 , i).y
ret = IpAoiCreateBox(aoirect)
ElseIf arrType(i) = AOI_ELLIPSE Then ' AOI_ELLIPSE = 3
aoirect.Left = arrShape(i)(0) + aoiOffset(k - 1 , i).x
aoirect.Right = arrShape(i)(1) + aoiOffset(k - 1 , i).x
aoirect.top = arrShape(i)(2) + aoiOffset(k - 1 , i).y
aoirect.bottom = arrShape(i)(3) + aoiOffset(k - 1 , i).y
ret = IpAoiCreateEllipse(aoirect)
ElseIf arrType(i) = AOI_POLYGON Then ' AOI_POLYGON = 5
numPts = UBound(arrShape(i)) - LBound(arrShape(i)) + 1
ReDim aoiPts(numPts)
aoipts = arrShape(i)
For m = 0 To numPts - 1
aoiPts(m).x = aoiPts(m).x + aoiOffset(k - 1 , i).x
aoiPts(m).y = aoiPts(m).y + aoiOffset(k - 1 , i).y
Next m
ret = IpAoiCreateIrregular(aoiPts(0) , numPts)
End If
Begin Dialog UserDialog 310,77,"Move ROI" ' %GRID:10,7,1,1
Text 20,7,280,21,"Adjust ROI#" & (i + 1) & " position for frame " & (k + 1),.Text1
OKButton 160,42,90,21
CancelButton 30,42,90,21
End Dialog
Dim dlgAOImovement As UserDialog
ret = Dialog(dlgAOImovement)
If ret = 0 Then Exit Sub ' not cause the error message when CANCEL button pushed
ret = IpAoiValidate()
If arrType(i) = AOI_BOX Then ' AOI_BOX = 1
ret = IpAoiGet(GETBOUNDS, 0, aoirect)
aoiOffset(k , i).x = aoirect.Left - arrShape(i)(0)
aoiOffset(k , i).y = aoirect.top - arrShape(i)(2)
ElseIf arrType(i) = AOI_ELLIPSE Then ' AOI_ELLIPSE = 3
ret = IpAoiGet(GETBOUNDS, 0, aoirect)
aoiOffset(k , i).x = aoirect.Left - arrShape(i)(0)
aoiOffset(k , i).y = aoirect.top - arrShape(i)(2)
ElseIf arrType(i) = AOI_POLYGON Then ' AOI_POLYGON = 5
ret = IpAoiGet(GETNUMPTS, 0, numPts)
ReDim aoiPts(numPts - 1)
ret = IpAoiGet(GETPOINTS, numPts - 1, aoiPts(0))
aoiOffset(k , i).x = aoiPts(0).x - arrShape(i)(0).x
aoiOffset(k , i).y = aoiPts(0).y - arrShape(i)(0).y
End If
Next i
Next k
End If
'*****************************************************************
'drawing AOIs and getting intensity measurements from within each
'outputting data to output window
Dim tb As String
tb = Chr$(9)
ret = IpOutput("Mean intensity :")
Debug.Print
Debug.Print
ret = IpOutput("Frame #")
For i = 0 To numAOIs - 1
ret = IpOutput(tb & tb & iPTrim(ROItext(i)))
Next i
Debug.Print
Debug.Print
ret = IpSeqPlay(SEQ_FFRA) 'Go to the first frame
For k = 0 To numFrames - 1
ret = IpOutput(" " & Str$((k + 1)) & tb & tb)
For i = 0 To numAOIs - 1
ROIcolorcode = i-6*Int(i/6)+1
ROIpencolor = Choose(ROIcolorcode, 255, 65535, 65280, 16711935, 16776960, 16711680)
Select Case arrType(i)
Case AOI_BOX
aoirect.Left = arrShape(i)(0) + aoiOffset(k, i).x
aoirect.Right = arrShape(i)(1) + aoiOffset(k, i).x
aoirect.top = arrShape(i)(2) + aoiOffset(k, i).y
aoirect.bottom = arrShape(i)(3) + aoiOffset(k, i).y
ret = IpAoiCreateBox(aoirect)
IpAnCreateObj(GO_OBJ_RECT) ' create annotation object representing AOI
IpAnMove(0 , aoirect.Left , aoirect.top)
IpAnMove(5 , aoirect.Right , aoirect.bottom)
ret = IpAnSet(GO_ATTR_PENCOLOR, ROIpencolor)
IpAnSet(GO_ATTR_PENSTYLE, i)
ret = IpAnCreateObj(GO_OBJ_TEXT)
ret = IpAnMove(0, aoirect.Left, aoirect.top - 25)
ret = IpAnSet(GO_ATTR_FONTSIZE, 16)
ret = IpAnSet(GO_ATTR_TEXTAUTOSIZE, 1)
ret = IpAnSet(GO_ATTR_TEXTCOLOR, 255)
ret = IpAnText(IpTrim(ROItext(i)))
ret = IpAnMove(5, aoirect.Right, aoirect.bottom)
Case AOI_ELLIPSE
aoirect.Left = arrShape(i)(0) + aoiOffset(k, i).x
aoirect.Right = arrShape(i)(1) + aoiOffset(k, i).x
aoirect.top = arrShape(i)(2) + aoiOffset(k, i).y
aoirect.bottom = arrShape(i)(3) + aoiOffset(k, i).y
ret = IpAoiCreateEllipse(aoirect)
IpAnCreateObj(GO_OBJ_ELLIPSE) ' create annotation object representing AOI
IpAnMove(0 , aoirect.Left , aoirect.top)
IpAnMove(5 , aoirect.Right , aoirect.bottom)
ret = IpAnSet(GO_ATTR_PENCOLOR, ROIpencolor)
IpAnSet(GO_ATTR_PENSTYLE, i)
ret = IpAnCreateObj(GO_OBJ_TEXT)
ret = IpAnMove(0, aoirect.Left, aoirect.top - 25)
ret = IpAnSet(GO_ATTR_FONTSIZE, 16)
ret = IpAnSet(GO_ATTR_TEXTAUTOSIZE, 1)
ret = IpAnSet(GO_ATTR_TEXTCOLOR, 255)
ret = IpAnText(IpTrim(ROItext(i)))
ret = IpAnMove(5, aoirect.Right, aoirect.bottom)
Case AOI_POLYGON
numPts = UBound(arrShape(i)) - LBound(arrShape(i)) + 1
ReDim aoiPts(numPts)
aoipts = arrShape(i)
For m = 0 To numPts - 1
aoiPts(m).x = aoiPts(m).x + aoiOffset(k , i).x
aoiPts(m).y = aoiPts(m).y + aoiOffset(k , i).y
Next m
ret = IpAoiCreateIrregular(aoiPts(0) , numPts)
ret = IpAnCreateObj(GO_OBJ_POLY) ' create annotation object representing AOI
ret = IpAnPolyAddPtArray(aoiPts(0), numPts)
ret = IpAnSet(GO_ATTR_CONNECT, 1)
ret = IpAnSet(GO_ATTR_PENCOLOR, ROIpencolor)
IpAnSet(GO_ATTR_PENSTYLE, i)
PolyAOItext.Left = aoiPts(0).x
PolyAOItext.top = aoiPts(0).y
PolyAOItext.Right = aoiPts(0).x + 100
PolyAOItext.bottom = aoiPts(0).y + 100
ret = IpAnCreateObj(GO_OBJ_TEXT)
ret = IpAnMove(0, PolyAOItext.Left, PolyAOItext.top)
ret = IpAnSet(GO_ATTR_FONTSIZE, 16)
ret = IpAnSet(GO_ATTR_TEXTAUTOSIZE, 1)
ret = IpAnSet(GO_ATTR_TEXTCOLOR, 255)
ret = IpAnText(IpTrim(ROItext(i)))
ret = IpAnMove(5, PolyAOItext.Right, PolyAOItext.bottom)
End Select
ReDim HistogramStats(10) As Single
ReDim HistogramRange(10) As Single
ret = IpHstGet(GETSTATS, 0, HistogramStats(0))
ret = IpHstGet(GETRANGE, 0, HistogramRange(0))
ret = IpOutput(Format$(HistogramStats(0),"##.000000") & tb)
' ret = IpMacroWait(4)
Next i
Debug.Print ""
ret = IpSeqPlay(SEQ_NEXT) 'Go to the next frame
Next k
End Sub
Private Sub AnnotateDelete()
Dim nObj As Integer
Dim nList() As Long
Dim i As Integer
Dim nObjects As Integer
' Check the number of annotation objects
ret = IpAnGet(GO_OBJ_NUMBER, nObj)
If nObj = 0 Then GoTo Finished
' Get their ID's (which are probably not sequential)
ReDim nList(nObj)
For i=0 To (nObj-1)
nList(i+1) = IpAnGet(GO_OBJ_INDEX, i)
Next
' Select and delete them
For i=0 To (nObj-1)
ret = IpAnActivateObjID(nList(i+1))
ret = IpAnDeleteObj()
Next
' ret = IpClprDeleteSampler() 'also delete any caliper which might exist
ret = IpAoiMultAppend(0) 'and multiple AOI's
ret = IpAoiShow(FRAME_NONE) 'and hide all AOI's
Finished:
End Sub
Function CreateDefaultPaths()
Dim AppDir As String * 255
Dim AppPathName As String
ret = IpOutputShow(0)
ret = IpAppGetStr(GETAPPDIR, 0, AppDir)
AppPathName = IpTrim$(AppDir)
End Function
