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

Question

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

我已经尝试了下面的代码，启动一个Thread来绘制动画......

下面的代码有效，但有一些油漆问题：

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。