Mega Code Archive
Painting on VCL components without canvas
<![CDATA[
Title: Painting on VCL components without canvas
Question: How to paint or write on a visual component which has no canvas
Answer:
I sometimes need to draw on a panel or a button. If you need it also here is a simple way:
Those visual components without canvas property must have a window handle and a device context. By using GetDC (references to exported procedure of USER32.DLL in windows unit) you can get a handle for its device context. Now all you have to do is simply using this handle in painting, drawing or textout calls.
The following is a simple example:
.
.
.
procedure TForm1.Button2Click(Sender: TObject);
begin
DrawOnComponent(Panel1, 'Hi there'#13#10'And this is the second line');
end;
procedure TForm1.DrawOnComponent(AComponent: TPanel; AText: string);
var
dc : hdc;
APen : hpen;
ABrush : hbrush;
ARect : TRect;
begin
dc := getdc(AComponent.handle); //get device context of component
ARect := AComponent.ClientRect; //select rectangle to draw on
ARect.left := ARect.Left + 10;
ARect.top := ARect.Top + 10;
ARect.Right:= ARect.Right -10;
ARect.Bottom := ARect.Bottom - 10;
apen := createpen(PS_SOLID, 3, clRed); //create graphic object to be used
abrush := createsolidbrush(clWhite);
try
SelectObject(dc, ABrush); //fill background
fillrect(dc, AComponent.ClientRect, abrush);
SelectObject(dc, APen); //draw a rectangle
MoveToEx(dc, ARect.left, ARect.Top-5, nil);
LineTo(dc, ARect.right, ARect.Top-5);
LineTo(dc, ARect.right, ARect.Bottom);
LineTo(dc, ARect.left, ARect.Bottom);
LineTo(dc, ARect.left, ARect.Top-5);
//Rectangle(dc, 0, 0, AComponent.Width-1, AComponent.Height-1);
//An existing object can be used for drawing
SelectObject(dc, AComponent.font.handle);
DrawText( dc,
PChar(AText),
length(AText),
ARect,
DT_CENTER or DT_END_ELLIPSIS or DT_VCENTER);
finally
//free the graphic objects created in this proc. before leaving
DeleteObject(APen);
DeleteObject(ABrush);
end;
end;
ANOTHER METHOD:
1- Create your (for example) TYourPanel inheriting from TPanel.
2- Add property Canvas to published properties.
3- Override create and destroy methods of TPanel to create an instance of TCanvas for your component and to destroy it.
4- Do not to register your component if you wanto to see it on object panel.
5- The code follows:
unit YourPanelUnit;
interface
uses
ExtCtrls, Graphics, Windows, Classes;
type
TYourPanel = class(TPanel)
private
FCanvas: TCanvas;
procedure SetCanvas(const Value: TCanvas);
protected
public
constructor Create(AOwner: TComponent); override;
destructor Destroy;override;
published
property Canvas : TCanvas read FCanvas write SetCanvas;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Custom', [TYourPanel]);
end;
{ TYourPanel }
constructor TYourPanel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FCanvas := TCanvas.Create;
end;
destructor TYourPanel.Destroy;
begin
FCanvas.Free;
inherited;
end;
procedure TYourPanel.SetCanvas(const Value: TCanvas);
begin
FCanvas := Value;
end;
end.
]]>