UNIT Upattern;
{-----------------------------------------------------------------------------
  NOM DE L'UNITE : UPATTERN.PAS
  BUT            : Test de transmission entre les différents ports du PPI 8255
  AUTEUR         : Stéphane Claus
  DATE           : Décembre 1996
 
 
  MODIFIE LE     : 12.04.1997  -  EDT:01
  RAISON         : - Ajout de commentaires
                   - Ajout du paramètre SansAjoutListe à la procédure
                     AjouteErreur
 -----------------------------------------------------------------------------}
 
 
{=============================================================================}
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
  TfrmPattern = CLASS(TForm)
    digdspTitre: TDigitalDisplay;
    bitbtnOK: TBitBtn;
    bitbtnAide: TBitBtn;
    rgrpPorts: TRadioGroup;
    GroupBox1: TGroupBox;
    bitbtnStart: TBitBtn;
    bitbtnStop: TBitBtn;
    grpbxInformations: TGroupBox;
    lstbxListeErreurs: TListBox;
    lblLstErreurs: TLabel;
    lblOK0: TLabel;
    lblKO0: TLabel;
    lblTotal0: TLabel;
    lblOK1: TLabel;
    lblKO1: TLabel;
    lblTotal1: TLabel;
    Bevel1: TBevel;
    lblNombreTransmissions: TLabel;
    PROCEDURE FormActivate(Sender: TObject);
    PROCEDURE bitbtnStartClick(Sender: TObject);
    PROCEDURE bitbtnStopClick(Sender: TObject);
    PROCEDURE FormClose(Sender: TObject; VAR Action: TCloseAction);
    PROCEDURE bitbtnOKClick(Sender: TObject);
  PRIVATE
    { Private-déclarations }
  PUBLIC
    { Public-déclarations }
    NbTransfertsOK : LONGINT;
    NbTransfertsKO : LONGINT;
    NbTransfertsTot : LONGINT;
    Pour100OK : INTEGER;
    Pour100KO : INTEGER;
    PROCEDURE RAZCompteurs(Sender:TObject);
    PROCEDURE AjouteErreur(Sender:TObject; SansAjoutListe: BOOLEAN);
  END; {CLASS}
 
VAR
  frmPattern: TfrmPattern;
 
 
 
{=============================================================================}
IMPLEMENTATION   {================================= I M P L E M E N A T I O N }
{=============================================================================}
 
 
 
{$R *.DFM}
 
 
USES
  UPrincpl, VCL8255;
 
 
PROCEDURE TfrmPattern.RAZCompteurs(Sender:TObject);
{-----------------------------------------------------------------------------
  BUT ........... : Réinitialise les compteurs d'erreurs
  ENTREE ........ : --
  SORTIE ........ : --
  EFFETS DE BORDS : --
  REMARQUE(S) ... : --
 -----------------------------------------------------------------------------}
BEGIN
  lblOK1.Caption := '';
  lblKO1.Caption := '';
  lblTotal1.Caption := '';
  lstbxListeErreurs.Clear;
  NbTransfertsOK := 0;
  NbTransfertsKO := 0;
  NbTransfertsTot := 0;
  Pour100OK := 0;
  Pour100KO := 0;
END; {PROCEDURE RAZCompteurs}
 
 
PROCEDURE TfrmPattern.AjouteErreur(Sender:TObject; SansAjoutListe: BOOLEAN);
{-----------------------------------------------------------------------------
  BUT ........... : Ajoute à la liste la nouvelle erreur détectée et met à jour
                    le panel Informations
  ENTREE ........ : SansAjoutListe = Si ce paramètre est à TRUE, seuls les
                                     infos sur les transferts sont affichés.
                                     S'il est à FALSE, le message d'erreur du
                                     à une erreur est ajuté à la liste.
  SORTIE ........ : --
  EFFETS DE BORDS : C'est décrit dans le but
  REMARQUE(S) ... : Ajout du paramètre "SansAjoutListe: BOOLEAN" dans l'EDT:01
 -----------------------------------------------------------------------------}
VAR
  Temp : REAL;
