Кнопка с несколькими строками текста

Как на кнопке поместить текст в нескольких строках?

Решение 1

Кнопка с двумя или более строками текста. Разместите на форме компонент TBitBtn и задайте для него достаточно длинный заголовок.. Создайте обработчик формы OnCreate, как показано ниже:

 
procedure TForm1.FormCreate(Sender: TObject);
var
 R: TRect;
 N: Integer;
 Buff: array[0..255] of Char;
 { другие переменные }
begin
 { ваш текст }
 with BitBtn1 do begin
 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;
...

[News Group]

Примечание
Недостаток этого способа в том, что кнопка не может содержать пиктограмму.

Решение 2

 
unit C_wrapb;
 
interface
 
uses
 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
 Forms, Dialogs, StdCtrls, Buttons;
 
type
 TWrapBtn = class(TBitBtn)
 private
 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;
 published
 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.

[News Group]

Примечание
В этом примере тоже нельзя отобразить пиктограмму на кнопке, но при этом мы видим все во время проектирования формы, и «запрещенные» свойства кнопки скрыты от наших глаз.