1. Accueil
  2. Delphi / Pascal
  3. Sources Delphi / Pascal
  4. Sources Graphique
  5. Composant label3d toute version de delphi.

Composant label3d toute version de delphi.

Soyez le premier à donner votre avis sur cette source.

Vue 5 500 fois - Téléchargée 930 fois

Télécharger le projet
Commenter

Description

Un Label graphique qui allie au choix un type Relief (type 3D), Défilant(Déroulant) ou Clignotant avec ou sans transparence. En mode conception les paramètres saisis sont visibles de suite sur le formulaire..
Utiliser le programme Essai.exe pour visualiser LABEL3D.

Source / Exemple : 


unit Label_3D;    // Composant Label3D - (C) Guy Bidi Février 2007 réactualisé
interface
uses Windows,SysUtils,Classes,Controls,StdCtrls,Types,Graphics,ExtCtrls,Forms,Dialogs;
Const Mess =#13+'  1 - About : CopyRight ou Aide Actuelle'+#13+#13+
      '  2 - LabelType : Choix entre un Texte en Relief'+#13+
      '                           ou Clignotant ou Défilant.'#13+#13+
      '  3 - Ecart3D : Valeur de relief pour simuler le 3D'+#13+#13+
      '  4 - Color1/Color2 : Couleur de 1er et 2'#232'me plan pour '+#13+
      '                               le Relief et le Clignotement'+#13+#13+
      '  5 - ColorFond : Couleur du fond rectangulaire du Label'+#13+#13+
      '  7 - ColorMouse: Couleur au passage de la souris'+#13+#13+
      '  8 - Interval  : Temps du Timer pour le clignotement'+#13+#13+
      '  9 - Transparent : Si oui active la couleur du Fond'+#13+#13+
      ' 10 - Caption : Texte du Label3D'+#13+#13+
      ' Décompilation/Modification interdite sans l''accord'+#13+
      '  de l''auteur  ® Guy Bidi - 2007 : Paounet@free.fr'+#13+#13;
      Bulle='Double-Cliquer pour sortir';
 type
  TStyleRelief = (Relief,Clignotant,Defilement);
  TAbout= (Copyright_Guy_Bidi,Aide);
  Label3D = class(TGraphicControl)
  private     { Déclarations privées }
    Rectangl:TRect;FColor1,FColor2,FColorFond,FColorMouse:TColor;
    FTemps,FEcart:Integer;Timer:TTimer;FStyleRelief:TStyleRelief;
    FCaption:String;FTransparent:Boolean;
    FAbout:TAbout;FormAide:TForm;Memo:TMemo;Image:TImage;
    Procedure SetColor1(const Value:TColor);
    Procedure SetColor2(const Value:TColor);
    procedure SetTemps(const Value:Integer);
    procedure SetEcart(const Value:Integer);
    procedure SetStyleRelief(const Value:TStyleRelief);
    procedure SetTransparent(const Value:Boolean);
    procedure SetColorFond(const Value:TColor);
    procedure SetColorMouse(const Value:TColor);
    procedure SetCaption(const Value:String);
    procedure SetAbout(const Value:TAbout);
    Procedure SetTimer(Valeur:Integer;Flag:Boolean);
   protected   { Déclarations protégées }
    Procedure LabelMove(Sender:TObject;Shift:TShiftState;X,Y:Integer);
    Procedure LabelLeave(Sender:TObject);
    Procedure Paint;Override;
    procedure MemoDblClick(Sender:TObject);
    Procedure OnTimer(Sender:TObject);Virtual;
  public      { Déclarations publiques }
    Destructor Destroy;override;
    Constructor Create (Aowner:Tcomponent);Override;
  published   { Déclarations publiées }
    property About:TAbout Read FAbout Write SetAbout Default Copyright_Guy_Bidi;
    Property Ecart3D:Integer Read FEcart Write SetEcart;
    Property LabelType:TStyleRelief Read FStyleRelief Write SetStyleRelief Default Relief;
    Property Color1:TColor Read FColor1 Write SetColor1;
    Property Color2:TColor Read FColor2 Write SetColor2;
    Property ColorFond:TColor Read FColorFond Write SetColorFond;
    Property ColorMouse:TColor Read FColorMouse Write SetColorMouse Default clHighlight;
    property Interval:Integer Read FTemps write SetTemps;
    Property Transparent:Boolean Read FTransparent Write SetTransparent;
    Property Caption:String Read FCaption write SetCaption;
    Property Visible;
    Property Font;
    Property OnClick;
    Property OnDblClick;
  end;
  Var Index:Integer;Temp:String;
