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: 

 

1Create 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