UNIT Uchrono; {----------------------------------------------------------------------------- NOM DE L'UNITE : UCHRONO.PAS BUT : Chenillard inversé pour effectuer un relevé sur le décodage d'adresse et une écriture en sortie sur un des ports du PPI 8255. AUTEUR : Stéphane Claus DATE : Janvier 1997 MODIFIE LE : 12.04.1997 - EDT:01 RAISON : - Ajout d'un message d'avertissement lors de l'ouverture de la fiche pour avertir l'utilisateur que cette fonction n'est pas précise et qu'il vaut mieux utiliser un programme sous DOS. - Ajout de commentaires REMARQUES : -----------------------------------------------------------------------------} {=============================================================================} INTERFACE {============================================== I N T E R F A C E } {=============================================================================} USES SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, DigDisp, StdCtrls, Buttons, ExtCtrls; TYPE TfrmChronoPPI = CLASS(TForm) digdspTitre: TDigitalDisplay; bitbtnOK: TBitBtn; bitbtnAide: TBitBtn; grpbxGenerateur: TGroupBox; bitbtnStart: TBitBtn; bitbtnStop: TBitBtn; rgrpPort: TRadioGroup; scrbarDelay: TScrollBar; lblPause: TLabel; PROCEDURE FormActivate(Sender: TObject); PROCEDURE bitbtnStartClick(Sender: TObject); PROCEDURE bitbtnStopClick(Sender: TObject); PROCEDURE FormClose(Sender: TObject; var Action: TCloseAction); procedure bitbtnOKClick(Sender: TObject); procedure scrbarDelayChange(Sender: TObject); PRIVATE { Private-déclarations } PUBLIC { Public-déclarations } END; {CLASS} VAR frmChronoPPI: TfrmChronoPPI; {=============================================================================} IMPLEMENTATION {================================= I M P L E M E N A T I O N } {=============================================================================} {$R *.DFM} USES UPrincpl, VCL8255; VAR StopTest : BOOLEAN; Delai : INTEGER; FUNCTION Delay(DelayMS:LONGINT):BOOLEAN; {----------------------------------------------------------------------------- BUT ........... : Remplace la fonction DELAY qui existrait sous DOS ENTREE ........ : DelayMS = Délai d'attente en MS bit = le no du bit à changer (entre 0 et 7) SORTIE ........ : TRUE s'il a été demandé à l'application de quitter EFFETS DE BORDS : -- REMARQUE(S) ... : -- -----------------------------------------------------------------------------} VAR ET : LONGINT; BEGIN ET := GetTickCount; REPEAT Application.ProcessMessages; UNTIL Application.Terminated OR (GetTickCount-ET > DelayMS); Result := Application.Terminated; END;{FUNCTION Delay} PROCEDURE TfrmChronoPPI.FormActivate(Sender: TObject); {----------------------------------------------------------------------------- BUT ........... : Initialisation de la fiche en fonction des paramètres actuels du programme ENTREE ........ : -- SORTIE ........ : -- EFFETS DE BORDS : -- REMARQUE(S) ... : -- -----------------------------------------------------------------------------} VAR Msg : STRING; BEGIN Caption := Application.Title; { Titre de la fenêtre } IF debugmode THEN BEGIN { Couleur de la fenêtre } Color := debugcolor; END {IF} ELSE BEGIN Color := clBtnFace; END; {ELSE} rgrpPort.ShowHint := affichehint; { Affichage des Hint } bitbtnStart.ShowHint := affichehint; bitbtnStop.ShowHint := affichehint; scrbarDelayChange(Sender); { Affichage du délai } {EDT:01 Message d'avertissement } Msg := 'NE PAS UTILSER CE MODULE' + #10 + 'Mais le programme CHRONO.EXE sous DOS' + #10 + 'Ainsi, vous ne serez pas perturbé par le multitâche de' + ' Windows...' + #10 + #10 + #10 + 'P.S.: QUITTEZ Windows avant d''exécuter CHRONO.EXE !!!...'; MessageDlg(Msg, mtInformation, [mbOk], 0); END; {PROCEDURE FormActivate} PROCEDURE TfrmChronoPPI.bitbtnStartClick(Sender: TObject); {----------------------------------------------------------------------------- BUT ........... : Petite boucle de test pour efectuer le relevé des différents signaux de synchronisation autour du PPI 8255 ENTREE ........ : -- SORTIE ........ : -- EFFETS DE BORDS : -- REMARQUE(S) ... : Cette procédure est identique aux procédures Chenillard et Pattern du composant PPI8255 -----------------------------------------------------------------------------} CONST valeur : ARRAY [1..8] OF BYTE = ($7F, $BF, { Valeurs à cérire sur le port.. } $DF, $EF, { ..utilisé pour les mesures.. } $F7, $FB, { ..c'est un bit à 0 qui se.. } $FD, $FE); { ..déplace } VAR NoValeur : BYTE; { Valeur actuellement écrite sur le port } BEGIN rgrpPort.Enabled := FALSE; { On ne change plus de port } IF NOT debugmode THEN BEGIN CASE rgrpPort.ItemIndex OF { Configure le port choisi en sortie.. } 0 : BEGIN { ..et les autres en entrée } frmMain.PPI8255.ModePortA := mpSortie; frmMain.PPI8255.ModePortB := mpEntree; frmMain.PPI8255.ModePortC := mpEntree; END; {BRANCH OF CASE} 1 : BEGIN frmMain.PPI8255.ModePortA := mpEntree; frmMain.PPI8255.ModePortB := mpSortie; frmMain.PPI8255.ModePortC := mpEntree; END; {BRANCH OF CASE} 2 : BEGIN frmMain.PPI8255.ModePortA := mpEntree; frmMain.PPI8255.ModePortB := mpEntree; frmMain.PPI8255.ModePortC := mpSortie; END; {BRANCH OF CASE} END; {CASE OF} NoValeur := 1; { Commence par la première valeur } Delai := scrbarDelay.Position; StopTest := FALSE; { Et c'est parti } REPEAT CASE rgrpPort.ItemIndex OF { Ecrit la valeur sur le port } 0 : BEGIN frmMain.PPI8255.PortA := valeur[NoValeur]; END; {BRANCH OF CASE} 1 : BEGIN frmMain.PPI8255.PortB := valeur[NoValeur]; END; {BRANCH OF CASE} 2 : BEGIN frmMain.PPI8255.PortC := valeur[NoValeur]; END; {BRANCH OF CASE} END; {CASE OF} Inc(NoValeur); { Passe à la valeur suivante } IF NoValeur > 8 THEN NoValeur := 1; Application.ProcessMessages; { Pour sortir une fois de la boucle } IF Delai > 0 THEN Delay(Delai); { Attend doudou dit donc } UNTIL StopTest; {EDT:01 Active à nouveau le choix du port } rgrpPort.Enabled := TRUE; { On peut de nouveau changer de port } END; {IF} END; {PROCEDURE bitbtnStartClick} PROCEDURE TfrmChronoPPI.bitbtnStopClick(Sender: TObject); {----------------------------------------------------------------------------- BUT ........... : Arrête d'envoyer la séquence de test sur le port choisi ENTREE ........ : -- SORTIE ........ : -- EFFETS DE BORDS : -- REMARQUE(S) ... : Cette procédure est identique aux procédures SetFStopChenillard et SetFStopPattern du composant PPI8255 -----------------------------------------------------------------------------} BEGIN StopTest := TRUE; { Arrête le test } (*EDT:01 Ca n'a rien à faire ici, cette ligne ! } rgrpPort.Enabled := TRUE; { On peut de nouveau changer de port }*) END; {PROCEDURE bitbtnStopClick} PROCEDURE TfrmChronoPPI.FormClose(Sender: TObject; var Action: TCloseAction); {----------------------------------------------------------------------------- BUT ........... : S'assure que le test est arrêté lors de la fermeture de la fiche ENTREE ........ : -- SORTIE ........ : -- EFFETS DE BORDS : -- REMARQUE(S) ... : -- -----------------------------------------------------------------------------} BEGIN bitbtnStopClick(Sender); END; {PROCEDURE FormClose} PROCEDURE TfrmChronoPPI.bitbtnOKClick(Sender: TObject); {----------------------------------------------------------------------------- BUT ........... : Arrête le test et ferme cette boîte de dialogue ENTREE ........ : -- SORTIE ........ : -- EFFETS DE BORDS : -- REMARQUE(S) ... : -- -----------------------------------------------------------------------------} BEGIN bitbtnStopClick(Sender); Close; END; {PROCEDURE bitbtnOKClick} PROCEDURE TfrmChronoPPI.scrbarDelayChange(Sender: TObject); {----------------------------------------------------------------------------- BUT ........... : Affiche le délai entre chaque changement d'état du port. ENTREE ........ : -- SORTIE ........ : -- EFFETS DE BORDS : -- REMARQUE(S) ... : Ce délai est changé par la ScrollBar scrbarDelay -----------------------------------------------------------------------------} BEGIN lblPause.Caption := 'Pause: ' + IntToStr(scrbarDelay.Position) + ' [ms]'; END; {PROCEDURE scrbarDelayChange} {=============================================================================} { INITIALISATIONS ------------------------------------------- Initialisations } {=============================================================================} INITIALIZATION END. {UNIT Uchrono}