User Tools

Site Tools


start:eti:carte:sources:uapropos

uAPropos.pas

UNIT Uapropos;
{-----------------------------------------------------------------------------
  NOM DE L'UNITE : UAPROPOS.PAS
  BUT            : Boîte de dialoge "A propos de...", version du programme
  AUTEUR         : Stéphane Claus
  DATE           : Décembre 1996
 
  MODIFIE LE     : 12.04.1997  -  EDT:01
  RAISON         : Ajout de commentaires
 
  REMARQUES      : - Cette boîte de dialogue est un adaptation de la boîte de
                     dialogue proposée dans Delphi for Dummies.
                   - Un double clic sur le logo affiche la liste des contextes
                     d'aide de ce programme.
 -----------------------------------------------------------------------------}
 
 
{=============================================================================}
INTERFACE   {============================================== I N T E R F A C E }
{=============================================================================}
 
 
 
USES
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, Buttons, ExtCtrls, DigDisp;
 
 
TYPE
  TfrmAbout = CLASS(TForm)
    digdspTitre: TDigitalDisplay;
    bitbtnOK: TBitBtn;
    timerTitre: TTimer;
    lblDOSVersion: TLabel;
    lblWindowsVersion: TLabel;
    lblWindowsMode: TLabel;
    lblCoproMath: TLabel;
    lblFreeMemory: TLabel;
    lblFreeSysRessources: TLabel;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Bevel1: TBevel;
    lblProgram: TLabel;
    lblVersion: TLabel;
    lblCopyright: TLabel;
    pnlLogoAppli: TPanel;
    imgLogoAppli: TImage;
    lblVersionVCL8255: TLabel;
    lblVersionVCL8254: TLabel;
    btnD: TButton; { Message caché }
    btnE: TButton; { 2ème lettre }
    btnL: TButton; { 3ème lettre }
    btnP: TButton; { 4ème lettre }
    btnH: TButton; { 5ème lettre }
    btnI: TButton; { T'as bien lu ? }
    PROCEDURE timerTitreTimer(Sender: TObject);
    PROCEDURE FormActivate(Sender: TObject);
    PROCEDURE FormClose(Sender: TObject; VAR Action: TCloseAction);
    PROCEDURE pnlLogoAppliDblClick(Sender: TObject);
    PROCEDURE btnDClick(Sender: TObject);
    PROCEDURE btnEClick(Sender: TObject);
    PROCEDURE btnLClick(Sender: TObject);
    PROCEDURE btnPClick(Sender: TObject);
    PROCEDURE btnHClick(Sender: TObject);
    PROCEDURE btnIClick(Sender: TObject);
  PRIVATE
    { Private-déclarations }
  PUBLIC
    { Public-déclarations }
  END;{CLASS}
 
 
VAR
  frmAbout: TfrmAbout;
 
 
 
{=============================================================================}
IMPLEMENTATION   {================================= I M P L E M E N A T I O N }
{=============================================================================}
 
 
 
{$R *.DFM}
 
 
USES
  UPrincpl,
  USayNo;
 
 
VAR
  EasternEgg : BYTE;                        { A 5 on affiche l'écran caché... }
 
 
PROCEDURE TfrmAbout.timerTitreTimer(Sender: TObject);
{-----------------------------------------------------------------------------
  BUT ........... : Fait bouger le titre...
  ENTREE ........ : --
  SORTIE ........ : --
  EFFETS DE BORDS : Il y a le titre qui bouge, un peu comme les panneaux
                    lumineux...
  REMARQUE(S) ... : Il ne doit pas y avoir de code de couleur dans le titre,
                    car sinon ça donne un effet dégueulasse !
 -----------------------------------------------------------------------------}
VAR
  Titre1,                                                   { Le titre actuel }
  Titre2 : STRING;                                         { Le nouveau titre }
  Lng : INTEGER;                                          { Longueur du titre }
BEGIN
  Titre1 := digdspTitre.Text;               { Recupère l'etat du titre actuel }
  Lng := Length(Titre1);                                          { Le mesure }
  Titre2 := Copy(Titre1, 2, Lng-1);                    { Bouge d'un caractère }
  Titre2 := Titre2 + Titre1[1];
  digdspTitre.Text := Titre2;                      { Affiche le nouveau titre }
END; {PROCEDURE timerTitreTimer}
 
 
PROCEDURE TfrmAbout.FormActivate(Sender: TObject);
{-----------------------------------------------------------------------------
  BUT ........... : Affichage des caractèristiques du système lors de
                    l'affichage de la fiche
  ENTREE ........ : --
  SORTIE ........ : --
  EFFETS DE BORDS : --
  REMARQUE(S) ... : Certaines fonctions telles que GetFreeSystemResources(),
                    GetVersion() ou GetWinFlags() ne fonctionne pas avec
                    Delphi 2 car elles ont été retirées de l'API Win32...
                    Merci Bill !
 -----------------------------------------------------------------------------}
VAR
  L : LONGINT;                                                 { No Comment ! }
BEGIN
  Caption := Application.Title;                         { Titre de la fenêtre }
  timerTitre.Enabled := TRUE; { Met en route le truc qui fait bouger le titre }
  imgLogoAppli.Picture.Graphic := Application.Icon;               { Programme }
  frmAbout.Icon := Application.Icon;
  lblProgram.Caption := Application.Title;
  {-- Version des VCLs}
  lblVersionVCL8255.Caption := 'VCL8255: Version '+frmMain.PPI8255.Version;
  lblVersionVCL8254.Caption := 'VCL8254: Version '+frmMain.PIT8254.Version;
  {-- Version de l'OS }
  L := GetVersion;
  lblDOSVersion.Caption := Format('DOS %u.%.2u',
    [HiByte(HiWord(L)), LoByte(HiWord(L))]);
  lblWindowsVersion.Caption := Format('Windows %u.%.2u',
    [LoByte(LoWord(L)), HiByte(LoWord(L))]);
  {-- Mode de fonctionnement de Windows }
  L := GetWinFlags;
  IF L AND WF_ENHANCED = 0 THEN BEGIN
    lblWindowsMode.Caption := 'Standard Mode';
  END {IF}
  ELSE BEGIN
    lblWindowsMode.Caption := '386 Enhanced Mode';
  END; {ELSE}
  {-- Coprocesseur }
  IF L AND WF_80x87 = 0 THEN BEGIN
    lblCoproMath.Caption := 'Absent';
  END {IF}
  ELSE BEGIN
    lblCoproMath.Caption := 'Présent';
  END; {ELSE}
  {-- Mémoire libre }
  lblFreeMemory.Caption := FormatFloat ('######', MemAvail DIV 1024);
  lblFreeMemory.Caption := lblFreeMemory.Caption + 'KB Libre';
  {-- Ressources système libres }
  L := GetFreeSystemResources(GFSR_SYSTEMRESOURCES);
  lblFreeSysRessources.Caption := IntToStr(L) + ' %Libre';
  {-- Autres infos }
  lblVersion.Caption := version;
  lblCopyright.Caption := copyright;
  {-- On commence la séquence de l'écran caché }
  EasternEgg := 0;
END; {PROCEDURE FormActivate}
 
 
PROCEDURE TfrmAbout.FormClose(Sender: TObject; var Action: TCloseAction);
{-----------------------------------------------------------------------------
  BUT ........... : Lors de la fermeture de la fiche, arrête le faire bouger le
                    titre, ça économise les ressources !
  ENTREE ........ : --
  SORTIE ........ : --
  EFFETS DE BORDS : --
  REMARQUE(S) ... : Le type TCloseEvent de OnClose a un paramètre Action. La
                    valeur du paramètre Action détermine si la fiche peut
                    effectivement être fermée. Les valeurs possibles de Action
                    sont :
                    Valeur	Signification
                    -----------------------------------------------------------
                    caNone	La fiche n'a pas le droit de se fermer, donc il
                                ne se passe rien.
                    caHide	La fiche n'est pas fermée, juste cachée.
                                L'application peut toujours accéder à une fiche
                                cachée.
                    caFree	La fiche est fermée et la mémoire allouée à la
                                fiche libérée.
                    caMinimize	La fiche n'est pas fermée, juste réduite en
                                icône. C'est l'action par défaut des fiches
                                enfant MDI.
 -----------------------------------------------------------------------------}
BEGIN
  timerTitre.Enabled := FALSE;
END; {PROCEDURE FormClose}
 
 
PROCEDURE TfrmAbout.pnlLogoAppliDblClick(Sender: TObject);
{-----------------------------------------------------------------------------
  BUT ........... : Accède à une page normalement innaccessible dans le fichier
                    d'aide. Cette page a tous les Context Number du fichier
                    d'aide lui même.
  ENTREE ........ : --
  SORTIE ........ : --
  EFFETS DE BORDS : --
  REMARQUE(S) ... : --
 -----------------------------------------------------------------------------}
BEGIN
  Application.HelpContext(999);
END; {PROCEDURE pnlLogoAppliDblClick}
 
 
{ Les 6 procédures qui suivent sont utilisées pour l'écran caché..
                           ..AUCUN COMMENTAIRE..
                                                            .. Ben pourquoi ? }
PROCEDURE TfrmAbout.btnDClick(Sender: TObject);
BEGIN
  IF EasternEgg = 0 THEN Inc(EasternEgg) ELSE EasternEgg := 0;
END; {PROCEDURE btnDClick}
 
PROCEDURE TfrmAbout.btnEClick(Sender: TObject);
BEGIN
  IF EasternEgg = 1 THEN Inc(EasternEgg) ELSE EasternEgg := 0;
END; {PROCEDURE btnEClick}
 
PROCEDURE TfrmAbout.btnLClick(Sender: TObject);
BEGIN
  IF EasternEgg = 2 THEN Inc(EasternEgg) ELSE EasternEgg := 0;
END; {PROCEDURE btnLClick}
 
PROCEDURE TfrmAbout.btnPClick(Sender: TObject);
BEGIN
  IF EasternEgg = 3 THEN Inc(EasternEgg) ELSE EasternEgg := 0;
END; {PROCEDURE btnPClick}
 
PROCEDURE TfrmAbout.btnHClick(Sender: TObject);
BEGIN
  IF EasternEgg = 4 THEN Inc(EasternEgg) ELSE EasternEgg := 0;
END; {PROCEDURE btnHClick}
 
PROCEDURE TfrmAbout.btnIClick(Sender: TObject);
BEGIN
  IF EasternEgg = 5 THEN BEGIN
    timerTitre.Enabled := FALSE;
    frmSayNo.ShowModal;
    timerTitre.Enabled := TRUE;
    EasternEgg := 0;
  END {IF}
  ELSE EasternEgg := 0;
END; {PROCEDURE btnIClick}
 
{ Les 6 procédures qui précédent sont utilisées pour l'écran caché..
      ..AUCUN COMMENTAIRE..
                  .. Si, il y en a quand même un:..
                                        .. J'aime pas le C ..
                                                            .. Ben pourquoi ? }
 
 
 
{=============================================================================}
{ INITIALISATIONS ------------------------------------------- Initialisations }
{=============================================================================}
 
 
 
INITIALIZATION
  EasternEgg := 0;
END. {UNIT Uapropos}

Dans les USES, il est question de uSayNo.pas

This website uses cookies. By using the website, you agree with storing cookies on your computer. Also you acknowledge that you have read and understand our Privacy Policy. If you do not agree leave the website.More information about cookies
start/eti/carte/sources/uapropos.txt · Last modified: 2016/07/24 02:59 by admin