Sub Main

'Image Editing Macro
'Created by Doug Karcher, Department of Horticulture, University of Arkansas
'Updated 10/9/02

	
	Dim App As Object
    Set App = CreateObject("SigmaScan.Application")
    Dim Worksheet As Object
    Set Worksheet = App.GetWorksheet
    Set Worksheet = Nothing
	mydate = Format(Now, "dd_mm_yy__hh_nn_ss")
	
	
	' OBTAIN PREVIOUS FILE INFO
   	Dim f, fso
   	Const ForReading = 1 
   	Const ForWriting = 2
   	Const ForAppending = 8
   	Set fso = CreateObject("Scripting.FileSystemObject")
   	If fso.FileExists(MacroDir & "\editimagevar.txt") Then
   	Set f = fso.OpenTextFile(MacroDir & "\editimagevar.txt", ForReading)
   	FolderName = f.ReadLine
   	FileName = f.ReadLine
   	ImageName1 = f.ReadLine
   	ImageNumber2 = f.ReadLine
   
   	Else 
   	Set f = fso.CreateTextFile(MacroDir & "editimagevar.txt", True)
   	FolderName = "" 
   	FileName = ""
   	ImageName1 = ""
   	ImageNumber2 = ""
   	End If
   	f.Close
	
		
	' USER CHOOSES FILES
	Beep
	Dim FilePath As String
	FirstFilePlace:
	FilePath = GetFilePath(FileName,,FolderName,"First File To Edit",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))
	Extension = Right(FileName,3)
	a = Len(ImageName)
	b=a
	Do
	string1 = Mid(ImageName,b,1)
	b=b-1
	Loop While string1 < "A"
	ImageName1 = Left(ImageName,(b+1))
	ImageNumber1 = Right(ImageName,(a-(b+1)))
	
	DialogPlace:
	Begin Dialog UserDialog 200,120,630,560,"Image Editing Macro Settings" ' %GRID:10,7,1,1
		
    	'*** file settings ***
		GroupBox 0,7,550,84,"Image &Files"
		TextBox 10,28,530,21,.FolderName
		Text 10,63,180,14,"Image Name:"
		TextBox 100,63,100,21,.ImageName1
		Text 210,70,150,14,"First Image:"
		TextBox 290,63,40,21,.ImageNumber1
		Text 350,70,150,14,"Final Image:"
		TextBox 430,63,40,21,.ImageNumber2
	
		GroupBox 0,98,550,63,"&Crop",.Crop
		CheckBox 10,126,110,14,"Crop Images",.CropOptions
		Text 150,119,90,14,"Left Pix:"
		Text 250,119,90,14,"Right Pix:"
		Text 350,119,90,14,"Top Pix:"
		Text 450,119,90,14,"Bottom Pix:"
		TextBox 150,133,90,21,.LeftCrop
		TextBox 250,133,90,21,.RightCrop
		TextBox 350,133,90,21,.TopCrop
		TextBox 450,133,80,21,.BottomCrop
		
		GroupBox 0,168,550,70,"&Resize",.GroupBox1
		OptionGroup .resizeoptions
			OptionButton 10,189,200,14,"Do not resize or resample"
			OptionButton 10,203,90,14,"Resize"
			OptionButton 10,217,100,14,"Resample"
		TextBox 230,210,70,21,.NewWidth
		TextBox 330,210,70,21,.NewHeight
		Text 230,196,80,14,"New Width:"
		Text 330,196,80,14,"New Height:"

		GroupBox 0,245,550,42,"&Hue",.GroupBox4
		Text 270,266,220,14,"Percent adjustment (-360 to 360):",.Text1
		CheckBox 10,266,110,14,"Adjust Hue",.HueOptions

		GroupBox 0,294,550,42,"&Saturation",.GroupBox5
		CheckBox 10,315,140,14,"Adjust Saturation",.SaturationOptions
		Text 270,315,220,14,"Percent adjustment (-100 to 100):",.Text3
		TextBox 480,259,60,21,.Hue

		GroupBox 0,343,550,42,"&Brightness",.GroupBox3
		CheckBox 10,364,140,14,"Adjust Brightness",.BrightnessOptions
		TextBox 480,308,60,21,.Saturation
		Text 270,364,220,14,"Percent adjustment (-100 to 100):",.Text2

		GroupBox 0,392,550,42,"&Contrast"
		CheckBox 10,413,130,14,"Adjust Contrast",.ContrastOptions
		Text 270,413,220,14,"Percent adjustment (-100 to 100):"
		TextBox 480,357,60,21,.Brightness
		
		

		GroupBox 0,490,550,42,"&Save",.GroupBox2
		CheckBox 10,511,320,14,"Overwrite original images with edited images.",.SaveOptions
		OKButton 0,539,200,21
		TextBox 480,406,60,21,.Contrast
		GroupBox 0,441,550,42,"Gamma Correct",.GammaGroup
		CheckBox 10,462,160,14,"Gamma Correction",.GammaOptions
		Text 330,462,150,14,"Adjustment (0.1 to 4.9):",.GammaText
		TextBox 480,455,60,21,.Gamma
		
		
	End Dialog
    '*** create variables from user settings ***
	Beep
	Dim dlg As UserDialog
    dlg.FolderName = FolderName	
    dlg.ImageName1 = ImageName1
    dlg.ImageNumber1 =  ImageNumber1
    dlg.ImageNumber2 = ImageNumber2
   
    Dialog dlg ' show dialog (wait for ok)
    
    FolderName = dlg.FolderName
    ImageName1 = dlg.ImageName1
    ImageNumber1 = dlg.ImageNumber1
    ImageNumber2 = dlg.ImageNumber2


	SaveFolder = FolderName
	If dlg.SaveOptions = 0 Then
	SaveFolder = Foldername + "\Edited Images\"
	MkDir SaveFolder
	End If
	
    
    
    
   	'*** calculate leading zeros first image***
 	ImageNumberLength = Len(ImageNumber1)
	c=0
	numzeros1=0
	Do 
	c=c+1
	mynum = Mid(ImageNumber1,c,1)
	myzero=0
	If mynum = 0 Then 
	numzeros1=numzeros1+1
	myzero=1
	End If
	'MsgBox myzero & " " & numzeros
	Loop While myzero = 1
	Lengthi = ImageNumberLength - numzeros1
	Initiali = Right(ImageNumber1,Lengthi)
	'MsgBox ImageNumber1 & " " & ImageNumberLength & " " & numzeros1 & " " & Initiali

	'*** calculate leading zeros final image***
 	ImageNumberLength2 = Len(ImageNumber2)
	c=0
	numzeros2=0
	Do 
	c=c+1
	mynum = Mid(ImageNumber2,c,1)
	myzero=0
	If mynum = 0 Then 
	numzeros2=numzeros2+1
	myzero=1
	End If
	'MsgBox myzero & " " & numzeros
	Loop While myzero = 1
	Lengthi2 = ImageNumberLength2 - numzeros2
	Initiali2 = Right(ImageNumber2,Lengthi2)
	'MsgBox ImageNumber2 & " " & ImageNumberLength2 & " " & numzeros2 & " " & Initiali2

	
	'BEGIN IMAGE EDIT LOOP
	For i=Initiali To Initiali2
  	subtractnum = Len(i) - Lengthi
  	numzeros = numzeros1 - subtractnum
  	Zeros = "00000000000000000"
  	If numzeros < 0 Then
  	Zeros = "" 
  	Else
  	Zeros = Left(Zeros,numzeros)
   	End If
  	CurrentFile = ImageName1&Zeros&i&"."&Extension
   	Set Turfimage = App.OpenImage(FolderName&CurrentFile)
		
	' CROP IMAGES?
	If dlg.CropOptions = 1 Then
	ResultCode = Turfimage.Crop(dlg.LeftCrop, dlg.TopCrop, dlg.RightCrop, dlg.BottomCrop)
	End If
	

	' RESIZE IMAGES?
	If dlg.resizeoptions > 0 Then
	If dlg.resizeoptions = 1 Then
	ResultCode = Turfimage.Resize(dlg.NewWidth,dlg.NewHeight)	
	Else
	ResultCode = Turfimage.Resample(dlg.NewWidth,dlg.NewHeight)	
	End If
	End If


	' ADJUST HUE?
	If dlg.HueOptions > 0 Then
		If CLng(dlg.Hue) < -360 Or CLng(dlg.Hue) > 360  Then
			Set Turfimage = Nothing
			MsgBox "Hue adjustment must be between -360 and 360!"
			GoTo DialogPlace:
		Else
			ResultCode = Turfimage.AdjustHue(dlg.Hue)	
		End If
	End If

	' ADJUST SATURATION?
	If dlg.SaturationOptions > 0 Then
		If CLng(dlg.Saturation) < -100 Or CLng(dlg.Saturation) > 100  Then
			Set Turfimage = Nothing
			MsgBox "Saturation adjustment must be between -100 and 100!"
			GoTo DialogPlace:
		Else
			ResultCode = Turfimage.AdjustSaturation(dlg.Saturation)
		End If	
	End If

	' ADJUST BRIGHTNESS?
	If dlg.BrightnessOptions > 0 Then
		If CLng(dlg.Brightness) < -100 Or CLng(dlg.Brightness) > 100  Then
			Set Turfimage = Nothing
			MsgBox "Brightness adjustment must be between -100 and 100!"
			GoTo DialogPlace:
		Else
			ResultCode = Turfimage.AdjustBrightness(dlg.Brightness)
		End If	
	End If

	' ADJUST CONTRAST?
	If dlg.ContrastOptions > 0 Then
		If CLng(dlg.Contrast) < -100 Or CLng(dlg.Contrast) > 100  Then
			Set Turfimage = Nothing
			MsgBox "Contrast adjustment must be between -100 and 100!"
			GoTo DialogPlace:
		Else
			ResultCode = Turfimage.AdjustContrast(dlg.Contrast)
		End If	
	End If
	
	
	' ADJUST GAMMA?
	If dlg.GammaOptions > 0 Then
		If CLng(dlg.Gamma) < -100 Or CLng(dlg.Gamma) > 100  Then
			Set Turfimage = Nothing
			MsgBox "Gamma adjustment must be between -100 and 100!"
			GoTo DialogPlace:
		Else
			ResultCode = Turfimage.GammaCorrect(dlg.Gamma)
		End If	
	End If
	
	' SAVE IMAGES?
	If dlg.SaveOptions = 0 Then
	ResultCode = Turfimage.SaveAs(SaveFolder + "edit_" + CurrentFile,10,24,2,1)
	Else
	ResultCode = Turfimage.Save
	End If
	
	Set Turfimage = Nothing
  	Next i
    ' END IMAGE EDIT LOOP
    
    
    ' SAVE USER OPTIONS
  	Dim tf
  	Set tf = fso.CreateTextFile(MacroDir & "\editimagevar.txt", True)
   	' Write a line with a newline character.
   	tf.WriteLine(FolderName)
   	tf.WriteLine(FileName)
   	tf.WriteLine(ImageName1)
   	tf.WriteLine(dlg.ImageNumber2)
   	tf.Close
 	
 	
	

End Sub