parame.frm

用VB6.0MapINfo绘等值线及表面图

      _ExtentY        =   847
      _Version        =   393216
      CancelError     =   -1  'True
   End
End
Attribute VB_Name = "Parame"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Private Sub CheckFillColor_Click()
    CheckPlotLine.value = 1
    If (CheckFillColor.value = 0) Then
        CheckPlotLine.Enabled = False
    Else
        CheckPlotLine.Enabled = True
    End If
End Sub

Private Sub Command1_Click()
    CurCellBackColor = PictureInit.BackColor
    
    bOKCancel = True
    Unload Me
End Sub

Private Sub Command3DOK_Click()
    KZ = Val(TextContou(10).Text)
    AngXY = Val(TextContou(8).Text)
    AngZ = Val(TextContou(9).Text)
    
    Unload Me
End Sub

Private Sub CommandContouValueOK_Click()

Vmin = Val(TextContou(0).Text)
Vmax = Val(TextContou(1).Text)
Vd = Val(TextContou(2).Text)
nDec = Val(TextContou(3).Text)

Call SetContouValue
Unload Me
End Sub

Private Sub CommandCur_Click()
On Error Resume Next
CommonDialog1.DialogTitle = CommandCur.Caption
CommonDialog1.ShowColor
If (Err = 0) Then '打开文件
    PictureCur.BackColor = CommonDialog1.Color
End If
End Sub

Private Sub CommandCurValue_Click()
    CurValue = TextCurValue.Text
    
    Unload Me
End Sub
Private Sub CommandEndColorCurve_Click()
On Error Resume Next
CommonDialog1.DialogTitle = CommandEndColorCurve.Caption
CommonDialog1.ShowColor
If (Err = 0) Then '打开文件
    EndColorCurve.BackColor = CommonDialog1.Color
End If

End Sub

Private Sub CommandEndColorFill_Click()
On Error Resume Next
CommonDialog1.DialogTitle = CommandEndColorFill.Caption
CommonDialog1.ShowColor
If (Err = 0) Then '打开文件
    EndColorFill.BackColor = CommonDialog1.Color
End If

End Sub

Private Sub CommandStartColorCurve_Click()
On Error Resume Next
CommonDialog1.DialogTitle = CommandStartColorCurve.Caption
CommonDialog1.ShowColor
If (Err = 0) Then '打开文件
    StartColorCurve.BackColor = CommonDialog1.Color
End If

End Sub

Private Sub CommandStartColorFill_Click()
On Error Resume Next
CommonDialog1.DialogTitle = CommandStartColorFill.Caption
CommonDialog1.ShowColor
If (Err = 0) Then '打开文件
    StartColorFill.BackColor = CommonDialog1.Color
End If

End Sub

Private Sub EndColorCurve_Click()
Call CommandEndColorCurve_Click
End Sub

Private Sub EndColorFill_Click()
Call CommandEndColorFill_Click
End Sub

Private Sub Form_Load()
Parame.Caption = StrCommand

If (StrCommand = "当前等值线值" Or StrCommand = "当前色块值") Then
    TextCurValue.Text = CurValue
  
    FrameCurValue.Left = 0
    FrameCurValue.Top = 0
    Parame.Width = (FrameCurValue.Width + 5) * Screen.TwipsPerPixelX
    Parame.Height = (FrameCurValue.Height + 25) * Screen.TwipsPerPixelY
    FrameCurValue.Visible = True
ElseIf (StrCommand = "等值线值" Or StrCommand = "色块值") Then
    TextContou(0).Text = Format(Vmin, FMT)
    TextContou(1).Text = Format(Vmax, FMT)
    TextContou(2).Text = Format(Vd, FMT)
    TextContou(3).Text = Format(nDec, "0")
  
    FrameContouValue.Left = 0
    FrameContouValue.Top = 0
    Parame.Width = (FrameContouValue.Width + 5) * Screen.TwipsPerPixelX
    Parame.Height = (FrameContouValue.Height + 25) * Screen.TwipsPerPixelY
    FrameContouValue.Visible = True
