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.
![Name: sshot.png
Views: 24
Size: 1.7 KB]()
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.
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