ScrollToPosition Method Example

ScrollToPosition is a Run mode method that can be used for pictures with Enhanced Coordinates enabled. The following example uses the ScrollToPosition method after zooming in on an object.

Option Explicit

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long

Private Declare Function GetClientRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long

Private Type RECT

    Left As Long

    Top As Long

    Right As Long

    Bottom As Long

End Type

Private Sub CFixPicture_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Double, ByVal Y As Double)

If Button > 1 Then

unzoom

Else

'this will center the zoom on a mouse click

ZoomtoObject X, Y

End If

End Sub

Private Sub ZoomtoObject(xpos As Double, ypos As Double)

 Dim lZoom As Double

    Dim scrollx, windowHeightPixel, pixelx As Long

    Dim scrolly, windowWidthPixel, pixely As Long

    Dim Top, windowWidthLogical  As Double

    Dim Left, windowHeightLogical As Double

    Dim lhwndWS As Long

    Dim lhwndParent As Long

    Dim lhwndPic As Long

    Dim lRet As Long

    Dim sBuf, sName As String

    Dim buffer As String

    sBuf = vbNullString

    sName = Me.PictureName

    windowWidthPixel = 0

    windowHeightPixel = 0

    'Find the Workspace window

    lhwndWS = FindWindow("WorkSpaceClass", sBuf)

    If lhwndWS > 0 Then

        lhwndParent = FindWindowEx(lhwndWS, 0, "MDIClient", vbNullString)

        If lhwndParent <> 0 Then

            lhwndPic = FindWindowEx(lhwndParent, 0, vbNullString, sName)

             'get client rect of picture

             If lhwndPic <> 0 Then

                Dim aRect2 As RECT

                lRet = GetClientRect(lhwndPic, aRect2)

                If lRet <> 0 Then

                    Top = 0

                    Left = 0

                    windowHeightPixel = aRect2.Bottom - aRect2.Top

                    windowWidthPixel = aRect2.Right - aRect2.Left

                End If

            End If

        End If

    End If

    

    Me.PixelToLogical windowWidthPixel, windowHeightPixel, windowWidthLogical, windowHeightLogical

    lZoom = Me.Zoom

    lZoom = lZoom + lZoom / 2

   

    scrollx = (windowWidthLogical / lZoom) / 2

    scrolly = (windowHeightLogical / lZoom) / 2

      

    If lZoom > 1 Then

        scrollx = xpos - scrollx

        scrolly = ypos - scrolly

    Else

        scrollx = xpos

        scrolly = ypos

    End If

    

    Me.Zoom = lZoom

    Me.LogicalToPixel scrollx, scrolly, pixelx, pixely

    Me.ScrollToPosition pixelx * lZoom, pixely * lZoom

End Sub

Private Sub unzoom()

Me.Zoom = 1

End Sub

NOTE: For more information on Enhanced Coordinates, refer to the Picture Coordinate Systems topic in the Creating Pictures e-book.