TLabel

Code:

unit LblEdit;

interface

uses

SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,

Forms, Dialogs, StdCtrls;

type

TLabelEdit = class(TEdit)

private

   FLabel: TLabel;

   procedure WMMove(var Msg: TWMMove); message WM_MOVE;

protected

   procedure SetParent(Value: TWinControl); override;

   function GetLabelCaption: string; virtual;

   procedure SetLabelCaption(const Value: string); virtual;

public

   constructor Create(AOwner: TComponent); override;

   destructor Destroy; override;

published

   property LabelCaption: string read GetLabelCaption write

     SetLabelCaption;

end;

procedure Register;

implementation

constructor TLabelEdit.Create(AOwner: TComponent);

begin

inherited Create(AOwner);

{ создаем TLabel }

FLabel := TLabel.Create(nil);

FLabel.Caption := 'Edit label';

end;

procedure TLabelEdit.SetParent(Value: TWinControl);

begin

{ убеждаемся, что TLabel имеет того же родителя что и TEdit }

if (Owner = nil) or not (csDestroying in Owner.ComponentState) then

   FLabel.Parent := Value;

inherited SetParent(Value);

end;

destructor TLabelEdit.Destroy;

begin

if (FLabel <> nil) and (FLabel.Parent = nil) then

   FLabel.Free;

inherited Destroy;

end;

function TLabelEdit.GetLabelCaption: string;

begin

Result := FLabel.Caption;

end;

procedure TLabelEdit.SetLabelCaption(const Value: string);

begin

FLabel.Caption := Value;

end;

procedure TLabelEdit.WMMove(var Msg: TWMMove);

begin

inherited;

{ заставляем TLabel 'прилипнуть' к верху TEdit }

if FLabel <> nil then

   with FLabel do

     SetBounds(Msg.XPos, Msg.YPos - Height, Width, Height);

end;

procedure Register;

begin

RegisterComponents('Samples', [TLabelEdit]);

end;

initialization

{ Мы используем TLabel, поэтому для обеспечения

"поточности" необходима регистрация }

RegisterClass(TLabel);

end.