以Delphi形式绘制控件 [英] Draw over controls in Delphi form
问题描述
我尝试以下操作：
procedure TForm1.FormPaint（Sender：TObject）;
var x，y：整数;
begin
x：= Mouse.CursorPos.X - 10;
y：= Mouse.CursorPos.Y - 10;
x：= ScreentoClient（point（x，y））。
y：= ScreenToClient（point（x，y））。
Canvas.Brush.Color：= clRed;
Canvas.FillRect（rect（x，y，x + 10，y + 10））;
无效;
结束
在绘制其他控件之前绘制矩形，因此它隐藏在控件后面（这是预期的根据Delphi文档的行为）
我的问题是如何绘制控件？
不要在油漆处理程序中无效。 无效会导致 WM_PAINT 发送，这当然是开始油漆处理。即使您不移动鼠标，您发布的代码示例将导致OnPaint事件一次又一次地运行。由于您的绘图取决于光标的位置，因此您可以使用OnMouseMove事件。但是，您还需要拦截其他窗口控件的鼠标消息。以下示例使用ApplicationEvents组件。如果您的应用程序将有多个表单，您需要设置一种机制来区分您正在绘制的表单。
另请参阅文档，VCL的 无效 使整个窗口无效。您不需要这样做，您正在绘制一个小矩形，并且确切地知道您正在绘制的位置。只是无效你绘制的地方和你绘制的地方。
至于绘制控件，实际上绘图部分很容易，但是你不能这样做提供的画布。表单已获得 WS_CLIPCHILDREN 样式，子窗口的表面将被排除在更新区域中，因此您必须使用 GetDCEx 或 GetWindowDC 。作为评论中提到的user205376，擦除所绘制的内容有点棘手，因为您可以在多个控件上实际绘制一个矩形。但是api还有一个快捷方式，正如您将在代码中看到的那样。
我试图评论一下代码，以便能够遵循，但跳过错误处理。实际的绘画可能在OnPaint事件处理程序中，但不是从TWinControl下降的控件将在处理程序之后进行绘制。所以这是一个WM_PAINT处理程序。
键入
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）;消息WM_PAINT;
public
end;
var
Form1：TForm1;
实现
{$ R * .dfm}
程序TForm1.FormCreate（发件人：TObject）;
begin
//在窗体创建时没有绘制矩形
FOldPt：= Point（-1，-1）;
结束
程序TForm1.ApplicationEvents1Message（var Msg：tagMSG;
var Handled：Boolean）;
var
R：TRect;
Pt：TPoint;
begin
如果Msg.message = WM_MOUSEMOVE然后开始
//假设没有绘图（将稍后测试点）。
//还有，在RedrawWindow下面会导致立即的WM_PAINT，这将
//提供一个提示给绘图处理程序，以便不绘制任何东西。
FMousePt：= Point（-1，-1）;
//首先，如果已经有一个前一个矩形，则将其清除
，如果（FOldPt.X> 0）和（FOldPt.Y> 0））开始
R：= Rect（FOldPt.X - 10，FOldPt.Y - 10，FOldPt.X，FOldPt.Y）;
InvalidateRect（Handle，@R，True）;
// invalidate childs
//指针可以在一个窗口上，但是矩形的一部分可能是
//在一个孩子或/和父母上，更好的让Windows处理它所有
RedrawWindow（Handle，@R，0，
RDW_INVALIDATE或RDW_UPDATENOW或RDW_ALLCHILDREN）;
结束
//是我们的窗体的消息窗口？
if Msg.hwnd = Handle then
// then save the bottom-right coordinates
FMousePt：= SmallPointToPoint（TSmallPoint（Msg.lParam））
else begin
//消息窗口是我们的子窗口之一吗？
如果GetAncestor（Msg.hwnd，GA_ROOT）=处理然后开始
//然后转换为窗体的客户端坐标
Pt：= SmallPointToPoint（TSmallPoint（Msg.lParam））;
windows.ClientToScreen（Msg.hwnd，Pt）;
FMousePt：= ScreenToClient（Pt）;
结束
结束
//我们画吗？ （测试点）
如果PtInRect（ClientRect，FMousePt）然后开始
R：= Rect（FMousePt.X - 10，FMousePt.Y - 10，FMousePt.X，FMousePt.Y）;
InvalidateRect（Handle，@R，False）;
结束
结束
结束
程序TForm1.WM_PAINT（var Msg：TWmPaint）;
var
DC：HDC;
Rgn：HRGN;
开始
继承;
如果（FMousePt.X> 0）和（FMousePt.Y> 0）然后开始
//保存我们绘制的地方，我们需要在绘制另一个之前擦除一个
FOldPt：= FMousePt;
//获取可以在子窗口上绘制的直流
DC：= GetDCEx（Handle，0，DCX_PARENTCLIP）;
//不绘制边框& caption
Rgn：= CreateRectRgn（ClientRect.Left，ClientRect.Top，
ClientRect.Right，ClientRect.Bottom）;
SelectClipRgn（DC，Rgn）;
DeleteObject（Rgn）;
//绘制一个红色矩形
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）;
结束
结束
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?
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;
这篇关于以Delphi形式绘制控件的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
