Draw over controls in Delphi form

Question

How can I draw something on the Forms canvas and over controls on the Form?

I try the following:

procedure TForm1.FormPaint(Sender: TObject);
var x,y: Integer;
begin
  x := Mouse.CursorPos.X - 10;
  y := Mouse.CursorPos.Y - 10;
  x := ScreentoClient(point(x,y)).X - 10;
  y := ScreenToClient(point(x,y)).Y - 10;
  Canvas.Brush.Color := clRed;
  Canvas.FillRect(rect(x, y, x + 10, y + 10));
  Invalidate;
end;

The rectangle is drawn before other controls are drawn, so it is hidden behind the controls (this is expected behavior according to the Delphi Docs).

My questions is how can I draw over controls?

Answer 1

Do not 'invalidate' in a paint handler. Invalidating causes a WM_PAINT to be sent, which of course starts the paint handling all over. Even if you don't move the mouse, the code sample you posted will cause the 'OnPaint' event to run again and again. Since your drawing depends on the position of the cursor, you'd use the 'OnMouseMove' event for this. But you need to intercept mouse messages for other windowed controls as well. The below sample uses a 'ApplicationEvents' component for this reason. If your application will have more than one form, you need to device a mechanism to differentiate which form you are drawing on.

Also see on the docs that, VCL's Invalidate invalidates the entire window. You don't need to do that, you're drawing a tiny rectangle and you know exactly where you're drawing. Just invalidate where you'll draw and where you've drawn.

As for drawing on controls, actually the drawing part is easy, but you can't do that with the provided canvas. Forms have got WS_CLIPCHILDREN style, child windows' surfaces will be excluded from the update region, so you'd have to use GetDCEx or GetWindowDC. As 'user205376' mentioned in the comments, erasing what you've drawn is a bit more tricky, since you can be drawing one rectangle actually on more than one control. But the api has a shortcut for this too, as you'll see in the code.

I tried to comment a bit the code to be able to follow, but skipped error handling. The actual painting could be in the 'OnPaint' event handler, but controls which do not descend from 'TWinControl' are being painted after the handler. So it's in a WM_PAINT handler.

type
  TForm1 = class(TForm)
    [..]
    ApplicationEvents1: TApplicationEvents;
    procedure FormCreate(Sender: TObject);
    procedure ApplicationEvents1Message(var Msg: tagMSG; var Handled: Boolean);
  private
    FMousePt, FOldPt: TPoint;
    procedure WM_PAINT(var Msg: TWmPaint); message WM_PAINT;
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  // no rectangle drawn at form creation
  FOldPt := Point(-1, -1);
end;

procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
  var Handled: Boolean);
var
  R: TRect;
  Pt: TPoint;
begin
  if Msg.message = WM_MOUSEMOVE then begin

    // assume no drawing (will test later against the point).
    // also, below RedrawWindow will cause an immediate WM_PAINT, this will
    // provide a hint to the paint handler to not to draw anything yet.
    FMousePt := Point(-1, -1);


    // first, if there's already a previous rectangle, invalidate it to clear
    if (FOldPt.X > 0) and (FOldPt.Y > 0) then begin
      R := Rect(FOldPt.X - 10, FOldPt.Y - 10, FOldPt.X, FOldPt.Y);
      InvalidateRect(Handle, @R, True);

      // invalidate childs
      // the pointer could be on one window yet parts of the rectangle could be
      // on a child or/and a parent, better let Windows handle it all
      RedrawWindow(Handle, @R, 0,
                     RDW_INVALIDATE or RDW_UPDATENOW or RDW_ALLCHILDREN);
    end;


    // is the message window our form?
    if Msg.hwnd = Handle then
      // then save the bottom-right coordinates
      FMousePt := SmallPointToPoint(TSmallPoint(Msg.lParam))
    else begin
      // is the message window one of our child windows?
      if GetAncestor(Msg.hwnd, GA_ROOT) = Handle then begin
        // then convert to form's client coordinates
        Pt := SmallPointToPoint(TSmallPoint(Msg.lParam));
        windows.ClientToScreen(Msg.hwnd, Pt);
        FMousePt := ScreenToClient(Pt);
      end;
    end;

    // will we draw?  (test against the point)
    if PtInRect(ClientRect, FMousePt) then begin
      R := Rect(FMousePt.X - 10, FMousePt.Y - 10, FMousePt.X, FMousePt.Y);
      InvalidateRect(Handle, @R, False);
    end;
  end;
end;

procedure TForm1.WM_PAINT(var Msg: TWmPaint);
var
  DC: HDC;
  Rgn: HRGN;
begin
  inherited;

  if (FMousePt.X > 0) and (FMousePt.Y > 0) then begin
    // save where we draw, we'll need to erase before we draw an other one
    FOldPt := FMousePt;

    // get a dc that could draw on child windows
    DC := GetDCEx(Handle, 0, DCX_PARENTCLIP);

    // don't draw on borders & caption
    Rgn := CreateRectRgn(ClientRect.Left, ClientRect.Top,
                          ClientRect.Right, ClientRect.Bottom);
    SelectClipRgn(DC, Rgn);
    DeleteObject(Rgn);

    // draw a red rectangle
    SelectObject(DC, GetStockObject(DC_BRUSH));
    SetDCBrushColor(DC, ColorToRGB(clRed));
    FillRect(DC, Rect(FMousePt.X - 10, FMousePt.Y - 10, FMousePt.X, FMousePt.Y), 0);

    ReleaseDC(Handle, DC);
  end;
end;