Советы по Delphi
Кнопка с несколькими строчками текста II
Я создал удобный компонент, инкапсулирующий обычную кнопку, но с возможностью многострочного заголовка. В *действительности* - это TBitBtn, чей Glyph *нарисован* в виде заголовка с переносом текста. Реальный заголовок невидим. Это работает! Попробуйте с этим поэкспериментировать и сообщите мне о ваших новых находках. Я был удивлен, что это свойство оказалось легко *подавить*. Тем более, что это свойство public/published, а не какой-то кот в мешке. Все это так, но вы можете перекрыть свойство другим с таким же именем и с атрибутом READ ONLY. И вы можете ссылать на свойство предка, как, например, "Inherited Glyph". ООП!
- Neil Rubenking
|
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. |
[000722]
