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\RAINRT.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 ,TimeStep As Integer
	Dim DayForecast As Date
	Dim TimeForecast As Integer
	TimeStep=7
	DayForecast=Date()
	For j = 3 To 14 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\FORECASTRAIN.xls",xcol:=1,ycol:=2,zcol:=j ,xmin:=97.4465,xmax:=105.641418, _
		ymin:=5.61075,ymax:=20.46511,numcols:=800,numrows:=1000,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)
	 TimeStep=TimeStep+3
	If TimeStep>24 Then
		DayForecast=DayForecast+1
		TimeForecast=TimeStep Mod 24
		TimeStep=TimeForecast
	Else
		DayForecast=DayForecast
		TimeForecast=TimeStep
	End If

	Dim Levels As Object
	Dim LevelFileName As String
	'Assigns the Levels collection to the variable named "Levels"
	Set Levels = ContourMap.Levels
	Dim TextUnit,TextMonth,TextSubTitle As Object
 	LevelFileName ="LEVELCOLOR\rain.lvl"
 	Set TextUnit = Shapes.AddText(5.00,5.9,"RAINFALL : mm.")
	Set Texttitle = Shapes.AddText(2.50,9.75,"FORECAST 3 HOURS ACCUMULATED RAINFALL")
	Set TextSubTitle = Shapes.AddText(2.50,9.5,"BY UNIFIED MODEL BASE ON 07:00 " & Format(Date(),"dd-mmm-yyyy"))

 		With TextUnit.Font
				.Face = "AngsanaUPC"
				.Size = 14
				.Bold =True
				.Color=srfColorDarkBlue
		End With
		With TextTitle.Font
				.Face = "AngsanaUPC"
				.Size = 16
				.Bold =True
				.Color=srfColorDarkBlue
		End With
		With TextSubTitle.Font
				.Face = "AngsanaUPC"
				.Size = 16
				.Bold =True
				.Color=srfColorDarkBlue
		End With
	Set TextMonth = Shapes.AddText(2.75,9.25,"FOR " & TimeForecast & ":00 Hr." & Format(DayForecast," d-mmm-yyyy"))
	With TextMonth.Font
		.Face = "AngsanaUPC"
		.Size = 19
		.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.25
	 DiscreteColorScale.Top=5.5
	 DiscreteColorScale.Width=0.5
	 DiscreteColorScale.Height=2.5
	 DiscreteColorScale.LabelFont.Face = "AngsanaUPC"
	 DiscreteColorScale.LabelFont.Size = 18
 
	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 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.2,2.7,"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.37
	MetLoGo.Top=2.85
	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

	Dim TextTitleDate As Object
	Dim DateString As String


	'Overlay the selected maps
	Plot.Selection.OverlayMaps
	Plot.Export(FileName:=Path+"FORECAST\" + GifFileName + ".gif", Options:="Width=310, height=600")
	'Plot.SaveAs ("D:\CLIMON\SURFERMAP\test.srf")  'Save the map
	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()-1) < 10 Then 
		Dday="0" & Day(Date()-1)
	Else
		Dday="" & Day(Date()-1)
	End If
	If  Month(Date()-1) < 10 Then 
		Mmonth="0" & Month(Date()-1)
	Else
		Mmonth="" & Month(Date()-1)
	End If
	Yyear=  "" & Year(Date()-1) 
	Yyear= Right(Yyear,2)
	DateFilename=Dday & Mmonth & Yyear
End Function	
Function ForecastTime(I_Loop)
Dim i,Time_Step As Integer
	Time_Step=7
	For i=3 To I_Loop
		Time_Step=Time_Step+3

	Next
End Function