Delphi开发放大镜如何获取窗体下方屏幕及实现光标放大功能

问题1：无法获取主窗体下方屏幕内容 #

核心原因 #

原有代码存在IF NOT PtInRect(fmrRect, curPos) THEN的判断逻辑，当窗体全屏运行时，光标始终处于窗体区域内，会直接跳过截图更新流程；同时直接获取桌面DC截图时会把放大镜窗体本身也截入画面。

修复方案 #

• 删除上述光标位置判断逻辑
• 截图前临时隐藏窗体，截图完成后立即恢复，速度极快不会产生肉眼可见的闪烁

问题2：无法展示放大后的光标 #

实现思路 #

截图完成后通过Windows API获取当前光标句柄、热点坐标，按照当前放大倍率缩放后绘制到TImage画布的对应位置即可。

修改后完整代码 #

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;
        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 := 2; // 初始放大倍率建议设为2，效果更明显
        // 全屏设置，可根据需求调整
        BorderStyle := bsNone;
        Left := 0;
        Top := 0;
        Width := Screen.DesktopWidth;
        Height := Screen.DesktopHeight;
        timer.Interval := 30; // 控制刷新频率，30ms约33帧，流畅度足够
        OutputDebugString(PChar(inttostr(factor)));
    END;

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

    PROCEDURE TMainForm.timerTimer(Sender: TObject);
    VAR
        srcRect, destRect: TRect;
        iWidth, iHeight: integer;
        C: TCanvas;
        curPos: TPoint;
        dx, dy: Real;
        // 光标绘制相关变量
        CursorInfo: TCursorInfo;
        IconInfo: TIconInfo;
        CursorPos: TPoint;
        DrawCursorSize: TSize;
    BEGIN
        IF IsIconic(Application.Handle) THEN
            exit;

        GetCursorPos(curPos);
        img.Visible := True;
        iWidth := img.Width;
        iHeight := img.Height;
        destRect := Rect(0, 0, iWidth, iHeight);

        dx := iWidth / (factor * 2);
        dy := iHeight / (factor * 2);

        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));

        // 临时隐藏窗体，避免截到自己
        Visible := False;
        // 等待窗体重绘隐藏，避免部分场景还能截到窗体残影
        Sleep(1);

        C := TCanvas.Create;
        TRY
            C.Handle := GetDC(GetDesktopWindow);
            img.Canvas.CopyRect(destRect, C, srcRect);
        FINALLY
            ReleaseDC(GetDesktopWindow, C.Handle);
            C.Free;
            // 立即恢复窗体显示
            Visible := True;
        END;

        // 绘制放大后的光标
        CursorInfo.cbSize := SizeOf(TCursorInfo);
        IF GetCursorInfo(CursorInfo) THEN
        BEGIN
            IF CursorInfo.flags = CURSOR_SHOWING THEN
            BEGIN
                IF GetIconInfo(CursorInfo.hCursor, IconInfo) THEN
                BEGIN
                    // 计算光标在放大画面中的位置
                    CursorPos.X := Round((curPos.X - srcRect.Left) * factor);
                    CursorPos.Y := Round((curPos.Y - srcRect.Top) * factor);
                    // 计算缩放后的光标大小
                    DrawCursorSize.cx := GetSystemMetrics(SM_CXCURSOR) * factor;
                    DrawCursorSize.cy := GetSystemMetrics(SM_CYCURSOR) * factor;
                    // 减去光标热点偏移，确保光标位置准确
                    CursorPos.X := CursorPos.X - IconInfo.xHotspot * factor;
                    CursorPos.Y := CursorPos.Y - IconInfo.yHotspot * factor;

                    // 绘制缩放后的光标
                    DrawIconEx(img.Canvas.Handle, CursorPos.X, CursorPos.Y, 
                        CursorInfo.hCursor, DrawCursorSize.cx, DrawCursorSize.cy, 
                        0, 0, DI_NORMAL);

                    // 释放资源
                    DeleteObject(IconInfo.hbmMask);
                    DeleteObject(IconInfo.hbmColor);
                END;
            END;
        END;
    END;

END.

额外优化建议 #

• 可以将timer.Interval调整为15~30之间，平衡流畅度和CPU占用
• 如果不想用临时隐藏窗体的方案，可以给窗体添加WS_EX_LAYERED和WS_EX_TRANSPARENT扩展样式，同时设置AlphaBlend属性为True、AlphaBlendValue为0，截图完成后再恢复透明度，也能避免截到窗体本身

内容的提问来源于stack exchange，提问作者user130268