[RESOLVED] Magnifying form

[moeur]

Here is a much better solution.
create a memory device context to hold the screen picture
update that DC only when you start to move the form
while the form is being moved, copy a region of that DC onto the form
It works more smoothly if the borders of the form are removed or set to fixed single.

Option Explicit
 
Private hdcScreen As Long
Private hdcCompatible As Long
Private hbmScreen As Long
 
Private ScreenWidth As Long
Private screenHeight As Long
Private XX As Single
Private YY As Single
 
Private ScaleFactor As Long
 
 
Private Declare Function StretchBlt Lib "gdi32" ( _
    ByVal hdc As Long, _
    ByVal X As Long, _
    ByVal Y As Long, _
    ByVal nWidth As Long, _
    ByVal nHeight As Long, _
    ByVal hSrcDC As Long, _
    ByVal xSrc As Long, _
    ByVal ySrc As Long, _
    ByVal nSrcWidth As Long, _
    ByVal nSrcHeight As Long, _
    ByVal dwRop As Long _
) As Long
 
Private Declare Function GetWindowRect Lib "user32" ( _
    ByVal hwnd As Long, _
    lpRect As RECT _
) 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 Declare Function CreateCompatibleDC Lib "gdi32" ( _
    ByVal hdc As Long _
) As Long
 
Private Declare Function BitBlt Lib "gdi32" ( _
    ByVal hDestDC As Long, _
    ByVal X As Long, _
    ByVal Y As Long, _
    ByVal nWidth As Long, _
    ByVal nHeight As Long, _
    ByVal hSrcDC As Long, _
    ByVal xSrc As Long, _
    ByVal ySrc As Long, _
    ByVal dwRop As Long _
) As Long
 
Private Declare Function DeleteDC Lib "gdi32" ( _
    ByVal hdc As Long _
) As Long
 
Private Declare Function CreateDC Lib "gdi32" Alias "CreateDCA" ( _
    ByVal lpDriverName As String, _
    ByVal lpDeviceName As String, _
    ByVal lpOutput As String, _
    ByVal lpInitData As Long _
) As Long
 
Private Declare Function CreateCompatibleBitmap Lib "gdi32" ( _
    ByVal hdc As Long, _
    ByVal nWidth As Long, _
    ByVal nHeight As Long _
) As Long
 
Private Declare Function GetDeviceCaps Lib "gdi32" ( _
    ByVal hdc As Long, _
    ByVal nIndex As Long _
) As Long
 
Private Declare Function SelectObject Lib "gdi32" ( _
    ByVal hdc As Long, _
    ByVal hObject As Long _
) As Long
 
Private Declare Function DeleteObject Lib "gdi32" ( _
    ByVal hObject As Long _
) As Long
 
Private Const HORZRES = 8            '  Horizontal width in pixels
Private Const VERTRES = 10           '  Vertical width in pixels
 
Sub UpDateImage()
    Me.Visible = False
    DoEvents
         'Copy color data for the entire display into a
         'bitmap that is selected into a compatible DC.
 
        If BitBlt(hdcCompatible, _
               0, 0, _
               ScreenWidth, screenHeight, _
               hdcScreen, _
               0, 0, _
               vbSrcCopy) = 0 Then
 
                MsgBox "Screen to Compat Blt Failed"
            Exit Sub
        End If
    Me.Visible = True
    DoEvents
End Sub
 
Sub ZoomIn(ZoomFactor As Long)
 Dim xLeft As Long, ytop As Long
 Dim nSrcWidth As Long, nSrcHeight As Long
 Dim ScaleFactor As Single
 Dim xBorder As Long
 Dim yBorder As Long
 Dim wndRect As RECT
 Dim clientRect As RECT
 
 GetWindowRect Me.hwnd, wndRect
 GetClientRect Me.hwnd, clientRect
 
'get size and location of form
 xBorder = Round((wndRect.Right - wndRect.Left - clientRect.Right) / 2, 0)
 yBorder = wndRect.Bottom - wndRect.Top - clientRect.Bottom - xBorder
 
 nSrcWidth = Round(clientRect.Right / ZoomFactor, 0)
 nSrcHeight = Round(clientRect.Bottom / ZoomFactor, 0)
 
 'align the center of windows
 ScaleFactor = (ZoomFactor - 1) / (2 * ZoomFactor)
 xLeft = wndRect.Left + xBorder + Round(clientRect.Right * ScaleFactor, 0)
 ytop = wndRect.Top + yBorder + Round(clientRect.Bottom * ScaleFactor, 0)
 
'make the magnified picture
 
 StretchBlt Me.hdc, 0, 0, clientRect.Right, clientRect.Bottom, hdcCompatible, xLeft, ytop, nSrcWidth, nSrcHeight, vbSrcCopy
 Me.Refresh
 
End Sub
 
Private Sub Form_Load()
 
    Me.AutoRedraw = True
    ScaleFactor = 2
    
' Create a normal DC and a memory DC for the entire screen. The
' normal DC provides a "snapshot" of the screen contents. The
' memory DC keeps a copy of this "snapshot" in the associated
' bitmap.
 
hdcScreen = CreateDC("DISPLAY", vbNullString, vbNullString, 0&)
If hdcScreen = 0 Then
    MsgBox "CreateDC failed"
    Exit Sub
End If
 
 
hdcCompatible = CreateCompatibleDC(hdcScreen)
If hdcCompatible = 0 Then
    MsgBox "hdcCompatible failed"
    Exit Sub
End If
 
ScreenWidth = GetDeviceCaps(hdcScreen, HORZRES)
screenHeight = GetDeviceCaps(hdcScreen, VERTRES)
 
' Create a compatible bitmap for hdcScreen.
hbmScreen = CreateCompatibleBitmap(hdcScreen, _
                     ScreenWidth, _
                     screenHeight)
 
If (hbmScreen = 0) Then
    MsgBox "hbmScreen failed"
    Exit Sub
End If
 
' Select the bitmaps into the compatible DC.
If SelectObject(hdcCompatible, hbmScreen) = 0 Then
    MsgBox "Compatible Bitmap Selection Failed!"
    Exit Sub
End If
 
    UpDateImage
    ZoomIn ScaleFactor
    
 
End Sub
 
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Select Case Button
    Case vbLeftButton
        XX = X 'Me.ScaleX(X, vbTwips, vbPixels)
        YY = Y 'Me.ScaleY(Y, vbTwips, vbPixels)
        UpDateImage
    Case vbRightButton
        PopupMenu mnPopup
    End Select
    
End Sub
 
 
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim NewLeft As Integer
Dim NewTop As Integer
    If Button = vbLeftButton Then
        NewLeft = Me.Left - XX + X
        NewTop = Me.Top - YY + Y
        If NewLeft + Me.Width <= Screen.Width Then
            If NewLeft >= 0 Then
                Me.Left = NewLeft
            Else
                Me.Left = 0
            End If
        Else
            Me.Left = Screen.Width - Me.Width
        End If
 
        If NewTop + Me.Height <= Screen.Height Then
            If NewTop >= 0 Then
                Me.Top = NewTop
            Else
                Me.Top = 0
            End If
        Else
            Me.Top = Screen.Height - Me.Height
        End If
 
    ZoomIn ScaleFactor
  End If
 
 
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
    DeleteObject hbmScreen
    DeleteDC hdcScreen
    DeleteDC hdcCompatible
End Sub
 
Private Sub mnExit_Click()
    Unload Me
End Sub
 
Private Sub mnFactor_Click(Index As Integer)
    ScaleFactor = Index
    ZoomIn ScaleFactor
End Sub