使用 Delphi 在桌面上绘图以强调鼠标点击

Question

如何在桌面窗口上绘制以在用户点击时绘制圆形动画...

我已经在尝试下面的代码，正在启动一个线程来绘制动画......

下面的代码可以工作，但是有一些油漆问题：

unit UMouseEmphasizer;

interface

implementation

uses
  Classes, Windows, Messages, Graphics, Forms;

type
  TEmphasizePointDrawer = class(TThread)
  private
    fPoint: TPoint;
    fCanvas: TCanvas;
  protected
    procedure Execute; override;
  public
    constructor Create(pt: TPoint); reintroduce;
    destructor Destroy; override;
  end;

constructor TEmphasizePointDrawer.Create(pt: TPoint);
begin
  fPoint := pt;
  fCanvas := TCanvas.Create;
  fCanvas.Handle := GetDCEx(0, 0, DCX_PARENTCLIP);
  inherited Create(True);
  FreeOnTerminate := True;
  Resume;
end;

destructor TEmphasizePointDrawer.Destroy;
begin
  ReleaseDC(0, fCanvas.Handle);
  fCanvas.Free;
  inherited;
end;

procedure TEmphasizePointDrawer.Execute;
const
  INFLATE_DELTA = 10;
var
  i: integer;
  r: TRect;
begin
  r := rect(0,0,0,0);
  with fCanvas do
  begin
    Brush.Style := bsClear;
    Pen.Style := psSolid;
    Pen.Color := clRed;
    Pen.Width := 2;

    for i := 0 to 2 do
    begin
      r := rect(
        fPoint.X - (i * INFLATE_DELTA),
        fPoint.Y - (i * INFLATE_DELTA),
        fPoint.X + (i * INFLATE_DELTA),
        fPoint.Y + (i * INFLATE_DELTA)
      );
      Ellipse(r);

      sleep(100);
    end;
  end;

  InflateRect(r, 2, 2);
  RedrawWindow(0, @R, 0, RDW_INVALIDATE or RDW_UPDATENOW or RDW_ALLCHILDREN);
end;

function MouseHookHandler(nCode: Integer; MsgID: WParam; Data: LParam): LResult; stdcall;
var
  pt: TPoint;
begin
  Result := 0;
  if nCode < 0 then
    Exit;

  pt := PMouseHookStruct(Data)^.pt;

  case MsgID of
    WM_LBUTTONUP:
      TEmphasizePointDrawer.Create(pt);
  end;
end;

var
  gHook: HHOOK=0;

procedure HookMouse; stdcall;
begin
  gHook := SetWindowsHookEx(WH_MOUSE, MouseHookHandler, HINSTANCE, 0);
end;

procedure UnhookMouse;
begin
  UnhookWindowsHookEx(gHook);
  gHook := 0;
end;

initialization
  HookMouse;

finalization
  UnhookMouse;

end.

Answer 1

我解决了这个问题：

procedure TEmphasizePointDrawer.Execute;
const
  INFLATE_DELTA = 5;
  COUNT = 3;
  BORDER = 2;
var
  i: integer;
  r: TRect;
begin
  with fCanvas do
  begin
    Brush.Style := bsClear;
    Pen.Style := psSolid;
    Pen.Color := clRed;
    Pen.Width := BORDER;

    for i := COUNT downto 0 do
    begin
      if i < COUNT then
      begin
        InflateRect(r, BORDER, BORDER);
        RedrawWindow(0, @R, 0, RDW_INVALIDATE or RDW_UPDATENOW or RDW_ALLCHILDREN);
        sleep(0);
        BitBlt(Handle, r.Left, r.Top, (r.Right - r.Left), (r.Bottom - r.Top), Handle, r.Left, r.Top, SRCCOPY);
      end;

      r := rect(
        fPoint.X - (i * INFLATE_DELTA),
        fPoint.Y - (i * INFLATE_DELTA),
        fPoint.X + (i * INFLATE_DELTA),
        fPoint.Y + (i * INFLATE_DELTA)
      );

      InflateRect(r, BORDER, BORDER);
      RedrawWindow(0, @R, 0, RDW_INVALIDATE or RDW_UPDATENOW or RDW_ALLCHILDREN);
      sleep(0);
      BitBlt(Handle, r.Left, r.Top, (r.Right - r.Left), (r.Bottom - r.Top), Handle, r.Left, r.Top, SRCCOPY);

      InflateRect(r, -BORDER, -BORDER);
      Ellipse(r);

      sleep(50);
    end;
  end;

  r := rect(
    fPoint.X - (COUNT * INFLATE_DELTA) - BORDER,
    fPoint.Y - (COUNT * INFLATE_DELTA) - BORDER,
    fPoint.X + (COUNT * INFLATE_DELTA) + BORDER,
    fPoint.Y + (COUNT * INFLATE_DELTA) + BORDER
  );
  RedrawWindow(0, @R, 0, RDW_INVALIDATE or RDW_UPDATENOW or RDW_ALLCHILDREN);
end;

function MouseHookHandler(nCode: Integer; MsgID: WParam; Data: LParam): LResult; stdcall;
var
  pt: TPoint;
begin
  // draw only when over my application forms!!!
  if (nCode < 0) or (FindControl(GetForegroundWindow()) = nil) then
  begin
    Result := CallNextHookEx(gHook, nCode, MsgID, Data);
    Exit;
  end;

  pt := PMouseHookStruct(Data)^.pt;

  case MsgID of
    WM_LBUTTONUP, WM_RBUTTONUP, WM_MBUTTONUP:
      TEmphasizePointDrawer.Create(pt);

  end;
  Result := 0;
end;

感谢您的回复！

Answer 2

据我所知，Stardock CursorXP 方法是用透明和移动的窗口覆盖鼠标，并在这个透明窗口上绘制动画。

你也可以在桌面上创建 ActiveDesktop 对象，当鼠标拖到上面时会看到并渲染这些圆圈。

---

如果您只指您自己的表单，那么“桌面窗口”是错误的术语。在 Windows 中，这意味着代表 Windows 桌面的系统无字幕窗口

但类似的想法也适用。您可以制作一个透明的动画 GIF，并在单击 dbl 时 - 只需将某个组件中的图片显示为表单上的最顶层控件。

更兼容的方法是制作一些特定的 ANI 光标（或从 WinXP 主题中选择一些）显示这些圆圈，然后在 dblclick 上临时将 TForm.Cursor 切换到该 ANI 光标，并在经过一段时间后将其切换回 crDefault。