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.
|
- << Назад
- Вперёд
Просьба писать ваши замечания, наблюдения и все остальное,
что поможет улучшить предоставляемую информацию на этом сайте.
ВСЕ КОММЕНТАРИИ МОДЕРИРУЮТСЯ ВРУЧНУЮ, ТАК ЧТО СПАМИТЬ БЕСПОЛЕЗНО!