procedure Register;
implementation
{$R MyResources.res}
procedure Register;
begin
  RegisterComponents('Guy Bidi', [Label3D]);
end;
destructor Label3D.Destroy;
begin
  inherited Destroy;
end;
constructor Label3D.Create(Aowner:TComponent);
begin
  inherited Create(Aowner);
  Color1:=ClBlack;Color2:=ClRed;Transparent:=True;ColorFond:=clWhite;
  Ecart3D:=1;LabelType:=Relief;Timer:=TTimer.Create(Self);Interval:=500;
  Timer.Interval:=FTemps;Timer.OnTimer:=OnTimer;Timer.Enabled:=False;
  Caption:='© Guy Bidi 2007';FormAide:=TForm.CreateNew(Application);
  OnMouseMove:=LabelMove;OnMouseLeave:=LabelLeave;FColorMouse:=clHighlight;
  ColorMouse:=FColorMouse;Index:=0;Temp:=Caption;
  With FormAide Do Begin Left:=0;Top:=0;BorderIcons:=[biSystemMenu];
  BorderStyle:=bsSingle;Height:=506;Width:=367;
  Caption:='Les Propriétés du Composant Label3D';Position:=poScreenCenter;
  Icon.LoadFromResourceName(Hinstance,'AIDE');Color:=clMoneyGreen;
  Hint:=Bulle;ShowHint:= True;OnDblClick:=MemoDblClick;End;
  Memo:=TMemo.Create(Owner);With Memo Do Begin Parent:=FormAide;Left:=0;Top:=58;
  Hint:=Bulle;Color:=clMoneyGreen;Enabled:=True;
  Font.Charset:=DEFAULT_CHARSET;Font.Color:=clBlack;Font.Height:=-13;
  Font.Name:='Segoe UI';Font.Style:=[fsBold];ParentShowHint:= False;
  ReadOnly:= True;ShowHint:= True;Lines.Text:=Mess;Height:=393;Width:=361;
  BorderStyle:=bsNone;WantReturns:=True;OnDblClick:=MemoDblClick;Align:=alCustom;End;
  Image:=TImage.Create(Owner);With Image Do Begin
  Parent:=FormAide;Left:=95;Top:=10;Height:=47;Width:=159;
  Picture.Bitmap.LoadFromResourceName(Hinstance,'IMAGE0');AutoSize:=True;
  OnDblClick:=MemoDblClick;End;
end;
Procedure Label3D.LabelMove(Sender:TObject;Shift:TShiftState;X,Y:Integer);
Begin                 // Passe la Couleur en HighLight
  if FStyleRelief=Relief then Begin
    Canvas.Brush.Style:=bsClear;Canvas.Font.Color:=FColorMouse;
    Rectangl:=Rect(0,0,Width,Height);
    DrawText(Canvas.Handle,PWideChar(Caption),-1,Rectangl,0);End;
End;
Procedure Label3D.LabelLeave(Sender:TObject);
Begin                 // Recupere la Couleur d'Origine
  Invalidate;
End;
Procedure Label3D.SetTimer(Valeur:Integer;Flag:Boolean);
Begin
  With Timer Do Begin Interval:=Valeur;Enabled:=Flag;End;
End;
procedure Label3D.MemoDblClick(Sender:TObject);
Begin
  SetTimer(500,False);FormAide.ModalResult:=mrOk;
