📄 movepar.frm

📁 用VB6.0MapINfo绘等值线及表面图
💻 FRM
📖 第 1 页 / 共 3 页
字号:
    Vmin = ParFill(IndexMove, 0).value
    Vmax = ParFill(IndexMove, Vn).value
    Vd = (Vmax - Vmin) / Vn
    
    lStartColorFill = ParFill(IndexMove, 0).FillColor
    lEndColorFill = ParFill(IndexMove, Vn).FillColor
    
    Call AddMSFlexGrid
End Sub
Private Sub RGBtoR_G_B(RGB As Long, R As Variant, G As Variant, B As Variant)
    R = RGB Mod 256
    G = (RGB And &HFF00FF00) / 256&
    B = (RGB And &HFF0000) / 65536
End Sub
Private Sub CommandAll_Click()
Dim I As Integer, J As Integer

    If (TheContouPath <> "") Then
        Call CommandCurOK_Click

        For I = 0 To nMove
            If (ParMove(I).Compute = True) Then
                'Begin一个文件对应的参数
                ParMove(IndexMove).ColorMin = ColorMin                      '底色
                ParMove(IndexMove).ValueMin = ValueMin
    
                ParMove(I).Make = 1                                         '是否已建立参数
                ParMove(I).DataType = DataType                              '是否网格数据
                ParMove(I).iOptionContou = iOptionContou                    '图形类型,0-平面等值线，1-立体等值线，2-立体表面图

                ParMove(I).Xmin = Xmin                                      'X最小值
                ParMove(I).Xmax = Xmax                                      'X最大值
                ParMove(I).Ymin = Ymin                                      'Y最小值
                ParMove(I).Ymax = Ymax                                      'Y最大值

                'ParMove(i).Vmin = Vmin                                      '最小值
                'ParMove(i).Vmax = Vmax                                      '最大值
                ParMove(I).Vd = Vd                                          '步长
                ParMove(I).Vn = Vn                                          '等值线数
                ParMove(I).nDec = nDec                                      '小数位数

                ParMove(I).iCheckFillColor = iCheckFillColor                '是否填色
                ParMove(I).lStartColorFill = lStartColorFill                '最小值填充颜色
                ParMove(I).lEndColorFill = lEndColorFill                    '最大值填充颜色
                ParMove(I).iOptionFill = iOptionFill                        '填充图例
                ParMove(I).bFill = bFill
                ParMove(I).bPlotLine = bPlotLine

                ParMove(I).iCheckContouMarkColor = iCheckContouMarkColor    '是否绘等值线线
                ParMove(I).lStartColorCurve = lStartColorCurve              '最小值线条颜色
                ParMove(I).lEndColorCurve = lEndColorCurve                  '最大值线条颜色
                ParMove(I).DeltaN = DeltaN                                  '间隔几条线标注
                ParMove(I).S0 = S0                                          '等值线上的标注间距
                ParMove(I).Hslz = Hslz                                      '标注字符高度(点)

                ParMove(I).AngXY = AngXY                                    '视线方位角(度)
                ParMove(I).AngZ = AngZ                                      '视线俯视角(度)
                ParMove(I).KZ = KZ                                          'Z坐标放大系数
                'End一个文件对应的参数
    
                For J = 0 To Vn
                    ParFill(I, J).FillColor = ParFill(IndexMove, J).FillColor
                    ParFill(I, J).bFillColor = ParFill(IndexMove, J).bFillColor
    
                    ParFill(I, J).iMark = ParFill(IndexMove, J).iMark
                    ParFill(I, J).MarkColor = ParFill(IndexMove, J).MarkColor
                    ParFill(I, J).bMarkColor = ParFill(IndexMove, J).bMarkColor
        
                    ParFill(I, J).value = ParFill(IndexMove, J).value
                Next J
            End If
        Next I
    End If
    bOKCancel = True
    Unload Me
End Sub
Private Sub CommandContouFill_Click()
Dim I As Integer, Temp As String

bClick = False
StrCommand = "填充颜色"
Parame.Show 1

If (iCheckFillColor = 0) Then
    Temp = "不填色"
Else
    Temp = "填色"
End If
For I = 0 To Vn
    MSFlexGridContou.Row = I
    MSFlexGridContou.Col = 2
    MSFlexGridContou.Text = Temp
    
    MSFlexGridContou.CellBackColor = ParFill(IndexMove, I).FillColor
