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