⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 contou.bas

📁 用VB6.0MapINfo绘等值线及表面图
💻 BAS
📖 第 1 页 / 共 5 页
字号:
🔍
12345 
        PZ = Vmin
        Call Project(Px, Py, PZ, Xo, Yo)


        Px = iMapType * (NX - 1) * DX
        Py = (I - 1) * DY
        PZ = Vmax
        Call Project(Px, Py, PZ, Xot, Yot)
    
        Call PlotCurve(Xo, Yo, 3)
        Call PlotCurve(Xot, Yot, 2)
    Next I
    
    For I = 1 To NX
        Px = (I - 1) * DX
        Py = jMapType * (NY - 1) * DY
        PZ = Vmin
        Call Project(Px, Py, PZ, Xo, Yo)


        Px = (I - 1) * DX
        Py = jMapType * (NY - 1) * DY
        PZ = Vmax
        Call Project(Px, Py, PZ, Xot, Yot)
    
        Call PlotCurve(Xo, Yo, 3)
        Call PlotCurve(Xot, Yot, 2)
    Next I
    
    For I = 1 To NH + 1
        Px = 0
        Py = jMapType * (NY - 1) * DY
        PZ = (I - 1) * HStep
        Call Project(Px, Py, PZ, Xo, Yo)

        Px = (NX - 1) * DX
        Py = jMapType * (NY - 1) * DY
        PZ = (I - 1) * HStep
        Call Project(Px, Py, PZ, Xot, Yot)
    
        Call PlotCurve(Xo, Yo, 3)
        Call PlotCurve(Xot, Yot, 2)
    Next I
    
    For I = 1 To NH + 1
        Px = iMapType * (NX - 1) * DX
        Py = 0
        PZ = (I - 1) * HStep
        Call Project(Px, Py, PZ, Xo, Yo)

        Px = iMapType * (NX - 1) * DX
        Py = (NY - 1) * DY
        PZ = (I - 1) * HStep
        Call Project(Px, Py, PZ, Xot, Yot)
    
        Call PlotCurve(Xo, Yo, 3)
        Call PlotCurve(Xot, Yot, 2)
    Next I
    
    For I = 2 To NH + 1
        Px = 0
        Py = 0
        PZ = (I - 1) * HStep
        Call Project(Px, Py, PZ, Xo, Yo)
        Xo = WcsX0 + Xo * XYFact
        Yo = WcsY0 - Yo * XYFact
    
        Mark = Format(Vmax - PZ, "##0 ")
        PictureMesh.CurrentX = Xo + PictureMesh.TextWidth(" ")
        PictureMesh.CurrentY = Yo - PictureMesh.TextHeight(Mark) / 2
        PictureMesh.Print Mark
    Next I
    
    For I = 2 To NH + 1
        Px = (NX - 1) * DX
        Py = (NY - 1) * DY
        PZ = (I - 1) * HStep
        Call Project(Px, Py, PZ, Xo, Yo)
        Xo = WcsX0 + Xo * XYFact
        Yo = WcsY0 - Yo * XYFact
    
        Mark = Format(Vmax - PZ, "##0 ")
        PictureMesh.CurrentX = Xo - PictureMesh.TextWidth(Mark)
        PictureMesh.CurrentY = Yo - PictureMesh.TextHeight(Mark) / 2
        PictureMesh.Print Mark
    Next I
