[dviper]

Для тех, кому это интересно!

Ниже приведен рабочий код:

Код:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197

unit DNCommentaryButton;   interface   uses   SysUtils, Classes, Controls, Messages, Graphics, Windows, ExtCtrls;   type   TTextAligment = (caLeft, caRight, caMiddle);   TTextVAligment = (caTop, caBottom, caCentre);     TPaddingCaption = class(TPersistent)   private     FpcLeft, FpcRight, FpcTop, FpcBottom: Integer;     procedure SetpsLeft(Value: Integer);     procedure SetpsRight(Value: Integer);     procedure SetpsTop(Value: Integer);     procedure SetpsBottom(Value: Integer);   published     property pcLeft: Integer read FpcLeft write SetpsLeft;     property pcRight: Integer read FpcRight write SetpsRight;     property pcTop: Integer read FpcTop write SetpsTop;     property pcBottom: Integer read FpcBottom write SetpsBottom;   end;     { -- Title -- Заголовок -- }   TTitle = class(TPersistent)   private     FFont: TFont;     FCaption: string;     FParent: TWinControl;     FTextAligment: TTextAligment;     FTextVAligment: TTextVAligment;   public     procedure SetCaption(Value: string);     constructor Create(AParent: TWinControl);   published     { Published declarations }     property Font: TFont read FFont write FFont;     property Caption: string read FCaption write SetCaption;     property TextAligment: TTextAligment read FTextAligment write FTextAligment;     property TextVAligment: TTextVAligment read FTextVAligment write FTextVAligment;   end;     // { -- Commentary -- Примечание -- }   // TCommentary = class(TPersistent)   // private   // published   // end;     // { -- BackgroundImage -- Фоновый рисунок -- }   // TBackgroundImage = class(TPersistent)   // private   // { Private declarations }     // public   // published   // { Published declarations }     // end;     { -- TDNCommentaryButton -- }   TDNCommentaryButton = class(TCustomControl)   private     { Private declarations }     FTitle: TTitle;     FPaddingCaption: TPaddingCaption;   protected     { Protected declarations }     r: TRect;     procedure SetTitle(Value: TTitle);     procedure SetPaddingCaption(Value: TPaddingCaption);   public     { Public declarations }     procedure Paint; override;     constructor Create(AOwner: TComponent); override;     destructor Destroy; override;   published     { Published declarations }     property Align;     property ParentFont;     property ParentShowHint;     property ShowHint;     property Visible;     property OnClick;     property Title: TTitle read FTitle write SetTitle;     property PaddingCaption: TPaddingCaption read FPaddingCaption write SetPaddingCaption;     end;   procedure Register;   implementation   procedure Register; begin   RegisterComponents('DNControls', [TDNCommentaryButton]); end;   { TDNCommentaryButton }   constructor TDNCommentaryButton.Create(AOwner: TComponent); begin   inherited Create(AOwner);   ControlStyle := ControlStyle + [csOpaque];     FPaddingCaption := TPaddingCaption.Create;   FTitle := TTitle.Create(Self); end;   destructor TDNCommentaryButton.Destroy; begin   inherited Destroy; end;   procedure TDNCommentaryButton.Paint; var   X: Integer;   Y: Integer; begin   inherited Paint;   r := ClientRect;     SetBkMode(Canvas.Handle, TRANSPARENT);     // Caption -- Заголовок   Canvas.Font := Font;   case FTitle.TextAligment of     caLeft:       X := FPaddingCaption.FpcLeft;     caRight:       X := Self.Width - Canvas.TextWidth(FTitle.FCaption) - FPaddingCaption.FpcRight;     caMiddle:       X := (Width div 2) - (Canvas.TextWidth(FTitle.FCaption) div 2);   end;     case FTitle.FTextVAligment of     caTop:       Y := FPaddingCaption.FpcTop;     caBottom:       Y := Self.Height - Canvas.TextHeight(FTitle.FCaption) - FPaddingCaption.FpcBottom;     caCentre:       Y := (Height div 2) - (Canvas.TextHeight(FTitle.FCaption) div 2);   end;     Canvas.TextOut(X, Y, FTitle.Caption); end;   procedure TDNCommentaryButton.SetPaddingCaption(Value: TPaddingCaption); begin   FPaddingCaption := Value;   Invalidate; end;   procedure TDNCommentaryButton.SetTitle(Value: TTitle); begin   FTitle := Value;   Invalidate; end;   { TPaddingCaption }   procedure TPaddingCaption.SetpsBottom(Value: Integer); begin   FpcBottom := Value; end;   procedure TPaddingCaption.SetpsLeft(Value: Integer); begin   FpcLeft := Value; end;   procedure TPaddingCaption.SetpsRight(Value: Integer); begin   FpcRight := Value; end;   procedure TPaddingCaption.SetpsTop(Value: Integer); begin   FpcTop := Value; end;   { TTitle }   constructor TTitle.Create(AParent: TWinControl); begin   inherited Create;   FParent := AParent; end;   procedure TTitle.SetCaption(Value: string); begin   FCaption := Value;   FParent.Invalidate; end;   end.

Огромный Респект NumLock-у!!!