colorlines.bas

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

'============================================================================
'	COLORLINES.BAS
'
'	This script creates a LVL file with line colors ranging from 
'		red-yellow-green-cyan-blue.
'    
'	Contour fills are not filled by default.  For Solid contour fill, change 
'		None to Solid in s1$.
'	Original SURF_LVL.BAS by Jud Ahern, University of Oklahoma, written in 
'		QBASIC. Port to SURFER 6 Scripter BASIC by TB, Golden Software, Inc. 
'
'												SKP 9/99 Surfer 7
'============================================================================

Sub Main

Dim contour(1000)

header$ = "'Level Flags LColor LStyle LWidth FFGColor FBGColor FPattern FMode"
q$ = Chr$(34)  ' a double quote
sp$ = Space$(1) ' a space
s1$ = "0 " + q$
s3$ = q$ + sp$ + q$ + "Solid" + q$ +" 0 " + q$ + "White" + q$ + sp$ + q$ + "White" + q$ + sp$ + q$ + "None" + q$ + " 2"
form$ = s1$ + s2$ + s3$

lvlfile$=InputBox$( "Name of level file to create - must be .lvl")
cmin=Val(InputBox$( "Minimum contour value: "))
cmax=Val(InputBox$( "Maximum contour value: "))
interval=Val(InputBox$( "Contour interval: "))
Open lvlfile$ For Output As #1

nlvls = (cmax - cmin) / interval - 1      ' was + 1, not -1
For i = 1 To nlvls
	contour(i) = cmin + i * interval      ' was (i - 1) *, not i *
Next 
end2 = Int(nlvls / 2)
end1 = Int(end2 / 2)
end3 = end2 + Int((nlvls - end2) / 2)

Print #1, "LVL2"
Print #1, header$

For i = 1 To end1
	r = 0
	b = 255
	g = Int((255 / (end1 - 1)) * (i - 1))
	red$ = LTrim$(Str$(r))
	green$ = LTrim$(Str$(g))
	blue$ = LTrim$(Str$(b))
	Debug.Print contour(i);" ";red$;" "; green$;" "; blue$
	Print #1, contour(i);" ";s1$+"R"+red$+" G"+green$+" B"+blue$+s3$
Next 

For i = end1 + 1 To end2
	r = 0
	g = 255
	b = 255 - Int(255 / (end2 - end1) * (i - end1))
	red$ = LTrim$(Str$(r))
	green$ = LTrim$(Str$(g))
	blue$ = LTrim$(Str$(b))
	Debug.Print contour(i);" ";red$;" "; green$;" "; blue$
	Print #1, contour(i);" ";s1$+"R"+red$+" G"+green$+" B"+blue$+s3$
Next 

For i = end2 + 1 To end3
	b = 0
	g = 255
	r = Int(255 / (end3 - end2) * (i - end2))
	red$ = LTrim$(Str$(r))
	green$ = LTrim$(Str$(g))
	blue$ = LTrim$(Str$(b))
	Debug.Print contour(i);" ";red$;" "; green$;" "; blue$
	Print #1, contour(i);" ";s1$+"R"+red$+" G"+green$+" B"+blue$+s3$
Next 

For i = end3 + 1 To nlvls
	r = 255
	b = 0
	g = 255 - Int(255 / (nlvls - end3) * (i - end3))
	red$ = LTrim$(Str$(r))
	green$ = LTrim$(Str$(g))
	blue$ = LTrim$(Str$(b))
	Debug.Print contour(i);" ";red$;" "; green$;" "; blue$
	Print #1, contour(i);" ";s1$+"R"+red$+" G"+green$+" B"+blue$+s3$
Next 

Close #1
'LVL2

' 52200 0 "R0 G60 B255" "Solid" 0 "White" "White" "Invisible" 2
	
End Sub