start:eti:carte:sources:uchen
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}
start/eti/carte/sources/uchen.txt · Last modified: 2016/07/24 02:14 by admin