Многострочный заголовок у TBitBtn 2
Я создал удобный компонент, инкапсулирующий обычную кнопку, но с возможностью многострочного заголовка. В *действительности* - это 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.
|
|
