COMPOSANT BOUTON TYPE VA-ET-VIENT POUR DATE ET HEURE AVEC FORMAT ET COULEUR

{ 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.