Drawing over desktop to emphasize mouse clicks with Delphi

Question

How can I draw over the desktop window to draw a circle animation on user clicks...

I already trying the code below, launching a Thread to draw the animation...

The code below works, but has some paint problems:

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.

This feature already exists in Windows. And why only the desktop window? That would be very limiting. — David Heffernan
What goes wrong? "Has some paint problems" doesn't describe the problem very well. — David
Beto Neto, it's rare for people to run code they see here - often you can tell the problem by reading it. If you say 'Nothing appears onscreen' or 'The colours are inverted' or 'It draws at the wrong location' or whatever else, that's a good starting point and will lead to more answers. You need detail when asking a question. Otherwise people will not have enough information to answer it, probably won't want to go to the trouble of running the code themselves, and you won't get any answers. So, put effort into describing your problem well and it will help you :) — David

Beto Neto Beto Neto · Accepted Answer · 2012-10-08T14:17:11

I solved the problem with:

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;

Thanks for the replies!

Drawing over desktop to emphasize mouse clicks with Delphi

2 Answers