End;
procedure Label3D.SetColorMouse(const Value:TColor);
Begin
  If Value<>FColorMouse then Begin FColorMouse:=Value;ColorMouse:=FColorMouse;
    Invalidate;End;
End;
procedure Label3D.SetAbout(const Value:TAbout);
Begin
  If Value<>FAbout then FAbout:=Value;If Value=Aide Then Begin
    SetTimer(220,True);FormAide.ShowModal;FAbout:=Copyright_Guy_Bidi;End;
   Invalidate;
End;
Procedure Label3D.Paint;
begin
  inherited Paint;
  Canvas.Font.Size:=Font.Size;Canvas.Font.Style:=Font.Style;
  Canvas.Font.Name:=Font.Name;Width:=Canvas.TextWidth(Temp)+Ecart3D;
  Height:=Canvas.TextHeight(Temp)+Ecart3D;
  If LabelType=Relief then Timer.Enabled:=False;
    begin
      If not Transparent then begin
          Canvas.Brush.Style:=bsSolid;Canvas.Brush.Color:=ColorFond;
          Canvas.FillRect(Rect(0,0,Width,Height));end
        else begin        // Texte 2eme plan
          Canvas.Brush.Style:=bsClear;Canvas.Font.Color:=Color2;
          Rectangl:=Rect(Ecart3D,Ecart3D,Width+Ecart3D,Height+Ecart3D);
          DrawText(Canvas.Handle,PWideChar(Temp),-1,Rectangl,0);end;
    End;
                  //Texte premier plan
  Canvas.Brush.Style:=bsClear;Canvas.Font.Color:=Color1;
  Rectangl:=Rect(0,0,Width,Height);
  DrawText(Canvas.Handle,PWideChar(Temp),-1,Rectangl,0);
end;
procedure Label3D.OnTimer(Sender:TObject);
var I:Integer;STextDefil,TextDefil:String;
begin
  If FStyleRelief=Defilement then begin                 // Defilement du Texte
    TextDefil:=Temp; For i:=2 to Length(TextDefil) do
      STextDefil:=STextDefil+TextDefil[i];STextDefil:=STextDefil+TextDefil[1];
      Temp:=STextDefil;Invalidate;end Else
  If Not(FormAide.Visible) then With Canvas Do Begin    // Clignotement
    If Font.Color=Color1 then Font.Color:=Color2 Else Font.Color:=Color1;
      Brush.Style:=bsClear;  Rectangl:=Rect(0,0,Width,Height);
      DrawText(Canvas.Handle,PWideChar(Temp),-1,Rectangl,0);End
  Else Begin Inc(Index);If Index>3 Then Index:=0;     // Memo du Texte
    Image.Picture.Bitmap.LoadFromResourceName(Hinstance,'IMAGE'+IntToStr(Index));
    End;
end;
procedure Label3D.SetCaption(const Value:String);
begin
  If Value<>FCaption then Begin FCaption:=Value;Caption:=Value;Temp:=Caption;
  end;Invalidate;
end;
procedure Label3D.SetColor1(const Value:TColor);
begin
  If Value<>FColor1 then begin FColor1:=Value;Color1:=Value;Invalidate;end;
end;
procedure Label3D.SetColor2(const Value:TColor);
begin
  If Value<>FColor2 then begin FColor2:=Value;Color2:=Value;Invalidate;end;
end;
 procedure Label3D.SetTemps(const Value:Integer);
begin
  If Value<>FTemps then begin FTemps:=Value;Timer.Interval:=Value;Invalidate;end;
end;
procedure Label3D.SetEcart(const Value:Integer);
begin
  If Value<>FEcart then begin FEcart:= Value;Invalidate;end;
end;
procedure Label3D.SetStyleRelief(const Value:TStyleRelief);
begin
  Temp:=Caption;
  If Value<>FStyleRelief then begin FStyleRelief:=Value;
    If (Value=Clignotant) or (Value=Defilement) Then Begin Caption:=Temp;
      Timer.Enabled:=True;Invalidate;End;End;
