' ******** CHANGE HISTORY *****************
' 1/5/98 Demo Macros for 16-bit Image-Pro Plus Demo CD, v. 3.0.1

Static PathName as string


Function ParsePathName(ImageName as string) as integer
'  check if global PathName already exists, if not get image and 
	Dim ImdirListing as integer, i as integer, j as integer, strlength1 as integer
	Dim firstfile as string, tempstring as string * 255, str1 as string, str2 as string
	Dim FileString as string * 255, Heading as string * 255
	if PathName <> "" then
		str1 = PathName + Imagename
		ParsePathName = IpWsLoad(str1,"TIF") 'path already exists, try to open
		if ParsePathName >= 0 then 'image opened
		exit Function
		end if
	end if 
	str1 = "Please locate the image named " + ImageName
	ret = IpMacroStop(str1,MS_MODAL)

	str1 = "Find " + Imagename
	str2 = PathName + ImageName
	Heading = str1
	FileString = str2
	ImDirListing = IpStGetName(heading,FileString,"*.TIF",tempstring)
	if ImDirListing = 0 then 'cancel was hit
		ParsePathName = -1
		exit Sub
	end if

	strlength1 = instr(1,tempstring,chr$(0)) - 1
	firstfile = left$(tempstring,strlength1)
' load the image
	ImdirListing = IpWsLoad(firstfile,"TIF")

	'now Parse for path name by finding the last '\'
	j= instr(firstfile,"\")
	do while j <> 0
		i = j
		j = instr(j+1, firstfile,"\")
	loop
	PathName = left$(firstfile,i)
	ParsePathName = ImdirListing 'found a new path and opened the image OK
end function
'***************************************************************************

Sub Separate_Fluorochromes()
	dim dinfo as IPDOCINFO
	dim values(3) as single
	dim hWnd as long
	dim red as integer, green as integer, blue as integer
	dim currentdoc as long, newcombo as long
	dim str1 as string, str2 as string


	ret = IpAppMaximize()
	ret = IpAppCloseAll()
	'original = IpWsLoad("fltriple.tif", "TIF")
	currentdoc = ParsePathName("fltriple.tif")

	
	'ret = IpDocGet(GETACTDOC, 0, currentdoc)
	if currentdoc < 0 then 
		ret = IpMacroStop("Please load a color fluorescence image, preferably 'fltriple.tif'", MS_MODAL)
		ret = IpTemplateMode(1)
		currentdoc = IpWsLoad("fltriple.tif","TIF")
		ret = IpTemplateMode(0)
	end if 

	ret = IpDocGet(GETDOCINFO, DOCSEL_ACTIVE, dinfo)
	if dinfo.class <> IMC_RGB then 
		ret = IpMacroStop("Color images only", MS_MODAL)
		goto end_separate
	end if
	ret = IpMacroStop("We will show how Image-Pro Plus can separate the colors of this image.", MS_MODAL)
	ret = IpAppSelectDoc(currentdoc)
	red = IpWsDuplicate()
	ret = IpDocGet(GETDOCWND, DOCSEL_ACTIVE, hWnd)
	ret = IpWsChangeDescription(INF_NAME,"Red")
	values(0) = 0
	values(1) = 256
	values(2) = 256
	ret = IpOpNumberRgb(values, OPA_SUB, 0)

	ret = IpAppSelectDoc(currentdoc)
	green = IpWsDuplicate()
	ret = IpDocGet(GETDOCWND, DOCSEL_ACTIVE, hWnd)
	ret = IpWsChangeDescription(INF_NAME,"Green")
	values(0) = 256
	values(1) = 0
	values(2) = 256
	ret = IpOpNumberRgb(values, OPA_SUB, 0)

	ret = IpAppSelectDoc(currentdoc)
	blue = IpWsDuplicate()
	ret = IpDocGet(GETDOCWND, DOCSEL_ACTIVE, hWnd)
	ret = IpWsChangeDescription(INF_NAME,"Blue")
	values(0) = 256
	values(1) = 256
	values(2) = 0
	ret = IpOpNumberRgb(values, OPA_SUB, 0)

	' Zoom out and tile 
	ret = IpAppSelectDoc(blue)
	ret = IpWsZoom(50)
	ret = IpAppSelectDoc(green)
	ret = IpWsZoom(50)
	ret = IpAppSelectDoc(red)
	ret = IpWsZoom(50)
	ret = IpAppSelectDoc(currentdoc)
	ret = IpWsZoom(50)
	ret = IpAppArrange(DOCS_TILE)
	ret = IpHstCreate()
	ret = IpHstSetAttr(STATISTICS, 2)
	ret = IpHstScale(0, 1, 0, 0)
	ret = IpHstScale(1, 1, 0, 0)
	ret = IpMacroStop("The histogram shows the intensities of the three channels.", MS_MODAL)
	ret = IpMacroStop("Would you like to make the enhance the visibility of the blue channel?",MS_MODAL+MS_YESNO)
	if ret = 0 then 'get out
		goto end_separate
	end if
	ret = IpHstDestroy()
	str1 = "One way to make the blue channel more visible is to display it as cyan.  "
	str2 = "We can make a cyan image by displaying the blue channel in both the blue and green channels."
	ret = IpMacroStop(str1 + str2,MS_MODAL)
	str1 = "Then we combine the maximum values of the blue and green channels into the green channel.  "
	str2 = "Finally, we rebuild the color image with the red, (green and blue), and blue channels."
	ret = IpMacroStop("First we extract each of the channels in the original image."+str1+str2,MS_MODAL)
	ret = IpAppSelectDoc(currentdoc)
	red = IpCmChannelExtract(CM_RGB, CM_RGB, 0)
	ret = IpAppSelectDoc(currentdoc)
	green = IpCmChannelExtract(CM_RGB, CM_RGB, 1)
	ret = IpAppSelectDoc(currentdoc)
	blue = IpCmChannelExtract(CM_RGB, CM_RGB, 2)
	ret = ipappselectdoc(green)
	ret = IpOpImageArithmetics(blue, 0.0, OPA_MAX, 0)
	ret = IpCmChannelMerge3(-1, red, green, blue, CM_RGB, 1)
	ret = IpDocGet(GETACTDOC,0,newcombo)
	ret = IpWsChangeDescription(INF_NAME,"Color w/ Enhanced Blue")
	ret = IpWsZoom(50)
	ret = IpAppSelectDoc(red)
	ret = IpDocClose()
	ret = IpAppSelectDoc(green)
	ret = IpDocClose()
	ret = IpAppSelectDoc(blue)
	ret = IpDocClose()
	ret = IpAppArrange(DOCS_TILE)
	ret = IpMacroStop("Now Enhance the New Image by adding some Nomarski-like edge detection.",MS_MODAL+MS_OKCAN)
	if ret = 1 then
		ret = IpAppSelectDoc(newcombo)
		ret = IpFltConvolveKernel("SCULPT.3x3", 5, 1)
		call sculpt()
	end if
end_separate:
End Sub

'******************************************************************************************

Sub Small_Cells()

	dim currentdoc as integer
	dim dinfo as IPDOCINFO
	dim values(3) as single
	dim hWnd as integer

	ret = IpAppMaximize()
	ret = IpDocMinimize()
	ret = IpAppCloseAll()
	currentdoc = ParsePathName("FLDUAL.TIF")

'Separate Fluorochromes routine
	if currentdoc < 0 then 
		ret = IpAppCloseAll()
		ret = IpMacroStop("Please find and load 'fldual.tif'", MS_MODAL)
		ret = IpTemplateMode(1)
		currentdoc = IpWsLoad("fldual.tif","TIF")
		ret = IpTemplateMode(0)
	end if 
	if currentdoc < 0 then
		goto end_separate2
	end if
	ret = IpDocGet(GETDOCINFO, DOCSEL_ACTIVE, dinfo)
	if dinfo.class <> IMC_RGB then 
		ret = IpMacroStop("Color images only", MS_MODAL)
		goto end_separate2
	end if
	ret = IpMacroStop("This macro will separate a fluorescence image and count cells.", MS_MODAL)
	ret = IpAppSelectDoc(DOCSEL_ACTIVE)
	ret = IpWsDuplicate()
	ret = IpDocGet(GETDOCWND, DOCSEL_ACTIVE, hWnd)
	ret = IpWsChangeDescription(INF_NAME,"Red")
	values(0) = 0
	values(1) = 256
	values(2) = 256
	ret = IpOpNumberRgb(values, OPA_SUB, 0)
	ret = IpAppSelectDoc(currentdoc)
	ret = IpWsDuplicate()
	ret = IpDocGet(GETDOCWND, DOCSEL_ACTIVE, hWnd)
	ret = IpWsChangeDescription(INF_NAME,"Green")
	values(0) = 256
	values(1) = 0
	values(2) = 256
	ret = IpOpNumberRgb(values, OPA_SUB, 0)

	ret = IpAppSelectDoc(currentdoc)
	ret = IpWsDuplicate()
	ret = IpDocGet(GETDOCWND, DOCSEL_ACTIVE, hWnd)
	ret = IpWsChangeDescription(INF_NAME,"Blue")
	values(0) = 256
	values(1) = 256
	values(2) = 0
	ret = IpOpNumberRgb(values, OPA_SUB, 0)

	' Zoom out and tile 
	ret = IpAppSelectDoc(3)
	ret = IpWsZoom(50)
	ret = IpAppSelectDoc(2)
	ret = IpWsZoom(50)
	ret = IpAppSelectDoc(0)
	ret = IpWsZoom(50)
	ret = IpAppSelectDoc(1)
	ret = IpWsZoom(50)
	ret = IpAppArrange(DOCS_TILE)

	ret = IpMacroStop("Let's concentrate on the green channel. This contains most of the cell information.", MS_MODAL)
	ret = IpAppSelectDoc(2)
	ret = IpAppSelectDoc(1) 
	ret = IpDocClose()
	ret = IpAppSelectDoc(2)
	ret = IpAppSelectDoc(3)
	ret = IpDocClose()
	ret = IpAppSelectDoc(2)
	ret = IpDocMove(148, 119)
	ret = IpDocMaximize()
	ret = IpDocSize(265, 284)
	ret = IpMacroStop("We will convert this image to a grey scale image to speed up processing.", MS_MODAL)
	ret = IpWsConvertToGray()
	ret = IpMacroStop("Let's equalize the intensities of this image.", MS_MODAL)
	ret = IpHstEqualize(EQ_BESTFIT)
	ret = IpLutApply()
	ret = IpMacroStop("We'll now automatically count all the small cells in this image.", MS_MODAL)
	ret = IpBlbShow(1)
	ret = IpBlbSetAttr(BLOB_AUTORANGE, 1)
	ret = IpBlbSetAttr(BLOB_BRIGHTOBJ, 1)
	ret = IpBlbSetAttr(BLOB_OUTLINEMODE, 3)
	ret = IpBlbSetAttr(BLOB_LABELMODE, 0)
	ret = IpBlbCount()
	ret = IpBlbUpdate(0)
	ret = IpMacroStop("If we zoom in, we see several cells that are touching.", MS_MODAL)
	ret = IpWsZoom(200)
	ret = IpMAcroStop("Image-Pro Plus's watershed split function will separate cells to get a accurate count.", MS_MODAL)
	ret = IpBlbSplitObjects(1)
	ret = IpWsZoom(200)
	ret = IpBlbSetFilterRange(BLBM_AREA, 15.0, 1000000.0)
	ret = IpBlbFilter()
	ret = IpMacroStop("We will measure the area and average diameter of each cell...", MS_MODAL)
	ret = IpBlbEnableMeas(BLBM_ALL,0)
	ret = IpBlbEnableMeas(BLBM_AREA, 1)
	ret = IpBlbEnableMeas(BLBM_MEANFERRET, 1)
	ret = IpBlbEnableMeas(BLBM_ROUNDNESS, 1)
	ret = IpBlbMeasure()
	ret = IpWsZoom(100)
	ret = IpMacroStop("...and display a histogram of areas.", MS_MODAL)
	ret = IpBlbShow(0)
	ret = IpBlbShowHistogram(BLBM_AREA, 50, 1)
	ret = IpMacroStop("...or histogram of average diameters.", MS_MODAL)
	ret = IpBlbShowHistogram(BLBM_MEANFERRET, 50, 1)

end_separate2:
End Sub

'*******************************
Sub Stained_Cells()

	ret = IpAppMaximize()
	ret = IpAppCloseAll()
	ret = IpMacroStop("The image used in this demo will look clearer if your system has a 24-bit display.", MS_MODAL)

	ret = ParsePathName("nucstain.tif")
	if ret < 0 then
		ret = IpMacroStop("Find and load the image 'nucstain.tif'",MS_MODAL)
		ret = IpTemplateMode(1)
		ret = IpWsLoad("nucstain.tif", "TIF")
		if ret < 0 then
			goto end_stained
		end if
		ret = IpTemplateMode(0)
	end if

	ret = IpMacroStop("Here is an image of stained cells. ", MS_MODAL)
	ret = IpMacroStop("We'll first enhance the image.", MS_MODAL)
	ret = IpHstEqualize(EQ_BESTFIT)
	ret = IpLutApply()
	ret = IpMacroStop("We will now count and measure the stained areas.", MS_MODAL)
	ret = IpBlbShow(1)
	ret = IpBlbSetAttr(BLOB_AUTORANGE, 0)
	ret = IpBlbSetAttr(BLOB_LABELMODE,0)
	ret = IpSegShow(1)
'**** Insert for 3.0 *********** Start ************
	ret = IpBlbShow(1)
	ret = IpBlbDelete()
	ret = IpSegSetAttr(COLORMODEL, CM_HSI)
	ret = IpSegSetAttr(SEGMETHOD, SEG_HISTOGRAM)
	ret = IpMacroStop("Setting Color 1 (red) for Nuclei",MS_MODAL)
	ret = IpSegRename(0, "Nuclei")
	ret = IpSegSetAttr(SETCURSEL, 0)
	ret = IpSegSetRange(0, 168, 198)
	ret = IpSegSetRange(1, 70, 255)
	ret = IpSegSetRange(2, 30, 182)
	ret = IpMacroStop("Setting Color 2 (yellow) for Cytoplasm",MS_MODAL)
	ret = IpSegNew("Cytoplasm")
	ret = IpSegSetAttr(SETCURSEL, 1)
	ret = IpSegSetRange(0, 203, 222)
	ret = IpSegSetRange(1, 41, 184)
	ret = IpSegSetRange(2, 117, 230)
	ret = IpMacroStop("Setting Color 3 (green) for Background",MS_MODAL)
	ret = IpSegNew("Background")
	ret = IpSegSetAttr(SETCURSEL, 2)
	ret = IpSegSetRange(0, 42, 255)
	ret = IpSegSetRange(1, 0, 43)
	ret = IpSegSetRange(2, 213, 255)
'****Insert for 3.0 ************* End ****************

	ret = IpMacroStop("The selected color ranges will be measured.", MS_MODAL)
	ret = IpSegShow(0)

'**** 3.0 addition start **************
	ret = IpBlbSetAttr(BLOB_SMOOTHING,0)
	ret = IpBlbSetAttr(BLOB_FILLHOLES,0)
	ret = IpBlbSetAttr(BLOB_OUTLINEMODE,3)
	ret = IpBlbSetAttr(BLOB_CLEANBORDER,0)
	ret = IpBlbSetAttr(BLOB_FILTEROBJECTS, 0)
'******* 3.0 addition end ******************
	ret = IpBlbSetFilterRange(BLBM_AREA, 50.0, 1000000.0)
	ret = IpMacroStop("We'll now obtain area, density and percent stain measurements.", MS_MODAL)
	ret = IpBlbEnableMeas(BLBM_ALL, 0)
	ret = IpblbEnableMeas(BLBM_AREA,1)
	ret = IpBlbEnableMeas(BLBM_PERAREA, 1)
	ret = IpBlbEnableMeas(BLBM_DENSITY, 1)
	ret = IpBlbCount()
	ret = IpBlbUpdate(1)
	ret = IpAppMenuSelect(0,0,"Count/&Size...",MENU_NAME)
	ret = IpAppMenuSelect(2,5,"",DLG_MENU_COORD)
	ret = IpMacroStop("The range statistics for each color are shown in the dialog box.",0)
end_stained:
End Sub


'************************************
Sub MeasureAngles()
	dim str1 as string, str2 as string
	dim r1 as integer, r2 as integer
	dim Angle as single
	Dim NumObj As integer

	ret = IpAppCloseAll()
	r1 = ParsePathName("fetlock.tif")
	if r1 < 0 then
		ret = IpMacroStop("Find and load the image 'fetlock.tif'", MS_MODAL)
		ret = IpTemplateMode(1)
		r1 = IpWsLoad("fetlock.tif","TIF")
		if r1 < 0 then
			goto end_fetlock
		end if
		ret = IpTemplateMode(0)
	end if
	ret = IpMacroStop("This is the x-ray of the fetlock of a horse.", MS_MODAL)
	r2 = IpWsDuplicate()
	ret = IpWsChangeDescription(INF_NAME,"Thresholded Image")
	ret = IpMacroStop("First, threshold the bones in the x-ray", MS_MODAL)
	ret = IpLutBinarize(33, 185, 1)
	ret = IpMacroStop("Then, clean up the image with an erosion.", MS_MODAL)
	ret = IpFltErode(MORPHO_5x5OCTAGON, 2)
	ret = IpMacroStop("Now thin the segmented bones to skeletal(in the imaging sense) elements.", MS_MODAL)
	ret = IpFltThin(50)
	ret = IpMacroStop("Dilate a little to help smooth the skeleton.", MS_MODAL)
	ret = IpFltDilate(MORPHO_3x3CROSS, 1)
	ret = IpFltDilate(MORPHO_5x5OCTAGON, 1)
	ret = IpMacroStop("Choose the segments of the bones to measure.", MS_MODAL)
	ipRect.left = 120
	ipRect.top = 23
	ipRect.right = 170
	ipRect.bottom = 127
	ret = IpAoiCreateBox(ipRect)
	ret = IpAoiMultShow(1)
	ret = IpAoiMultAppend(1)
	ipRect.left = 99
	ipRect.top = 198
	ipRect.right = 145
	ipRect.bottom = 266
	ret = IpAoiCreateBox(ipRect)
	ret = IpAoiMultAppend(1)
	ret = IpMacroStop("Finally, measure the angles and create an image of the original x-ray and the image skeletons.", MS_MODAL)
	ret = IpBlbEnableMeas(BLBM_ALL, 0)
	ret = IpBlbEnableMeas(BLBM_DIRECTION, 1)
	ret = IpBlbSetAttr(BLOB_AUTORANGE, 1)
	ret = IpBlbSetAttr(BLOB_BRIGHTOBJ, 1)
	ret = IpBlbSetAttr(BLOB_CLEANBORDER, 0)
	ret = IpBlbCount()
	ret = IpBlbUpdate(0)
	ret = IpBlbShowData(1)
	ret = IpCmChannelMerge3(-1, r2, r1, 0, CM_RGB, 1)
	ret = IpWsChangeDescription(INF_NAME,"X-Ray with 'skeleton' overlay")
	ret = IpAppArrange(DOCS_TILE)
	ret = IpAppSelectDoc(r2)
	str1 = "The two angles are given in the measurement data box. A simple subtraction will give the resultant angle."
	str2 ="  The angle is the angle of the major axis of an ellipse which fits the line within each AOI."
	ret = IpMacroStop(str1 + str2, MS_MODAL)

	ret = IpBlbGet(GETNUMOBJ, 0, 0, NumObj)
	if NumObj <= 1 then
		ret = IpMacroStop("Error in finding angles.",MS_STOP)
		goto end_fetlock
	end if
	Redim Values(NumObj-1) As Single
	ret = IpBlbData(BLBM_DIRECTION, 0, NumObj - 1, Values(0))
	if Values(0) > Values(1) then
		Angle = Values(0) - Values(1)
	else
		Angle = Values(1) - Values(0)
	end if

	str1 = "The angle between the two bones is " + str$(Angle) + " degrees."
	ret = IpTextFont("System", 14)
	ret = IpTextSetAttr(TXT_BOLD, 1)
	ret = IpTextSetAttr(TXT_UNDERLINE, 0)
	ret = IpTextSetAttr(TXT_ITALIC, 0)
	ret = IpTextSetAttr(TXT_STRIKEOUT, 0)
	ret = IpTextSetAttr(TXT_ENCLOSED, 0)
	ret = IpTextSetAttr(TXT_DROPSHADOW, 0)
	ret = IpTextSetAttr(TXT_SPACING, 0)
	Pts(0).x = 8
	Pts(0).y = 62
	str1 = "Top Angle is " +chr$(10) +chr$(13) + str$(values(0)) + " degrees"
	ret = IpDrawText(str1, Pts(0),2)

	Pts(0).x = 6
	Pts(0).y = 196
	str1 = "Bottom Angle is " +chr$(10)  +chr$(13) + str$(values(1)) + " degrees"
	ret = IpDrawText(str1, Pts(0),2)

	Pts(0).x = 125
	Pts(0).y = 279
	str1 = "The difference is " +chr$(10) +chr$(13) + str$(angle) + " degrees"
	ret = IpDrawText(str1, Pts(0),2)

	ret = IpMacroStop(str1,MS_MODAL)

end_fetlock:
End Sub


Sub CountHoles()
	dim str1 as string

	ret = IpAppMaximize()
	ret = IpAppCloseAll()
	ret = IpMacroStop("The object of this demo is to count the number of holes in each bright object", MS_MODAL)
	ret = ParsePathName("exm50x.tif")
	str1 = "Set the Count/Size options to:" + chr$(10) + chr$(13)
	str1 = str1 + "1) Count Bright Objects" + chr$(10) + chr$(13)
	str1 = str1 + "2) Measure the area of each object" + chr$(10) 
	str1 = str1 + "3) Measure the number of holes in each object" + chr$(10)
	ret = IpMacroStop(str1,MS_MODAL)
	ret = IpBlbShow(1)
	ret = IpBlbSetAttr(BLOB_OUTLINEMODE,3)
	ret = IpBlbSetAttr(BLOB_LABELMODE,0)
	ret = IpBlbSetAttr(BLOB_FILLHOLES, 0)
	ret = IpBlbSetAttr(BLOB_AUTORANGE, 1)
	ret = IpBlbSetAttr(BLOB_BRIGHTOBJ, 1)
	ret = IpBlbSetAttr(BLOB_CLEANBORDER,1)
	ret = IpBlbEnableMeas(BLBM_ALL, 0)
	ret = IpBlbEnableMeas(BLBM_AREA, 1)
	ret = IpBlbEnableMeas(BLBM_NUMHOLES, 1)
	ret = IpBlbCount()
	ret = IpBlbUpdate(0)
	ret = IpBlbShowScattergram(BLBM_AREA, BLBM_NUMHOLES, 1)
	str1 = "Show the scattergram of the number of holes vs. the area of each object"
	ret = IpMacroStop(str1,MS_MODAL)
	ret = IpBlbShowScattergram(BLBM_AREA, BLBM_NUMHOLES, 0)

	ret = IpBlbShowAutoClass(ipClassifiers(0), 1, 5, 1, 1)
	str1 = "Break the population of objects into 5 classes based on the number of holes in each object."
	ret = IpBlbShow(1)
	call SpreadClass(BLBM_NUMHOLES)
	ret = IpMacroStop(str1,MS_MODAL)
End Sub


private Sub Spreadclass(byval MeasureType as integer)
	ipBins(0) = 0.0
	ipBins(1) = 5.0
	ipBins(2) = 10.0
	ipBins(3) = 15.0
	ipBins(4) = 20.0
	ipBins(5) = 25.0
	ret = IpBlbShowSingleClass(MEASURETYPE, ipBins(0), 5, 1)
	ret = IpblbSetAttr(BLOB_OUTLINEMODE,6)
	ret = IpBlbUpdate(2)
End Sub

Private Sub sculpt()
	ret = IpFltConvolveKernel("SCULPT.3x3", 5, 1)
	ret = IpHstEqualize(EQ_BESTFIT)
End Sub
'******************************************************************************************
Sub CastIron()

	ret = IpAppMaximize()
	ret = IpAppCloseAll()
	ret = ParsePathName("castiron.tif")

	if ret < 0 then
			goto end_stained
	end if

	ret = IpMacroStop("Here is an image of castiron. ", MS_MODAL)
	ret = IpMacroStop("We'll first smooth the image with a 7x7 median filter.", MS_MODAL)
	ret = IpFltMedian(7,1)
	ret = IpMacroStop("We will now measure the three phases in the image.", MS_MODAL)
	ret = IpBlbShow(1)
	ret = IpBlbSetAttr(BLOB_AUTORANGE, 0)
	ret = IpBlbSetAttr(BLOB_LABELMODE,0)
	ret = IpSegShow(1)
'************************ Insert for 3.0 *********** Start ************
	ret = IpBlbShow(1)
	ret = IpBlbDelete()
	ret = IpSegSetAttr(SEGMETHOD, SEG_HISTOGRAM)
	ret = IpMacroStop("Setting the dark phase (red)",MS_MODAL)
	ret = IpSegRename(0, "Dark")
	'ret = IpSegSetAttr(SETCURSEL, 0)
	ret = IpSegSetRange(0, 0, 84)
	ret = IpMacroStop("Setting the gray phase (green)",MS_MODAL)
	ret = IpSegNew("Gray")
	ret = IpSegSetAttr(SETCURSEL, 1)
	ret = IpSegSetRange(0, 85, 189)
	ret = IpMacroStop("Setting the bright phase (yellow)",MS_MODAL)
	ret = IpSegNew("Bright")
	ret = IpSegSetAttr(SETCURSEL, 2)
	ret = IpSegSetRange(0, 190,255)

	ret = IpMacroStop("The selected gray-value ranges will be measured.", MS_MODAL)
	ret = IpSegShow(0)
	
'*********** 3.0 addition start **************
	ret = IpBlbSetAttr(BLOB_SMOOTHING,0)
	ret = IpBlbSetAttr(BLOB_FILLHOLES,0)
	ret = IpBlbSetAttr(BLOB_OUTLINEMODE,3)
	ret = IpBlbSetAttr(BLOB_CLEANBORDER,0)
	ret = IpBlbSetAttr(BLOB_FILTEROBJECTS, 0)

'******* 3.0 addition end ******************
	ret = IpBlbSetFilterRange(BLBM_AREA, 50.0, 1000000.0)
	ret = IpMacroStop("We'll now obtain area and density stain measurements.", MS_MODAL)
	ret = IpBlbEnableMeas(BLBM_ALL, 0)
	ret = IpblbEnableMeas(BLBM_AREA,1)
	ret = IpBlbEnableMeas(BLBM_PERAREA, 1)
	ret = IpBlbEnableMeas(BLBM_DENSITY, 1)
	ret = IpBlbCount()
	ret = IpBlbUpdate(1)
	ret = IpAppMenuSelect(0,0,"Count/&Size...",MENU_NAME)
	ret = IpAppMenuSelect(2,5,"",DLG_MENU_COORD)
	ret = IpMacroStop("The range statistics for each phase are shown in the dialog box.",0)
end_stained:
End Sub

'***************************
Sub ThroughfocusSequence()
	dim str1 as string * 255
	dim str2 as string
	dim str3 as string * 255
	dim i as integer, j as integer, r1 as integer, r2 as integer
	dim rSequence as integer
	dim seqinfo as IPDOCINFO

	ret = IpAppCloseAll()
	str1 = "This macro will create a sequence of through focus images of the developing heart of an embryo"
	str2 = " and do a series of operations on the sequence."
	ret = IpMacroStop(str1+str2,MS_MODAL)

	r1 = ParsePathName("1z31g011.tif")
	if r1 < 0 then
		ret = IpMacroStop("Error in finding sequence 1z31g...")
		exit function
	end if

	ret = IpDocCloseEx(r1)
	str3 = PathName + "1z31g011.tif"
	str1 = str3 
	str2 = PathName + "1z31g###.tif"
	rSequence = IpSeqOpen(str3,"TIF",-1,-1)
	for i = 12 to 40
		ret = IpStAutoName(str2,i,str3)
		ret = IpSeqMerge(str3,"TIF",-1,-1)
	next i

	ret = IpMacroStop("We have created a sequence of 30 thru-focus images of an embryonic heart.", MS_MODAL)

	ret = IpAppMenuSelect(448, 0, "Toolbar...", MENU_NAME)
	ret = IpSeqPlay(SEQ_FOR)
	ret = IpAppMenuSelect(448, 0, "Toolbar...", MENU_NAME)
	ret = IpMacroStop("Would you like to apply a pseudocolor lookup table to the sequence?",MS_MODAL + MS_YESNO)
	if ret = 1 then
		ret = IpPcShow(0)
		ret = IpPcSetDivisions(128)
		ret = IpPcSetRange(-1,30, 255)
		ret = IpPcSetColorSpread(1)
		ret = IpSeqPlay(SEQ_STOP)
		ret = IpSeqPlay(SEQ_FOR)
	end if
	ret = IpMacroStop("Would you like to follow the histogram of an area of interest through the sequence?", MS_MODAL + MS_YESNO)
	if ret = 1 then
		call Time_Histogram()
	end if
	ret = IpMacroStop("Would you like to see a 2-D projection of the sequence?", MS_MODAL + MS_YESNO)
	if ret = 1 then
		ret = IpHstDestroy() 'slows down calculation of 2-D projection
		ret = IpAoiShow(FRAME_NONE)
		ret = IpAppSelectDoc(rSequence)
		
		ret = IpSeqPlay(SEQ_FFRA) ' go to first frame
		r1 = IpWsDuplicate()
		for i = 12 to 40
			ret = IpAppSelectDoc(rSequence)
			ret = IpSeqPlay(SEQ_NEXT)
			ret = IpDocGet(GETACTDOC,0,r2)
			ret = IpAppSelectDoc(r1)
			ret = IpOpImageArithmetics(r2,0,OPA_MAX,0)
		next i
		ret = IpAppSelectDoc(r1)
		ret = IpWsChangeDescription(INF_NAME,"A two-dimensional projection through the embryonic heart.")
	end if
		

End Sub
''****************************
private Sub Time_Histogram()
	ipRect.left = 182
	ipRect.top = 248
	ipRect.right = 390
	ipRect.bottom = 398
	ret = IpAoiCreateBox(ipRect)
	ret = IpAoiMove(-12, 10)
	ret = IpHstCreate()
	'ret = IpHstMove(357, 218)
	ret = IpHstSize(436, 238)
	ret = IpHstMove(314, 192)
	ret = IpAppMenuSelect(448, 0, "Toolbar...", MENU_NAME)
	ret = IpSeqPlay(SEQ_FOR)
	ret = IpAppMenuSelect(448, 0, "Toolbar...", MENU_NAME)
End Sub

''************************
sub MouseBrain()
'  fake autoradiography measurements
'  using arbitrarily selected numbers for density
'  vs. picocurie readings

	dim str1 as string, str2 as string
	dim r1 as integer
	dim textpt as POINTAPI

	ret = IpAppCloseAll()
	str1 = "This macro sets an arbitrary calibration curve of image density to picocuries and "
	str2 = "measures the average labeling for several regions in the mouse brain slice."
	ret = IpMacroStop(str1+str2,MS_MODAL)

	r1 = ParsePathName("MusBrain.tif")
	if r1 < 0 then
		ret = IpMacroStop("Can't find or load image")
		exit sub
	end if

	call SetCalibration()
	ret = IpMacroStop("The calibration curve is established; now set AOIs and Measure the average density in picocurie units",0)
	call SetMusAois()
' Annotate in overlay on the image
	str1 = "The value given at each AOI is the " + chr$(10) + "average density given in picocuries."
	ret = IpTextFont("Courier New", 12)
	ret = IpTextShow(0)
	textpt.x = 5
	textpt.y = 5
	ret = IpDrawText(str1,textpt,2)
	ret = IpICalShow(0) 'close calibration window
end sub

Private Sub SetCalibration()
	dim str1 as string
	dim ReturnName as string * 50
	dim ReturnVal as integer
	ret = IpICalShow(1)
	ret = IpICalMove(20,20)
	ReturnVal = IpCalGet("iName",ReturnName)
	str1 = rtrim$(ReturnName)
	if str1 <> "MouseBrain" or ReturnVal < 0 then
	ret = IpICalCreate()
	ret = IpICalSetName("MouseBrain")
	ret = IpICalSetUnitName("picocuries")
	end if
	ret = IpICalReset()
	ret = IpICalShowFormat(1)
	ret = IpICalSetOptDens(2.0,225.0)	
End Sub

Private Sub SetMusAois()
	dim numpts as integer
	dim i as integer
	dim drawPoints as POINTAPI

	ipRect.left = 146
	ipRect.top = 78
	ipRect.right = 196
	ipRect.bottom = 115
	ret = IpAoiCreateBox(ipRect)
	ret = IpAoiMultShow(1)
	ret = IpAoiMultAppend(1)
	ret = IpAoiMove(262, -3)
	ret = IpAoiMultAppend(1)
	ret = IpAoiMove(-273, 151)
	ret = IpAoiMultAppend(1)
	ret = IpAoiMove(324, 0)
	ret = IpAoiMultAppend(1)
	ret = IpAoiMove(-166, 102)
	ret = IpAoiMultAppend(1)
	ipRect.left = 293
	ipRect.top = 328
	ipRect.right = 312
	ipRect.bottom = 348
	ret = IpAoiCreateBox(ipRect)
	ret = IpAoiMove(-38, -186)
	ret = IpAoiMultAppend(1)
	ret = IpAoiMove(129, 0)
	ret = IpAoiMultAppend(1)
	ret = IpAoiShow(FRAME_NONE)
	ret = IpBlbSetRange(0, 255)
	ret = IpBlbEnableMeas(BLBM_ALL, 0)
	ret = IpBlbEnableMeas(BLBM_DENSITY, 1)
	ret = IpBlbEnableMeas(BLBM_CENTRX, 1)
	ret = IpBlbEnableMeas(BLBM_CENTRY, 1)
	ret = IpBlbSetAttr(BLOB_OUTLINEMODE, 1)
	ret = IpBlbSetAttr(BLOB_LABELMODE,0)
	ret = IpBlbSetAttr(BLOB_CLEANBORDER,0)
	ret = IpBlbCount()
	ret = IpBlbUpdate(0)
	ret = IpBlbGet(GETNUMOBJ,0,0,numpts)
	redim Dens(numpts) as single
	redim XCoords(numpts) as single
	redim YCoords(numpts) as single
	ret = IpBlbData(BLBM_DENSITY,0,numpts-1,Dens(0))
	ret = IpBlbData(BLBM_CENTRX,0,numpts-1,XCoords(0))
	ret = IpBlbData(BLBM_CENTRY,0,numpts-1,YCoords(0))
	for i = 0 to numpts -1
		drawPoints.x = XCoords(i)
		drawPoints.y = YCoords(i)
		ret = IpDrawText(str$(Dens(i)),drawPoints,1)
	next i
	ret = IpAoiMultAppend(0)
End Sub