Developpez.com - Delphi
X

Choisissez d'abord la catégorieensuite la rubrique :

Nono40.developpez.com
Le petit coin du web de Nono40
SOURCES TESTS DELPHI WIN32 AUTOMATISMES DELPHI .NET QUICK-REPORT
Retour à l'accueil
11 - LABEL ORIENTABLE

PRÉSENTATION : C'est un composant libellé dont le texte est orientable et étirable
ZIP : Téléchargez le zip APERÇUS : -1.jpg-

NOTES : Installation:
Installer le composant TOrLabel contenu dans le fichier UOrLabel.PAS

Utilisation: comme un label mais avec quelques changements :
- la propriété Font n'existe pas, utilisez OrFont
- OrFont.Orient définit la rotation par pas de 0,1 degré
- OrLabel ne fonctionne qu'avec des polices TrueType
- Alignement/WordWarp etc n'existent pas...

Remarques:
TOrFont n'est pas descendante de TFont, elle ne peut donc pas être assignée à un autre composant. Mais vous pouvez l'utiliser dans vos propres composants : voir la méthode Paint du TOrLabel pour l'utilisation du TOrFont.
TOrFont et TOrLabel fonctionnent avec Delphi5 et Delphi6.


CODE :
//
// TOrLabel :  label orientable et étirable par Nono40
//
// ( Système de limitation d'occupation resources inspiré de Graphics.pas )
//
//  26/04/2002 :  Création
//  27/04/2002 :  Ajout de TOrFont.Incline
//             :  Ajout de TOrLabel.AutoSize
//             :  Ajout de TOrLabel.InclineMode
//  28/04/2002 :  Ajout de quelques commentaires...
//             :  Ajout de TOrFont.Width
//  29/04/2002 :  Modification de CalculXY pour tenir compte de OrFont.Width
//
//  OrFont.Orient   défini l'orientation du texte entier
//  OrFont.Incline  défini l'orientation de chaque caractère dans le texte
//     Incline n'est utilisé que ici OrLabel.InclineMode=IM_ADVANCED
//     IM_ADVANCED ne fonctionne qu'avec WNT4 et supérieur
//     Incline et InclineMode sont ignorés avec W95,W98,WMe
//  OrFont.Width    défini la largeur moyenne de chaque caractère
//     Une largeur de 0 utilise la proportion normale de la police
//
//

Unit UOrLabel;

{$P+,S-,W-,R-,T-,X+,H+,B-}

Interface

Uses Windows, SysUtils, Classes, Graphics, Controls, Messages;

Type

// Structure utilisée par le gestionnaire de ressource et décrivant un OrFont
  POrFontData = ^TOrFontData;
  TOrFontData = Record
    Handle  : HFont;
    Height  : Integer;
    Pitch   : TFontPitch;
    Style   : TFontStylesBase;
    Charset : TFontCharset;
    Name    : TFontDataName;
    Orient  : Integer;
    Incline : Integer;
    Width   : Integer;
  End;

  POrResource = ^TOrResource;
  TOrResource = Record
    Next     : POrResource;
    RefCount : Integer;
    Handle   : THandle;
    HashCode : Word;
    OrFont   : TOrFontData;
  End;

