Draw over controls in Delphi form - delphi

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;

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.

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.

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
copy the bitmap of the form with controls, and use this bitmap as the background image of this new control, or
make this new window have an irregular shape, so that it is transparent outside some irregularly shaped region.

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.

Related

How do I define an area and check if the mouse is in it?

I am trying to define an area in the shape of a triangle and check if the mouse is in it. I can find if the mouse is in a certain square area using the code below. My program needs to detect the mouse in a triangle or a more complex shape.
if (Mouse.CursorPos.X < 20) or (50 > tbmn.Left + tbmn.Width) or (Mouse.CursorPos.Y < 20) or (Mouse.CursorPos.Y > tbmn.Top + 60) then
begin
end;
So basically, what I want to do is have a shape anywhere on the screen and check if the mouse is in it.
Is there a way to easily calculate a region of the screen and detect if the mouse is present in it?
Asuming you have a component where you draw a triangle inside and only want to have the component detect mouse hit when the cursor is over the visible part of the shape then you could do something like this:
Have an alpha layer on the component being drawn. Then intercept the Windows CM_HITTEST message. in the hit test message procedure you then check if the alpha value is 0. If it is 0 then the mouse is over an area with some visible color value.
Type
TSomeComponent = class(TGraphicControl)
private
FPNG : TGraphic;
procedure CMHitTest(var Message: TCMHitTest); message CM_HITTEST;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Paint; Override;
end;
procedure Register;
implementation
uses
GR32, GR32_Brushes,Winapi.Windows;
procedure TSomeComponent.CMHitTest(var Message: TCMHitTest);
var
colorEntry: TColor32Entry;
bmp : TBitmap32;
begin
bmp := TBitmap32.Create();
try
try
bmp.Assign(FPNG);
colorEntry := TColor32Entry(bmp.Pixels[Message.XPos,Message.YPos]);
if colorEntry.A <> 0 then
Message.Result := HTCLIENT
else
Message.Result := HTNOWHERE;
except
Message.Result := HTCLIENT;
end;
finally
bmp.Free;
end;
end;
You can use region functions from WinApi.
Here are example for simple triangle:
function PtInTriangle(ptX,ptY,X1,Y1,X2,Y2,X3,Y3:integer):Boolean;
var rgn:THandle; pts:array [0..2] of TPoint;
begin
pts[0].X:=X1; pts[0].Y:=Y1;
pts[1].X:=X2; pts[1].Y:=Y2;
pts[2].X:=X3; pts[2].Y:=Y3;
rgn := CreatePolygonRgn( pts[0], 3, WINDING);
Result := PtInRegion(rgn, ptX, ptY);
DeleteObject(rgn);
end;
This function takes about ~30..40us on my machine, and PtInRegion() takes only ~10% of this time (so, you can optimize it by caching Region object). Here are code with simple bencmark:
function PtInTriangle(ptX,ptY,X1,Y1,X2,Y2,X3,Y3:integer):Boolean;
var rgn:THandle; pts:array [0..2] of TPoint;
t,t1,t2,t3:Int64;
begin
// Create region
QueryPerformanceCounter(t);
pts[0].X:=X1; pts[0].Y:=Y1;
pts[1].X:=X2; pts[1].Y:=Y2;
pts[2].X:=X3; pts[2].Y:=Y3;
rgn := CreatePolygonRgn( pts[0], 3, WINDING);
QueryPerformanceCounter(t1); Dec(t1,t);
// Check point
QueryPerformanceCounter(t);
Result := PtInRegion(rgn, ptX, ptY);
QueryPerformanceCounter(t2); Dec(t2,t);
// Delete region
QueryPerformanceCounter(t);
DeleteObject(rgn);
QueryPerformanceCounter(t3); Dec(t3,t);
// Debug output
QueryPerformanceFrequency(t);
OutputDebugString(PChar(Format('All:%d(%.1fus) Create:%d PtInRect:%d(%.1f%%) Delete:%d',
[t1+t2+t3,(t1+t2+t3)/t*1E6,t1,t2,t2*100/(t1+t2+t3),t3])));
end;
Also, you can create complex regions with CreatePolyPolygonRgn() or CombineRgn().

(Delphi 7) Object drawn on canvas (and the canvas itself) does not appear

I've been trying to display a rectangle by creating a canvas on a bitmap. It looks like this:
TRoom = class
private
width, length, X1,X2,Y1,Y2, index: integer;
public
plane: TBitmap;
procedure draw;
procedure setparam;
function getparam: integer;
end;
procedure TRoom.draw;
begin
plane:= TBitmap.create;
plane.canvas.Pen.Color:= 1791767;
plane.Canvas.pen.Width:= 3;
plane.canvas.Rectangle(10,10,20,20);
end;
As stated in the title, neither the canvas, nor the rectangle appear.
I have never worked with the canvas in Delphi before so I expect it to be something rather trivial.
A TBitmap is a non visual class that represents a raster image, a 2D array of pixels. On its own it is never visible. You would need to paint it on the screen in order to see it.
What you should do is create a visual control to which you can paint. For instance a TPaintBox. Put one of those on your form and add a handler for its OnPaint event.
procedure TForm1.PaintBox1Paint(Sender: TCanvas);
begin
PaintBox1.Canvas.Pen.Color :=. 1791767;
PaintBox1.Canvas.Pen.Width := 3;
PaintBox1.Canvas.Rectangle(10, 10, 20, 20);
end;

