1 Attachment(s)
Magnifying glass for your desktop
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.
VB Code:
[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.
VB Code:
[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.
VB Code:
[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.
Re: Magnifying glass for your desktop
ITs very good, only thing is you cannot see in the very corner of the screeen
Otherwise great job
Re: Magnifying glass for your desktop
Yes I noticed that, What you have to do is allow the magnifier to go off the screen a little,
Re: Magnifying glass for your desktop
True, still it is a good app, well played
Re: Magnifying glass for your desktop
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
VB Code:
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.
