CODEWITHSUNDEEP
delphi
Beto Neto
Beto Neto

Reputation: 4102

Drawing over desktop to emphasize mouse clicks with Delphi

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.

Upvotes: 1

Views: 944

Answers (2)

Beto Neto
Beto Neto

Reputation: 4102

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!

Upvotes: 3

Arioch &#39;The
Arioch &#39;The

Reputation: 16065

Stardock CursorXP approach, for what i can tell, is to cover mouse with transparent and moving window and draw animation on this transparent window instead.

You also probably may make ActiveDesktop object on the desktop, that would see when mouse is dragged over it and render those circles.

If you mean only your own forms, then "desktop window" is wrong term. In Windows that means the system captionless window that represents the Windows Desktop

But the similar idea applies. You can make a transparent animated GIF and when dbl-clicked - just show the picture in some component as topmost control on the form.

Even more compatible approach would be to make some specific ANI cursor (or choosing some from WinXP themes) showing those circles, then on dblclick temporary switch TForm.Cursor to that ANI cursor and switch it back to crDefault after some times passed.

Upvotes: 0

Related Questions