Composant TDateHeure Version 2007 ® Guy Bidi
Utilisable jusqu'à la version 2007, issu d'un
Bouton TSpeedButton son fonctionnement consiste
en un bouton type va-et-vient. Celui-ci affiche
alternativement au click gauche de la souris :
- la date selon un format au choix:
type: 08/01/07 ou type: Lundi 8 Janvier 2007 et
- l''heure du système type 15:12:40.
Au click gauche de la souris avec ALT ou CTRL la
couleur de la police de caractère s''incrémente
d''une unité.
Au click droit de la souris le format de la date'+#13+
bascule entre les types Normal et Littéral.
Auteur : Guy Bidi - Email : paounet@free.fr';
Source / Exemple :
{ Composant fait par Guy Bidi - Juin 2007 - Freeware
Pour les questions et autres écrire à paounet@free.fr
TDateHeure est un bouton va-et-vient entre la Date selon un
format 12/01/07 ou Vendredi 12 Janvier 2007 et l'heure du
système 13:17:45 }
unit DateHeure;
interface
uses SysUtils,Classes,Controls,StdCtrls,ExtCtrls,Buttons,Graphics,
DateUtils,Dialogs;
Const Mess=
'Le composant TDateHeure Version 2007 est la'+#13+
'propriété de ® Guy Bidi . Utilisable jusqu''à la'+#13+
'version 2007, issu d''un Bouton TSpeedButton son'+#13+
'fonctionnement consiste en un bouton type'+#13+
'va-et-vient. Celui-ci affiche alternativement'+#13+
'au click gauche de la souris :'+#13+#13+
'- la date selon un format au choix:'+#13+
' type: 08/01/07 ou type: Lundi 8 Janvier 2007 et'+#13+
'- l''heure du système type 15:12:40.'+#13+#13+
'Au click gauche de la souris avec ALT ou CTRL la'+#13+
'couleur de la police de caractère s''incrémente'+#13+
'd''une unité.'+#13+#13+
'Au click droit de la souris le format de la date'+#13+
'bascule entre les types Normal et Littéral.'+#13+#13+
'Auteur : Guy Bidi - Email : paounet@free.fr';
type
TDateForme=(Normal,Litteral); // Propriété DateForme rajoutée
TDateAbout=String; // Propriété About rajoutée
TDateHeure = class(TSpeedButton) // Définition du Button DateHeure
private { Déclarations privées }
// Intégration d'un timer et d'un bouton TSpeedButton
Timer:TTimer;FDateForme:TDateForme;FDateAbout:TDateAbout;
// Déclaration de la procédure du choix de DateFormat
Procedure SetDateForme(DateForme:TDateForme);
protected { Déclarations protégées }
Procedure Affiche(Sender:TObject); // Lorsque Click sur Button
Procedure Temps(Sender:TObject); // Lorsque le Timer entre en fonction
// Lorsque la souris Clique sur le Button droit ou gauche
Procedure Change(Sender:TObject;Button:TMouseButton;Shift:TShiftState;X,Y:Integer);
public { Déclarations publiques }
Constructor Create (Aowner:Tcomponent);Override;
destructor Destroy;override;
published { Déclarations publiées }
property Name;
Property Visible;
Property Width;
Property Height;
Property Color;
Property Caption;
Property Transparent;
Property Hint;
Property Font;
Property OnMouseUp;
// Propriété ABout rajoutée en lecture seule
Property About:TDateAbout read FDateAbout;
// Propriété DateForme rajoutée en Lecture et Écriture
Property DateForme:TDateForme read FDateForme write SetDateForme;
end;
procedure Register;
implementation
Var Flag:Boolean;
Function Jour(Dat:TDateTime):string; // Extrait la Date littérale
begin
Result:=LongDayNames[DayOfWeek(Dat)]+' '+
Copy(DateToStr(Now),1,2)+' '+LongMonthNames[DayOfWeek(Dat)]+
' '+Copy(DateToStr(Now),Length(DateToStr(Now))-3,4);
End;
// Construction du Bouton TDateHeure, du Timer et des évenements
constructor TDateHeure.Create(Aowner:TComponent);
begin
inherited Create(Aowner);
Height:=22;Width:=85;With Font Do Begin Color:=clMaroon;
Name:='Comic Sans MS';Size:=9;Style:=[fsBold];End;
Timer:=TTimer.Create(Self);With Timer Do Begin Enabled:=False;
Interval:=1000;OnTimer:=Temps;End;Flag:=False;
Caption:=DateTostr(Date);DateForme:=Normal;ShowHint:=True;
Hint:='Click et Click+Ctrl';FDateAbout:=Mess;
OnClick:=Affiche;OnMouseUp:=Change;
end;
// Procedure liée à la propriété DateForme {Normal ou Litteral}
procedure TDateHeure.SetDateForme(DateForme:TDateForme);
begin
If DateForme=Normal Then Begin Width:=85;Caption:=DateTostr(Date);End
Else Begin Width:=146;Caption:=Jour(Now);End;
FDateForme:=DateForme;
end;
destructor TDateHeure.Destroy; // Destruction des Composants
begin
Timer.Free;inherited Destroy;
end;
// Fonction qui renvoie la couleur incrémentée de 1
// de la police de caractères du bouton
Function Trouve(Couleur:Tcolor):TColor;
Const Coul:Array[0..16] Of TColor=(ClBlack,ClMaroon,ClGreen,ClOlive,
ClNavy,ClPurple,ClTeal,ClGray,ClSilver,ClRed,ClLIme,ClYellow,
ClBlue,ClFuchsia,clAqua,ClWhite,clWindowText);
Var i,j:Integer;
Begin
j:=0;for i:=0 to 16 Do if Couleur=Coul[i] then j:=i+1;
If j=17 Then j:=0;Trouve:=Coul[j];
End;
// Changement de l'aspect du contenu du bouton selon la propriété
// DateForme choisie - Click Droit et gauche avec Ctrl ou Alt
Procedure TDateHeure.Change(Sender:TObject;Button:TMouseButton;Shift:TShiftState;X,Y:Integer);
Begin
if Button=mbRight then Begin If DateForme=Normal Then
DateForme:=Litteral Else DateForme:=Normal;
SetDateForme(DateForme);End
Else if (Button=mbLeft) And ((Shift=[ssCtrl]) Or
(SHift=[ssAlt])) Then Font.Color:=Trouve(Font.Color);
End;
// Click gauche sur le Button
Procedure TDateHeure.Affiche(Sender:TObject);
Begin
if Flag then Begin If DateForme=Normal Then Begin Width:=85;
Caption:=DateTostr(Date);End Else Begin Width:=146;
Caption:=Jour(Now);End;Timer.Enabled:=False;End
Else Begin Timer.Enabled:=True;Width:=85;
Caption:=TimeTostr(Now);End;Flag:=Not(Flag);
End;
Procedure TDateHeure.Temps(Sender:TObject); // Timer affcihe l'heure
begin
Caption:=TimeTostr(Now);
end;
procedure Register; // Enregistrement du composant TDateHeure
begin
RegisterComponents('Guy',[TDateHeure]);
end;
end.
Conclusion :
Valide sur delphi 2007 for win32.... Adaptation facile pour d'autres
composants...
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.