delphidrawingcustom-draw

Draw over controls in Delphi form


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?


Solution

  • 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;