Attribute VB_Name = "Module2"
'  Script3.bas creates several maps from a single data file.  The data
'  file is organized with columns corresponding to X, Y, Z1, Z2, etc.
'  A contour map is created for each set of data: X,Y,Z1, X,Y,Z2, etc.
'  The first row of the data file contains column headings.  This is
'  extracted and used to title the corresponding map.

Sub Main
	On Error GoTo Err_Handling
    Dim SurferApp As Object
	Dim Doc As Object
	Dim Plotwindow As Object
	Dim Map As Object
	Dim MapTitle1 As Object
	Dim MapTitle2 As Object
	Dim MethodLabel As Variant
	Dim retValue As Boolean
	Dim Data As String
	Dim Grid As String
	Dim Path As String
	Dim Method As Integer
	Dim GifFileName As String

	Data = "data.dat"
	Grid = "RAINRT\DEP05RT.grd"
	MethodLabel = Array("Kriging", "Inverse Distance", "Minimum Curvature", _
		"Modified Shepard's Method", "Natural Neighbor", "Nearest Neighbor", _
		"Polynomial Regression", "Radial Basis Functions", _
		"Triangulation with Linear Interpolation")

	'Creates an instance of the Surfer Application object and assigns it to the
	'variable named "SurferApp"
	Set SurferApp = CreateObject("Surfer.Application")

	'Assigns the location of the data and grid files to the variable named "Path"
	Path = "C:\Inetpub\wwwroot\AUTORUN\"
	
	'Disables Plotwindow's AutoRedraw to speed up the script
	'Plotwindow.AutoRedraw = False
	 Method =2
	 Dim j As Integer
			For j = 3 To 5 Step 1
			
		'Grids the specified data file using the Kriging algorithm and
		'assigns the return value to the variable named "retValue"
		retValue = SurferApp.GridData(DataFile:=Path+"RAINRT\TodayMSL.xls",xcol:=1,ycol:=2,zcol:=j ,xmin:=97.4465,xmax:=105.641418, _
		ymin:=5.61075,ymax:=20.46511,numcols:=820,numrows:=1486,Algorithm:=Method, _
		ShowReport:=False, OutGrid:=Path + Grid)
			
		SurferApp.GridBlank(InGrid:=Path+Grid , _
		 		BlankFile:=Path+"SURFDATA\thailand.bln" , _
				OutGrid:=Path+"SURFDATA\out.grd" , _
				OutFmt:=srfGridFmtS7)
		'Creates a contour map from the gridded data and assigns it to the variable
		'named "Map"
	
	Dim Plot As Object
	 Set Plot = SurferApp.Documents.Add(srfDocPlot)
	'Declares Shapes as an object
	 Dim Shapes As Object
	'Assigns the Shapes collection to the variable named "Shapes"
	 Set Shapes = Plot.Shapes
	'Declares MapFrame as an object
	 Dim BaseMap As Object
	'Creates a base map and assigns the map coordinate system to the
	'variable named "MapFrame"

 	Set MapFrame1 = Shapes.AddContourMap(GridFileName:=Path+"SURFDATA\out.grd")
 			For Each Axis In MapFrame1.Axes
				Axis.ShowLabels = False
				Axis.MajorTickType = srfTickNone
				Axis.MinorTickType = srfTickNone
				Axis.Visible = False
			Next Axis
 	Dim ContourMap As Object
	'Assigns the contour map properties to the variable named "ContourMap"
	 Set ContourMap = MapFrame1.Overlays(1)
	
	'Declares Levels as an object
	Dim Levels As Object
	Dim LevelFileName As String
	'Assigns the Levels collection to the variable named "Levels"
	 Set Levels = ContourMap.Levels
	  Dim TextUnit,TextTitleDate,textDate As Object
		 	If j =3 Then 
 				LevelFileName ="LEVELCOLOR\Pressure.lvl"
 				Set TextUnit = Shapes.AddText(5.00,5.6,"PRESSURE")
 				Set Texttitle = Shapes.AddText(3,9.15,"AIR PRESSURE AT MSL" )
 				Set textDate = Shapes.AddText(3.3,8.9,Day(Date()) &" "&  MonthName(Month(Date())) &" "&  Year(Date()) & " " & Hour(Now())  & ":00")
				GifFileName="MSL" & DateFilename()
			 ElseIf j =4 Then
 				LevelFileName ="LEVELCOLOR\PressureChange.lvl"
 				Set TextUnit = Shapes.AddText(4.75,5.6,"PRESSURE")
 				Set Texttitle = Shapes.AddText(2.75,9.15,"COMPARE WITH PREVIOUS DAY")
				GifFileName="MSLChange" & DateFilename()
			Else
 				LevelFileName ="LEVELCOLOR\PressureChange.lvl"
 				Set TextUnit = Shapes.AddText(4.75,5.6,"PRESSURE")
 				Set Texttitle = Shapes.AddText(2.75,9.15,"COMPARE WITH PASS 3 HRs")
				GifFileName="Change3hr" & DateFilename()

 			End If

 		With TextUnit.Font
			.Face = "AngsanaUPC"
			.Size = 14
			.Bold =True
			.Color=srfColorDarkBlue
		End With
		
		With TextTitle.Font
			.Face = "AngsanaUPC"
			.Size = 18
			.Bold =True
			.Color=srfColorDarkBlue
		End With
			With textDate.Font
			.Face = "AngsanaUPC"
			.Size = 16
			.Bold =True
			.Color=srfColorDarkGreen
		End With
	Levels.LoadFile(Path+LevelFileName)

	Dim ColorScale As Object
	Set ColorScale=ContourMap.ColorScale
	ContourMap.ShowColorScale = True
	ContourMap.FillContours=True

	Dim DiscreteColorScale As Object
	'Assigns the color scale properties to the variable named
	'DiscreteColorScale"
	 Set DiscreteColorScale = ContourMap.ColorScale
	 DiscreteColorScale.Left=5
	 DiscreteColorScale.Top=5.2
	 DiscreteColorScale.Width=0.6
	 DiscreteColorScale.Height=2.5
	 DiscreteColorScale.LabelFont.Face = "AngsanaUPC"
	 DiscreteColorScale.LabelFont.Size = 16
 
	Set BaseMap = Shapes.AddBaseMap(ImportFileName:=Path+"SHAPEFILE\province.shp")
		 For Each Axis In BaseMap.Axes
			Axis.ShowLabels = False
			Axis.MajorTickType = srfTickNone
			Axis.MinorTickType = srfTickNone
			Axis.Visible = False
		Next Axis

	Set Plot = BaseMap.Parent
	Set baseMap1=BaseMap.Overlays(1)
	baseMap1.Line.ForeColor=srfColorBabyBlue

	Set PostMap = Shapes.AddClassedPostMap(Path+"SURFDATA\postmap.xls", _
								xCol:=1, yCol:=2, zCol:=4,labcol:=5)

	PostMap.BackgroundFill.ForeColor = srfColorWhite
	PostMap.BackgroundFill.Pattern = "Solid"
	Set clpost1 = PostMap.Overlays("Classed Post")
		clPost1.NumClasses = 3
		clpost1.ShowLegend = False
		clpost1.LabelFont.Face = "AngsanaUPC"
		clpost1.LabelFont.Size = 5

		For i = 1 To 3
			With clpost1.BinSymbol(i)
			.Set = "GSI Default Symbols"
			.Index = 11
			.Size = 0.02
			End With
		Next i
	clpost1.BinSymbol(1).Color =srfColorRed
	clpost1.BinSymbol(2).Color =srfColorDarkBlueGreen
	clpost1.BinSymbol(3).Color =srfColorBlue
	' Clear all selections and then select the two MapFrame objects
	Set TextMet = Shapes.AddText(3.3,2.4,"THAI METEOROLOGICAL DEPARTMENT ")
	With TextMet.Font
		.Face = "AngsanaUPC"
		.Size = 12
		.Bold =True
		.Color=srfColorDarkGreen
	End With
	Dim MetLoGo As Object
	Set MetLoGo=Shapes.AddBaseMap(ImportFileName:=Path+"SURFDATA\LoGo.bmp")
	MetLoGo.Left=2.47
	MetLoGo.Top=2.55
	MetLoGo.Width=.6
	MetLoGo.Height=.6
	For Each Axis In MetLoGo.Axes
			Axis.ShowLabels = False
			Axis.MajorTickType = srfTickNone
			Axis.MinorTickType = srfTickNone
			Axis.Visible = False
		Next Axis

	Plot.Selection.DeselectAll
	BaseMap.Selected = True
	MapFrame1.Selected = True
	PostMap.Selected=True

	'Overlay the selected maps
	Plot.Selection.OverlayMaps
	Plot.Export(FileName:=Path+"GIFMAP3Hrs\" + GifFileName + ".gif", Options:="Width=320, height=669")
		Next j
'SurferApp.Visible=True
	Err_Handling:
		Exit Sub
End Sub

Function DateFilename()
	Dim Dday,Mmonth,Yyear As String
	Dim Nday,Nmonth As Integer
	If  Day(Date()) < 10 Then
		Dday="0" & Day(Date())
	Else
		Dday="" & Day(Date())
	End If
	If  Month(Date()) < 10 Then
		Mmonth="0" & Month(Date())
	Else
		Mmonth="" & Month(Date())
	End If
	Yyear=  "" & Year(Date())
	Yyear= Right(Yyear,2)
	DateFilename=Dday & Mmonth & Yyear & Hour(Now())
End Function
Function FileName()
		If Hour(Now()) <10 Then
			FileName="0" & Hour(Now()) & "00"
		Else
			FileName= Hour(Now()) & "00"
   		End If
End Function