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

=== Как сделать многострочную надпись на TBitBtn? ===
Выводите текст надписи непосредственно на "glyph" TBitBtn'а
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;
ID: 01238
----
Я создал удобный компонент, инкапсулирующий обычную кнопку, но с возможностью многострочного заголовка. В *действительности* - это TBitBtn, чей Glyph *нарисован* в виде заголовка с переносом текста. Реальный заголовок невидим. Это работает! Попробуйте с этим поэкспериментировать и сообщите мне о ваших новых находках. Я был удивлен, что это свойство оказалось легко *подавить*. Тем более, что это свойство public/published, а не какой-то кот в мешке. Все это так, но вы можете перекрыть свойство другим с таким же именем и с атрибутом READ ONLY. И вы можете ссылать на свойство предка, как, например, "Inherited Glyph". ООП! 
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.
Source: http://delphiworld.narod.ru/
ID: 01248