Next I
DoEvents
bClick = True

End Sub

Private Sub CommandContouFillInit_Click()
    Dim I As Integer, J As Integer
    Dim N As Integer, No(1 To 2000) As Integer
    Dim StartColor As Long, EndColor As Long
    Dim V1 As Integer, V2 As Integer, ColorMin As Long
    
    N = 0
    For I = 0 To Vn
        If (ParFill(IndexMove, I).FillColorInit = QBColor(15)) Then
        Else
            N = N + 1
            No(N) = I
        End If
    Next I
    If (N > 1) Then
        iCheckFillColor = 1
        bFill = True
        
        For J = 1 To N - 1
            V1 = No(J)
            V2 = No(J + 1)
            
            StartColor = ParFill(IndexMove, V1).FillColorInit
            EndColor = ParFill(IndexMove, V2).FillColorInit
            Call SetFillColor(StartColor, EndColor, V1, V2, ColorMin)
        Next J
        
        Call AddMSFlexGrid
    End If
End Sub
Private Sub CommandContouMark_Click()
Dim I As Integer, Temp As String

bClick = False
StrCommand = "画线标注"
Parame.Show 1

If (iCheckContouMarkColor = 0) Then
    Temp = "不画线"
Else
    Temp = "画线"
End If
For I = 0 To Vn
    MSFlexGridContou.Row = I
    MSFlexGridContou.Col = 4
    
    MSFlexGridContou.CellForeColor = ParFill(IndexMove, I).MarkColor
    If (Temp = "不画线") Then
        MSFlexGridContou.Text = "不画线"
    Else
        If (ParFill(IndexMove, I).iMark = 1) Then
            MSFlexGridContou.Text = "画线 标注"
        Else
            MSFlexGridContou.Text = "画线 不标注"
        End If
    End If
Next I
DoEvents
bClick = True

End Sub

Private Sub CommandContouMarkInit_Click()
    Dim I As Integer, J As Integer
    Dim N As Integer, No(1 To 2000) As Integer
    Dim StartColor As Long, EndColor As Long
    Dim V1 As Integer, V2 As Integer
    
    N = 0
    For I = 0 To Vn
        If (ParFill(IndexMove, I).MarkColorInit = QBColor(15)) Then
        Else
            N = N + 1
            No(N) = I
        End If
    Next I
    If (N > 1) Then
        For J = 1 To N - 1
            V1 = No(J)
            V2 = No(J + 1)
            
            StartColor = ParFill(IndexMove, V1).MarkColorInit
            EndColor = ParFill(IndexMove, V2).MarkColorInit
            Call SetMarkColor(StartColor, EndColor, V1, V2)
        Next J
        
        Call AddMSFlexGrid
    End If
End Sub
Private Sub CommandContouValue_Click()
    If (OptionContou(0).value = True) Then
        StrCommand = "等值线值"
    Else
        StrCommand = "色块值"
    End If
    bClick = False
    Parame.Show 1
    Call SetFillColor(lStartColorFill, lEndColorFill, 0, Vn, ColorMin)
    Call SetMarkColor(lStartColorCurve, lEndColorCurve, 0, Vn)

    Call AddMSFlexGrid
    DoEvents
    bClick = True
End Sub
Private Sub AddMSFlexGrid()
Dim I As Integer, Temp As String

'Begin等值线值
MSFlexGridContou.Clear
MSFlexGridContou.Rows = Vn + 1
For I = 0 To Vn
    MSFlexGridContou.TextMatrix(I, 0) = Format(I + 1, "###0")
    MSFlexGridContou.TextMatrix(I, 1) = Format(ParFill(IndexMove, I).value, FMT)
Next I
'End等值线值

'Begin填充颜色
If (iCheckFillColor = 0) Then
    Temp = "不填色"
Else
    Temp = "填色"
End If
For I = 0 To Vn
    MSFlexGridContou.Row = I
    MSFlexGridContou.Col = 2
    MSFlexGridContou.Text = Temp
    
    MSFlexGridContou.CellBackColor = ParFill(IndexMove, I).FillColor
    
    MSFlexGridContou.Col = 3
    MSFlexGridContou.CellBackColor = ParFill(IndexMove, I).FillColorInit
Next I
'End填充颜色

