Sub Main
   
'----------------------------------------------------------------------------------------------------------------------------------
'CHANGE VARIABLE VALUES BELOW TO CUSTOMIZE DEFAULT MACRO SETTINGS

	'Only change information to the right of the "=".
	'Do not delete any quotation marks (").
	
	FolderName = "X:\Karcher DIA Pix"	'Default folder containing images
	ImageRootName = "Image"			'Default image name
	ImageFileExtension = "jpg"		'Default file extension
	LowHue = 45						'Default lower hue threshold value
	HighHue = 100 					'Default upper hue threshold value
	LowSat = 0						'Default lower saturation threshold value
	HighSat = 100					'Default upper saturation threshold value
	LowInt = 0						'Default lower intensity threshold value
	HighInt = 100					'Default upper intensity threshold value
	FirstImageNumber = "001"		'Default first image number
	FinalImageNumber = "020"		'Default final image number
	SaveCheck = 1					'Default spreadsheet save option (0=no, 1=yes)
	Thresholdoptions = 0			'Default color analysis threshold option (0=no, 1=yes)
	CoverCheck = 1					'Default cover analysis execution (0=no, 1=yes)
	ColorCheck = 1					'Default color analysis execution (0=no, 1=yes)
	TotalPixelOptions = 1			'Default cover analysis total pixel option (0=every image, 1=first image, 2=user input)
'----------------------------------------------------------------------------------------------------------------------------------


