contourfill.bas

Surfer是地学中常用的一个软件

'==========================================================================
'CONTOURFILL.BAS
'
'This script demonstrates the following:
'
'	How to create a contour map
'	How to fill the contour intervals with user defined range
'	How to fill a single contour interval with a specific color
'
'												SKP 9/99 Surfer 7
'==========================================================================

Sub Main
	'Declare the variable that will reference the application
	Dim SurferApp As Object
	
	'Creates an instance of the Surfer Application object 
	' and assigns it to the variable named "SurferApp"
	Set SurferApp = CreateObject("Surfer.Application")
	
	'Make Surfer visible
	SurferApp.Visible = True
	
	'Assigns the location of the data and grid files to the variable "Path"
	Path = SurferApp.Path + "\samples\"
	
	'Declares Doc as an Object
	Dim Doc As Object
	
	'Creates a new plot window with variable name "Doc"
	Set Doc = SurferApp.Documents.Add 
	
	'Turn off screen updating for faster redraws
	SurferApp.ScreenUpdating = False
		
	'Creates a contour map and assigns it to the variable "MapFrame"
	Set MapFrame = Doc.Shapes.AddContourMap(GridFileName:=Path+"demogrid.grd")
	
	'Fill Contours
	MapFrame.Overlays(1).FillContours = True

	'Set the colors to be gradational from green to blue
	Set Levels = MapFrame.Overlays(1).Levels
	n = Levels.Count
	ColorInc = 255.0 / (n-1)
	For i=1 To n
		ColorInc = 255.0 * (i-1) / (n-1)
		Levels(i).Fill.ForeColor = RGB(0,255-ColorInc,ColorInc)
	Next i
	
	'Change a specific contour interval to Green
	Levels(8).Fill.ForeColor = srfColorYellow
	
	'Move first map to lower left
	MapFrame.Selected = True
	Doc.Selection.Left = 1.0
	Doc.Selection.Top = 4.0
		
	'Deselect All
	Doc.Selection.DeselectAll
	
	'Create a second contour map and fill contours
	Set MapFrame2 = Doc.Shapes.AddContourMap(GridFileName:=Path+"demogrid.grd")
	MapFrame2.Overlays(1).FillContours = True
	
	'Set the colors to be gradational from blue to white
	Set Levels2 = MapFrame2.Overlays(1).Levels
	m = Levels2.Count
	ColorInc2 = 255.0 / (m-1)
	For j=1 To m
		ColorInc2 = 255.0 * (j-1) / (m-1)
		Levels2(j).Fill.ForeColor = RGB(ColorInc2,ColorInc2,255)
	Next j
	
	'Move second map to upper right
	MapFrame2.Selected = True
	Doc.Selection.Left = 4.5
	Doc.Selection.Top = 10.0
	
	'Turn on screen updating to view maps
	Doc.Windows(1).Zoom(srfGridZoomFitToWindow)
	SurferApp.ScreenUpdating = True
	
End Sub