0

I'm modifying an open-source Delphi magnifier application to meet my needs. It's very simple and only contains a TImage control to show the zoomed screen.

image

When I run it, it looks like this:

image

Basically, when the user moves the cursor, the app copies the corresponding rectangle and draws it on the TImage to give a zooming effect.

However, the problems are:

  • It doesn't show the zoomed cursor (Windows Magnifier does that)
  • It can't get the screen portion underneath the Main Form (Windows Magnifier does that).

How can I implement these two features? I have no clues right now.

My final goal is to make it run in full screen and still zoom, just like Windows Magnifier does.

Below is the code I have.

UNIT uZoom;

INTERFACE

    USES
        ShellApi, Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
        ComCtrls, StdCtrls, ExtCtrls, Buttons, System.Actions, Vcl.ActnList;

    TYPE
        TMainForm = CLASS(TForm)
            img: TImage;
    timer: TTimer;
            ActionList1: TActionList;
            inc_factor: TAction;
            dec_factor: TAction;
            PROCEDURE FormResize(Sender: TObject);
            PROCEDURE FormDestroy(Sender: TObject);
            PROCEDURE timerTimer(Sender: TObject);
            PROCEDURE inc_factorExecute(Sender: TObject);
            PROCEDURE FormCreate(Sender: TObject);
            PROCEDURE dec_factorExecute(Sender: TObject);
        PRIVATE
        PUBLIC
        END;

    VAR
        MainForm: TMainForm;

    VAR
        factor: integer;

IMPLEMENTATION

    {$R *.DFM}

    PROCEDURE TMainForm.FormResize(Sender: TObject);
    BEGIN
        img.Picture := NIL;
    END;

    PROCEDURE TMainForm.inc_factorExecute(Sender: TObject);
    BEGIN
        factor := factor + 1;
        OutputDebugString(PChar(inttostr(factor)));
        Invalidate;
    END;

    PROCEDURE TMainForm.dec_factorExecute(Sender: TObject);
    BEGIN
        factor := factor - 1;
        IF factor = 0 THEN
            factor := 1;
        OutputDebugString(PChar(inttostr(factor)));
        Invalidate;
    END;

    PROCEDURE TMainForm.FormCreate(Sender: TObject);
    BEGIN
        factor := 1;
        OutputDebugString(PChar(inttostr(factor)));
        Invalidate;
    END;

    PROCEDURE TMainForm.FormDestroy(Sender: TObject);
    BEGIN
        timer.Interval := 0;
    END;

    PROCEDURE TMainForm.timerTimer(Sender: TObject);
    VAR
        srcRect, destRect, fmrRect: TRect;
        iWidth, iHeight, DmX, DmY: integer;
        C: TCanvas;
        curPos: TPoint;
    BEGIN
        // Determines whether the specified window is minimized (iconic).
        IF IsIconic(Application.Handle) THEN
            exit;

        // Retrieves a handle to the desktop window. The desktop window covers the entire screen.
        // The desktop window is the area on top of which other windows are painted.
        VAR
            hDesktop: Hwnd := GetDesktopWindow;

            // Retrieves the position of the mouse cursor, in screen coordinates.
        GetCursorPos(curPos);
        fmrRect := Rect(MainForm.Left, MainForm.Top, MainForm.Left + MainForm.Width, MainForm.Top + MainForm.Height);

        // The PtInRect function determines whether the specified point lies within the specified rectangle.
        // A point is within a rectangle if it lies on the left or top side or is within all four sides.
        // A point on the right or bottom side is considered outside the rectangle.
        IF NOT PtInRect(fmrRect, curPos) THEN
        BEGIN
            img.Visible := True;

            iWidth := img.Width;
            iHeight := img.Height;
            destRect := Rect(0, 0, iWidth, iHeight);

            VAR dx: real := iWidth / (factor * 4);
            VAR dy: real := iHeight / (factor * 4);

            srcRect := Rect(curPos.x, curPos.y, curPos.x, curPos.y);
            InflateRect(srcRect, Round(dx), Round(dy));

            IF srcRect.Left < 0 THEN
                OffsetRect(srcRect, -srcRect.Left, 0);
            IF srcRect.Top < 0 THEN
                OffsetRect(srcRect, 0, -srcRect.Top);
            IF srcRect.Right > Screen.DesktopWidth THEN
                OffsetRect(srcRect, -(srcRect.Right - Screen.DesktopWidth), 0);
            IF srcRect.Bottom > Screen.DesktopHeight THEN
                OffsetRect(srcRect, 0, -(srcRect.Bottom - Screen.DesktopHeight));

            C := TCanvas.Create;
            TRY
                C.Handle := GetDC(GetDesktopWindow);

                img.Canvas.CopyRect(destRect, C, srcRect);
            FINALLY
                ReleaseDC(hDesktop, C.Handle);
                C.Free;
            END;
        END;
    END;

END.
Remy Lebeau
  • 555,201
  • 31
  • 458
  • 770
user130268
  • 1,341
  • 2
  • 12
  • 20
  • 1
    There are really two completely separate questions here that should probably be asked separately. For the first, this answer is C#, but it's all WinAPI in the end and that works exactly the same way in Delphi [How to capture the screen and mouse pointer using Windows APIs?](https://stackoverflow.com/q/6750056/327083) – J... Nov 18 '21 at 16:40
  • See also : [How can I capture screen under my own window excluding my own window](https://stackoverflow.com/q/6495569/327083) – J... Nov 18 '21 at 16:42
  • Also : [How do I capture desktop screenshot behind full screen form?](https://stackoverflow.com/q/18844031/327083) – J... Nov 18 '21 at 16:48
  • Also : [Screenshot behind a full screen Form results in a black screen](https://stackoverflow.com/q/48614900/327083) – J... Nov 18 '21 at 16:50

0 Answers0