modfeedback.bas

来自「地理信息系统工程案例精选程序,本书所有案例均需要单独配置」· BAS 代码 · 共 36 行

BAS
36
字号
Attribute VB_Name = "modFeedback"
Sub MapRectToPixels(r As Rectangle, xMin As Integer, yMin As Integer, xMax As Integer, yMax As Integer)
    Dim p As New MapObjects2.POINT
    Dim xc As Single, yc As Single
    
    p.x = r.Left
    p.y = r.Top
    Map2.FromMapPoint p, xc, yc
    
    xMin = Form1.ScaleX(xc, vbTwips, vbPixels)  ' convert to pixels
    yMin = Form1.ScaleY(yc, vbTwips, vbPixels)  ' convert to pixels

    p.x = r.Right
    p.y = r.bottom
    Map2.FromMapPoint p, xc, yc
    
    xMax = Form1.ScaleX(xc, vbTwips, vbPixels)  ' convert to pixels
    yMax = Form1.ScaleY(yc, vbTwips, vbPixels)  ' convert to pixels
End Sub

Sub PixelsRectToMap(xMin As Integer, yMin As Integer, xMax As Integer, yMax As Integer, r As Rectangle)
    Dim xc As Single, yc As Single, p As MapObjects2.POINT
    
    xc = Form1.ScaleX(xMin, vbPixels, vbTwips) ' convert to twips
    yc = Form1.ScaleY(yMin, vbPixels, vbTwips) ' convert to twips
    Set p = Map2.ToMapPoint(xc, yc)
    r.Left = p.x
    r.Top = p.y
  
    xc = Form1.ScaleX(xMax, vbPixels, vbTwips) ' convert to twips
    yc = Form1.ScaleY(yMax, vbPixels, vbTwips) ' convert to twips
    Set p = Map2.ToMapPoint(xc, yc)
    r.Right = p.x
    r.bottom = p.y
End Sub

⌨️ 快捷键说明

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