Советы по Delphi



TLabel+TEdit без контейнераПри


unit LblEdit;
interface
uses
SysUtils, 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]




Содержание  Назад