end;
procedure Label3D.SetTransparent(const Value:Boolean);
begin
  If Value<>FTransparent then begin FTransparent := Value;Invalidate;end;
end;
procedure Label3D.SetColorFond(const Value:TColor);
begin
  If Value<>FColorFond then begin FColorFond := Value;Invalidate;end;
end;
end.

Conclusion :


Parfaitement modifiable à loisir on peut bien sûr y adjoindre d'autres propriétés.
Télécharger le projet

Codes Sources

A voir également

Ajouter un commentaire Commentaires
Bacterius Messages postés 3792 Date d'inscription samedi 22 décembre 2007 Statut Membre Dernière intervention 3 juin 2016 10
4 sept. 2009 à 09:08
@Cirec : "Aquatic Ecology and Water Quality Management Group" ... wtf ?

(petite touche d'humour à prendre au quatrième degré)

Cordialement, Bacterius !
Cirec Messages postés 3833 Date d'inscription vendredi 23 juillet 2004 Statut Modérateur Dernière intervention 18 septembre 2022 50
2 sept. 2009 à 16:02
Salut,

toujours et encore les mêmes remarques que sur tes sources précédentes ...
11 fichiers sont inutiles dans le zip

Mais par dessus tout c'est l'indentation du code qui fait défaut
ça rend le code quasi illisible !!!!

Franchement, c'est pas plus facile à lire comme ça ?

constructor Label3D.Create(Aowner: TComponent);
begin
inherited Create(Aowner);
Color1 := ClBlack;
Color2 := ClRed;
Transparent := True;
ColorFond := clWhite;
Ecart3D := 1;
LabelType := Relief;
Timer := TTimer.Create(Self);
Interval := 500;
Timer.Interval := FTemps;
Timer.OnTimer := OnTimer;
Timer.Enabled := False;
Caption := '© Guy Bidi 2007';
FormAide := TForm.CreateNew(Application);
OnMouseMove := LabelMove;
OnMouseLeave := LabelLeave;
FColorMouse := clHighlight;
ColorMouse := FColorMouse; Index := 0;
Temp := Caption;
with FormAide do
begin
Left := 0;
Top := 0;
BorderIcons := [biSystemMenu];
BorderStyle := bsSingle;
Height := 506;
Width := 367;
Caption := 'Les Propriétés du Composant Label3D';
Position := poScreenCenter;
Icon.LoadFromResourceName(Hinstance, 'AIDE');
Color := clMoneyGreen;
Hint := Bulle;
ShowHint := True;
OnDblClick := MemoDblClick;
end;
Memo := TMemo.Create(Owner);
with Memo do
begin
Parent := FormAide;
Left := 0;
Top := 58;
Hint := Bulle;
Color := clMoneyGreen;
Enabled := True;
Font.Charset := DEFAULT_CHARSET;
Font.Color := clBlack;
Font.Height := -13;
Font.Name := 'Segoe UI';
Font.Style := [fsBold];
ParentShowHint := False;
ReadOnly := True;
ShowHint := True;
Lines.Text := Mess;
Height := 393;
Width := 361;
BorderStyle := bsNone;
WantReturns := True;
OnDblClick := MemoDblClick;
Align := alCustom;
end;
Image := TImage.Create(Owner);
with Image do
begin
Parent := FormAide;
Left := 95;
Top := 10;
Height := 47;
Width := 159;
Picture.Bitmap.LoadFromResourceName(Hinstance, 'IMAGE0');
AutoSize := True;
OnDblClick := MemoDblClick;
end;
end;

et non j'ai pas fait ça à la main
il existe un outil :
http://www.aew.wur.nl/UK/Delforexp/
il est juste configuré sur le "Standard Borland" et c'est tout !!!
Utilisateur anonyme
2 sept. 2009 à 12:52
Salut,

Je n'ai pas testé, n'ayant pas delphi sous les yeux. Ceci dit trois remarques :

*l'indentation est à revoir
*Il faut renommer les composants
*Penser à écrire des commentaires
S'inscrire maintenant

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.

Du même auteur (cs_Paounet)