Как сделать многострочную надпись на TBitBtn?

Code:

procedure TForm1.FormCreate(Sender: TObject);

var

R: TRect;

N: Integer;

Buff: array[0..255] of Char;

begin

with BitBtn1 do

   begin

     Caption := 'A really really long caption';

     Glyph.Canvas.Font := Self.Font;

     Glyph.Width := Width - 6;

     Glyph.Height := Height - 6;

     R := Bounds(0, 0, Glyph.Width, 0);

     StrPCopy(Buff, Caption);

     Caption := '';

     DrawText(Glyph.Canvas.Handle, Buff, StrLen(Buff), R,

       DT_CENTER or DT_WORDBREAK or DT_CALCRECT);

     OffsetRect(R, (Glyph.Width - R.Right) div 2,

       (Glyph.Height - R.Bottom) div 2);

     DrawText(Glyph.Canvas.Handle, Buff, StrLen(Buff), R,

       DT_CENTER or DT_WORDBREAK);

   end;

end;

Code:

unit C_wrapb;

interface

uses

SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,

Forms, Dialogs, StdCtrls, Buttons;

type

TWrapBtn = class(TBitBtn)

private

   { Private declarations }

   function GetGlyph: string;

   function GetMargin: Integer;

   function GetSpacing: Integer;

   function GetKind: TBitBtnKind;

   function GetLayout: TButtonLayout;

   function GetNumGlyphs: TNumGlyphs;

   procedure CMTextChanged(var Message: TMessage);

     message CM_TEXTCHANGED;

   procedure CMFontChanged(var Message: TMessage);

     message CM_FONTCHANGED;

   procedure WMSize(var Msg: TWMSize);

     message WM_SIZE;

   procedure CaptionGlyph;

protected

   { Protected declarations }

public

   { Public declarations }

published

   { Published declarations }

   property Glyph: string read GetGlyph;

   property Margin: Integer read GetMargin;

   property Spacing: Integer read GetSpacing;

   property Kind: TBitBtnKind read GetKind;

   property Layout: TButtonLayout read GetLayout;

   property NumGlyphs: TNumGlyphs read GetNumGlyphs;

end;

procedure Register;

implementation

procedure TWrapBtn.CaptionGlyph;

var

GP: TBitmap;

R: TRect;

Buff: array[0..255] of Char;

begin

GP := TBitmap.Create;

try

   with GP do

   begin

     Canvas.Font := Self.Font;

     StrPCopy(Buff, Caption);

     inherited Margin := 0;

     inherited Spacing := GetSpacing;

     Width := Self.Width - GetSpacing;

     Height := Self.Height - GetSpacing;

     R := Bounds(0, 0, Width, 0);

     DrawText(Canvas.Handle, Buff, StrLen(Buff), R,

       DT_CENTER or DT_WORDBREAK or DT_CALCRECT);

     OffsetRect(R, (Width - R.Right) div 2,

       (Height - R.Bottom) div 2);

     DrawText(Canvas.Handle, Buff, StrLen(Buff), R,

       DT_CENTER or DT_WORDBREAK);

   end;

   inherited Glyph := GP;

   inherited NumGlyphs := 1;

finally

   GP.Free;

end;

end;

function TWrapBtn.GetGlyph: string;

begin

Result := '(Н/Д)';

end;

procedure TWrapBtn.CMTextChanged(var Message: TMessage);

begin

inherited;

CaptionGlyph;

end;

procedure TWrapBtn.CMFontChanged(var Message: TMessage);

begin

inherited;

CaptionGlyph;

end;

procedure TWrapBtn.WMSize(var Msg: TWMSize);

begin

inherited;

CaptionGlyph;

end;

function TWrapBtn.GetMargin: Integer;

begin

Result := 0;

end;

function TWrapBtn.GetSpacing: Integer;

begin

{$IFDEF Win32}

Result := 12;

{$ELSE}

Result := 6;

{$ENDIF}

end;

function TWrapBtn.GetKind: TBitBtnKind;

begin

Result := bkCustom;

end;

function TWrapBtn.GetLayout: TButtonLayout;

begin

Result := blGlyphLeft;

end;

function TWrapBtn.GetNumGlyphs: TNumGlyphs;

begin

Result := 1;

end;

procedure Register;

begin

RegisterComponents('FAQ', [TWrapBtn]);

end;

end.