ElseIf (AngXY < 270) Then
    If (iMapType = 0) Then
        '右面
        X(0) = (NX - 1) * DY
        Y(0) = 0
        Z(0) = Vmax
    
        X(1) = (NX - 1) * DY
        Y(1) = 0
        Z(1) = Vmin
    
        X(2) = (NX - 1) * DY
        Y(2) = (NY - 1) * DY
        Z(2) = Vmin
    
        X(3) = (NX - 1) * DY
        Y(3) = (NY - 1) * DY
        Z(3) = Vmax
    
        For I = 0 To 3
            Call Project(X(I), Y(I), Z(I), Xo, Yo)
        
            P(I).X = WcsX0 + Xo * XYFact
            P(I).Y = WcsY0 - Yo * XYFact
        Next I
        P(4) = P(0)
                
        hRgnClose = CreatePolygonRgn(P(1), 4, WINDING) '创建多边形区域
        hBrush = CreateSolidBrush(&HC0FFC0)
        FillRgn PictureMesh.hdc, hRgnClose, hBrush
        DeleteObject (hBrush)
        DeleteObject (hRgnClose)
        
        '后面
        X(0) = 0
        Y(0) = (NY - 1) * DY
        Z(0) = Vmax
    
        X(1) = 0
        Y(1) = (NY - 1) * DY
        Z(1) = Vmin
    
        X(2) = (NX - 1) * DX
        Y(2) = (NY - 1) * DY
        Z(2) = Vmin
    
        X(3) = (NX - 1) * DX
        Y(3) = (NY - 1) * DY
        Z(3) = Vmax
    
        For I = 0 To 3
            Call Project(X(I), Y(I), Z(I), Xo, Yo)
        
            P(I).X = WcsX0 + Xo * XYFact
            P(I).Y = WcsY0 - Yo * XYFact
        Next I
        P(4) = P(0)
                
        hRgnClose = CreatePolygonRgn(P(1), 4, WINDING) '创建多边形区域
        hBrush = CreateSolidBrush(&HC0C0FF)
        FillRgn PictureMesh.hdc, hRgnClose, hBrush
        DeleteObject (hBrush)
        DeleteObject (hRgnClose)
        
        
        X(0) = 0
        Y(0) = 0
        Z(0) = Vmax
    
        X(1) = (NX - 1) * DX
        Y(1) = 0
        Z(1) = Vmax
    
        X(2) = (NX - 1) * DX
        Y(2) = (NY - 1) * DY
        Z(2) = Vmax
    
        X(3) = 0
        Y(3) = (NY - 1) * DY
        Z(3) = Vmax
    
        For I = 0 To 3
            Call Project(X(I), Y(I), Z(I), Xo, Yo)
        
            P(I).X = WcsX0 + Xo * XYFact
            P(I).Y = WcsY0 - Yo * XYFact
        Next I
        P(4) = P(0)
                
        hRgnClose = CreatePolygonRgn(P(1), 4, WINDING) '创建多边形区域
        hBrush = CreateSolidBrush(&HFFC0C0)
        FillRgn PictureMesh.hdc, hRgnClose, hBrush
        DeleteObject (hBrush)
        DeleteObject (hRgnClose)
    End If

    For I = 1 To NY
        Px = jMapType * (NX - 1) * DX
        Py = (I - 1) * DY
        PZ = Vmin
        Call Project(Px, Py, PZ, Xo, Yo)


        Px = jMapType * (NX - 1) * DX
        Py = (I - 1) * DY
        PZ = Vmax
        Call Project(Px, Py, PZ, Xot, Yot)
    
        Call PlotCurve(Xo, Yo, 3)
        Call PlotCurve(Xot, Yot, 2)
    Next I
    
    For I = 1 To NX
        Px = (I - 1) * DX
        Py = jMapType * (NY - 1) * DY
        PZ = Vmin
        Call Project(Px, Py, PZ, Xo, Yo)

        Px = (I - 1) * DX
        Py = jMapType * (NY - 1) * DY
        PZ = Vmax
        Call Project(Px, Py, PZ, Xot, Yot)
    
        Call PlotCurve(Xo, Yo, 3)
        Call PlotCurve(Xot, Yot, 2)
    Next I
    
    For I = 1 To NH + 1
        Px = 0
        Py = jMapType * (NY - 1) * DY
        PZ = (I - 1) * HStep
        Call Project(Px, Py, PZ, Xo, Yo)

        Px = (NX - 1) * DX
        Py = jMapType * (NY - 1) * DY
        PZ = (I - 1) * HStep
        Call Project(Px, Py, PZ, Xot, Yot)
    
        Call PlotCurve(Xo, Yo, 3)
        Call PlotCurve(Xot, Yot, 2)
    Next I
    
    For I = 1 To NH + 1
        Px = jMapType * (NX - 1) * DX
        Py = 0
        PZ = (I - 1) * HStep
        Call Project(Px, Py, PZ, Xo, Yo)

        Px = jMapType * (NX - 1) * DX
        Py = (NY - 1) * DY
        PZ = (I - 1) * HStep
        Call Project(Px, Py, PZ, Xot, Yot)
   
        Call PlotCurve(Xo, Yo, 3)
        Call PlotCurve(Xot, Yot, 2)
    Next I
    
    For I = 2 To NH + 1
        Px = 0
        Py = (NY - 1) * DY
        PZ = (I - 1) * HStep
        Call Project(Px, Py, PZ, Xo, Yo)
        Xo = WcsX0 + Xo * XYFact
        Yo = WcsY0 - Yo * XYFact
    
        Mark = Format(Vmax - PZ, "##0 ")
        
        PictureMesh.CurrentX = Xo + PictureMesh.TextWidth(" ")
        PictureMesh.CurrentY = Yo - PictureMesh.TextHeight(Mark) / 2
        PictureMesh.Print Mark
    Next I
    
    For I = 2 To NH + 1
        Px = (NX - 1) * DX
        Py = 0
        PZ = (I - 1) * HStep
        Call Project(Px, Py, PZ, Xo, Yo)
        Xo = WcsX0 + Xo * XYFact
        Yo = WcsY0 - Yo * XYFact
    
        Mark = Format(Vmax - PZ, "##0 ")
        PictureMesh.CurrentX = Xo - PictureMesh.TextWidth(Mark)
        PictureMesh.CurrentY = Yo - PictureMesh.TextHeight(Mark) / 2
        PictureMesh.Print Mark
    Next I
