4

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?

Kromster
  • 7,181
  • 7
  • 63
  • 111
iamjoosy
  • 3,299
  • 20
  • 30
  • 1
    If you place a `TButton` on a `TMemo`, would you expect the memo to be able to draw on the surface of the button? If you put a Microsoft WordPad window over a Microsoft Paint window, would you expect the Paint window to be able to draw inside the WordPad window? – Andreas Rejbrand Dec 18 '10 at 17:09
  • @Andreas: So how do "toys" like doggies running all over your screen, or the hammer tool with which you could "crack" your screen once demonstrated by Mark Miller in a "Fun with Delphi" session, do it? – Marjan Venema Dec 18 '10 at 17:23
  • @Marjan: They are windows with irregular shapes. Just like Microsoft WordPad can be on top of Microsoft Paint, so can an irregularly shaped window (e.g. a dog) be on top of Microsoft Paint. – Andreas Rejbrand Dec 18 '10 at 17:27
  • 1
    Actually, its not true, Andreas Rejbrand. Its easy to draw on the desktop window, erasing stuff just drawn poses a problem, tho. – Free Consulting Dec 18 '10 at 18:30
  • @user20537: Yes, I have done that many times. Just `GetDesktopWindow` and do your drawing. But the OP tries to draw to other controls by using the DC of his own control. – Andreas Rejbrand Dec 18 '10 at 18:33
  • @Andreas Rejbrand, thats the way to break out of particular window clipping region and Z order. BTW, that unformatted code above invalidates immediately after drawing :-) – Free Consulting Dec 18 '10 at 18:50
  • 2
    @Andreas - Then why not tell him to use a different DC instead of saying it cannot be done. – Sertac Akyuz Dec 19 '10 at 06:06

5 Answers5

10

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;
Sertac Akyuz
  • 54,131
  • 4
  • 102
  • 169
  • Note that the DC retrieved by `GetDCEx` can be assigned to the Form's [`Canvas.Handle`](http://docs.embarcadero.com/products/rad_studio/delphiAndcpp2009/HelpUpdate2/EN/html/delphivclwin32/Graphics_TCanvas_Handle.html) if one is more comfortable drawing with the canvas. But clipping would require api calls. – Sertac Akyuz Dec 19 '10 at 11:24
  • That's exactly what I was loking for. Thanks for the detailed example, and taking the time to understand my problem. – iamjoosy Dec 19 '10 at 12:50
  • @iamjoosy - You're welcome! :) Don't worry for the time, it was an interesting problem. – Sertac Akyuz Dec 19 '10 at 13:50
  • Hi! Nice code.... can you show me a sample how to draw over the desktop window and draw a circle animation on user clicks ??? – Beto Neto Oct 08 '12 at 12:46
1

The application main window cannot draw over other control surface. Controls periodically paint and erase themselves (based on the control "paint cycle")

Your application can only draw on controls that allow the application to do it. Many common controls provide flexibility to applications for customizing the control appearance, thru control custom draw techniques.

PA.
  • 28,486
  • 9
  • 71
  • 95
1

You can't.

Controls are drawn on top of their parent window. Whatever you draw on the parent window will be seen behind the controls over that window. It is not clear why you need to do such a drawing; however, maybe you can create a transparent control inside the form and set it to front, then draw on its canvas. That way your drawing would look on top of the form and its other controls, but that way user cannot interact with other controls on the form, because they are behind the transparent control.

vcldeveloper
  • 7,399
  • 2
  • 33
  • 39
1

You cannot do this. You need to create a windowed control (such as a window) and place this window on top of the controls you want to draw "on". Then you can either

  1. copy the bitmap of the form with controls, and use this bitmap as the background image of this new control, or

  2. make this new window have an irregular shape, so that it is transparent outside some irregularly shaped region.

Andreas Rejbrand
  • 105,602
  • 8
  • 282
  • 384
  • Yep, that's what I did in the past. I just thought there might be an easier solution. The flaw in my thinking was that I ignored the fact, that the parent window is drawn before the child controls are drawn and hence, the canvas of the parent is drawn over. – iamjoosy Dec 18 '10 at 22:00
-1

I did something who involve to draw handles around components on my form here what I did.

First create a message like this :

Const
PM_AfterPaint = WM_App + 1;

Write a Procedure to handle the message:

Procedure AfterPaint(var msg: tmsg); Message PM_AfterPaint;

Procedure AfterPaint(var msg: tmsg);
begin
  {place the drawing code here}
  ValidateRect(Handle, ClientRect);
end;

Validaterect will tell Windows that there is no need to repaint your form. Your painting will cause portion of the form to be "invalidate". ValidateRect say to windows everything is "validate".

You also need, last step, to override the paint procedure.

Procedure Paint; Override;

Procedure TForm1.paint;
Begin
  Inherited;
  PostMessage(Handle, PM_AfterPaint, 0, 0);
End; 

So each time your form need to be repainted (WM_Paint), it will call the ancestor paint and add a AfterPaint message to the message queue. When The message is process, AfterPaint is call and do paint your stuff and tell Windows that everything is fine, preventing another call to paint.

Hope this help.