TLabel+TEdit без контейнераПри
| unit LblEdit; interface usesSysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,Forms, Dialogs, StdCtrls; typeTLabelEdit = class(TEdit)privateFLabel : TLabel ;procedure WMMove( var Msg : TWMMove ) ; message WM_MOVE ;protectedprocedure SetParent( Value : TWinControl ) ; override ;function GetLabelCaption : string ; virtual ;procedure SetLabelCaption( const Value : string ) ; virtual ;publicconstructor Create( AOwner : TComponent ) ; override ;destructor Destroy ; override ;publishedproperty LabelCaption : string read GetLabelCaption writeSetLabelCaption ; end; procedure Register; implementation constructor TLabelEdit.Create( AOwner : TComponent ) ; begininherited 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 ) thenFLabel.Parent := Value ;inherited SetParent( Value ) ;end ; destructor TLabelEdit.Destroy ; beginif ( FLabel <> NIL ) and ( FLabel.Parent = NIL ) thenFLabel.Free ;inherited Destroy ;end ; function TLabelEdit.GetLabelCaption : string ; beginResult := FLabel.Caption ;end ; procedure TLabelEdit.SetLabelCaption( const Value : string ) ; beginFLabel.Caption := Value ;end ; procedure TLabelEdit.WMMove( var Msg : TWMMove ) ; begininherited ; { заставляем TLabel 'прилипнуть' к верху TEdit }if FLabel <> NIL then with FLabel doSetBounds( Msg.XPos, Msg.YPos - Height, Width, Height ) ;end ; procedure Register;beginRegisterComponents('Samples', [TLabelEdit]);end; initialization{ Мы используем TLabel, поэтому для обеспечения "поточности" необходима регистрация }RegisterClass( TLabel ) ;end. |
- Mike Scott [000779]