ElseIf (AngXY < 360) Then
    If (iMapType = 0) Then
        '右面
        X(0) = (NX - 1) * DY
        Y(0) = 0
        Z(0) = Vmax
    
        X(1) = (NX - 1) * DY
        Y(1) = 0
        Z(1) = Vmin
    
        X(2) = (NX - 1) * DY
        Y(2) = (NY - 1) * DY
        Z(2) = Vmin
    
        X(3) = (NX - 1) * DY
        Y(3) = (NY - 1) * DY
        Z(3) = Vmax
    
        For I = 0 To 3
            Call Project(X(I), Y(I), Z(I), Xo, Yo)
        
            P(I).X = WcsX0 + Xo * XYFact
            P(I).Y = WcsY0 - Yo * XYFact
        Next I
        P(4) = P(0)
                
        hRgnClose = CreatePolygonRgn(P(1), 4, WINDING) '创建多边形区域
        hBrush = CreateSolidBrush(&HC0FFC0)
        FillRgn PictureMesh.hdc, hRgnClose, hBrush
        DeleteObject (hBrush)
        DeleteObject (hRgnClose)
        
        '前面
        X(0) = 0
        Y(0) = 0
        Z(0) = Vmax
    
        X(1) = 0
        Y(1) = 0
        Z(1) = Vmin
    
        X(2) = (NX - 1) * DX
        Y(2) = 0
        Z(2) = Vmin
    
        X(3) = (NX - 1) * DX
        Y(3) = 0
        Z(3) = Vmax
    
        For I = 0 To 3
            Call Project(X(I), Y(I), Z(I), Xo, Yo)
        
            P(I).X = WcsX0 + Xo * XYFact
            P(I).Y = WcsY0 - Yo * XYFact
        Next I
        P(4) = P(0)
                
        hRgnClose = CreatePolygonRgn(P(1), 4, WINDING) '创建多边形区域
        hBrush = CreateSolidBrush(&HC0C0FF)
        FillRgn PictureMesh.hdc, hRgnClose, hBrush
        DeleteObject (hBrush)
        DeleteObject (hRgnClose)
        
        
        X(0) = 0
        Y(0) = 0
        Z(0) = Vmax
    
        X(1) = (NX - 1) * DX
        Y(1) = 0
        Z(1) = Vmax
    
        X(2) = (NX - 1) * DX
        Y(2) = (NY - 1) * DY
        Z(2) = Vmax
    
        X(3) = 0
        Y(3) = (NY - 1) * DY
        Z(3) = Vmax
    
        For I = 0 To 3
            Call Project(X(I), Y(I), Z(I), Xo, Yo)
        
            P(I).X = WcsX0 + Xo * XYFact
            P(I).Y = WcsY0 - Yo * XYFact
        Next I
        P(4) = P(0)
                
        hRgnClose = CreatePolygonRgn(P(1), 4, WINDING) '创建多边形区域
        hBrush = CreateSolidBrush(&HFFC0C0)
        FillRgn PictureMesh.hdc, hRgnClose, hBrush
        DeleteObject (hBrush)
        DeleteObject (hRgnClose)
    End If

    For I = 1 To NY
        Px = jMapType * (NX - 1) * DX
        Py = (I - 1) * DY
        PZ = Vmin
        Call Project(Px, Py, PZ, Xo, Yo)

        Px = jMapType * (NX - 1) * DX
        Py = (I - 1) * DY
        PZ = Vmax
        Call Project(Px, Py, PZ, Xot, Yot)
    
        Call PlotCurve(Xo, Yo, 3)
        Call PlotCurve(Xot, Yot, 2)
    Next I
    
    For I = 1 To NX
        Px = (I - 1) * DX
        Py = iMapType * (NY - 1) * DY
        PZ = Vmin
        Call Project(Px, Py, PZ, Xo, Yo)

        Px = (I - 1) * DX
        Py = iMapType * (NY - 1) * DY
        PZ = Vmax
        Call Project(Px, Py, PZ, Xot, Yot)
    
        Call PlotCurve(Xo, Yo, 3)
        Call PlotCurve(Xot, Yot, 2)
    Next I
    
    For I = 1 To NH + 1
        Px = 0
        Py = iMapType * (NY - 1) * DY
        PZ = (I - 1) * HStep
        Call Project(Px, Py, PZ, Xo, Yo)

        Px = (NX - 1) * DX
        Py = iMapType * (NY - 1) * DY
        PZ = (I - 1) * HStep
        Call Project(Px, Py, PZ, Xot, Yot)
    
        Call PlotCurve(Xo, Yo, 3)
        Call PlotCurve(Xot, Yot, 2)
    Next I
    
    For I = 1 To NH + 1
        Px = jMapType * (NX - 1) * DX
        Py = 0
        PZ = (I - 1) * HStep
        Call Project(Px, Py, PZ, Xo, Yo)


        Px = jMapType * (NX - 1) * DX
        Py = (NY - 1) * DY
        PZ = (I - 1) * HStep
        Call Project(Px, Py, PZ, Xot, Yot)
    
        Call PlotCurve(Xo, Yo, 3)
        Call PlotCurve(Xot, Yot, 2)
    Next I
    
    For I = 2 To NH + 1
        Px = 0
        Py = 0
12345

⌨️ 快捷键说明

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