BEGIN
  { Lit où on en est }
  NbTransfertsOK := frmMain.PPI8255.PatternNbOK;
  NbTransfertsKO := frmMain.PPI8255.PatternNbErreurs;
  { Calcul ne nombre total de transferts }
  NbTransfertsTot := NbTransfertsKO + NbTransfertsOK;
  { Conversion en % }
  Temp := 100 / NbTransfertsTot;
  Pour100OK := Round(NbTransfertsOK * Temp);
  Pour100KO := 100 - Pour100OK;
  { Affichage des informations }
  lblOK1.Caption := IntToStr(NbTransfertsOK);
  lblKO1.Caption := IntToStr(NbTransfertsKO);
  lblTotal1.Caption := IntToStr(NbTransfertsTot);
  { S'il on peut encore ajouter un message d'erreur à la liste, on le fait,
    sinon le message est perdu. Le nombre maximum d'éléments dans une liste est
    de 16380. On s'arrête à 10'000, car c'est amplement suffisant pour notre
    test. }
  {EDT:01 N'ajoute que si SansAjoutListe est à FALSE }
  IF ((lstbxListeErreurs.Items.Count <= 10000) AND
      (NOT SansAjoutListe))  THEN BEGIN
    { Liste pas encore complète et ajout du message demandé }
    lstbxListeErreurs.Items.Add(frmMain.PPI8255.PatternMessage)
  END; {IF}
END; {PROCEDURE AjouteErreur}
 
 
PROCEDURE TfrmPattern.FormActivate(Sender: TObject);
{-----------------------------------------------------------------------------
  BUT ........... : Initialisation de la fiche en fonction des paramètres
                    actuels du programme
  ENTREE ........ : --
  SORTIE ........ : --
  EFFETS DE BORDS : --
  REMARQUE(S) ... : --
 -----------------------------------------------------------------------------}
BEGIN
  Caption := Application.Title;                         { Titre de la fenêtre }
  IF debugmode THEN Color := debugcolor               { Couleur de la fenêtre }
               ELSE Color := clBtnFace;
  rgrpPorts.ShowHint := affichehint;                     { Affichage des Hint }
  bitbtnStart.ShowHint := affichehint;
  bitbtnStop.ShowHint := affichehint;
  lblOK1.ShowHint := affichehint;
  lblKO1.ShowHint := affichehint;
  lblTotal1.ShowHint := affichehint;
  lstbxListeErreurs.ShowHint := affichehint;
  RAZCompteurs(Sender);                                   { Reset des erreurs }
END; {PROCEDURE FormActivate}
 
 
PROCEDURE TfrmPattern.bitbtnStartClick(Sender: TObject);
{ BUT: Démarre le test pattern }
{-----------------------------------------------------------------------------
  BUT ........... :
  ENTREE ........ : --
  SORTIE ........ : --
  EFFETS DE BORDS : --
  REMARQUE(S) ... : --
 -----------------------------------------------------------------------------}
BEGIN
  {-- Désactive les contrôles génants }
  rgrpPorts.Enabled := FALSE;
  bitbtnStart.Enabled := FALSE;
  {-- RAZ des compteurs }
  RAZCompteurs(Sender);
  {-- Choix des ports à utiliser }
  CASE rgrpPorts.ItemIndex OF
    0 : frmMain.PPI8255.PatternPorts := ppABC;
    1 : frmMain.PPI8255.PatternPorts := ppBAC;
    2 : frmMain.PPI8255.PatternPorts := ppCAB;
    3 : frmMain.PPI8255.PatternPorts := ppAB;
    4 : frmMain.PPI8255.PatternPorts := ppAC;
    5 : frmMain.PPI8255.PatternPorts := ppBA;
    6 : frmMain.PPI8255.PatternPorts := ppBC;
    7 : frmMain.PPI8255.PatternPorts := ppCA;
    8 : frmMain.PPI8255.PatternPorts := ppCB;
  END; {CASE OF}
  {-- Démarre le test }
  IF NOT debugmode THEN BEGIN
    frmMain.PPI8255.Pattern;
  END; {IF}
END; {PROCEDURE bitbtnStartClick}
 
 
PROCEDURE TfrmPattern.bitbtnStopClick(Sender: TObject);
{-----------------------------------------------------------------------------
  BUT ........... : Arrête le test pattern et affiche les statistiques des
                    transferts effectués
  ENTREE ........ : --
  SORTIE ........ : --
  EFFETS DE BORDS : --
  REMARQUE(S) ... : --
 -----------------------------------------------------------------------------}
VAR
  Temp : REAL;
BEGIN
  {-- Arrête le test}
  frmMain.PPI8255.PatternStop := TRUE;
  {-- Réactive les contrôles génants }
  rgrpPorts.Enabled := TRUE;
  bitbtnStart.Enabled := TRUE;
  {-- On en est ou avec les erreurs ?? }
  NbTransfertsOK := frmMain.PPI8255.PatternNbOK;
  NbTransfertsKO := frmMain.PPI8255.PatternNbErreurs;
  NbTransfertsTot := NbTransfertsKO + NbTransfertsOK;
  IF NbTransfertsTot > 0 THEN BEGIN
    (*EDT:01 Simplification...
    Temp := 100 / NbTransfertsTot;
    Pour100OK := Trunc(NbTransfertsOK * Temp);
    Pour100KO := 100 - Pour100OK;
    lblOK1.Caption := IntToStr(NbTransfertsOK);
    lblKO1.Caption := IntToStr(NbTransfertsKO);
    lblTotal1.Caption := IntToStr(NbTransfertsTot); *)
    AjouteErreur(Sender, TRUE);
  END; {IF}
END; {PROCEDURE bitbtnStopClick}
 
 
PROCEDURE TfrmPattern.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 TfrmPattern.bitbtnOKClick(Sender: TObject);
{-----------------------------------------------------------------------------
  BUT ........... : Arrête le test de pattern et referme cette boîte de
                    dialogue
  ENTREE ........ : --
  SORTIE ........ : --
  EFFETS DE BORDS : --
  REMARQUE(S) ... : --
 -----------------------------------------------------------------------------}
BEGIN
  bitbtnStopClick(Sender);
  Close;
END; {PROCEDURE bitbtnOKClick}
 
 
 
{=============================================================================}
{ INITIALISATIONS ------------------------------------------- Initialisations }
{=============================================================================}
 
 
 
INITIALIZATION
END. {UNIT Upattern}