Canvas.textout doesn´t show text after a new series is made visible

So what i'm doing is display the x and y values of the mouse pointer on a teechart chart using the following code, inside the onmousemove event:
oscilografia.Repaint;
if ((x>236) and (x<927)) and ((y>42) and (y<424)) then
begin
oscilografia.Canvas.Brush.Style := bsSolid;
oscilografia.Canvas.Pen.Color := clBlack;
oscilografia.Canvas.Brush.Color := clWhite;
oscilografia.Canvas.TextOut(x+10,y,datetimetostr(oscilografia.Series[0].XScreenToValue(x))+','+FormatFloat('#0.00',oscilografia.series[0].YScreenToValue(y)));
edit1.Text:=inttostr(x)+' '+inttostr(y);
end;
The code works fine, but a problem happens when i make another series visible by selecting it on the legend: the text inside the box created by canvas.textout isn´t shown anymore.
The box is still there following the mouse, but without any text. So i would like a solution to this.
The basic problem is down to how painting works. Windows do not have persistent drawing surfaces. What you paint onto a window will be overwritten the next time the system needs to repaint it.
You need to arrange that all painting is in response to WM_PAINT messages. In Delphi terms that typically means that you would put your painting code in an overridden Paint method.
So the basic process goes like this:
Derive a sub-class of the chart control and in that class override Paint. Call the inherited Paint method and then execute your code to display the desired text.
In your OnMouseMove event handler, if you detect that the mouse coordinates text needs to be updated, call Invalidate on the chart.
The call to Invalidate will mark that window as being dirty and when the next paint cycle occurs, your code in Paint will be executed.
What is more, when anything else occurs that forces a paint cycle, for instance other modifications to the chart, your paint code will execute again.
Note, as an alternative to sub-classing, you can probably use the TChart event OnAfterDraw. But I'm not an expert on TChart, so am not sure. The main points though are as I state above.
From a comment you wrote, I see you followed this example.
Note it doesn't draw any rectangle; it only draws text, so I'm not sure to understand what box is following your mouse.
Also note the example calls Invalidate, as David Heffernan suggested in his answer.
Find below a modified version of the same example, painting a rectangle before the text.
procedure TForm1.FormCreate(Sender: TObject);
begin
Series1.FillSampleValues(10);
Chart1.View3D := False;
end;
procedure TForm1.Chart1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var tmpL,tmpL2,ClickedValue : Integer;
tmpWidth, tmpHeight: Integer;
tmpText: string;
begin
clickedvalue := -1;
tmpL2:= -1;
With Chart1 do
begin
If (Series1.Clicked(X, Y) <> -1) And (not OnSeriesPoint) Then
begin
Canvas.Brush.Style := bsSolid;
Canvas.Pen.Color := clBlack;
Canvas.Brush.Color := clWhite;
tmpText:=FormatFloat('#.00',Series1.XScreenToValue(x))+','+FormatFloat('#.00',Series1.YScreenToValue(y));
tmpWidth:=Canvas.TextWidth(tmpText)+10;
tmpHeight:=Canvas.TextHeight(tmpText);
Canvas.Rectangle(x+5, y, x+tmpWidth, y+tmpHeight);
Canvas.TextOut(x+10,y,tmpText);
OnSeriesPoint := True;
ClickedValue:= Series1.Clicked(x,y);
End;
//Repaint Chart to clear Textoutputted Mark
If (ClickedValue=-1) And (OnSeriesPoint) Then
begin
OnSeriesPoint := False;
Invalidate;
End;
tmpL := Chart1.Legend.Clicked(X, Y);
If (tmpL <> -1) And ((tmpL <> tmpL2) Or (not OnLegendPoint)) Then
begin
repaint;
Canvas.Brush.Color := Series1.LegendItemColor(tmpL);
Canvas.Rectangle( X, Y, X + 20, Y + 20);
Canvas.Brush.Color := clWhite;
Canvas.TextOut(x+15,y+7,FormatFloat('#.00',Series1.XValues.Items[Series1.LegendToValueIndex(tmpl)]));
tmpL2 := tmpL;
OnLegendPoint := True;
End;
If (tmpL2 = -1) And (OnLegendPoint) Then
begin
OnLegendPoint := False;
Invalidate;
End;
End;
End;

How can I save currently used cursor into the stream (resource or file)?

