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. |
- Mike Scott [000779]