// Objet font orientable
  TOrFont = Class(TGraphicsObject)
  Private
    FColor         : TColor;
    FPixelsPerInch : Integer;
    FOrResource    : POrResource;
    Procedure GetData(Var OrFontData: TOrFontData);
    Procedure SetData(Const OrFontData: TOrFontData);
  Protected
    Function  GetHandle  : HFont;
    Function  GetHeight  : Integer;
    Function  GetName    : TFontName;
    Function  GetPitch   : TFontPitch;
    Function  GetSize    : Integer;
    Function  GetStyle   : TFontStyles;
    Function  GetCharset : TFontCharset;
    Function  GetOrient  : Integer;
    Function  GetIncline : Integer;
    Function  GetWidth   : Integer;
    Procedure SetColor       (      Value: TColor         );
    Procedure SetHandle      (      Value: HFont          );
    Procedure SetHeight      (      Value: Integer        );
    Procedure SetName        (Const Value: TFontName      );
    Procedure SetPitch       (      Value: TFontPitch     );
    Procedure SetSize        (      Value: Integer        );
    Procedure SetStyle       (      Value: TFontStyles    );
    Procedure SetCharset     (      Value: TFontCharset   );
    Procedure SetOrient      (      Value: Integer        );
    Procedure SetIncline     (      Value: Integer        );
    Procedure SetWidth       (      Value: Integer        );
  Public
    Constructor Create;
    Destructor Destroy; override;
    Procedure Assign(Source: TPersistent); override;
    Property Handle: HFont read GetHandle write SetHandle;
    Property PixelsPerInch: Integer read FPixelsPerInch write FPixelsPerInch;
  Published
    Property Charset : TFontCharset read GetCharset write SetCharset;
    Property Color   : TColor       read FColor     write SetColor;
    Property Height  : Integer      read GetHeight  write SetHeight;
    Property Name    : TFontName    read GetName    write SetName;
    Property Pitch   : TFontPitch   read GetPitch   write SetPitch    default fpDefault;
    Property Size    : Integer      read GetSize    write SetSize     stored False;
    Property Style   : TFontStyles  read GetStyle   write SetStyle;
    Property Orient  : Integer      read GetOrient  write SetOrient;
    Property Incline : Integer      read GetIncline write SetIncline;
    Property Width   : Integer      read GetWidth   write SetWidth;
  End;

// Définition du type label orientable
  TInclineMode= (IM_COMPATIBLE,IM_ADVANCED);

  TOrLabel = Class(TGraphicControl)
  Private
    FTransparent  : Boolean;          // Le texte est transparent
    FOnMouseLeave : TNotifyEvent;
    FOnMouseEnter : TNotifyEvent;
    FOrFont       : TOrFont;          // Font orientable utilisée
    FDecalX       : Integer;          // Déclage du coin haut gauche du texte par rapport 
                                      // au centre du composant
    FDecalY       : Integer;          // Est déduit en fonction des autres propriétés et de la fonte
    FInclineMode  : TInclineMode;     // Mode de gestion de la propriété incline de la fonte
                                      // car incline n'est utilisable que sous NT4 ou supérieur
    Procedure SetTransparent(Value: Boolean      );
    Procedure SetInclineMode(Value: TInclineMode );
    Procedure CMTextChanged(Var Message: TMessage); message CM_TEXTCHANGED;
    Procedure CMMouseEnter (Var Message: TMessage); message CM_MOUSEENTER;
    Procedure CMMouseLeave (Var Message: TMessage); message CM_MOUSELEAVE;
    Procedure OnOrFontChanged(Sender:TObject);
    Procedure CalculXY;               // Procédure interne qui calcule DecalX et DecalY
  Protected
    Procedure SetAutosize   (Value: Boolean      );Override;
    Procedure Paint; override;
  Public
    Constructor Create(AOwner: TComponent); override;
    Destructor Destroy; override;
  Published
    Property Transparent : Boolean      read FTransparent write SetTransparent default False;
    Property InclineMode : TInclineMode read FInclineMode Write SetInclineMode;
    Property OrFont      : TOrFont      read FOrFont      write FOrFont;
    Property AutoSize;
    Property Align;
    Property Anchors;
    Property Caption;
    Property Color;
    Property Constraints;
    Property DragCursor;
    Property DragKind;
    Property DragMode;
    Property Enabled;
    Property ParentColor;
    Property ParentShowHint;
    Property PopupMenu;
    Property ShowHint;
    Property Visible;
    Property OnClick;
    Property OnContextPopup;
    Property OnDblClick;
    Property OnDragDrop;
    Property OnDragOver;
    Property OnEndDock;
    Property OnEndDrag;
    Property OnMouseDown;
    Property OnMouseMove;
    Property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
    Property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
    Property OnMouseUp;
    Property OnStartDock;
    Property OnStartDrag;
  End;

Procedure Register;

Implementation

Uses Consts,Math;

