The topic of writing screen magnifiers came up the other day, and I thought I might trot out this old approach.
Basically it shows simple use of a GDI Region object with StretchBlt. I had another example using StretchBlt then MaskBlt, but this is actually far simpler and less code.
A Timer is used here only to catch any movement at 5 frames/sec to keep overhead low, but even 10 fps shouldn't be too expensive on most PCs. The demo does a "4x" magnification.
Here "DrawGrid" was just a simple program with some colors for me to magnify.
The "MagnifyX4" program is the grey square with the red arrow pointing at the magnified region, which can be dragged around to magnify different parts of the screen.
The circular GDI Region was only used to produce the "clever" circular magnification. You could just use StretchBlt without it to get a square magnifier.
Code:
Option Explicit
'
'Form1 is borderless, mainly to help draw an "arrow" to indicate the captured area of the
'desktop in this demo. With a border the arrow would be off a bit (too low by the caption
'bar height and outline).
'
'We use a Timer control here in order to accomodate magnifying anything animated or moving.
'
'Assumptions:
'
' o Form1's client area is square.
'
Private Const WIN32NULL As Long = 0
Private Declare Function CreateEllipticRgn Lib "gdi32" ( _
ByVal nLeftRect As Long, _
ByVal nTopRect As Long, _
ByVal nRightRect As Long, _
ByVal nBottomRect As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function GetWindowRect Lib "user32" ( _
ByVal hWnd As Long, _
ByRef RECT As RECT) As Long
Private Declare Function ReleaseDC Lib "user32" ( _
ByVal hWnd As Long, _
ByVal hDC As Long) As Long
Private Declare Function SelectClipRgn Lib "gdi32" ( _
ByVal hDC As Long, _
ByVal hRgn As Long) As Long
Private Declare Function StretchBlt Lib "gdi32" ( _
ByVal hdcDest As Long, _
ByVal nXOriginDest As Long, _
ByVal nYOriginDest As Long, _
ByVal nWidthDest As Long, _
ByVal nHeightDest As Long, _
ByVal hdcSrc As Long, _
ByVal nXOriginSrc As Long, _
ByVal nYOriginSrc As Long, _
ByVal nWidthSrc As Long, _
ByVal nHeightSrc As Long, _
Optional ByVal dwRop As RasterOpConstants = vbSrcCopy) As Long
Private CaptureWH As Long
Private GrabX As Single
Private GrabY As Single
Private MagnifyWH As Long
Private Sub Peek()
Dim hDCScreen As Long
Dim hRgn As Long
Dim RECT As RECT
hDCScreen = GetDC(WIN32NULL)
hRgn = CreateEllipticRgn(0, 0, MagnifyWH, MagnifyWH)
SelectClipRgn hDC, hRgn
GetWindowRect hWnd, RECT
With RECT
StretchBlt hDC, _
0, _
0, _
MagnifyWH, _
MagnifyWH, _
hDCScreen, _
.Left - CaptureWH, _
.Top - CaptureWH, _
CaptureWH, _
CaptureWH
End With
SelectClipRgn hDC, WIN32NULL
DeleteObject hRgn
ReleaseDC WIN32NULL, hDCScreen
Set Picture = Image
End Sub
Private Sub Form_Load()
AutoRedraw = True
ScaleMode = vbTwips
BackColor = &H808080
ForeColor = vbRed
DrawWidth = 3
Line (30, 30)-(360, 360)
Line (30, 30)-(360, 30)
Line (30, 30)-(30, 360)
MagnifyWH = ScaleX(ScaleWidth, ScaleMode, vbPixels)
CaptureWH = MagnifyWH / 4
Show
DoEvents
Peek
MsgBox "Left-click and drag to move, shift-left-click to exit"
With Timer1
.Interval = 200 '5 fps capture.
.Enabled = True
End With
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Shift And vbShiftMask Then
Unload Me
ElseIf Button = vbLeftButton Then
GrabX = X
GrabY = Y
End If
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim NewLeft As Single
Dim NewTop As Single
If Button = vbLeftButton Then
NewLeft = Left + X - GrabX
NewTop = Top + Y - GrabY
Move NewLeft, NewTop
'Commented out since we're using Timer1 to magnify anything animated
'such as a video we're watching:
'Peek
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
Timer1.Enabled = False
End Sub
Private Sub Timer1_Timer()
Peek
End Sub
Since Windows comes with a Magnifier utility now I'm not sure how useful this is any more. But you might want to build a "mag" tool into a graphics utility or something I suppose.
Microsoft has had a Magnification API since Windows Vista but unfortunately for VB6-compiled programs, they can't make use of it when running on a 64-bit OS.
Originally Posted by MSDN
Note
The Magnification API is not supported under WOW64; that is, a 32-bit magnifier application will not run correctly on 64-bit Windows.
Well I think everything used in my demo dates back to Win95. If such a simplistic technique does the job it might be one alternative for people to try.
Since Windows comes with a Magnifier utility now I'm not sure how useful this is any more.
Hi dilettante, your code is very useful.
Originally Posted by dilettante
But you might want to build a "mag" tool into a graphics utility or something I suppose.
Yes. I want to add a "screen color picking" tool to my ColorPicker (I want to put this color-magnifier in the upper left corner of the title bar of the ColorPicker Form). I'll compare your method and LaVolpe's method and choose a solution that is more suitable for me. Thank you very much.
Last edited by dreammanor; Jul 20th, 2020 at 04:46 AM.
just thinking of a use for my magnifying glass image that I use in one of my desktop .js widgets. The widgets do not know about the desktop so they can't magnify anything. VB6 can, so it might be a possible use for it. GDI may be slowish but it might do at a pinch.
Last edited by yereverluvinuncleber; Jul 7th, 2023 at 06:41 PM.
Skillset: VMS,DOS,Windows Sysadmin from 1985, fault-tolerance, VaxCluster, Alpha,Sparc. DCL,QB,VBDOS- VB6,.NET, PHP,NODE.JS, Graphic Design, Project Manager, CMS, Quad Electronics. classic cars & m'bikes. Artist in water & oils. Historian.
By the power invested in me, all the threads I start are battle free zones - no arguing about the benefits of VB6 over .NET here please. Happiness must reign.