'DO NOT EDIT BELOW LINE OR MACRO WILL NOT RUN PROPERLY!
'----------------------------------------------------------------------------------------------------------------------------------
   
   Dim App As Object
    Set App = CreateObject("SigmaScan.Application")
    Dim Worksheet As Object
    Set Worksheet = App.GetWorksheet
    Set Worksheet = Nothing
	ExeDirectory = App.GetExeFileDirectory()
    mydate = Format(Now, "dd_mm_yy__hh_nn_ss")
    
    
    '*** Create file system object for reading/writing macro preferred macro settings
    Dim f, fso
   	Const ForReading = 1 
   	Const ForWriting = 2
   	Const ForAppending = 8
   	Set fso = CreateObject("Scripting.FileSystemObject")
   	   		   	If fso.FileExists(MacroDir & "\Turf Analysis Macro Settings 1-2.txt") Then
			   	Set f = fso.OpenTextFile(MacroDir & "\Turf Analysis Macro Settings 1-2.txt", ForReading)
		   	 	FolderName = f.Readline
		   	 	FinalImageNumber = f.Readline
			   	LowHue = f.Readline
			   	HighHue = f.Readline
			   	LowSat = f.Readline
			   	HighSat = f.Readline
			   	SaveCheck = f.Readline
			   	Thresholdoptions = f.Readline
			   	CoverCheck = f.Readline
			   	ColorCheck = f.Readline
			   	TotalPixelOptions = f.Readline
			   	f.Close
			End If 
  	
    
    '*** Obtain info on first file to analyze ***
	Dim FilePath As String
	FirstFilePlace:
	FilePath = GetFilePath(,,FolderName,"First File To Analyze",0)
	Index1 = InStrRev(FilePath,Chr(92))
	Length1 = Len(FilePath)
	FolderName = Left(FilePath,Index1)
	Length2 = Length1 - Index1
	FileName = Mid(FilePath,(Index1+1),Length2)
	Length3 = Len(FileName)
	Index2 = InStr(FileName,Chr(46))
	ImageName = Left(FileName,(Index2-1))
	ImageFileExtension = Right(FileName,3)
	a = Len(ImageName)
	b=a
	Do
	string1 = Mid(ImageName,b,1)
	b=b-1
	Loop While string1 < "A"
	ImageRootName = Left(ImageName,(b+1))
	FirstImageNumber = Right(ImageName,(a-(b+1)))
		
	
	'*** dialog box for macro settings ***
	UserDialogPlace:
	Begin Dialog UserDialog 200,120,830,511,"Turf Analysis 1.2 - Settings" ' %GRID:10,7,1,1
		
		'*** file settings ***
		GroupBox 10,21,810,112,"Image Files Information"
		TextBox 30,56,780,21,.FolderName
		Text 30,91,180,14,"Shared name of images:"
		TextBox 30,105,130,21,.ImageRootName
		Text 210,91,160,14,"Image file extesnion:",.Text2
		TextBox 210,105,60,21,.ImageFileExtension
		Text 410,91,150,14,"First image number:"
		TextBox 410,105,80,21,.FirstImageNumber
		Text 570,91,150,14,"Final image number:"
		TextBox 570,105,80,21,.FinalImageNumber
		Text 30,42,420,14,"Folder containing images to be analyzed:",.Text1
	
        '*** color analysis settings ***
		GroupBox 10,147,470,77,"Color Analysis"
		CheckBox 30,168,200,21,"Perform color analysis",.ColorCheck
		OptionGroup .Thresholdoptions
			OptionButton 90,189,320,14,"Use entire image to calculate average color"
			OptionButton 90,203,380,14,"Use threshold settings below to calculate average color"
		
		'*** cover analysis settings ***
		GroupBox 10,238,410,105,"Cover Analysis",.GroupBox2
		CheckBox 30,259,200,14,"Perform cover analysis",.CoverCheck
		OptionGroup .TotalPixelOptions
			OptionButton 90,273,300,14,"Measure total pixels for every image (slow)"
			OptionButton 90,287,310,14,"Measure total pixles for first image only (fast)"
			OptionButton 90,301,320,14,"Enter total pixels shared by all images (fastest)"
		Text 130,315,90,14,"Total pixels:",.Text5
		TextBox 210,315,90,21,.TotalPixels
			
		'*** threshold settings ***
		GroupBox 10,357,330,84,"Threshold Settings",.GroupBox1
		Text 20,385,100,14,"From Hue:"
		TextBox 100,385,40,21,.LowHue
		Text 20,420,90,14,"To Hue:"
		TextBox 100,413,40,21,.HighHue
		Text 180,385,70,14,"From Sat:"
		TextBox 260,385,40,21,.LowSat
		Text 180,420,100,14,"To Sat:"
		TextBox 260,413,40,21,.HighSat
		
		'*** save as Excel option ***        
		CheckBox 10,455,500,14,"Save output as Excel worksheet in image folder",.SaveCheck
	
		'*** OK button ***
		OKButton 10,483,200,21
	
	End Dialog
   
   '*** create variables from user settings ***
    Dim dlg As UserDialog
    dlg.LowHue = LowHue  
	dlg.HighHue = HighHue
    dlg.LowSat = LowSat 
    dlg.HighSat = HighSat
 	dlg.FolderName = FolderName	
    dlg.ImageRootName = ImageRootName
    dlg.ImageFileExtension = ImageFileExtension
    dlg.FirstImageNumber =  FirstImageNumber
    dlg.FinalImageNumber = FinalImageNumber
    dlg.SaveCheck = SaveCheck
    dlg.Thresholdoptions = Thresholdoptions
    dlg.CoverCheck = CoverCheck
    dlg.ColorCheck = ColorCheck
    dlg.SaveCheck = SaveCheck
    dlg.TotalPixelOptions = TotalPixelOptions
    Dialog dlg ' show dialog (wait for ok)
    
    
    '*** change variables from user input in dialogue ***
    LowHue = CLng(dlg.LowHue)
	HighHue = CLng(dlg.HighHue)
	LowSat = CLng(dlg.LowSat)
	HighSat = CLng(dlg.HighSat)+1
	FolderName = dlg.FolderName
		If Mid(FolderName,Len(FolderName),1)<>"\" Then
			FolderName = FolderName & "\"
		End If	
	ImageRootName = dlg.ImageRootName
	ImageFileExtension = dlg.ImageFileExtension
	FirstImageNumber = dlg.FirstImageNumber
	FinalImageNumber = dlg.FinalImageNumber
	SaveCheck = dlg.SaveCheck
	Thresholdoptions = dlg.Thresholdoptions
	ColorCheck = dlg.ColorCheck
	CoverCheck = dlg.CoverCheck
	TotalPixelOptions = dlg.TotalPixelOptions
	 	
	'*** open new worksheet ***
	Set Worksheet = App.NewWorksheet
    Worksheet.Show
    Worksheet.MakePermanent
   
   	'*** clear all measurement settings ***
   	For i=0 To 54
	App.DoNotCollectMeasurement(i)
	Next i

    '*** label worksheet columns ***
    Worksheet.SetCellText("A",1,"IMAGE")
    Worksheet.SetCellText("B",1,"TOTAL PIXELS")
    Worksheet.SetCellText("C",1,"SELECTED PIXELS")
    Worksheet.SetCellText("D",1,"%COVER")
    Worksheet.SetCellText("E",1,"RED")
    Worksheet.SetCellText("F",1,"GREEN")
    Worksheet.SetCellText("G",1,"BLUE")
	Worksheet.SetCellText("H",1,"HUE")
	Worksheet.SetCellText("I",1,"SATURATION")
	Worksheet.SetCellText("J",1,"BRIGHTNESS")
		
	'*** define variable for spreadsheet row output ***
	j = 1

	'*** BEGIN ANALYSIS LOOP ***
	For i=CLng(FirstImageNumber) To CLng(FinalImageNumber)
	
		'*** add leading zeros to image names***
		Zeros = ""
		If Len(i) < Len(FirstImageNumber) Then
			NumZeros = Len(FirstImageNumber) - Len(i)
	    	For ii = 1 To NumZeros
	    	Zeros = Zeros & "0"
	    	Next ii
	    End If
	    
	    '*** open image to analyze ***
		Set Turfimage = App.OpenImage(FolderName&ImageRootName&Zeros&i&"."&ImageFileExtension)
		ResultCode = Turfimage.SetZoomLevel(0.5)'zoom out to view analysis of image
    	j = j + 1 	'advance spreadsheet row for output
   		Worksheet.SetCellText("A",j,FolderName&ImageRootName&Zeros&i&"."&ImageFileExtension)
	    		
		'*** define threshold array variables ***
		Dim Left0(1) As Long
	    Left0(0) = 0
	    Dim Right1(1) As Long
	    Right1(0) = 256
	    Dim Top2(1) As Long
	    Top2(0) = 0
	    Dim Bottom3(1) As Long
	    Bottom3(0) = 101
	
		'***cover analysis***
		If dlg.CoverCheck = 1 Then
			
			'*** define columns for collecting measurement data ***
			For x=0 To 54
			App.DoNotCollectMeasurement(x)
			Next x
			App.CollectMeasurement(32, "W") 'pixel numbers
			
			'*** find total number of pixels ***
			If dlg.TotalPixelOptions = 0 Then 'measure total pixels for every image
				ResultCode = Turfimage.ColorThreshold(1, True, 1, Left0, Top2, Right1, Bottom3)
	 			ResultCode = Turfimage.MeasureObjects(1)
	 			TotalPix = Worksheet.GetCellValue("W",1)
		   		ResultCode = Worksheet.SetCellText("W",1,"")
	   		End If
	   		
	   		If dlg.TotalPixelOptions = 1 Then 'measure total pixels for first image only
				If i = CLng(FirstImageNumber) Then
				    ResultCode = Turfimage.ColorThreshold(1, True, 1, Left0, Top2, Right1, Bottom3)
		 			ResultCode = Turfimage.MeasureObjects(1)
		 			TotalPix = Worksheet.GetCellValue("W",1)
			   		ResultCode = Worksheet.SetCellText("W",1,"")
		   		End If
	   		End If
	   		
  			If dlg.TotalPixelOptions = 2 Then 'user input total pixels
				TotalPix = CLng(dlg.TotalPixels)
		   	End If
		   	ResultCode=Worksheet.SetCellValue("B",J,TotalPix)
		   		
		   	
		   	'*** measure selected pix ***
		   	Left0(0) = LowHue
		    Right1(0) = HighHue
		  	Top2(0) = LowSat
		    Bottom3(0) = HighSat
		    ResultCode = Turfimage.ColorThreshold(1, False, 1, Left0, Top2, Right1, Bottom3)
		    ResultCode = Turfimage.MeasureObjects(1)
   			
		   	PixelSum = 0
		    y = 1
		   	Do Until Worksheet.GetCellValue("W",y) = 0
		    PixelSum = Worksheet.GetCellValue("W",y) + PixelSum
		    ResultCode = Worksheet.SetCellText("W",y,"")
		    y = y + 1
		    Loop
		   			
			ResultCode=Worksheet.SetCellValue("C",J,PixelSum)
			PctCover = (PixelSum/TotalPix)*100
			ResultCode=Worksheet.SetCellValue("D",J,PctCover)
	  
	End If    
	'*** end cover analysis
	    
    
    '*** color analysis ***
    If ColorCheck = 1 Then
    App.CollectMeasurement(32, "W") 'pixel numbers
	App.CollectMeasurement(50, "X") 'average red
	App.CollectMeasurement(51, "Y") 'average green
	App.CollectMeasurement(52, "Z") 'average blue
    
    '*** threshold and measure pixels ***
    If dlg.thresholdoptions = 0 Then
    Left0(0) = 0
    Right1(0) = 256
  	Top2(0) = 0
    Bottom3(0) = 101
    ResultCode = Turfimage.ColorThreshold(1, True, 1, Left0, Top2, Right1, Bottom3)
    Else
    Left0(0) = LowHue
    Right1(0) = HighHue
  	Top2(0) = LowSat
    Bottom3(0) = HighSat
    ResultCode = Turfimage.ColorThreshold(1, False, 1, Left0, Top2, Right1, Bottom3)
    End If
    ResultCode = Turfimage.MeasureObjects(1)
   
   ' FIND TOTAL PIXEL NUMBER 
    Pixelsum = 0
    y = 1
   	Do Until Worksheet.GetCellValue("W",y) = 0
    Pixelsum = Worksheet.GetCellValue("W",y) + Pixelsum
    y = y + 1
    Loop

   ' FIND AVERAGE RGB VALUES
   	Dim Avgred
    Avgred = 0
    Dim Avgblue
    Avgblue = 0
    Dim Avggreen
    Avggreen = 0
    Dim z
    z = 1
   
   	Do Until Worksheet.GetCellValue("W",z) = 0
    PixelFraction = Worksheet.GetCellValue("W",z) / Pixelsum
    Avgred = (PixelFraction * Worksheet.GetCellValue("X",z)) + Avgred
    Avgblue = (PixelFraction * Worksheet.GetCellValue("Y",z)) + Avgblue
    Avggreen = (PixelFraction * Worksheet.GetCellValue("Z",z)) + Avggreen
    
    ResultCode = Worksheet.SetCellText("X",z,"")
    ResultCode = Worksheet.SetCellText("Y",z,"")
    ResultCode = Worksheet.SetCellText("Z",z,"")
    ResultCode = Worksheet.SetCellText("W",z,"")
    z = z + 1
    Loop
   
    
    
	Worksheet.SetCellValue("E",j,Avgred)
	Worksheet.SetCellValue("F",j,Avgblue)
	Worksheet.SetCellValue("G",j,Avggreen)

    
    '* CONVERT TO HSB
    Dim Red 
    Red = Worksheet.GetCellValue("E",j)/255
    Dim Green 
    Green = Worksheet.GetCellValue("F",j)/255
    Dim Blue 
    Blue = Worksheet.GetCellValue("G",j)/255
    
    
    Dim MaxRGB
    If Red>Green And Red>Blue Then
    MaxRGB=Red
    ElseIf Green>Blue Then 
    MaxRGB=Green 
    Else
    MaxRGB=Blue
    End If
    
    Dim MinRGB
    If Red<Green And Red<Blue Then
    MinRGB=Red 
    ElseIf Green<Blue Then 
    MinRGB=Green 
    Else 
    MinRGB=Blue
    End If
    
    Dim DeltaRGB
    DeltaRGB = MaxRGB-MinRGB
    
    Dim Hue
    If MaxRGB=Red Then 
    Hue=60*((Green-Blue)/DeltaRGB)
    ElseIf MaxRGB=Green Then 
    Hue=60*(2+((Blue-Red)/DeltaRGB)) 
    Else 
    Hue=60*(4+((Red-Green)/DeltaRGB))
    End If
    
    Dim Sat
    Sat = DeltaRGB/MaxRGB
    
    Dim Bright
    Bright = MaxRGB
    
    Red=Red*255
    Green=Green*255
    Blue=Blue*255
    
    
    
    
    ResultCode=Worksheet.SetCellValue("H",J,Hue)
	ResultCode=Worksheet.SetCellValue("I",J,Sat)
	ResultCode=Worksheet.SetCellValue("J",J,Bright)
	
	
	End If
	'*** end color analysis ***
      
	'*** close current image ***
	Set Turfimage = Nothing
    
    '*** end analysis loop ***
    Next i
	
	
	'*** save output as excel spreadsheet
	If dlg.SaveCheck = 1 Then
	WorksheetName = FolderName & "Turf Analysis " & mydate & ".xls"
	ResultCode = Worksheet.SaveAs(WorksheetName, 4, 0)
	End If
	
	
	
	'*** Save user input information ***
  	Dim tf
  	Set tf = fso.CreateTextFile(MacroDir & "\Turf Analysis Macro Settings 1-2.txt", True)
   	' Write a line with a newline character.
   	tf.WriteLine(FolderName)
   	tf.WriteLine(FinalImageNumber)
   	tf.WriteLine(LowHue)
   	tf.WriteLine(HighHue)
   	tf.WriteLine(LowSat)
   	tf.WriteLine(HighSat-1)
   	tf.WriteLine(SaveCheck)
   	tf.WriteLine(Thresholdoptions)
   	tf.WriteLine(CoverCheck)
   	tf.WriteLine(ColorCheck)
   	tf.WriteLine(TotalPixelOptions)
   	tf.Close
 	

End Sub