Does anyone know how to save the cursor (currently used by my application, even if it's custom or animated) into the stream or file, so that I'll be able to send it over network to another computer where my application load and use it ? Simply, I want to clone the cursor from a remote computer.
As I found in this article, most of icon functions can be used for cursors as well, but I can't find any easy to translate example. Here's one example using COM, but I'm not sure if the IPicture interface is useable also for cursors. Here for instance is the discussion about saving the image into the *.cur file, but I can't find anything suitable for saving and loading cursors into stream, resource or something what I'll be able to send over network and load on a target computer.
P.S. there's no SaveCursorToFile function as you might expect.
Thanks for any suggestions
Have a look here: IconsToFile.pas.
This also saves (static) cursors. Can be tested with:
hIconToFile('C:\Temp\Demo.cur', GetCursor, BitC32);
Works. You might have to adjust the bit rate though. I think it will have trouble with animated cursors, but might be enough to get you started.
I think that DrawIconEx might be useful to help with this. With it you can simply draw the entire cursor image to a certain canvas. There is also possibility to draw the specified animated cursor frame by passing its index into the istepIfAniCur parameter. The following example shows how to save the current cursor into the stream (Button1Click) and load it back and display (Button2Click).
The other question is how to detect if the cursor is animated.
var
Stream: TMemoryStream;
procedure TForm1.FormCreate(Sender: TObject);
begin
Stream := TMemoryStream.Create;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
Stream.Free;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
Picture: TPicture;
CursorInfo: TCursorInfo;
begin
Picture := TPicture.Create;
CursorInfo.cbSize := SizeOf(CursorInfo);
GetCursorInfo(CursorInfo);
Picture.Bitmap.Transparent := True;
Picture.Bitmap.Width := GetSystemMetrics(SM_CXCURSOR);
Picture.Bitmap.Height := GetSystemMetrics(SM_CYCURSOR);
DrawIconEx(
Picture.Bitmap.Canvas.Handle, // handle to the target canvas
0, // left coordinate
0, // top coordinate
CursorInfo.hCursor, // handle to the current cursor
0, // width, 0 for autosize
0, // height, 0 for autosize
0, // animated cursor frame index
0, // flicker-free brush handle
DI_NORMAL // flag for drawing image and mask
);
Picture.Bitmap.SaveToStream(Stream);
Picture.Free;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
Picture: TPicture;
begin
Stream.Position := 0;
Picture := TPicture.Create;
Picture.Bitmap.Transparent := True;
Picture.Bitmap.Width := GetSystemMetrics(SM_CXCURSOR);
Picture.Bitmap.Height := GetSystemMetrics(SM_CYCURSOR);
Picture.Bitmap.LoadFromStream(Stream);
SetBkMode(Canvas.Handle, TRANSPARENT);
Canvas.FillRect(Rect(0, 0, 32, 32));
Canvas.Draw(0, 0, Picture.Graphic);
Picture.Free;
end;

Filling a region draws it off canvas

Using the following code in Delphi 2007:
procedure TfrmTest.PaintBox1Paint(Sender: TObject);
const
Rect_Size = 10;
begin
PaintBox1.Canvas.Brush.Color := clYellow;
PaintBox1.Canvas.FillRect(Rect(0, 0, PaintBox1.width, PaintBox1.height));
PaintBox1.Canvas.Brush.Color := clRed;
DrawARect(PaintBox1.Canvas, 0, 0, Rect_Size, Rect_Size);
end;
procedure TfrmTest.DrawARect(ACanvas: TCanvas; iLeft, iTop, iWidth, iHeight: Integer);
var
rgnMain: HRGN;
begin
rgnMain := CreateRectRgn(iLeft, iTop, iLeft + iWidth, iTop + iHeight);
try
SelectClipRgn(ACanvas.handle, rgnMain);
ACanvas.FillRect(ACanvas.ClipRect);
SelectClipRgn(ACanvas.handle, 0);
finally
DeleteObject(rgnMain);
end;
end;
I get this:
(Yellow area shows boundaries of PaintBox1).
alt text http://www.freeimagehosting.net/uploads/62cf687d29.jpg
(Image shows a form with a yellow box [PaintBox1] in the center. However my red rectange [rgnMain] has been drawn at pos 0,0 on the form)
My expectation was that the red rectangle would be at the top left of the PaintBox1 canvas, not the form's canvas. Why is it not? Can regions only be used with controls that have a Windows handle?
Thanks
Device Contexts require a window handle. What VCL does for non-windowed controls is to offset the view port of the DC acquired for the TWinControl they are on, by using SetWindowOrgEx in TWinControl.PaintControls. The new view port is in logical units. So for 'TGraphicControl's, which does not descend from TWinControl, you can use GDI functions which work on logical coordinates. See the remarks section for SelectClipRgn, which says the coordinates should be specified in device units. You'd offset the region or the coordinates.

Resources