delphi - 如何在我的 Delphi 表单下获取图像？

Question

我正在修改一个开源的 Delphi 放大镜应用程序以满足我的需要。它非常简单，只包含一个TImage显示缩放屏幕的控件。

当我运行它时，它看起来像这样：

基本上，当用户移动光标时，应用程序会复制相应的矩形并将其绘制在 上TImage以提供缩放效果。

然而，问题是：

• 它不显示缩放光标（Windows 放大镜会这样做）
• 它无法获取主窗体下方的屏幕部分（Windows 放大镜会这样做）。

如何实现这两个功能？我现在没有任何线索。

我的最终目标是让它全屏运行并且仍然可以缩放，就像 Windows 放大镜一样。

下面是我的代码。

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.