fsurface.frm

用浮动水平线算法绘剖面图！在环境工程领域或三维图形中可以看到！

VERSION 5.00
Begin VB.Form fSurface 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "用浮动水平线算法绘剖面图"
   ClientHeight    =   6132
   ClientLeft      =   48
   ClientTop       =   336
   ClientWidth     =   7404
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   511
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   617
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton CommandOK 
      Caption         =   "确定"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.8
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   372
      Left            =   6180
      TabIndex        =   8
      Top             =   3060
      Width           =   1152
   End
   Begin VB.TextBox TextS 
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.8
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   372
      Left            =   6180
      TabIndex        =   7
      Text            =   "Text1"
      Top             =   2340
      Width           =   1212
   End
   Begin VB.TextBox TextAngZ 
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.8
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   372
      Left            =   6180
      TabIndex        =   5
      Text            =   "Text1"
      Top             =   1380
      Width           =   1212
   End
   Begin VB.TextBox TextAngXY 
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.8
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   372
      Left            =   6120
      TabIndex        =   3
      Text            =   "Text1"
      Top             =   480
      Width           =   1212
   End
   Begin VB.CommandButton Command1 
      Caption         =   "放弃"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.8
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   6180
      TabIndex        =   1
      Top             =   4620
      Width           =   1212
   End
   Begin VB.PictureBox Picture1 
      AutoRedraw      =   -1  'True
      BackColor       =   &H00FFFFFF&
      Height          =   6000
      Left            =   120
      ScaleHeight     =   496
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   496
      TabIndex        =   0
      Top             =   60
      Width           =   6000
   End
   Begin VB.Label Label2 
      Alignment       =   2  'Center
      Caption         =   "Z放大系数"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.8
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   312
      Left            =   6180
      TabIndex        =   6
      Top             =   1980
      Width           =   1152
   End
   Begin VB.Label LabelAngZ 
      Alignment       =   2  'Center
      Caption         =   "俯视角"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.8
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   312
      Left            =   6120
      TabIndex        =   4
      Top             =   1020
      Width           =   1152
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      Caption         =   "方位角"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.8
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   252
      Left            =   6180
      TabIndex        =   2
      Top             =   120
      Width           =   1152
   End
End
Attribute VB_Name = "fSurface"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim AngXY As Single, AngZ As Single, S As Single
Dim GridZ() As Single, Zmin As Single, Zmax As Single
Dim NX As Integer, NY As Integer, IX As Integer, IY As Integer
Dim Xmin As Single, Xmax As Single, Ymin As Single, Ymax As Single
Dim TheInPath As String
Private Sub Command1_Click()
Unload Me
End Sub


'InNum-输入数,nDec-小数位数,nWidth-宽度,IC-左右对齐标志,OutStr-输出字符串
Public Function Formats(InNum As Variant, cFormat As String) As String
Dim I As Integer

I = Len(cFormat)
Formats = Format(InNum, cFormat)
If (Len(Formats) < I) Then Formats = Space(I - Len(Formats)) + Formats
End Function

Private Sub CommandOK_Click()
    AngXY = Val(TextAngXY.Text)
    AngZ = Val(TextAngZ.Text)
    S = Val(TextS.Text)
    
    If (S <= 0) Then S = 1
    If (AngZ < 0) Then AngZ = 45
    
    Picture1.Picture = LoadPicture()
    Call Surface(GridZ, Xmin, Xmax, Ymin, Ymax, Zmin, Zmax, NY, NX, AngXY, AngZ, S)
End Sub

Private Sub Form_Load()
    Dim LineTemp As String

    Screen.MousePointer = 11

    TheInPath = App.Path

    If (Right(TheInPath, 1) <> "\") Then
        TheInPath = TheInPath + "\"
    End If
    
    Zmin = 10000000000#
    Zmax = -Zmin
    Open TheInPath + "Mapsurface.GRD" For Input As #1
    Line Input #1, LineTemp
    Input #1, NY, NX
    
    NX = NX - 1
    NY = NY - 1
    ReDim GridZ(0 To NY, 0 To NX)
    
    Input #1, Xmin, Xmax
    Input #1, Ymin, Ymax
    Input #1, Zmin, Zmax
    For IY = 0 To NY
        For IX = 0 To NX
            Input #1, GridZ(IY, IX)
        Next IX
    Next IY
    Close (1)
    
    AngXY = 20
    AngZ = 45
    S = 1
    Call Surface(GridZ, Xmin, Xmax, Ymin, Ymax, Zmin, Zmax, NY, NX, AngXY, AngZ, S)
    
    TextAngXY.Text = "20"
    TextAngZ.Text = "45"
    TextS.Text = "1"
    Screen.MousePointer = 0
End Sub
Private Sub Picture1_Click()
    Picture1.Picture = LoadPicture()
    AngXY = AngXY + 10
    If (AngXY > 360) Then AngXY = 0
    
    fSurface.Caption = Format(AngXY, "###0")
    
    TextAngXY.Text = Format(AngXY, "###0")
    
    Call Surface(GridZ, Xmin, Xmax, Ymin, Ymax, Zmin, Zmax, NY, NX, AngXY, AngZ, S)
End Sub