'Begin画线标注
If (iCheckContouMarkColor = 0) Then
    Temp = "不画线"
Else
    Temp = "画线"
End If
For I = 0 To Vn
    MSFlexGridContou.Row = I
    
    MSFlexGridContou.Col = 4
    MSFlexGridContou.CellForeColor = ParFill(IndexMove, I).MarkColor
    If (Temp = "不画线") Then
        MSFlexGridContou.Text = "不画线"
    Else
        If (ParFill(IndexMove, I).iMark = 1) Then
            MSFlexGridContou.Text = "画线 标注"
        Else
            MSFlexGridContou.Text = "画线 不标注"
        End If
    End If
    
    MSFlexGridContou.Col = 5
    MSFlexGridContou.CellForeColor = ParFill(IndexMove, I).MarkColorInit
    If (Temp = "不画线") Then
        MSFlexGridContou.Text = ""
    Else
        MSFlexGridContou.Text = "------"
    End If
Next I
'End画线标注
End Sub

Private Sub CommandCurCancel_Click()
bOKCancel = False
Unload Me
End Sub


Private Sub CommandCurOK_Click()
'Begin一个文件对应的参数
ParMove(IndexMove).ColorMin = ColorMin                              '底色
ParMove(IndexMove).ValueMin = ValueMin

ParMove(IndexMove).Make = 1                                         '是否已建立参数
ParMove(IndexMove).DataType = DataType                              '是否网格数据
ParMove(IndexMove).iOptionContou = iOptionContou                    '图形类型,0-平面等值线，1-立体等值线，2-立体表面图

ParMove(IndexMove).Xmin = Xmin                                      'X最小值
ParMove(IndexMove).Xmax = Xmax                                      'X最大值
ParMove(IndexMove).Ymin = Ymin                                      'Y最小值
ParMove(IndexMove).Ymax = Ymax                                      'Y最大值

ParMove(IndexMove).Vmin = Vmin                                      '最小值
ParMove(IndexMove).Vmax = Vmax                                      '最大值
ParMove(IndexMove).Vd = Vd                                          '步长
ParMove(IndexMove).Vn = Vn                                          '等值线数
ParMove(IndexMove).nDec = nDec                                      '小数位数

ParMove(IndexMove).iCheckFillColor = iCheckFillColor                '是否填色
ParMove(IndexMove).lStartColorFill = lStartColorFill                '最小值填充颜色
ParMove(IndexMove).lEndColorFill = lEndColorFill                    '最大值填充颜色
ParMove(IndexMove).iOptionFill = iOptionFill                        '填充图例
ParMove(IndexMove).bFill = bFill
ParMove(IndexMove).bPlotLine = bPlotLine

ParMove(IndexMove).iCheckContouMarkColor = iCheckContouMarkColor    '是否绘等值线线
ParMove(IndexMove).lStartColorCurve = lStartColorCurve              '最小值线条颜色
ParMove(IndexMove).lEndColorCurve = lEndColorCurve                  '最大值线条颜色
ParMove(IndexMove).DeltaN = DeltaN                                  '间隔几条线标注
ParMove(IndexMove).S0 = S0                                          '等值线上的标注间距
ParMove(IndexMove).Hslz = Hslz                                      '标注字符高度(点)

ParMove(IndexMove).AngXY = AngXY                                    '视线方位角(度)
ParMove(IndexMove).AngZ = AngZ                                      '视线俯视角(度)
ParMove(IndexMove).KZ = KZ                                          'Z坐标放大系数
'End一个文件对应的参数
End Sub

Private Sub CommandDelete_Click()
    Dim I As Integer
    
    Row = MSFlexGridContou.Row
    If (Row = Vn) Then
        Vn = Vn - 1
    Else
        For I = Row To Vn - 1
            ParFill(IndexMove, I) = ParFill(IndexMove, I + 1)
        Next I
        Vn = Vn - 1
    End If
    
    Vmin = ParFill(IndexMove, 0).value
    Vmax = ParFill(IndexMove, Vn).value
    Vd = (Vmax - Vmin) / Vn
    
    lStartColorFill = ParFill(IndexMove, 0).FillColor
    lEndColorFill = ParFill(IndexMove, Vn).FillColor
    
    Call AddMSFlexGrid
End Sub
Private Sub Form_Load()
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -