Results 1 to 6 of 6

Thread: [VB6] Another "magnifier"

  1. #1

    Thread Starter
    PowerPoster
    Join Date
    Feb 2006
    Posts
    24,482

    [VB6] Another "magnifier"

    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: 1343
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.

    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
    Attached Files Attached Files

  2. #2

    Thread Starter
    PowerPoster
    Join Date
    Feb 2006
    Posts
    24,482

    Re: [VB6] Another "magnifier"

    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.

  3. #3
    Hyperactive Member
    Join Date
    Aug 2017
    Posts
    380

    Re: [VB6] Another "magnifier"

    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.

    Quote 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.

  4. #4

    Thread Starter
    PowerPoster
    Join Date
    Feb 2006
    Posts
    24,482

    Re: [VB6] Another "magnifier"

    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.

  5. #5
    PowerPoster
    Join Date
    Sep 2012
    Posts
    2,083

    Re: [VB6] Another "magnifier"

    Quote Originally Posted by dilettante View Post
    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.

    Quote Originally Posted by dilettante View Post
    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.

  6. #6
    PowerPoster yereverluvinuncleber's Avatar
    Join Date
    Feb 2014
    Location
    Norfolk UK (inbred)
    Posts
    2,235

    Re: [VB6] Another "magnifier"

    Love this!


    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.
    https://github.com/yereverluvinunclebert

    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.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width