frmoption.frm

实现对导线测量数据的自动计算和导线图形的显示

         Begin VB.Label Label11 
            AutoSize        =   -1  'True
            Caption         =   "高亮颜色"
            Height          =   195
            Left            =   240
            TabIndex        =   27
            Top             =   1320
            Width           =   720
         End
         Begin VB.Label Label10 
            AutoSize        =   -1  'True
            Caption         =   "导线边颜色"
            Height          =   195
            Left            =   240
            TabIndex        =   24
            Top             =   960
            Width           =   900
         End
         Begin VB.Label Label9 
            AutoSize        =   -1  'True
            Caption         =   "导线点颜色"
            Height          =   195
            Left            =   240
            TabIndex        =   23
            Top             =   600
            Width           =   900
         End
         Begin VB.Label lblMapBackColor 
            AutoSize        =   -1  'True
            Caption         =   "背景颜色"
            Height          =   195
            Left            =   240
            TabIndex        =   5
            Top             =   240
            Width           =   720
         End
      End
      Begin VB.CheckBox chkAppearance 
         Caption         =   "3D外形"
         Height          =   255
         Left            =   240
         TabIndex        =   3
         Top             =   480
         Width           =   975
      End
      Begin VB.Label Label14 
         AutoSize        =   -1  'True
         Caption         =   "边缘距离"
         Height          =   195
         Left            =   240
         TabIndex        =   33
         Top             =   840
         Width           =   720
      End
      Begin VB.Label Label13 
         AutoSize        =   -1  'True
         Caption         =   "捕捉距离"
         Height          =   195
         Left            =   1680
         TabIndex        =   31
         Top             =   840
         Width           =   720
      End
      Begin VB.Label Label12 
         AutoSize        =   -1  'True
         Caption         =   "控制点大小"
         Height          =   195
         Left            =   1560
         TabIndex        =   29
         Top             =   480
         Width           =   900
      End
      Begin VB.Label Label7 
         Caption         =   "格网颜色"
         Height          =   255
         Left            =   -73200
         TabIndex        =   20
         Top             =   480
         Width           =   735
      End
   End
End
Attribute VB_Name = "FrmOption"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'是否显示坐标格网
Public IfShowGrid As Boolean
Public intScale As Integer

Private Sub Check1_Click()

End Sub

Private Sub chkShowGrid_Click()
If chkShowGrid.Value = 1 Then
    If TextXco.Text <> "" And TextYco.Text <> "" And _
        TextRowNums.Text <> "" And TextColNums.Text <> "" Then
        chkShowGrid.Value = 1
    Else
        chkShowGrid.Value = 0
        MsgBox "请填写下列各项参数。", vbInformation, "提示"
    End If

End If

End Sub

Private Sub cmdApply_Click()


'设置地图Appearance
If chkAppearance.Value = 1 Then
    FrmMain.PictureMap.Appearance = 1
ElseIf chkAppearance.Value = 0 Then
    FrmMain.PictureMap.Appearance = 0

End If

'设置地图背景颜色
FrmMain.PictureMap.BackColor = picMapBackColor.BackColor

Select Case ComboScale.Text
Case "1:500"
    intScale = 500
Case "1:1000"
    intScale = 1000
Case "1:2000"
    intScale = 2000
    
Case "1:5000"
    intScale = 5000
    
Case Else

End Select

If chkShowGrid.Value = 1 Then
    IfShowGrid = True
Else
    IfShowGrid = False
End If

If FrmMain.IfCalculate = True Then

    FrmMain.PictureMap.Cls
    
    Select Case FrmMain.TraverseType
        Case "ClosedTraverse"
            FrmMain.DrawSketchLine ResultX(), ResultY(), True, FrmMain.PictureMap, CDbl(TxtMarginDist.Text), picColor(1).BackColor
        
        Case Else
            FrmMain.DrawSketchLine ResultX(), ResultY(), False, FrmMain.PictureMap, CDbl(TxtMarginDist.Text), picColor(1).BackColor
    End Select
    
    FrmMain.DrawSketchPoint ResultX(), ResultY(), FrmMain.PictureMap, CDbl(TxtCtlPSize.Text), picColor(0).BackColor
    
    '画出坐标格网
    If IfShowGrid = True Then
        ShowGrid CDbl(TextXco.Text), CDbl(TextYco.Text), CInt(TextRowNums.Text), _
                 CInt(TextColNums.Text), intScale, PicGridColor.BackColor, FrmMain.PictureMap
    End If

End If
'FrmMain.PictureMap.Refresh

FrmMain.IfOptionSet = True


End Sub

Private Sub CmdExit_Click()
Me.Hide
End Sub

Private Sub Form_Load()

'设置地图的背景色
picMapBackColor.BackColor = FrmMain.PictureMap.BackColor

chkAppearance.Value = FrmMain.PictureMap.Appearance

IfShowGrid = False

ComboScale.Clear
ComboScale.AddItem "1:500"
ComboScale.AddItem "1:1000"
ComboScale.AddItem "1:2000"
ComboScale.AddItem "1:5000"
ComboScale.ListIndex = 0

End Sub


Private Sub picColor_Click(Index As Integer)
On Error GoTo FError

CommonDialog1.ShowColor
picColor(Index).BackColor = CommonDialog1.Color

FError:

End Sub

Private Sub PicGridColor_Click()
On Error GoTo FError
CommonDialog1.ShowColor
PicGridColor.BackColor = CommonDialog1.Color
FError:

End Sub

Private Sub picMapBackColor_Click()

On Error GoTo FError

CommonDialog1.ShowColor
picMapBackColor.BackColor = CommonDialog1.Color

FError:

End Sub

'**********************
'显示坐标格网
'**********************
'X西南角X坐标
'Y西南角Y坐标
'Rows格网的行数
'Cols格网的列数
'MapScale地图比例尺(分母项)
'GridColor格网颜色
'PicMap绘制格网的地图
Public Sub ShowGrid(ByVal X As Double, ByVal Y As Double, ByVal Rows As Integer, _
                     ByVal Cols As Integer, ByVal MapScale As Integer, _
                     GridColor As ColorConstants, PicMap As PictureBox)

'每个格网的长度
Dim Interval As Integer
Interval = MapScale * 0.1

Dim i As Integer

'画横线（Y轴）
For i = 1 To Rows + 1
    PicMap.Line (Y, X + i * Interval - Interval)-(Y + Interval * 4, X + i * Interval - Interval), GridColor
    PicMap.CurrentX = Y - 15
    PicMap.CurrentY = X + i * Interval - Interval + 5
    PicMap.Print X + i * Interval - Interval
Next

'画纵线（X轴）
For i = 1 To Cols + 1
    PicMap.Line (Y + i * Interval - Interval, X)-(Y + i * Interval - Interval, X + Interval * 4), GridColor
    PicMap.CurrentX = Y + i * Interval - Interval - 5
    PicMap.CurrentY = X
    PicMap.Print Y + i * Interval - Interval

Next

'标注X坐标
For i = 1 To Rows + 1
    PicMap.CurrentX = Y - 15
    PicMap.CurrentY = X + i * Interval - Interval + 5
    PicMap.Print X + i * Interval - Interval
Next

'标注Y坐标
For i = 1 To Cols + 1
    PicMap.CurrentX = Y + i * Interval - Interval - 5
    PicMap.CurrentY = X
    PicMap.Print Y + i * Interval - Interval

Next

End Sub

Private Sub Picture1_Click()

End Sub