Var
  ScreenLogPixels: Integer;// Variable de finesse de l'écran pour définir Size en fonctoin de Height
  IM_ADVANCED_OK : Boolean;// Variable à vrai di le mode étendu est utiliable, en fait à vrai si
                           // l'environnement est de type WNT4

{ Resource managers }
// Ce gestionnaire de ressources est inspiré de celui de Borland pour le TFont.
// Il permet de limité le nomnre de Handles de Font demandés à windows : toutes les OrFont
// identiques utiliseront le même HFont.
// ( ce qui évite le "out of ressource error" si souvent présent avec delphi 1 )
Type
  TResourceManager = Class(TObject)
    ResList: POrResource;
    FLock: TRTLCriticalSection;
    Constructor Create;
    Destructor Destroy; override;
    Function AllocResource(Const ResData): POrResource;
    Procedure FreeResource(Resource: POrResource);
    Procedure ChangeResource(GraphicsObject: TOrFont; Const ResData);
    Procedure AssignResource(GraphicsObject: TOrFont; AResource: POrResource);
    Procedure Lock;
    Procedure Unlock;
  End;

Var
  OrFontManager: TResourceManager;

Function GetHashCode(Const Buffer; Count: Integer): Word; assembler;
Asm
        MOV     ECX,EDX
        MOV     EDX,EAX
        Xor     EAX,EAX
@@1:    ROL     AX,5
        Xor     AL,[EDX]
        INC     EDX
        DEC     ECX
        JNE     @@1
End;

Constructor TResourceManager.Create;
Begin
  InitializeCriticalSection(FLock);
  ResList := Nil;
End;

Destructor TResourceManager.Destroy;
Begin
  DeleteCriticalSection(FLock);
End;

Procedure TResourceManager.Lock;
Begin
  EnterCriticalSection(FLock);
End;

Procedure TResourceManager.Unlock;
Begin
  LeaveCriticalSection(FLock);
End;

Function TResourceManager.AllocResource(Const ResData): POrResource;
Var
  ResHash: Word;