ElseIf (StrCommand = "视角参数") Then
    TextContou(8).Text = AngXY
    TextContou(9).Text = AngZ
    TextContou(10).Text = KZ
    
    Frame3D.Left = 0
    Frame3D.Top = 0
    Parame.Width = (Frame3D.Width + 5) * Screen.TwipsPerPixelX
    Parame.Height = (Frame3D.Height + 25) * Screen.TwipsPerPixelY
    Frame3D.Visible = True
ElseIf (StrCommand = "填充颜色") Then
    StartColorFill.BackColor = lStartColorFill
    EndColorFill.BackColor = lEndColorFill
    CheckFillColor.value = iCheckFillColor
    Call CheckFillColor_Click
    CheckPlotLine.value = bPlotLine


    FrameContouFill.Left = 0
    FrameContouFill.Top = 0
    Parame.Width = (FrameContouFill.Width + 5) * Screen.TwipsPerPixelX
    Parame.Height = (FrameContouFill.Height + 25) * Screen.TwipsPerPixelY
    FrameContouFill.Visible = True
ElseIf (StrCommand = "当前填充连续颜色设置" Or StrCommand = "当前标注连续颜色设置") Then
    OptionInit(Init).value = True
    PictureInit.BackColor = CurCellBackColor
  
    FrameInit.Left = 0
    FrameInit.Top = 0
    Parame.Width = (FrameInit.Width + 5) * Screen.TwipsPerPixelX
    Parame.Height = (FrameInit.Height + 25) * Screen.TwipsPerPixelY
    FrameInit.Visible = True
ElseIf (StrCommand = "画线标注") Then
    CheckContouMarkColor.value = iCheckContouMarkColor
    StartColorCurve.BackColor = lStartColorCurve
    EndColorCurve.BackColor = lEndColorCurve
    TextContou(4).Text = Format(PenWidthT, "0")
    TextContou(5).Text = Format(DeltaN - 1, "0")
    TextContou(6).Text = S0
    TextContou(7).Text = Format(Hslz, "##0")
    
    FrameContouMarkColor.Left = 0
    FrameContouMarkColor.Top = 0
    Parame.Width = (FrameContouMarkColor.Width + 5) * Screen.TwipsPerPixelX
    Parame.Height = (FrameContouMarkColor.Height + 25) * Screen.TwipsPerPixelY
    FrameContouMarkColor.Visible = True
ElseIf (StrCommand = "当前填充参数") Then
    FrameEditContou.Visible = True
    FrameEditContou.Caption = "当前填充参数"
    CheckEditContou.Caption = "是否填充当前等值线"
    CheckMarkCur.Enabled = False
    PictureCur.BackColor = CurCellBackColor
    If (Trim(CurTXT) = "填色") Then
        CheckEditContou.value = 1
    Else
        CheckEditContou.value = 0
    End If
    FrameEditContou.Left = 0
    FrameEditContou.Top = 0
    Parame.Width = (FrameEditContou.Width + 5) * Screen.TwipsPerPixelX
    Parame.Height = (FrameEditContou.Height + 25) * Screen.TwipsPerPixelY
    FrameEditContou.Visible = True
ElseIf (StrCommand = "当前标注参数") Then
    CheckMarkCur.Enabled = True
    FrameEditContou.Visible = True
    FrameEditContou.Caption = "当前标注参数"
    CheckEditContou.Caption = "是否绘当前等值线"
    PictureCur.BackColor = CurCellForeColor
    If (Trim(CurTXT) = "不画线") Then
        CheckEditContou.value = 0
        CheckMarkCur.value = False
    ElseIf (Trim(CurTXT) = "画线 标注") Then
        CheckEditContou.value = 1
        CheckMarkCur.value = 1
    Else
        CheckEditContou.value = 1
        CheckMarkCur.value = 0
    End If
    FrameEditContou.Left = 0
    FrameEditContou.Top = 0
    Parame.Width = (FrameEditContou.Width + 5) * Screen.TwipsPerPixelX
    Parame.Height = (FrameEditContou.Height + 25) * Screen.TwipsPerPixelY
    FrameEditContou.Visible = True
End If
Parame.Left = (Screen.Width - Parame.Width) / 2
Parame.Top = (Screen.Height - Parame.Height) / 2

