Einzelnen Beitrag anzeigen

HJay

Registriert seit: 7. Dez 2009
172 Beiträge
 
Delphi XE7 Enterprise
 
#8

Re: TButton mit zwei Captions und unterschiedlichem Font

  Alt 18. Dez 2009, 19:02
Ich habe Fortschritte gemacht, aber leider noch ein Problem: Die beiden Captions werden korrekt gezeichnet, aber nachdem man draufgedrückt hat, bleibt der Button leer. Sobald die Form eine andere Paint-Message erhält, zeichnet er sich wieder. Was habe ich vergessen? Auf welche Message müsste ich noch reagieren?

Delphi-Quellcode:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;

type
  TMyButton = class(TButton)
  protected
    procedure Paint(var Msg: TMessage); message WM_PAINT;
  private
    FCanvas: TCanvas;
  public
    CaptionTop : String;
    CaptionBottom : String;

    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    property Canvas: TCanvas read FCanvas;
  end;

  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    MyButton : TMyButton;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TMyButton }

constructor TMyButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Parent := AOwner as TWinControl;
  FCanvas := TCanvas.Create;
  FCanvas.Handle := GetDC(Self.Handle);;
end;

destructor TMyButton.Destroy;
begin
  FCanvas.Free;
  inherited;
end;

procedure TMyButton.Paint(var Msg: TMessage);
begin
  inherited;
  Canvas.Pen.Color := clBlack;
  Canvas.Brush.Style := bsClear;
  Canvas.TextOut(2, 2, CaptionTop);
  Canvas.Font.Style := Canvas.Font.Style + [fsBold]; // zweite Zeile anders formatiert
  Canvas.Textout(2, 2 + Canvas.TextHeight(CaptionTop), CaptionBottom);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  MyButton := TMyButton.Create(Self);
  MyButton.Left := 16;
  MyButton.Top := 48;
  MyButton.Height := 48;
  MyButton.CaptionTop := 'upper text';
  MyButton.CaptionBottom := 'lower text';
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  MyButton.Free;
  inherited;
end;

end.
  Mit Zitat antworten Zitat