bil2grd2.bas

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

'bil2grd.bas converts a BIL file with HDR, STX, and BLW files from
' the USGS NED Seamless Data web page to a Surfer GRD file.
' 17 Apr 03 - MB.
'Added ability to read 8 bit data.
' 15 Aug 03 - TB.
'Changed final GRD file name to prevent conflict with HDR file.
' 22 Sep 03 - TB.

'Option Explicit
Private bilFile,zLo,zHi As String
Private swapBytes As Boolean
Private iRows,iCols As Integer
Private xLo,xHi,yLo,yHi As Double
Private ibits As Integer

Sub GetHdr
   Dim hdrFile,s,byteorder,layout As String
   'Dim iBands,ibits As Integer
   Dim iBands As Integer
   Dim i,j As Integer

   hdrFile = Mid(bilFile, 1, Len(bilFile)-3) + "hdr"
   Open hdrFile For Input As #2
   Line Input #2,s

   'BYTEORDER
   i = InStr(s,"BYTEORDER")
   j = InStr(i,s,vbLf)
   i = InStrRev(s," ",j) + 1
   byteorder = Mid(s,i,j-i)
   swapBytes = False
   If byteorder = "M" Then
      swapBytes = True
      MsgBox("This script does not support byte swapping yet")
   ElseIf Not byteorder = "I" Then
      MsgBox("Unrecognized BYTEORDER")
   End If

   'LAYOUT
   i = InStr(s,"LAYOUT")
   j = InStr(i,s,vbLf)
   i = InStrRev(s," ",j) + 1
   layout = Mid(s,i,j-i)
   If Not layout = "BIL" Then
      MsgBox("Unrecognized LAYOUT")
   End If

   'NROWS
   i = InStr(s,"NROWS")
   j = InStr(i,s,vbLf)
   i = InStrRev(s," ",j) + 1
   iRows = Mid(s,i,j-i)
   Debug.Print iRows;" rows"

   'NCOLS
   i = InStr(s,"NCOLS")
   j = InStr(i,s,vbLf)
   i = InStrRev(s," ",j) + 1
   iCols = Mid(s,i,j-i)
   Debug.Print iCols;" columns"

   'NBANDS
   i = InStr(s,"NBANDS")
   j = InStr(i,s,vbLf)
   i = InStrRev(s," ",j) + 1
   iBands = Mid(s,i,j-i)
   Debug.Print iBands;" bands"
   If Not iBands = 1 Then
      MsgBox("Unrecognized NBANDS")
      End
   End If

   'NBITS
   i = InStr(s,"NBITS")
   j = InStr(i,s,vbLf)
   i = InStrRev(s," ",j) + 1
   ibits = Mid(s,i,j-i)
   Debug.Print ibits;" bits"
   If Not ibits = 16 And Not ibits = 8 Then
   	Debug.Print " NBITS not 16."
      MsgBox("Unrecognized NBITS" & CStr(ibits) & vbCrLf & _
      " Must be 8 or 16.")
      End
   End If

   Close #2
End Sub

Sub GetBlw
   Dim blwFile,s As String
   Dim xScl,yScl,x,y As String

   blwFile = Mid(bilFile, 1, Len(bilFile)-3) + "blw"
   Open blwFile For Input As #2
   Line Input #2,s
   xScl = Split(s,vbLf)(0)
   yScl = Split(s,vbLf)(3)
   x = Split(s,vbLf)(4)
   y = Split(s,vbLf)(5)

   xLo = CDbl(x)
   xHi = xLo + CDbl(xScl)*(iCols-1)
   yHi = CDbl(y)
   yLo = yHi + CDbl(yScl)*(iRows-1)
	Debug.Print xLo;" ";xHi;" ";yLo;" ";yHi;" XY min max"
   Close #2
End Sub

Sub GetStx
   Dim stxFile,s As String

   stxFile = Mid(bilFile, 1, Len(bilFile)-3) + "stx"
   Open stxFile For Input As #2
   Line Input #2,s
   zLo = Split(s)(1)
   zHi = Split(s)(2)
   Debug.Print zLo;" ";zHi;" Z min max"
   Close #2
End Sub

Sub Main
	Debug.Print "----- ";Time;" -----"
	Set surf = CreateObject("surfer.application")
	surf.Documents.Add
   Dim grdFile,s As String
   Dim i,j,z As Integer
   Dim z8 As Byte '8 bit unsigned integer.

   bilFile = GetFilePath("","bil","","Open BIL File")
   If bilFile = "" Then End

   grdtmp = Left(bilFile,Len(bilFile)-4) + "Tmp.grd"
   grdFile = Mid(bilFile, 1, Len(bilFile)-4) + "Final.grd"

   Open bilFile For Binary Access Read As #1
   Open grdtmp For Output As #4

   Print #4,"DSAA"
   Call GetHdr
   Print #4,iCols;" ";iRows
   Call GetBlw
   Print #4,xLo;" ";xHi
   Print #4,yLo;" ";yHi
   Call GetStx
   Print #4,zLo;" ";zHi

	If ibits = 16 Then
   	For i = 1 To FileLen(bilFile)/2
      j = j + 1
      Get #1,,z
      If j < 10 Then
         Print #4,z;
      Else
         Print #4,z
         j = 0
      End If
   	Next i
  ElseIf ibits = 8 Then
 		For i = 1 To FileLen(bilFile)
      j = j + 1
      Get #1,,z8
      If j < 10 Then
         Print #4,z8;
      Else
         Print #4,z8
         j = 0
      End If
   	Next i
	End If

  Close #1,#4
	surf.GridTransform(ingrid:=grdtmp, _
		operation:=srfGridTransMirrorY, _
		outgrid:=grdFile)

   MsgBox(grdFile+" created")
    
End Sub