Содержание материала

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.

 

 

 

Добавить комментарий

Не использовать не нормативную лексику.

Просьба писать ваши замечания, наблюдения и все остальное,
что поможет улучшить предоставляемую информацию на этом сайте.

ВСЕ КОММЕНТАРИИ МОДЕРИРУЮТСЯ ВРУЧНУЮ, ТАК ЧТО СПАМИТЬ БЕСПОЛЕЗНО!


Защитный код
Обновить