uChen.pas

UNIT Uchen;
{-----------------------------------------------------------------------------
  NOM DE L'UNITE : UCHEN.PAS
  BUT            : Chenillard style K2000 sur un des ports du PPI8255
  AUTEUR         : Stéphane Claus
  DATE           : Décembre 1996
 
  MODIFIE LE     : 12.04.1997  -  EDT:01
  RAISON         : - Ajout de commentaires
                   - Affiche l'état des LEDs correct lors de l'ouverture de la
                     fiche et non plus toutes éteintes.
 
  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
  TfrmChenillard = CLASS(TForm)
    digdspTitre: TDigitalDisplay;
    bitbtnOK: TBitBtn;
    bitbtnAide: TBitBtn;
    rgrpPort: TRadioGroup;
    grpbxVitesse: TGroupBox;
    scrbarVitesseChenillard: TScrollBar;
    grpbxChenillard: TGroupBox;
    bitbtnStart: TBitBtn;
    bitbtnStop: TBitBtn;
    chkbxAfficheEtat: TCheckBox;
    shpLed7: TShape;
    shpLed6: TShape;
    shpLed5: TShape;
    shpLed4: TShape;
    shpLed3: TShape;
    shpLed2: TShape;
    shpLed1: TShape;
    shpLed0: TShape;
    shpEtat: TShape;
    PROCEDURE scrbarVitesseChenillardChange(Sender: TObject);
    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 }
    PROCEDURE MAJEtatLEDs(Sender: TObject);  { Affiche l'état actuel des LEDs }
  END; {CLASS}
 
 
VAR
  frmChenillard: TfrmChenillard;
 
 
 
{=============================================================================}
IMPLEMENTATION   {================================= I M P L E M E N A T I O N }
{=============================================================================}
 
 
 
{$R *.DFM}
 
 
USES
  UPrincpl, VCL8255;
 
 
TYPE
  bbit = 0..7;
 
 
FUNCTION BitSetB(B : Byte; bit : bbit) : Boolean; ASSEMBLER;
{-----------------------------------------------------------------------------
  BUT ........... : Test si un des bits et à 1
  ENTREE ........ : B = Le byte qui contient un bit à tester
                    bit = Le n° du bit à tester
  SORTIE ........ : TRUE = Le bit testé est à 1
                    FALSE = Le bit testé est à 0
  EFFETS DE BORDS : --
  REMARQUE(S) ... : Je ne suis pas sûr que cette fonction fonctionne sous
                    Delphi 2.0
 -----------------------------------------------------------------------------}
ASM
  MOV CL, bit
  MOV BL, 1
  SHL BL, CL
  MOV AL, 0       {positionne result à FALSE}
  TEST B, BL
  JZ @No
  INC AL          {positionne result à TRUE}
  @No:
END; {FUNCTION BitSetB}
 
 
PROCEDURE TfrmChenillard.MAJEtatLEDs(Sender: TObject);
{-----------------------------------------------------------------------------
  BUT ........... : Met à jour l'état du port.
  ENTREE ........ : --
  SORTIE ........ : --
  EFFETS DE BORDS : la couleur de certains composants TShape peut changer
  REMARQUE(S) ... : Cette procédure est directement appelée par l'événement
                    OnChenillardBouge du composant PPI8255 présent sur la
                    fiche frmMain de l'unité Uprincpl
 -----------------------------------------------------------------------------}
VAR
  ValeurPort : BYTE;
BEGIN
  IF chkbxAfficheEtat.Checked THEN BEGIN
    {-- L'affichage est bien demandé }
    CASE frmMain.PPI8255.ChenillardPort OF                 { Lit ou on en est }
      pPortA : ValeurPort := frmMain.PPI8255.PortA;
      pPortB : ValeurPort := frmMain.PPI8255.PortB;
      pPortC : ValeurPort := frmMain.PPI8255.PortC;
    END; {CASE OF}
    { Si la led est ON => Vert clair, sinon vert foncé }
    IF BitSetB(ValeurPort, 0) THEN shpLed0.Brush.Color := clLime
                              ELSE shpLed0.Brush.Color := clGreen;
    IF BitSetB(ValeurPort, 1) THEN shpLed1.Brush.Color := clLime
                              ELSE shpLed1.Brush.Color := clGreen;
    IF BitSetB(ValeurPort, 2) THEN shpLed2.Brush.Color := clLime
                              ELSE shpLed2.Brush.Color := clGreen;
    IF BitSetB(ValeurPort, 3) THEN shpLed3.Brush.Color := clLime
                              ELSE shpLed3.Brush.Color := clGreen;
    IF BitSetB(ValeurPort, 4) THEN shpLed4.Brush.Color := clLime
                              ELSE shpLed4.Brush.Color := clGreen;
    IF BitSetB(ValeurPort, 5) THEN shpLed5.Brush.Color := clLime
                              ELSE shpLed5.Brush.Color := clGreen;
    IF BitSetB(ValeurPort, 6) THEN shpLed6.Brush.Color := clLime
                              ELSE shpLed6.Brush.Color := clGreen;
    IF BitSetB(ValeurPort, 7) THEN shpLed7.Brush.Color := clLime
                              ELSE shpLed7.Brush.Color := clGreen;
  END; {IF}
END; {PROCEDURE MAJEtatLEDs}
 
 
PROCEDURE TfrmChenillard.FormActivate(Sender: TObject);
{-----------------------------------------------------------------------------
  BUT ........... : Initialisation de la fiche en fonction des paramètres
                    actuels du programme
  ENTREE ........ : --
  SORTIE ........ : --
  EFFETS DE BORDS : --
  REMARQUE(S) ... : --
 -----------------------------------------------------------------------------}
VAR
  SvgchkbxAfficheEtat : BOOLEAN;
BEGIN
  Caption := Application.Title;                         { Titre de la fenêtre }
  IF debugmode THEN BEGIN            { Couleur de la fenêtre et des contrôles }
    Color := debugcolor;
  END {IF}
  ELSE BEGIN
    Color := clBtnFace;
  END; {ELSE}
 
  rgrpPort.ShowHint := affichehint;                      { Affichage des Hint }
  scrbarVitesseChenillard.ShowHint := affichehint;
  shpEtat.ShowHint := affichehint;
  chkbxAfficheEtat.ShowHint := affichehint;
  bitbtnStart.ShowHint := affichehint;
  bitbtnStop.ShowHint := affichehint;
 
  (*EDT:01 Affiche l'état correct des LEDs
  shpLed0.Brush.Color := clGreen;               { RAZ de l'état du chenillard }
  shpLed1.Brush.Color := clGreen;
  shpLed2.Brush.Color := clGreen;
  shpLed3.Brush.Color := clGreen;
  shpLed4.Brush.Color := clGreen;
  shpLed5.Brush.Color := clGreen;
  shpLed6.Brush.Color := clGreen;
  shpLed7.Brush.Color := clGreen; *)
  SvgchkbxAfficheEtat := chkbxAfficheEtat.Checked;
  chkbxAfficheEtat.Checked := TRUE;
  MAJEtatLEDs(Sender);
  chkbxAfficheEtat.Checked := SvgchkbxAfficheEtat;
END; {PROCEDURE FormActivate}
 
 
PROCEDURE TfrmChenillard.scrbarVitesseChenillardChange(Sender: TObject);
{-----------------------------------------------------------------------------
  BUT ........... : Change la vitesse du chenillard
  ENTREE ........ : --
  SORTIE ........ : --
  EFFETS DE BORDS : --
  REMARQUE(S) ... : La propriété ChenillardDelai du composant PPI8255 de la
                    fiche frmMain est automatiquement mise à jour
 -----------------------------------------------------------------------------}
BEGIN
  frmMain.PPI8255.ChenillardDelai := scrbarVitesseChenillard.Position;
END; {PROCEDURE scrbarVitesseChenillardChange}
 
 
PROCEDURE TfrmChenillard.bitbtnStartClick(Sender: TObject);
{-----------------------------------------------------------------------------
  BUT ........... : Démarre le chenillard
  ENTREE ........ : --
  SORTIE ........ : --
  EFFETS DE BORDS : --
  REMARQUE(S) ... : - L'exécution du chenillard n'est pas possible en mode
                      debug
                    - Une fois que le chenillard est démarré, il n'est plus
                      possible de choisir le port, ni de le démarrer une
                      seconde fois
 -----------------------------------------------------------------------------}
BEGIN
  rgrpPort.Enabled := FALSE;                                 { On bloque tout }
  bitbtnStart.Enabled := FALSE;
  CASE rgrpPort.ItemIndex OF             { Choix d'un port pour le chenillard }
    0 : frmMain.PPI8255.ChenillardPort := pPortA;
    1 : frmMain.PPI8255.ChenillardPort := pPortB;
    2 : frmMain.PPI8255.ChenillardPort := pPortC;
  END; {CASE OF}
  IF NOT debugmode THEN BEGIN                         { Démarre le chenillard }
    frmMain.PPI8255.Chenillard;
  END; {IF}
END; {PROCEDURE bitbtnStartClick}
 
 
PROCEDURE TfrmChenillard.bitbtnStopClick(Sender: TObject);
{-----------------------------------------------------------------------------
  BUT ........... : Arrête le chenillard
  ENTREE ........ : --
  SORTIE ........ : --
  EFFETS DE BORDS : --
  REMARQUE(S) ... : --
 -----------------------------------------------------------------------------}
BEGIN
  frmMain.PPI8255.ChenillardStop := TRUE;             { Stoppe le chenillard }
  rgrpPort.Enabled := TRUE;                  { On libère ce qui était bloqué }
  bitbtnStart.Enabled := TRUE;
END; {PROCEDURE bitbtnStopClick}
 
 
PROCEDURE TfrmChenillard.FormClose(Sender: TObject; VAR Action: TCloseAction);
{-----------------------------------------------------------------------------
  BUT ........... : S'assurer que le chenillard est arrêté lorsqu'on quitte
  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
  bitbtnStopClick(Sender);
END; {PROCEDURE FormClose}
 
 
PROCEDURE TfrmChenillard.bitbtnOKClick(Sender: TObject);
{-----------------------------------------------------------------------------
  BUT ........... : Arrête le chenillard et ferme la boîte de dialogue
  ENTREE ........ : --
  SORTIE ........ : --
  EFFETS DE BORDS : --
  REMARQUE(S) ... : --
 -----------------------------------------------------------------------------}
BEGIN
  bitbtnStopClick(Sender);
  Close;
END; {PROCEDURE bitbtnOKClick}
 
 
 
{=============================================================================}
{ INITIALISATIONS ------------------------------------------- Initialisations }
{=============================================================================}
 
 
 
INITIALIZATION
END. {UNIT Uchen}