Begin
  ResHash := GetHashCode(ResData, SizeOf(TOrFontData));
  Lock;
  Try
    Result := ResList;
    While (Result <> NilAnd ((Result^.HashCode <> ResHash) Or
      Not CompareMem(@Result^.OrFont, @ResData, SizeOf(TOrFontData))) Do
      Result := Result^.Next;
    If Result = Nil Then
    Begin
      GetMem(Result, SizeOf(TOrResource));
      With Result^ Do
      Begin
        Next := ResList;
        RefCount := 0;
        Handle := TOrFontData(ResData).Handle;
        HashCode := ResHash;
        Move(ResData, OrFont, SizeOf(OrFont));
      End;
      ResList := Result;
    End;
    Inc(Result^.RefCount);
  Finally
    Unlock;
  End;
End;

Procedure TResourceManager.FreeResource(Resource: POrResource);
Var
  P: POrResource;
  DeleteIt: Boolean;
Begin
  If Resource <> Nil Then
    With Resource^ Do
    Begin
      Lock;
      Try
        Dec(RefCount);
        DeleteIt := RefCount = 0;
        If DeleteIt Then
        Begin
          If Resource = ResList Then
            ResList := Resource^.Next
          Else
          Begin
            P := ResList;
            While P^.Next <> Resource Do P := P^.Next;
            P^.Next := Resource^.Next;
          End;
        End;
      Finally
        Unlock;
      End;
      If DeleteIt Then
      Begin  // this is outside the critsect to minimize lock time
        If Handle <> 0 Then DeleteObject(Handle);
        FreeMem(Resource);
      End;
    End;
End;

Procedure TResourceManager.ChangeResource(GraphicsObject: TOrFont; Const ResData);
Var
  P: POrResource;
Begin
  Lock;
  Try  // prevent changes to GraphicsObject.FResource pointer between steps
    P := GraphicsObject.FOrResource;
    GraphicsObject.FOrResource := AllocResource(ResData);
    If GraphicsObject.FOrResource <> P Then GraphicsObject.Changed;
    FreeResource(P);
  Finally
    Unlock;
  End;
End;

Procedure TResourceManager.AssignResource(GraphicsObject: TOrFont; AResource: POrResource);
Var
  P: POrResource;
Begin
  Lock;
  Try
    P := GraphicsObject.FOrResource;
    If P <> AResource Then
    Begin
      Inc(AResource^.RefCount);
      GraphicsObject.FOrResource := AResource;
      GraphicsObject.Changed;
      FreeResource(P);
    End;
  Finally
    Unlock;
  End;
End;

// Font 'orientable' utilisée par le TOrLabel
{ TFont }

Var
  // Valeurs par défaut d'une OrFont
  DefOrFontData: TOrFontData = (
    Handle: 0;
    Height: 0;
    Pitch: fpDefault;
    Style: [];
    Charset : DEFAULT_CHARSET;
    Name: 'Arial';
    Orient: 0);

// Procédure d'initialisation appelée au lancement de l'unité
Procedure InitScreenLogPixelsEtAutre;
Var
  DC  : HDC;
  Ver : TOSVersionInfo;
Begin
  // définition de la précision de l'écran ( utilisé pour le rapport height/size de la font
  DC := GetDC(0);
  ScreenLogPixels := GetDeviceCaps(DC, LOGPIXELSY);
  ReleaseDC(0,DC);
  DefOrFontData.Height := -MulDiv(8, ScreenLogPixels, 72);
  // recherche de l'environnement pour déterminer si la gestion de Incline est possible
  Ver.dwOSVersionInfoSize:= SizeOf(Ver);
  GetVersionEx(Ver);
  IM_ADVANCED_OK:= Ver.dwPlatformID=VER_PLATFORM_WIN32_NT;
End;

// Procédure utilisé pour extraire les paramètres d'une fonte existante
// assignée à OrFont via la propriété Handle
Function GetFontData(Font: HFont): TOrFontData;
Var
  LogFont: TLogFont;
Begin
  Result := DefOrFontData;
  If Font <> 0 Then
  Begin
    If GetObject(Font, SizeOf(LogFont), @LogFont) <> 0 Then
    With Result, LogFont Do
    Begin
      Height := lfHeight;
      Width  := lfWidth;
      If lfWeight >= FW_BOLD Then     Include(Style, fsBold);
      If lfItalic = 1        Then     Include(Style, fsItalic);
      If lfUnderline = 1     Then     Include(Style, fsUnderline);
      If lfStrikeOut = 1     Then     Include(Style, fsStrikeOut);
      Incline := lfOrientation;
      Orient  := lfEscapement;
      Charset := TFontCharset(lfCharSet);
      Name := lfFaceName;
      Case lfPitchAndFamily And $F Of
        VARIABLE_PITCH: Pitch := fpVariable;
        FIXED_PITCH: Pitch := fpFixed;
      Else
        Pitch := fpDefault;
      End;
      Handle := Font;
    End;
  End;
End;

// Création du OrFont...
Constructor TOrFont.Create;
Begin
  DefOrFontData.Handle := 0;
  FOrResource := OrFontManager.AllocResource(DefOrFontData);
  FColor := clWindowText;
  FPixelsPerInch := ScreenLogPixels;
  Name := 'Arial';
End;

//... et sa destruction
Destructor TOrFont.Destroy;
Begin
  OrFontManager.FreeResource(FOrResource);
End;

// Une autre fonte est assignée à OrFont on en rercherche les valeurs
Procedure TOrFont.Assign(Source: TPersistent);
Begin
  If Source Is TFont Then
  Begin
    Lock;
    Try
      TOrFont(Source).Lock;
      Try
        OrFontManager.AssignResource(Self, TOrFont(Source).FOrResource);
        Color := TOrFont(Source).Color;
        If PixelsPerInch <> TOrFont(Source).PixelsPerInch Then
          Size := TOrFont(Source).Size;
      Finally
        TOrFont(Source).Unlock;
      End;
    Finally
      Unlock;
    End;
    Exit;
  End;
  Inherited Assign(Source);
End;

Procedure TOrFont.GetData(Var OrFontData: TOrFontData);
Begin
  OrFontData := FOrResource^.OrFont;
  OrFontData.Handle := 0;
End;

Procedure TOrFont.SetData(Const OrFontData: TOrFontData);
Begin
  Lock;
  Try
    OrFontManager.ChangeResource(Self, OrFontData);
  Finally
    Unlock;
  End;
End;

Procedure TOrFont.SetColor(Value: TColor);
Begin
  If FColor <> Value Then
  Begin
    FColor := Value;
    Changed;
  End;
End;

// Fonction de création du Handle de resource si besoin
Function TOrFont.GetHandle: HFont;
Var
  LogFont: TLogFont;
Begin
  With FOrResource^ Do
  Begin
    If Handle = 0 Then
    Begin
      OrFontManager.Lock;
      With LogFont Do
      Try
        If Handle = 0 Then
        Begin
          lfHeight            := OrFont.Height;
          lfWidth             := OrFont.Width;
          lfEscapement        := OrFont.Orient;
          lfOrientation       := OrFont.Incline;
          If fsBold In OrFont.Style
            Then lfWeight     := FW_BOLD
            Else lfWeight     := FW_NORMAL;
          lfItalic            := Byte(fsItalic In OrFont.Style);
          lfUnderline         := Byte(fsUnderline In OrFont.Style);
          lfStrikeOut         := Byte(fsStrikeOut In OrFont.Style);
          lfCharSet           := DEFAULT_CHARSET;
          lfQuality           := DEFAULT_QUALITY;
          lfOutPrecision      := Out_DEFAULT_PRECIS;
          lfClipPrecision     := CLIP_DEFAULT_PRECIS;
          lfPitchAndFamily    := DEFAULT_PITCH;
          StrPCopy(lfFaceName, OrFont.Name);

          Handle := CreateFontIndirect(LogFont);
        End;
      Finally
        OrFontManager.Unlock;
      End;
    End;
    Result := Handle;
  End;
End;

Procedure TOrFont.SetHandle(Value: HFont);
Begin
  SetData(GetFontData(Value));
End;

Function TOrFont.GetHeight: Integer;
Begin
  Result := FOrResource^.OrFont.Height;
End;

Procedure TOrFont.SetHeight(Value: Integer);
Var
  FontData: TOrFontData;
Begin
  GetData(FontData);
  FontData.Height := Value;
  SetData(FontData);
End;

Function TOrFont.GetName: TFontName;
Begin
  Result := FOrResource^.OrFont.Name;
End;

Procedure TOrFont.SetName(Const Value: TFontName);
Var
  FontData: TOrFontData;
Begin
  If Value <> '' Then
  Begin
    GetData(FontData);
    FillChar(FontData.Name, SizeOf(FontData.Name), 0);
    FontData.Name := Value;
    SetData(FontData);
  End;
End;

Function TOrFont.GetSize: Integer;
Begin
  Result := -MulDiv(Height, 72, FPixelsPerInch);
End;

Procedure TOrFont.SetSize(Value: Integer);
Begin
  Height := -MulDiv(Value, FPixelsPerInch, 72);
End;

Function TOrFont.GetStyle: TFontStyles;
Begin
  Result := FOrResource^.OrFont.Style;
End;

Procedure TOrFont.SetStyle(Value: TFontStyles);
Var
  FontData: TOrFontData;
Begin
  GetData(FontData);
  FontData.Style := Value;
  SetData(FontData);
End;

Function TOrFont.GetPitch: TFontPitch;
Begin
  Result := FOrResource^.OrFont.Pitch;
End;

Procedure TOrFont.SetPitch(Value: TFontPitch);
Var
  FontData: TOrFontData;
Begin
  GetData(FontData);
  FontData.Pitch := Value;
  SetData(FontData);
End;

Function TOrFont.GetCharset: TFontCharset;
Begin
  Result := FOrResource^.OrFont.Charset;
End;

Procedure TOrFont.SetCharset(Value: TFontCharset);
Var
  FontData: TOrFontData;
Begin
  GetData(FontData);
  FontData.Charset := Value;
  SetData(FontData);
End;

Function TOrFont.GetOrient: Integer;
Begin
  Result := FOrResource^.OrFont.Orient;
End;

Procedure TOrFont.SetOrient(Value: Integer);
Var
  FontData: TOrFontData;
Begin
  GetData(FontData);
  FontData.Orient := Value;
  SetData(FontData);
End;

Function TOrFont.GetIncline: Integer;
Begin
  Result := FOrResource^.OrFont.Incline;
End;

Procedure TOrFont.SetIncline(Value: Integer);
Var
  FontData: TOrFontData;
Begin
  GetData(FontData);
  FontData.Incline := Value;
  SetData(FontData);
End;

Function TOrFont.GetWidth: Integer;
Begin
  Result := FOrResource^.OrFont.Width;
End;

Procedure TOrFont.SetWidth(Value: Integer);
Var
  FontData: TOrFontData;
Begin
  GetData(FontData);
  FontData.Width := Value;
  SetData(FontData);
End;

{ TOrLabel }

// Creation du OrLabel...
Constructor TOrLabel.Create(AOwner: TComponent);
Begin
  Inherited Create(AOwner);
  ControlStyle := ControlStyle + [csReplicatable];
  Width := 65;
  Height := 17;
  OrFont := TOrFont.Create;           // Création de la fonte utilisée
  OrFont.OnChange := OnOrFontChanged;
End;

// ...et sa destruction
Destructor TOrLabel.Destroy;
Begin
  OrFont.Free;                        // Libération de la fonte
  Inherited Destroy;
End;

// Calcul de la position du coin haut gauche par rapport au centre du label
Procedure TOrLabel.CalculXY;
Var
  i,j     :Integer;
  a,b,d   : Double;
  l       : Double;
  Taille  : TSize;
  OldMode : Integer;
Begin
  With Canvas Do
  Begin
    OldMode:=0;
    // Quand c'est possible et quand c'est demandé on passe le HDC en mode étendu
    If IM_ADVANCED_OK And(InclineMode=IM_ADVANCED) 
      Then OldMode:=SetGraphicsMode(Canvas.Handle,GM_ADVANCED);
    // On cherche la taille du texte avec les fonctions de Windows
    SelectObject(Canvas.Handle, FOrFont.Handle);
    GetTextExtentPoint32(Canvas.Handle,PChar(Caption),Length(Caption),Taille);
    i:=Taille.cx;
    j:=Taille.cy;
    // On remet la fonte d'origine et le mode origine avant de quitter
    SelectObject(Canvas.Handle, Canvas.Font.Handle);
    If (OldMode<>0)And(InclineMode=IM_ADVANCED) Then SetGraphicsMode(Canvas.Handle,OldMode);

    // ArcTan(j/i) donne l'angle de la diagonale du texte par rapport au bas du texte
    // Orient donne l'angle entre la bas du texte et l'horizontale
    // donc "a" représente l'angle entre la diagonale et la bas du texte
    Try
      If i<>0 Then d:=ArcTan(j/i)
              Else d:=PI/2;
    Except
      d:=PI/2;
    End;
    a:=FOrFont.Orient*2*PI/3600-d;

    // "l" est la diagonale du label, on en déduit alors la position de coin haut-gauche du texte
    l:=Sqrt(i*i+j*j);
    FDecalX:= Round(l*cos(a)) Div 2;
    FDecalY:=-Round(l*sin(a)) Div 2;

    // En cas d'ajustement automatique, on définit la nouvelle taille
    If AutoSize
    Then Begin
    // "b" représente l'angle formé par le centre du label et le coin bas-gauche du texte
      b:=FOrFont.Orient*2*PI/3600+d;
      Self.Width  :=Max(Abs(FDecalX)Shl 1,Abs(Round(l*cos(b))));
      Self.Height :=Max(Abs(FDecalY)Shl 1,Abs(Round(l*sin(b))));
    End;
  End;
End;

// Dessin du label, tout est fait par l'API
Procedure TOrLabel.Paint;
Var OldMode:Integer;
Begin
  With Canvas Do
  Begin
    // sélection du pinceau pour gérer la transparence.
    If Transparent
    Then Begin
      Brush.Style := bsClear;
    End
    Else Begin
      Brush.Color := Self.Color;
      Brush.Style := bsSolid;
    // Comme on dessine par l'API il faut spécifier explicitement l'usage du pinceau
      SelectObject(Canvas.Handle, Brush.Handle);
    End;
    // De même que la couleur d'écriture
    SetTextColor(Canvas.Handle, FOrFont.Color);
    // et la fonte utilisée
    SelectObject(Canvas.Handle, FOrFont.Handle);
    OldMode:=0;
    // Quand c'est possible et quand c'est demandé on passe le HDC en mode étendu
    If IM_ADVANCED_OK And(InclineMode=IM_ADVANCED) 
      Then OldMode:=SetGraphicsMode(Canvas.Handle,GM_ADVANCED);
    // On dessine le texte avec ExtTextOut ( DrawText ne gère pas les fonte orientées )
    ExtTextOut  (Canvas.Handle, Self.Width Div 2-FDecalX
                              , Self.Height Div 2-FDecalY
                              , 0
                              , Nil
                              , PChar(Caption),Length(Caption)
                              , Nil);
    // On remet la fonte d'origine et le mode origine avant de quitter
    SelectObject(Canvas.Handle, Canvas.Font.Handle);
    If (OldMode<>0)And(InclineMode=IM_ADVANCED) Then SetGraphicsMode(Canvas.Handle,OldMode)
  End;
End;

// Procédures de mise à jour des propriétés
Procedure TOrLabel.SetTransparent(Value: Boolean);
Begin
  If FTransparent <> Value Then
  Begin
    FTransparent:=Value;
    Invalidate;
  End;
End;

Procedure TOrLabel.SetInclineMode(Value: TInclineMode);
Begin
  If FInclineMode <> Value Then
  Begin
    FInclineMode:=Value;
    Invalidate;
  End;
End;

// Celle-ci surcharge celle du GraphicControl car il faut calculer DecalX et DecalY
Procedure TOrLabel.SetAutosize(Value: Boolean);
Begin
  Inherited SetAutoSize(Value);
  If AutoSize Then CalculXY;
End;

// Réaction aux changements de texte et de fonte
Procedure TOrLabel.CMTextChanged(Var Message: TMessage);
Begin
  CalculXY;
  Invalidate;
End;

Procedure TOrLabel.OnOrFontChanged(Sender:TObject);
Begin
  CalculXY;
  Invalidate;
End;

// Et enfin gestion des évènements nouveaux
Procedure TOrLabel.CMMouseEnter(Var Message: TMessage);
Begin
  Inherited;
  If Assigned(FOnMouseEnter) Then FOnMouseEnter(Self);
End;

Procedure TOrLabel.CMMouseLeave(Var Message: TMessage);
Begin
  Inherited;
  If Assigned(FOnMouseLeave) Then FOnMouseLeave(Self);
End;

Procedure Register;
Begin
  RegisterComponents('Exemples', [TOrLabel]);
End;

Initialization
  InitScreenLogPixelsEtAutre;
  OrFontManager := TResourceManager.Create;
Finalization
  OrFontManager.Free;
End.

Les sources présentées sur cette page sont libres de droits et vous pouvez les utiliser à votre convenance. Par contre, la page de présentation constitue une œuvre intellectuelle protégée par les droits d'auteur. Copyright © 2003 Bruno Guérangé. Aucune reproduction, même partielle, ne peut être faite de ce site et de l'ensemble de son contenu : textes, documents, images, etc. sans l'autorisation expresse de l'auteur. Sinon vous encourez selon la loi jusqu'à trois ans de prison et jusqu'à 300 000 € de dommages et intérêts.

Responsables bénévoles de la rubrique Delphi : Gilles Vasseur - Alcatîz -