[dviper]

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

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

Код:

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-у!!!