Tassociatlabel : composant tlabel lié à un control dérivé de twincontrol

Description

Un Composant qui ce lie automatiquement à un control dérivé de TWinControl. Plusieurs
TAssociatLabel peuvent être liés à un même control et à différent endroit. Il améliore en soit
le composant 'TLabeledEdit' proposé par DELPHI 6.

Source / Exemple :


(**********************************)
(* Composant : TAssociatLabel              *)
(* Auteur    : Christophe POULAIN         *)
(* Version   : 1.0.0                               *)
(* Création  : 15/03/2002                     *)
(*		                           *)
(* E_mail    : aphilanantes@free.fr         *)
(*********************************)

Unit AssociatLabel;

Interface

Uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;

Type
  TAround  = (arAboveLeft,arAboveCenter,arAboveRight,
              arBelowLeft,arBelowCenter,arBelowRight,
              arLeftTop,arLeftCenter,arLeftBottom,
              arRightTop,arRightCenter,arRightBottom);

  TAssociatLabel = Class(TCustomLabel)
    Private
      fAround  : TAround;                    // Position autour du control associé
      fIndent  : Integer;                    // Ecart avec le control associé
      Procedure SetAround(Value : TAround);
      Procedure SetAssociate(Value : TWincontrol);
      Function  GetAssociate : TWincontrol;
      Procedure SetIndent(Value : Integer);
    Protected
      Procedure AdjustBounds; Override;
    Public
      Constructor Create(AOwner : TComponent); Override;
    Published
      Property Around : TAround Read fAround Write SetAround Default arAboveLeft;
      Property Associate : TWincontrol Read GetAssociate Write SetAssociate;
      Property Indent : Integer Read fIndent Write SetIndent;
      Property Alignment;
      Property Layout;
      Property Anchors;
      Property AutoSize;
      Property BiDiMode;
      Property Caption;
      Property Color;
      Property Constraints;
      Property Enabled;
      Property Font;
      Property ParentBiDiMode;
      Property ParentColor;
      Property ParentFont;
      Property Transparent;
      Property Visible;
      Property WordWrap;
    End;

Procedure Register;

Implementation

(******************************************)
(* Procedures et Fonctions TAssociatLabel *)
(******************************************)

Procedure TAssociatLabel.SetAround(Value : TAround);

Begin
  If fAround <> Value Then
  Begin
    fAround:=Value;
    AdjustBounds;
  End;
End;

Procedure TAssociatLabel.SetAssociate(Value : TWincontrol);

Begin
  FocusControl:=Value;
  AdjustBounds;
End;

Function TAssociatLabel.GetAssociate : TWincontrol;

Begin
  Result:=FocusControl;
End;

Procedure TAssociatLabel.SetIndent(Value : Integer);

Begin
  If fIndent <> Value Then
  Begin
    fIndent:=Value;
    AdjustBounds;
  End;  
End;

Procedure TAssociatLabel.AdjustBounds;

Var
  Rect    : TRect;
  NewTop,
  NewLeft : Integer;

  Function Justify(Aig : Boolean) : Integer;

  Var
    LT, RB, WH : Integer;

  Begin
    If Aig Then
    Begin
      LT:=Rect.Left;RB:=Rect.Right;WH:=Width;
    End
    Else
    Begin
      LT:=Rect.Top;RB:=Rect.Bottom;WH:=Height;
    End;
    Case (Ord(fAround) Mod 3) Of
      0 : Result:=LT;
      1 : Result:=(LT+RB-WH) Div 2;
      2 : Result:=RB-WH;
    End;
  End;

Begin
  Inherited;
  If Associate<>Nil Then
  Begin
    Rect:=Associate.BoundsRect;
    NewTop:=0;NewLeft:=0;
    Case Ord(fAround) Div 3 Of
      0 : Begin
            NewTop:=Rect.Top-Height-fIndent;
            NewLeft:=Justify(True);
          End;
      1 : Begin
            NewTop:=Rect.Bottom+fIndent;
            NewLeft:=Justify(True);
          End;
      2 : Begin
            NewTop:=Justify(False);
            NewLeft:=Rect.Left-Width-fIndent;
          End;
      3 : Begin
            NewTop:=Justify(False);
            NewLeft:=Rect.Right+fIndent;
          End;
    End;
    SetBounds(NewLeft,NewTop,Width,Height);
  End;
End;

Constructor TAssociatLabel.Create(AOwner : TComponent);

Begin
  Inherited Create(AOwner);
  fIndent:=5;
  AdjustBounds;
End;

Procedure Register;

Begin
  RegisterComponents('Complément', [TAssociatLabel]);
End;

End.

Codes Sources

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.