Componentes - pintando os que não tem canvas |
Top Previous Next |
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.
|