Magnifying glass for your desktop

[moeur]

In response to another thread I developed this little app that makes your form into a magnifying glass for your desktop. Try it out it's pretty cool.

When the form loads, I create a memory device context to store the current contents of the desktop.

[FONT=Courier New][COLOR=#0000FF]Private[/COLOR] [COLOR=#0000FF]Sub[/COLOR] Form_Load()
 
    Me.AutoRedraw = True
    ScaleFactor = 2
    
[COLOR=#007A00]' 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.
[/COLOR] 
hdcScreen = CreateDC("[COLOR=#7A0000]DISPLAY[/COLOR]", vbNullString, vbNullString, 0&)
[COLOR=#0000FF]If[/COLOR] hdcScreen = 0 [COLOR=#0000FF]Then
[/COLOR]    MsgBox "[COLOR=#7A0000]CreateDC failed[/COLOR]"
    [COLOR=#0000FF]Exit[/COLOR] [COLOR=#0000FF]Sub
End[/COLOR] [COLOR=#0000FF]If
[/COLOR]
 
hdcCompatible = CreateCompatibleDC(hdcScreen)
[COLOR=#0000FF]If[/COLOR] hdcCompatible = 0 [COLOR=#0000FF]Then
[/COLOR]    MsgBox "[COLOR=#7A0000]hdcCompatible failed[/COLOR]"
    [COLOR=#0000FF]Exit[/COLOR] [COLOR=#0000FF]Sub
End[/COLOR] [COLOR=#0000FF]If
[/COLOR] 
ScreenWidth = GetDeviceCaps(hdcScreen, HORZRES)
screenHeight = GetDeviceCaps(hdcScreen, VERTRES)
 
[COLOR=#007A00]' Create a compatible bitmap for hdcScreen.
[/COLOR]hbmScreen = CreateCompatibleBitmap(hdcScreen, _
                     ScreenWidth, _
                     screenHeight)
 
[COLOR=#0000FF]If[/COLOR] (hbmScreen = 0) [COLOR=#0000FF]Then
[/COLOR]    MsgBox "[COLOR=#7A0000]hbmScreen failed[/COLOR]"
    [COLOR=#0000FF]Exit[/COLOR] [COLOR=#0000FF]Sub
End[/COLOR] [COLOR=#0000FF]If
[/COLOR] 
[COLOR=#007A00]' Select the bitmaps into the compatible DC.
[/COLOR][COLOR=#0000FF]If[/COLOR] SelectObject(hdcCompatible, hbmScreen) = 0 [COLOR=#0000FF]Then
[/COLOR]    MsgBox "[COLOR=#7A0000]Compatible Bitmap Selection Failed![/COLOR]"
    [COLOR=#0000FF]Exit[/COLOR] [COLOR=#0000FF]Sub
End[/COLOR] [COLOR=#0000FF]If
[/COLOR] 
    UpDateImage
    ZoomIn ScaleFactor
    
[COLOR=#0000FF]End[/COLOR] [COLOR=#0000FF]Sub[/COLOR][/FONT]

Now, when the user holds down the left mouse button I make the form invisible and read-in the contents of the current desktop to the memory DC.

[FONT=Courier New][COLOR=#0000FF]Private[/COLOR] [COLOR=#0000FF]Sub[/COLOR] Form_MouseDown(Button [COLOR=#0000FF]As[/COLOR] [COLOR=#0000FF]Integer[/COLOR], Shift [COLOR=#0000FF]As[/COLOR] [COLOR=#0000FF]Integer[/COLOR], X [COLOR=#0000FF]As[/COLOR] [COLOR=#0000FF]Single[/COLOR], Y [COLOR=#0000FF]As[/COLOR] [COLOR=#0000FF]Single[/COLOR])
    [COLOR=#0000FF]Select[/COLOR] [COLOR=#0000FF]Case[/COLOR] Button
    [COLOR=#0000FF]Case[/COLOR] vbLeftButton
        XX = X
        YY = Y
        UpDateImage
    [COLOR=#0000FF]Case[/COLOR] vbRightButton
        PopupMenu mnPopup
    [COLOR=#0000FF]End[/COLOR] [COLOR=#0000FF]Select
End[/COLOR] [COLOR=#0000FF]Sub
[/COLOR]
[COLOR=#0000FF]Sub[/COLOR] UpDateImage()
    Me.Visible = False
    DoEvents
         [COLOR=#007A00]'Copy color data for the entire display into a
[/COLOR]         [COLOR=#007A00]'bitmap that is selected into a compatible DC.
[/COLOR] 
        [COLOR=#0000FF]If[/COLOR] BitBlt(hdcCompatible, _
               0, 0, _
               ScreenWidth, screenHeight, _
               hdcScreen, _
               0, 0, _
               vbSrcCopy) = 0 [COLOR=#0000FF]Then
[/COLOR] 
                MsgBox "[COLOR=#7A0000]Screen to Compat Blt Failed[/COLOR]"
            [COLOR=#0000FF]Exit[/COLOR] [COLOR=#0000FF]Sub
[/COLOR]        [COLOR=#0000FF]End[/COLOR] [COLOR=#0000FF]If
[/COLOR]    Me.Visible = True
    DoEvents
[COLOR=#0000FF]End[/COLOR] [COLOR=#0000FF]Sub[/COLOR][/FONT]

When the mouse is moved with the left button down, the form is dragged across the desktop and a magnified image of the desktop below the form is copied to the from from the memory DC.

[FONT=Courier New][COLOR=#0000FF]Private[/COLOR] [COLOR=#0000FF]Sub[/COLOR] Form_MouseMove(Button [COLOR=#0000FF]As[/COLOR] [COLOR=#0000FF]Integer[/COLOR], Shift [COLOR=#0000FF]As[/COLOR] [COLOR=#0000FF]Integer[/COLOR], X [COLOR=#0000FF]As[/COLOR] [COLOR=#0000FF]Single[/COLOR], Y [COLOR=#0000FF]As[/COLOR] [COLOR=#0000FF]Single[/COLOR])
[COLOR=#0000FF]If[/COLOR] Button = vbLeftButton [COLOR=#0000FF]Then
[/COLOR]        Me.Left = Me.Left - XX + X
        Me.Top = Me.Top - YY + Y
        ZoomIn ScaleFactor
  [COLOR=#0000FF]End[/COLOR] [COLOR=#0000FF]If
End[/COLOR] [COLOR=#0000FF]Sub
[/COLOR]
[COLOR=#0000FF]Sub[/COLOR] ZoomIn(ZoomFactor [COLOR=#0000FF]As[/COLOR] [COLOR=#0000FF]Long[/COLOR])
 [COLOR=#0000FF]Dim[/COLOR] xLeft [COLOR=#0000FF]As[/COLOR] [COLOR=#0000FF]Long[/COLOR], ytop [COLOR=#0000FF]As[/COLOR] [COLOR=#0000FF]Long
[/COLOR] [COLOR=#0000FF]Dim[/COLOR] nSrcWidth [COLOR=#0000FF]As[/COLOR] [COLOR=#0000FF]Long[/COLOR], nSrcHeight [COLOR=#0000FF]As[/COLOR] [COLOR=#0000FF]Long
[/COLOR] [COLOR=#0000FF]Dim[/COLOR] ScaleFactor [COLOR=#0000FF]As[/COLOR] [COLOR=#0000FF]Single
[/COLOR] [COLOR=#0000FF]Dim[/COLOR] xBorder [COLOR=#0000FF]As[/COLOR] [COLOR=#0000FF]Long
[/COLOR] [COLOR=#0000FF]Dim[/COLOR] yBorder [COLOR=#0000FF]As[/COLOR] [COLOR=#0000FF]Long
[/COLOR] [COLOR=#0000FF]Dim[/COLOR] wndRect [COLOR=#0000FF]As[/COLOR] RECT
 [COLOR=#0000FF]Dim[/COLOR] clientRect [COLOR=#0000FF]As[/COLOR] RECT
 
 GetWindowRect Me.hwnd, wndRect
 GetClientRect Me.hwnd, clientRect
 
[COLOR=#007A00]'get size and location of form
[/COLOR] 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)
 
 [COLOR=#007A00]'align the center of windows
[/COLOR] ScaleFactor = (ZoomFactor - 1) / (2 * ZoomFactor)
 xLeft = wndRect.Left + xBorder + Round(clientRect.Right * ScaleFactor, 0)
 ytop = wndRect.Top + yBorder + Round(clientRect.Bottom * ScaleFactor, 0)
 
[COLOR=#007A00]'make the magnified picture
[/COLOR] StretchBlt Me.hdc, 0, 0, clientRect.Right, clientRect.Bottom, hdcCompatible, xLeft, ytop, nSrcWidth, nSrcHeight, vbSrcCopy
 Me.Refresh
[COLOR=#0000FF]End[/COLOR] [COLOR=#0000FF]Sub[/COLOR][/FONT]

Attached is a project that demos this idea.

[I_Love_My_Vans]

ITs very good, only thing is you cannot see in the very corner of the screeen

Otherwise great job

[moeur]

Yes I noticed that, What you have to do is allow the magnifier to go off the screen a little,

[I_Love_My_Vans]

True, still it is a good app, well played

[moeur]

OK, to allow the magnifier to move off the screen, change the MouseMove Event. I've changed it in the code listing above, but not in the ZIP file

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
   If Button = vbLeftButton Then
        Me.Left = Me.Left - XX + X
        Me.Top = Me.Top - YY + Y
        ZoomIn ScaleFactor
   End If
End Sub

There will be some anomalies in the very top corners.