End Sub

Private Sub CommandContouFillColorOK_Click()

lStartColorFill = StartColorFill.BackColor
lEndColorFill = EndColorFill.BackColor
iCheckFillColor = CheckFillColor.value
Call SetFillColor(lStartColorFill, lEndColorFill, 0, Vn, ColorMin)

If (iCheckFillColor = 1) Then
    bFill = True
Else
    bFill = False
End If
bPlotLine = CheckPlotLine.value

Unload Me
End Sub
Private Sub CommandContouMarkColorOK_Click()
    iCheckContouMarkColor = CheckContouMarkColor.value
    lStartColorCurve = StartColorCurve.BackColor
    lEndColorCurve = EndColorCurve.BackColor
    
    PenWidthT = Val(TextContou(4).Text)
    DeltaN = Val(TextContou(5).Text) + 1
    S0 = Val(TextContou(6).Text)
    Hslz = Val(TextContou(7).Text)

    Call SetMarkColor(lStartColorCurve, lEndColorCurve, 0, Vn)
    
    Unload Me
End Sub

Private Sub CommandEditContouOK_Click()

If (FrameEditContou.Caption = "当前填充参数") Then
    CurCellBackColor = PictureCur.BackColor
    ParFill(IndexMove, Row - 1).FillColor = PictureCur.BackColor
    ParFill(IndexMove, Row - 1).bFillColor = CheckEditContou.value
    If (CheckEditContou.value = 0) Then
        CurTXT = "不填色"
    Else
        CurTXT = "填色"
    End If
Else
    CurCellForeColor = PictureCur.BackColor
    ParFill(IndexMove, Row - 1).MarkColor = PictureCur.BackColor
    ParFill(IndexMove, Row - 1).bMarkColor = CheckEditContou.value
    If (CheckEditContou.value = 0) Then
        CurTXT = "不画线"
    Else
        If (CheckMarkCur.value = 1) Then
            CurTXT = "画线 标注"
            ParFill(IndexMove, Row - 1).iMark = 1
        Else
            CurTXT = "画线 不标注"
            ParFill(IndexMove, Row - 1).iMark = 0
        End If
    End If
End If
Unload Me
End Sub

Private Sub LabelInit_Click()
 Call PictureInit_Click
End Sub

Private Sub OptionFill_Click(Index As Integer)
iOptionFill = Index
End Sub

Private Sub OptionInit_Click(Index As Integer)
    Init = Index
End Sub

Private Sub PictureCur_Click()
Call CommandCur_Click
End Sub

Private Sub PictureInit_Click()
    On Error Resume Next
    
    CommonDialog1.DialogTitle = LabelInit.Caption
    CommonDialog1.Color = PictureInit.BackColor
    CommonDialog1.ShowColor
    If (Err = 0) Then '打开文件
        PictureInit.BackColor = CommonDialog1.Color
        OptionInit(1).value = True
    End If
End Sub

Private Sub StartColorCurve_Click()
Call CommandStartColorCurve_Click
End Sub

Private Sub StartColorFill_Click()
Call CommandStartColorFill_Click
End Sub

Private Sub TextContou_GotFocus(Index As Integer)
TextContou(Index).SelStart = 0
TextContou(Index).SelLength = Len(TextContou(Index).Text)
End Sub

Private Sub TextContou_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
If (KeyCode = 13) Then
    SetNextFocus (Index)
End If
End Sub



Private Sub SetNextFocus(CurIndex As Integer)
Dim NextIndex As Integer

If (CurIndex < 4) Then
    NextIndex = CurIndex + 1
ElseIf (CurIndex = 4) Then
    NextIndex = 0
ElseIf (CurIndex = 5 Or CurIndex = 6) Then
    NextIndex = CurIndex + 1
ElseIf (CurIndex = 7) Then
    NextIndex = 5
ElseIf (CurIndex = 8 Or CurIndex = 9) Then
    NextIndex = CurIndex + 1
ElseIf (CurIndex = 10) Then
    NextIndex = 8
End If
TextContou(NextIndex).SetFocus
End Sub