VB实现指示窗口中拖动方框的程序

引自：http://dev.21tx.com/2008/11/06/14137.html

在指示窗口中拖动方框的程序如下：

'用Form_Load、Map1_AfterLayerDraw、Map1_AfterLayerDraw过程来添加指示窗口；

'用Map1_MouseDown过程添加放大缩小功能，以检查指示窗口的连动功能；

'实现在Map2中拖动方框，改变Map1的功能；

Option Explicit
Dim g_feedback As DragFeedback

Private Sub Map2_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    '将点击转换为Map2上的点对象；
    Dim p As Point
    Set p = Map2.ToMapPoint(x, y)

    '如果点击发生在方框内，开始拖动；

    If Map1.Extent.IsPointIn(p) Then
        Set g_feedback = New DragFeedback
        g_feedback.DragStart Map1.Extent, Map2, x, y
    End If
End Sub

'开始拖动方框

Private Sub Map2_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Not g_feedback Is Nothing Then
        g_feedback.DragMove x, y
    End If
End Sub

'拖动完成，并在Map1中显示新位置；

Private Sub Map2_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Not g_feedback Is Nothing Then
        Map1.Extent = g_feedback.DragFinish(x, y)
        Set g_feedback = Nothing
    End If
End Sub
Private Sub MapRectToPixels(r As MapObjects2.Rectangle, xMin As Integer, yMin As Integer, xMax As Integer, yMax As Integer)
    Dim p As New Point
    Dim xc As Single, yc As Single

    p.x = r.Left
    p.y = r.Top
    m_map.FromMapPoint p, xc, yc

    ' convert to pixels
    xMin = m_map.Parent.ScaleX(xc, vbTwips, vbPixels)
    yMin = m_map.Parent.ScaleY(yc, vbTwips, vbPixels)

    p.x = r.Right
    p.y = r.Bottom
    m_map.FromMapPoint p, xc, yc

    ' convert to pixels
    xMax = m_map.Parent.ScaleX(xc, vbTwips, vbPixels)
    yMax = m_map.Parent.ScaleY(yc, vbTwips, vbPixels)
End Sub

Sub PixelsRectToMap(xMin As Integer, yMin As Integer, xMax As Integer, yMax As Integer, r As MapObjects2.Rectangle)
    Dim xc As Single, yc As Single

    ' convert to twips
    xc = m_map.Parent.ScaleX(xMin, vbPixels, vbTwips)
    yc = m_map.Parent.ScaleY(yMin, vbPixels, vbTwips)

    Set p = m_map.ToMapPoint(xc, yc)
    r.Left = p.x
    r.Top = p.y

    ' convert to twips
    xc = m_map.Parent.ScaleX(xMax, vbPixels, vbTwips)
    yc = m_map.Parent.ScaleY(yMax, vbPixels, vbTwips)
    Set p = m_map.ToMapPoint(xc, yc)
    r.Right = p.x
    r.Bottom = p.y
End Sub

 

★VB部分相关文章推荐：★

※vb中line的用法[转]

※画图工具的VB实现

※VB 一个获得自己外网 IP 地址的程序代码

※VB程序中实现IP地址子网掩码网关DNS的更改  [