start:eti:carte:sources:vcl8255
Vcl8255.pas
UNIT Vcl8255; {----------------------------------------------------------------------------- NOM DE L'UNITE : VCL8255.PAS BUT : Composant VCL 8255 renfermant tout les contrôles du PPI AUTEUR : S.Claus / M.Amarantidis DATE : Novembre 1996 MODIFIE LE : 05.12.1996 - 1.01 - S.Claus RAISON : - Ajouté le type TPort - Ajouté les propriétés ChenillardStop, ChenillardDelai et ChenillardPort - Ajouté la méthode Chenillard MODIFIE LE : 08.12.1996 - 1.02 - S.Claus RAISON : - Ajouté l'état mpIndefini pour le type TModePort - Ajouté le type TPortPattern - Ajouté les propriétés PatternPorts, PatternStop, PatternNbErreurs, PatternMessage et PatternNbOK - Ajouté la méthode Pattern - Ajouté l'événement OnErrorPattern MODIFIE LE : 08.12.1996 - 1.03 - S.Claus RAISON : - Correction de la procédure Chenillard: Un port en sortie, deux ports en entrée. - Correction de la procédure Chenillard: Lors de la mise à 1 du bit, il faut soustraire 1 à NoBit car la procédure SetBitB va de 0 à 7 et non pas de 1 à 8 - Ajouté l'événement OnChenillardBouge pour une utilisation dans le programme. MODIFIE LE : 14.12.1996 - 1.04 - S.Claus RAISON : - Quelques adaptations en vue de l'utilisation de ce composant sous Delphi 2.0 MODIFIE LE : 22.12.1996 - 1.05 - S.Claus - Changé le type des propriétés PatternNbErreurs et PatternNbOK de WORD à LONGINT car sinon, on peut passer en négatif. - Ajouté la propriété Version afin de pouvoir lire la version de la VCL depuis le programme appelant. MODIFIE LE : 08.01.1997 - 1.06 - M.Amarantidis - Correction du chenillard pour n'allumer qu'une LED à la fois et non pas n'importe quoi. MODIFIE LE : 15.01.1997 - 1.07 - S.Claus - Ajout de nouveaux type de tests de pattern, en utilisant uniquement deux ports: un en émission et un un réception. Seul un des ports est configuré en sortie. Ces nouveaux paramètres sont: ppAB, ppAC, ppBA, ppBC, ppCA et ppCB - Empêche toute modification de l'état des ports si le chenillard ou le test de pattern est en cours d'exécution - N'exécute pas une seconde fois le Chenillard ou le test de pattern si une de ces deux procédures est déjà en cours d'exécution. MODIFIE LE : 22.01.1997 - 1.08 - M.Amarantidis - Modification pour la configuration des modes des ports: réécrit chaque fois la configuration complète du port, car la lecture du mot de contrôle est INTERDITE. - Empêche l'exécution du chenillard pendant le test de pattern et empêche l'exécution du pattern pendant le chenillard MODIFIE LE : 22.01.1997 - 1.09 - S.Claus - Ajout de commentaires... - Les variables internes au composant commencent toutes par F... - Utilise partout les fonctions d'E/S en assembleur au lieu du tableau Port de Delphi - N'arrête pas le Pattern si on exécute le chenillard en même temps - Ne reconfigure les port que si la nouvelle configuration est différente de l'actuelle REMARQUES : - Pour la configuration du 8255, la structure du mot de contrôle qu'il faut écrire à l'adresse de contrôle est la suivante: D7 D6 D5 D4 D3 D2 D1 D0 ¦ ¦ ¦ ¦ ¦ ¦ ¦ ¦ ¦ +--+ ¦ ¦ ¦ ¦ ¦ GROUPE B ¦ ¦ ¦ ¦ ¦ ¦ +----- Port C (bas): ¦ ¦ ¦ ¦ ¦ ¦ 1: Entrée / 0: Sortie ¦ ¦ ¦ ¦ ¦ +-------- Port B: ¦ ¦ ¦ ¦ ¦ 1: Entrée / 0: Sortie ¦ ¦ ¦ ¦ +----------- Sélection de mode: ¦ ¦ ¦ ¦ 0: Mode 0 / 1: Mode 1 ¦ ¦ ¦ ¦ ¦ ¦ ¦ ¦ GROUPE A ¦ ¦ ¦ +-------------- Port C (haut): ¦ ¦ ¦ 1: Entrée / 0: Sortie ¦ ¦ +----------------- Port A: ¦ ¦ 1: Entrée / 0: Sortie ¦ +----------------------- Sélection de mode: ¦ 00: Mode 0 / 01: Mode 1 ¦ 1X: Mode 2 ¦ +-------------------------- Drapeau de mode défini: 1: Actif - Dans cette VCL, le 8255 n'est utilisé que dans le mode 0, qui est un mode d'entrée/sortie simple. - Les propriétés PatternNbOK et PatternMessage sont en lecture seule et ne peuvent être vues avec l'inspecteur d'objet. -----------------------------------------------------------------------------} {=============================================================================} INTERFACE {============================================== I N T E R F A C E } {=============================================================================} USES WinTypes, WinProcs, Classes, SysUtils; CONST versionvcl = '1.09'; { Version du VCL } adressebase = $300; { Adresse de base du 8255 } nbpas = 100; { Pattern pour le test de transfert } patterntest : ARRAY[1..nbpas] OF BYTE = ($00, $01, $02, $03, $04, $05, $06, $07, $08, $09, $10, $11, $12, $13, $14, $15, $16, $17, $18, $19, $20, $21, $22, $23, $24, $25, $26, $27, $28, $29, $30, $31, $32, $33, $34, $35, $36, $37, $38, $39, $40, $41, $42, $43, $44, $45, $46, $47, $48, $49, $50, $51, $52, $53, $54, $55, $56, $57, $58, $59, $60, $61, $62, $63, $64, $65, $66, $67, $68, $69, $70, $71, $72, $73, $74, $75, $76, $77, $78, $79, $80, $81, $82, $83, $84, $85, $86, $87, $88, $89, $90, $91, $92, $93, $94, $95, $96, $97, $98, $99); TYPE TModePort = (mpSortie, mpEntree, mpIndefini); { Etats possibles des ports } TPort = (pPortA, pPortB, pPortC); { Port } TPortPattern = (ppABC, ppBAC, ppCAB, { Type de test de pattern } {1.07 Nouvelles configurations possibles } ppAB, ppAC, ppBA, ppBC, ppCA, ppCB); TPPI8255 = CLASS(TComponent) {=========================================================================} PRIVATE { Private-déclarations ---------------------------------- PRIVATE } {-- Divers } FVersion : STRING; { Version de la VCL } FAdresseBase8255 : WORD; { Adresse de base du 8255 } FAdresseCtrl, { Adresse du port de contrôle } FAdressePortA, { Adresse du port A } FAdressePortB, { Adresse du port B } FAdressePortC : WORD; { Adresse du port C } FCanWrite : BOOLEAN; { Accès au hardware autorisé ? } {-- Configuration des ports } FModeDuPortA, { Mode de fonctionnement du port A } FModeDuPortB, { Mode de fonctionnement du port B } FModeDuPortC : TModePort; { Mode de fonctionnement du port C } {-- Chenillard } FPortChenillard : TPort; { Port utilisé par le chenillard } FStopChenillard : BOOLEAN; { Arrêt du chenillard } FDelaiChenillard : WORD; { Délai entre chaque chgmnt d'état } FOnChenillardBouge : TNotifyEvent; { Changemement d'état } { Le type TNotifyEvent est le type des événements qui n'ont pas de paramètre. Ces événements se contentent de notifier au composant qu'un événement particulier s'est produit. Par exemple, OnClick, qui est de type TNotifyEvent, indique au contrôle qu'un clic s'est produit sur le contrôle. } {-- Pattern } FPortsPattern : TPortPattern; { Ports utilisés par le pattern } FStopPattern : BOOLEAN; { Arrêt du pattern } FNbErrPattern : LONGINT; { Nb pattern transmis AVEC erreur } FNbOkPattern : LONGINT; { Nb pattern transmis SANS erreur } FMsgErrPattern : STRING; { Description de l'erreur } FOnErrorPattern : TNotifyEvent; { Erreur de transm. survenue } {-- Divers } PROCEDURE AjusteAdresses; { Set des adresses des ports } PROCEDURE SetAdresseBase(Adresse:WORD); { Config de l'adresse de base } PROCEDURE SetCanWrite(WriteEnabled:BOOLEAN); { Change état de FCanWrite } {-- Configuration des ports } PROCEDURE SetPortA(Mode:TModePort); { Init du port A et FModeDuPortA } PROCEDURE SetPortB(Mode:TModePort); { Init du port B et FModeDuPortB } PROCEDURE SetPortC(Mode:TModePort); { Init du port C et FModeDuPortC } {-- Lecture / Ecriture } FUNCTION LitPortA:BYTE; { Lit valeur présente sur le port A } PROCEDURE EcritPortA(Valeur:BYTE); { Ecrit une valeur sur le port A } FUNCTION LitPortB:BYTE; { Lit valeur présente sur le port B } PROCEDURE EcritPortB(Valeur:BYTE); { Ecrit une valeur sur le port B } FUNCTION LitPortC:BYTE; { Lit valeur présente sur le port C } PROCEDURE EcritPortC(Valeur:BYTE); { Ecrit une valeur sur le port C } {-- Chenillard } PROCEDURE SetFPortChenillard(LePort:TPort); { Sélection du port } PROCEDURE SetFStopChenillard(Stop:BOOLEAN); { Arrête le chenillard } PROCEDURE SetFDelaiChenillard(Delay:WORD); { Modif de la "vitesse" } {-- Pattern } PROCEDURE SetFPortsPattern(Valeur:TPortPattern); { Sélection du port } PROCEDURE SetFStopPattern(Stop:BOOLEAN); { Arrête le pattern } {=========================================================================} PUBLIC { Public-déclarations ------------------------------------- PUBLIC } CONSTRUCTOR Create(AOwner:TComponent); OVERRIDE; { Constructeur } DESTRUCTOR Destroy; OVERRIDE; { Destructeur } {=========================================================================} PUBLISHED { Published declarations ---------------------------- PUBLISHED } { Le mot déclaré property permet de déclarer une propriété. La définition d'une propriété dans une classe déclare un attribut nommé pour les objets de la classe et pour les actions associées à la lecture et à l'écriture de l'attribut. READ => Fonction / Variable utilisé lors de la lecture de la propriété WRITE => Fonction / Variable utilisé lors de l'affectation d'une valeur à la propriété DEFAULT => Valeur par défaut (optionnel) S'il n'y a pas de "section" WRITE, la propriété est en lecture seule... } { DIVERS ------------------------------------------------------- Divers } PROPERTY Version : STRING { Version du composant } READ FVersion; { Renvoie la valeur de la variable } PROPERTY Enabled : BOOLEAN { Composant activé ? } READ FCanWrite { Renvoie la valeur de la variable } WRITE SetCanWrite; { Modifie la vaiable FCanWrite } PROPERTY Adresse : WORD { Adresse de base du PPI8255 } READ FAdresseBase8255 { Renvoie la valeur de la variable } WRITE SetAdresseBase; { CONFIGURATION DES PORTS --------------------- Configuration des ports } PROPERTY ModePortA : TModePort { Config du port A } READ FModeDuPortA { Renvoie la valeur de la variable } WRITE SetPortA { Initialise le port et la variable } DEFAULT mpIndefini; { Par défaut: état indéfini } PROPERTY ModePortB : TModePort { Comme pour le port A } READ FModeDuPortB WRITE SetPortB DEFAULT mpIndefini; PROPERTY ModePortC : TModePort { Comme pour le port A } READ FModeDuPortC WRITE SetPortC DEFAULT mpIndefini; { LECTURE / ECRITURE ------------------------------- Lecture / Ecriture } PROPERTY PortA : BYTE { Valeur du port A } READ LitPortA { Lit la valeur actuellement présente sur le port } WRITE EcritPortA; { Ecrit une valeur sur le port } PROPERTY PortB : BYTE { Comme pour le port A } READ LitPortB WRITE EcritPortB; PROPERTY PortC : BYTE { Comme pour le port A } READ LitPortC WRITE EcritPortC; { CHENILLARD ----------------------------------------------- Chenillard } PROPERTY ChenillardPort : TPort { Port utilisé par le chenillard } READ FPortChenillard { Lit quel est le port choisi } WRITE SetFPortChenillard { Initialise la variable } DEFAULT pPortA; { Par défaut, le port A } PROPERTY ChenillardStop : BOOLEAN { Arrêt du chenillard } READ FStopChenillard { Renvoie la valeur de la variable } WRITE SetFStopChenillard { Initialise la variable } DEFAULT TRUE; { Par défaut, le chenillard est arrêté } PROPERTY ChenillardDelai : WORD { Attente entre chaque changemnt d'état } READ FDelaiChenillard { Lit la valeur actuelle du délai } WRITE SetFDelaiChenillard { Modification du délai } DEFAULT 300; { Par défaut, 300 [ms] } PROPERTY OnChenillardBouge:TNotifyEvent { Le chenillard avance... } READ FOnChenillardBouge { Notification de l'événement } WRITE FOnChenillardBouge; { Notification de l'événement } PROCEDURE Chenillard; VIRTUAL; { LE chenillard } { PATTERN ----------------------------------------------------- Pattern } PROPERTY PatternPorts : TPortPattern { Ports utilisés par le pattern } READ FPortsPattern { Lit quel sont les ports choisis } WRITE SetFPortsPattern { Initialise la variable } DEFAULT ppABC; { Test du port A vers les ports B et C } PROPERTY PatternStop : BOOLEAN { Arrêt du test de pattern } READ FStopPattern { Renvoie la valeur de la variable } WRITE SetFStopPattern { Initialise la variable } DEFAULT TRUE; { Par défaut, le pattern est arrêté } PROPERTY PatternNbOK:LONGINT { Nb de transferts sans erreur } READ FNbOkPattern { Renvoie la valeur de la variable } DEFAULT 0; { Par défaut, pas encore de transferts } PROPERTY PatternNbErreurs:LONGINT { Nb de transferts avec erreur } READ FNbErrPattern { Renvoie la valeur de la variable } DEFAULT 0; { Par défaut, pas d'erreur } PROPERTY PatternMessage:STRING { Message descriptif erreur pattern } READ FMsgErrPattern; { Renvoie la valeur de la variable } PROPERTY OnErrorPattern : TNotifyEvent { Erreur de transmisson... } READ FOnErrorPattern { Notification de l'événement } WRITE FOnErrorPattern; { Notification de l'événement } PROCEDURE Pattern; VIRTUAL; { LE test de pattern } END; {CLASS TPPI8255} PROCEDURE Register; { Enregistrement de l'objet dans l'inspecteur d'objets } {=============================================================================} IMPLEMENTATION {================================= I M P L E M E N A T I O N } {=============================================================================} USES Forms, { Pour "Application.ProcessMessages" } Dialogs; {1.04 Ajouté le tableau de constantes Poids } CONST Poids : ARRAY[0..7] OF WORD = (1, 2, 4, 8, 16, 32, 64, 128); TYPE bbit = 0..7; { Pour l'accés aux bits } {-----------------------------------------------------------------------------} { INITIALISATIONS ------------------------------------------- Initialisations } {-----------------------------------------------------------------------------} CONSTRUCTOR TPPI8255.Create; {----------------------------------------------------------------------------- BUT ........... : C'est le CONSTRUCTOR. On initialise les variables du composant et on appel le constructeur hérité de TComponent ENTREE ........ : -- SORTIE ........ : -- EFFETS DE BORDS : Les variables globales sont initialisées REMARQUE(S) ... : -- -----------------------------------------------------------------------------} BEGIN { Toujours appeler le constructeur reçu en héritage } INHERITED Create(AOwner); FVersion := versionvcl; { Version } FCanWrite := FALSE; { Interdiction d'écrire sur les ports } SetAdresseBase(adressebase); { Valeur par défaut des adresses } FModeDuPortA := mpIndefini; { Etat des ports infédini (T'as } FModeDuPortB := mpIndefini; { une boule de cristal ?) } FModeDuPortC := mpIndefini; (*SetPortA(mpEntree); Si FCanWrite est à FALSE, cette initialisation n'est SetPortB(mpEntree); pas possible . . . SetPortC(mpEntree); *) FStopChenillard := TRUE; { Le Chenillard est arrêté } FDelaiChenillard := 300; { 300ms d'attente entre chaque changement } FStopPattern := TRUE; { Le test de pattern est arrêté } FNbOkPattern := 0; { Pas de transfert OK } FNbErrPattern := 0; { Pas d'erreurs } FMsgErrPattern := ''; { Pas de message } END; {CONSTRUCTOR Create} DESTRUCTOR TPPI8255.Destroy; {----------------------------------------------------------------------------- BUT ........... : Tout remettre en ordre quand on a fini ENTREE ........ : -- SORTIE ........ : -- EFFETS DE BORDS : -- REMARQUE(S) ... : -- -----------------------------------------------------------------------------} BEGIN INHERITED Destroy; { Toujours appeler le destructor hérité } END; {DESTRUCTOR Destroy} {-----------------------------------------------------------------------------} { ACCES BAS NIVEAU ----------------------------------------- Accés bas niveau } {-----------------------------------------------------------------------------} FUNCTION InPortB(LePort:WORD):BYTE; {----------------------------------------------------------------------------- BUT ........... : Lecture de l'état d'un port ENTREE ........ : LePort = Port sur lequel la valeur doit être lue SORTIE ........ : Valeur actuellement présente sur le port EFFETS DE BORDS : -- REMARQUE(S) ... : 1.04: Sauvegarde puis restauration du registre DX par un PUSH/POP -----------------------------------------------------------------------------} VAR Valeur : BYTE; BEGIN ASM PUSH DX MOV DX, LePort IN AL, DX MOV Valeur, AL POP DX END; {ASM} InPortB := Valeur; END; {FUNCTION InPortB} PROCEDURE OutPortB(LePort:WORD; Value:BYTE); {ASSEMBLER;} {----------------------------------------------------------------------------- BUT ........... : Ecrit une valeur sur un port ENTREE ........ : LePort = Port sur lequel la valeur doit être écrite Valuer = Valeur à écrire sur le port SORTIE ........ : -- EFFETS DE BORDS : -- REMARQUE(S) ... : 1.04: Sauvegarde puis restauration du registre DX par un PUSH/POP -----------------------------------------------------------------------------} BEGIN ASM PUSH DX MOV DX, LePort MOV AL, Value OUT DX, AL POP DX END; {ASM} END; {PROCEDURE OutPortB} PROCEDURE SetBitB(VAR B : Byte; bit : bbit); {----------------------------------------------------------------------------- BUT ........... : Mise à 1 d'un bit ENTREE ........ : B = Le byte à modifier bit = le no du bit à changer (entre 0 et 7) SORTIE ........ : -- EFFETS DE BORDS : -- REMARQUE(S) ... : 1.04 Ce test logique remplace la fonction en assembleur suivante: PROCEDURE SetBitB(VAR B : Byte; bit : bbit); ASSEMBLER; ASM MOV CL, bit MOV BL, 1 SHL BL, CL LES DI, B OR ES:[DI], BL (*OR positionne le bit*) END; (*PROCEDURE SetBitB*) -----------------------------------------------------------------------------} BEGIN B := B OR Poids[bit] END; {PROCEDURE SetBitB} PROCEDURE ClearBitB(VAR B : Byte; bit : bbit); {----------------------------------------------------------------------------- BUT ........... : Mise à 0 d'un bit ENTREE ........ : B = Le byte à modifier bit = le no du bit à changer (entre 0 et 7) SORTIE ........ : -- EFFETS DE BORDS : -- REMARQUE(S) ... : 1.04 Ce test logique remplace la fonction en assembleur suivante: PROCEDURE ClearBitB(VAR B : Byte; bit : bbit); ASSEMBLER; ASM MOV CL, bit MOV BL, 1 SHL BL, CL NOT BL LES DI, B AND ES:[DI], BL (*AND of NOT BL met à zéro le bit*) END; (*PROCEDURE ClearBitB*) -----------------------------------------------------------------------------} BEGIN B := B AND NOT Poids[bit]; END; {PROCEDURE ClearBitB} (*1.04 Supprimé cette procédure qui n'est pas utilisée PROCEDURE ToggleBitB(VAR B : Byte; bit : bbit); ASSEMBLER; {----------------------------------------------------------------------------- BUT ........... : Inverse l'état d'un bit (0->1 et 1->0) ENTREE ........ : B = Le byte à modifier bit = le no du bit à changer (entre 0 et 7) SORTIE ........ : -- EFFETS DE BORDS : -- REMARQUE(S) ... : -----------------------------------------------------------------------------} ASM MOV CL, bit MOV BL, 1 SHL BL, CL LES DI, B XOR ES:[DI], BL {XOR bascule le bit} END; {PROCEDURE ToggleBitB} *) {-----------------------------------------------------------------------------} { UTILITAIRES --------------------------------------------------- Utilitaires } {-----------------------------------------------------------------------------} 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) ... : 1.04 Remplacé GetTick par GetTickCount + Simplification (*FUNCTION Delay(DelayMS:LONGINT):BOOLEAN; VAR ET : LONGINT; FUNCTION GetTick:LONGINT; (* BUT: Indique depuis combien de temps Windows est en fonction *) VAR TI:TTimerInfo; BEGIN (* Initialise la taille du RECORD TTimerInfo *) TI.dwSize := SizeOf(TI); TimerCount(@TI); (* Retourne le temps écoulé *) Result := TI.dwmsThisVM; END; (*FUNCTION GetTick:LONGINT*) BEGIN (*FUNCTION Delay*) ET := GetTick; REPEAT Application.ProcessMessages; UNTIL Application.Terminated OR (GetTick-ET > DelayMS); Result := Application.Terminated; END; (*FUNCTION Delay*) -----------------------------------------------------------------------------} VAR ET : LONGINT; BEGIN IF DelayMS = 0 THEN BEGIN {1.09 Si pas d'attente, quitte de suite } Result := Application.Terminated; Exit; END; {IF} ET := GetTickCount; REPEAT Application.ProcessMessages; UNTIL Application.Terminated OR (GetTickCount-ET > DelayMS); Result := Application.Terminated; END;{FUNCTION Delay} PROCEDURE Register; {----------------------------------------------------------------------------- BUT ........... : Ajoute ce composant dans la palette des composants de Delphi ENTREE ........ : -- SORTIE ........ : -- EFFETS DE BORDS : Le composant est ajouté à la page "More..." REMARQUE(S) ... : -- -----------------------------------------------------------------------------} BEGIN RegisterComponents('More...', [TPPI8255]); END; {PROCEDURE Register} {-----------------------------------------------------------------------------} { ENTREE/SORTIE ----------------------------------------------- Entrée/Sortie } {-----------------------------------------------------------------------------} PROCEDURE TPPI8255.SetCanWrite(WriteEnabled:BOOLEAN); {----------------------------------------------------------------------------- BUT ........... : Autorise ou non l'écriture sur les ports ENTREE ........ : WriteEnabled : L'état futur de la variable FCanWrite SORTIE ........ : -- EFFETS DE BORDS : FCanWrite prend la valeur du paramètre WriteEnabled REMARQUE(S) ... : -- -----------------------------------------------------------------------------} BEGIN FCanWrite := WriteEnabled; END; {PROCEDURE SetCanWrite} PROCEDURE TPPI8255.AjusteAdresses; {----------------------------------------------------------------------------- BUT ........... : Ajuste toutes les adresses du 8255 en fonction de l'adresse de base ENTREE ........ : -- SORTIE ........ : -- EFFETS DE BORDS : Les variables FAdressePortA, FAdressePortB, FAdressePortC et FAdresseCtrl sont ajustées en fonction de la variable FAdresseBase8255 REMARQUE(S) ... : -- -----------------------------------------------------------------------------} BEGIN FAdressePortA := FAdresseBase8255 + 0; FAdressePortB := FAdresseBase8255 + 1; FAdressePortC := FAdresseBase8255 + 2; FAdresseCtrl := FAdresseBase8255 + 3; END; {PROCEDURE TPPI8255.AjusteAdresses} PROCEDURE TPPI8255.SetAdresseBase(Adresse:WORD); {----------------------------------------------------------------------------- BUT ........... : Configuration de l'adresse de base ENTREE ........ : Adresse = L'adresse de base SORTIE ........ : -- EFFETS DE BORDS : Les différentes adresses des ports du PPI sont modifiées REMARQUE(S) ... : -- -----------------------------------------------------------------------------} BEGIN FAdresseBase8255 := Adresse; AjusteAdresses; { MAJ des autres adresses } END; {PROCEDURE TPPI8255.SetAdresseBase} PROCEDURE TPPI8255.SetPortA(Mode:TModePort); {----------------------------------------------------------------------------- BUT ........... : Initialisation du port A en entrée ou en sortie ENTREE ........ : Mode = Comment doit être configuré le port A SORTIE ........ : -- EFFETS DE BORDS : La variable FModeDuPortA est initialisée à la valeur de Mode REMARQUE(S) ... : - Cette modification n'est possible que si: a) les E/S sont autorisées, soit que FCanWrite est à TRUE b) On ne configure pas le port dans un mode indéfini (on sait ce qu'on veut faire) c) Le chenillard et le pattern ne sont pas en cours d'exécution -----------------------------------------------------------------------------} VAR ValeurControle : BYTE; BEGIN {1.07 Empêche toute modification de l'état du port si le chenillard ou le pattern est en cours d'exécution IF FCanWrite AND (Mode <> mpIndefini) THEN BEGIN } IF FCanWrite AND (Mode <> mpIndefini) AND FStopChenillard AND FStopPattern THEN BEGIN {1.09 Ne reconfigure le port que si la configuration change } IF FModeDuPortA = Mode THEN Exit; FModeDuPortA := Mode; { MAJ de la propriété } {1.08 Cette lecture est interdite ! } (*ValeurControle := InPortB(FAdresseCtrl); { Valeur de contrôle actuelle } ValeurControle := Port[FAdresseCtrl]; { Valeur de contrôle actuelle } *) ValeurControle := 0; SetBitB(ValeurControle, 7); { Drapeau de mode défini: Actif } ClearBitB(ValeurControle, 6); { Passe en mode 0 pour tous les groupes } ClearBitB(ValeurControle, 5); ClearBitB(ValeurControle, 2); {1.08 Reconfigure chaque fois tous les ports} IF FModeDuPortA = mpSortie THEN ClearBitB(ValeurControle, 4) { A Sortie } ELSE SetBitB (ValeurControle, 4); { A Entree } IF FModeDuPortB = mpSortie THEN ClearBitB(ValeurControle, 1) { B Sortie } ELSE SetBitB (ValeurControle, 1); { B Entree } IF FModeDuPortC = mpSortie THEN ClearBitB(ValeurControle, 0) { C Sortie } ELSE SetBitB (ValeurControle, 0); { C Entree } IF FModeDuPortC = mpSortie THEN ClearBitB(ValeurControle, 3) { C Sortie } ELSE SetBitB (ValeurControle, 3); { C Entree } OutPortB(FAdresseCtrl, ValeurControle); { Configure correctement le 8255 } END; {IF} END; {PROCEDURE SetPortA} PROCEDURE TPPI8255.SetPortB(Mode:TModePort); {----------------------------------------------------------------------------- BUT ........... : Initialisation du port B en entrée ou en sortie ENTREE ........ : Mode = Comment doit être configuré le port B SORTIE ........ : -- EFFETS DE BORDS : La variable FModeDuPortB est initialisée à la valeur de Mode REMARQUE(S) ... : - Cette modification n'est possible que si: a) les E/S sont autorisées, soit que FCanWrite est à TRUE b) On ne configure pas le port dans un mode indéfini (on sait ce qu'on veut faire) c) Le chenillard et le pattern ne sont pas en cours d'exécution -----------------------------------------------------------------------------} VAR ValeurControle : BYTE; BEGIN {1.07 Empêche toute modification de l'état du port si le chenillard ou le pattern est en cours d'exécution IF FCanWrite AND (Mode <> mpIndefini) THEN BEGIN } IF FCanWrite AND (Mode <> mpIndefini) AND FStopChenillard AND FStopPattern THEN BEGIN {1.09 Ne reconfigure le port que si la configuration change } IF FModeDuPortB = Mode THEN Exit; FModeDuPortB := Mode; { MAJ de la propriété } {1.08 Cette lecture est interdite ! } (*ValeurControle := InPortB(FAdresseCtrl); { Valeur de contrôle actuelle } ValeurControle := Port[FAdresseCtrl]; { Valeur de contrôle actuelle } *) ValeurControle := 0; SetBitB(ValeurControle, 7); { Drapeau de mode défini: Actif } ClearBitB(ValeurControle, 6); { Passe en mode 0 pour tous les groupes } ClearBitB(ValeurControle, 5); ClearBitB(ValeurControle, 2); {1.08 Reconfigure chaque fois tous les ports} IF FModeDuPortA = mpSortie THEN ClearBitB(ValeurControle, 4) { A Sortie } ELSE SetBitB (ValeurControle, 4); { A Entree } IF FModeDuPortB = mpSortie THEN ClearBitB(ValeurControle, 1) { B Sortie } ELSE SetBitB (ValeurControle, 1); { B Entree } IF FModeDuPortC = mpSortie THEN ClearBitB(ValeurControle, 0) { C Sortie } ELSE SetBitB (ValeurControle, 0); { C Entree } IF FModeDuPortC = mpSortie THEN ClearBitB(ValeurControle, 3) { C Sortie } ELSE SetBitB (ValeurControle, 3); { C Entree } OutPortB(FAdresseCtrl, ValeurControle); { Configure correctement le 8255 } END; {IF} END; {PROCEDURE SetPortB} PROCEDURE TPPI8255.SetPortC(Mode:TModePort); {----------------------------------------------------------------------------- BUT ........... : Initialisation du port C en entrée ou en sortie ENTREE ........ : Mode = Comment doit être configuré le port C SORTIE ........ : -- EFFETS DE BORDS : La variable FModeDuPortC est initialisée à la valeur de Mode REMARQUE(S) ... : - Cette modification n'est possible que si: a) les E/S sont autorisées, soit que FCanWrite est à TRUE b) On ne configure pas le port dans un mode indéfini (on sait ce qu'on veut faire) c) Le chenillard et le pattern ne sont pas en cours d'exécution - L'initialisation de se port se fait en deux fois, car il ne s'agit pas d'un port 8 bits, mais de deux ports de 4 bits -----------------------------------------------------------------------------} VAR ValeurControle : BYTE; BEGIN {1.07 Empêche toute modification de l'état du port si le chenillard ou le pattern est en cours d'exécution IF FCanWrite AND (Mode <> mpIndefini) THEN BEGIN } IF FCanWrite AND (Mode <> mpIndefini) AND FStopChenillard AND FStopPattern THEN BEGIN {1.09 Ne reconfigure le port que si la configuration change } IF FModeDuPortC = Mode THEN Exit; FModeDuPortC := Mode; { MAJ de la propriété } {1.08 Cette lecture est interdite ! } (*ValeurControle := InPortB(FAdresseCtrl); { Valeur de contrôle actuelle } ValeurControle := Port[FAdresseCtrl]; { Valeur de contrôle actuelle } *) ValeurControle := 0; SetBitB(ValeurControle, 7); { Drapeau de mode défini: Actif } ClearBitB(ValeurControle, 6); { Passe en mode 0 pour tous les groupes } ClearBitB(ValeurControle, 5); ClearBitB(ValeurControle, 2); {1.08 Reconfigure chaque fois tous les ports} IF FModeDuPortA = mpSortie THEN ClearBitB(ValeurControle, 4) { A Sortie } ELSE SetBitB (ValeurControle, 4); { A Entree } IF FModeDuPortB = mpSortie THEN ClearBitB(ValeurControle, 1) { B Sortie } ELSE SetBitB (ValeurControle, 1); { B Entree } IF FModeDuPortC = mpSortie THEN ClearBitB(ValeurControle, 0) { C Sortie } ELSE SetBitB (ValeurControle, 0); { C Entree } IF FModeDuPortC = mpSortie THEN ClearBitB(ValeurControle, 3) { C Sortie } ELSE SetBitB (ValeurControle, 3); { C Entree } OutPortB(FAdresseCtrl, ValeurControle); { Configure correctement le 8255 } END; {IF} END; {PROCEDURE SetPortC} FUNCTION TPPI8255.LitPortA:BYTE; {----------------------------------------------------------------------------- BUT ........... : Lit la valeur actuellement présente sur le port A ENTREE ........ : -- SORTIE ........ : -- EFFETS DE BORDS : -- REMARQUE(S) ... : -- -----------------------------------------------------------------------------} BEGIN Result := InPortB(FAdressePortA) END; {FUNCTION LitPortA} PROCEDURE TPPI8255.EcritPortA(Valeur:BYTE); {----------------------------------------------------------------------------- BUT ........... : Ecrit une valeur sur le port A ENTREE ........ : -- SORTIE ........ : -- EFFETS DE BORDS : -- REMARQUE(S) ... : - L'écriture n'est possible que si a) le port est configuré en sortie b) les E/S sont permises -----------------------------------------------------------------------------} BEGIN IF FCanWrite AND (FModeDuPortA = mpSortie) THEN BEGIN OutPortB(FAdressePortA, Valeur); END; {IF} END; {PROCEDURE EcritPortA} FUNCTION TPPI8255.LitPortB:BYTE; {----------------------------------------------------------------------------- BUT ........... : Lit la valeur actuellement présente sur le port B ENTREE ........ : -- SORTIE ........ : -- EFFETS DE BORDS : -- REMARQUE(S) ... : -- -----------------------------------------------------------------------------} BEGIN Result := InPortB(FAdressePortB) END; {FUNCTION LitPortB} PROCEDURE TPPI8255.EcritPortB(Valeur:BYTE); {----------------------------------------------------------------------------- BUT ........... : Ecrit une valeur sur le port B ENTREE ........ : -- SORTIE ........ : -- EFFETS DE BORDS : -- REMARQUE(S) ... : - L'écriture n'est possible que si a) le port est configuré en sortie b) les E/S sont permises -----------------------------------------------------------------------------} BEGIN IF FCanWrite AND (FModeDuPortB = mpSortie) THEN BEGIN OutPortB(FAdressePortB, Valeur); END; {IF} END; {PROCEDURE EcritPortB} FUNCTION TPPI8255.LitPortC:BYTE; {----------------------------------------------------------------------------- BUT ........... : Lit la valeur actuellement présente sur le port C ENTREE ........ : -- SORTIE ........ : -- EFFETS DE BORDS : -- REMARQUE(S) ... : -- -----------------------------------------------------------------------------} BEGIN Result := InPortB(FAdressePortC) END; {FUNCTION LitPortC} PROCEDURE TPPI8255.EcritPortC(Valeur:BYTE); {----------------------------------------------------------------------------- BUT ........... : Ecrit une valeur sur le port C ENTREE ........ : -- SORTIE ........ : -- EFFETS DE BORDS : -- REMARQUE(S) ... : - L'écriture n'est possible que si a) le port est configuré en sortie b) les E/S sont permises -----------------------------------------------------------------------------} BEGIN IF FCanWrite AND (FModeDuPortC = mpSortie) THEN BEGIN OutPortB(FAdressePortC, Valeur); END; {IF} END; {PROCEDURE EcritPortC} {-----------------------------------------------------------------------------} { CHENILLARD ----------------------------------------------------- Chenillard } {-----------------------------------------------------------------------------} PROCEDURE TPPI8255.SetFStopChenillard(Stop:BOOLEAN); {----------------------------------------------------------------------------- BUT ........... : Arrête le Chenillard en mettant à TRUE la variable FStopChenillard ENTREE ........ : -- SORTIE ........ : -- EFFETS DE BORDS : -- REMARQUE(S) ... : -- -----------------------------------------------------------------------------} BEGIN FStopChenillard := Stop; END; {PROCEDURE SetFStopChenillard} PROCEDURE TPPI8255.SetFPortChenillard(LePort:TPort); {----------------------------------------------------------------------------- BUT ........... : Change le port utilisé par le chenillard ENTREE ........ : LePort = Le port choisi pour le chenillard SORTIE ........ : -- EFFETS DE BORDS : FPortChenillard est initialisé à la valeur de LePort REMARQUE(S) ... : - Si le chenillard est en fonction, il sera arrêté -----------------------------------------------------------------------------} BEGIN SetFStopChenillard(TRUE); { Arrête le chenillard s'il était en train de.. ..tourner } FPortChenillard := LePort; { Hissez les voiles, et virer à babord, on.. ..change de port } END; {PROCEDURE SetFPortChenillard} PROCEDURE TPPI8255.SetFDelaiChenillard(Delay:WORD); {----------------------------------------------------------------------------- BUT ........... : Fixe la vitesse du Chenillard, càd le temps qu'il faut attendre entre chaque changement d'état ENTREE ........ : Delay = Le nombre de [ms] qu'il faut attendre. Cette valeur va de 0 à 65535 (1000 = 1 seconde) SORTIE ........ : -- EFFETS DE BORDS : FDelaiChenillard est initialisé à la valeur de Delay REMARQUE(S) ... : - Si le chenillard est en fonction, il sera arrêté -----------------------------------------------------------------------------} BEGIN FDelaiChenillard := Delay; END; {PROCEDURE SetFDelaiChenillard} PROCEDURE TPPI8255.Chenillard; {----------------------------------------------------------------------------- BUT ........... : Effet de Chenillard sur un des ports ENTREE ........ : -- SORTIE ........ : -- EFFETS DE BORDS : -- REMARQUE(S) ... : - Pour arrêter le chenillard une fois qu'il est lancé, il faut mettre à TRUE la variable FStopChenillard via la propriété ChenillardStop - A chaque changement d'état du chenillard, l'événement OnChenillardBouge est déclenché -----------------------------------------------------------------------------} VAR EtatPort : BYTE; { Etat actuel du port } Sens : SHORTINT; { Sens de déplacement du bit à 1 } NoBit : SHORTINT; { No du bit qui est à 1 } BEGIN {-- Initialisations } EtatPort := 0; Sens := +1; NoBit := 0; {-- Si le test de pattern est en cours, l'arrête et quitte cette procédure } IF NOT FStopPattern THEN BEGIN { 1.09 Il n'est pas nécessaire de l'arrêter } {SetFStopPattern(TRUE);} {1.07 Quitte la procédure } Exit; END {IF} ELSE IF NOT FStopChenillard THEN BEGIN {1.07 Si le chenillard est déjà activé quitte la procédure } Exit; END; {IF} {-- Set du mode de fonctionnement des différents ports en fonction du port choisi pour le chenillard } CASE FPortChenillard OF pPortA : BEGIN SetPortA(mpSortie); SetPortB(mpEntree); SetPortC(mpEntree); EcritPortA(EtatPort); END; {BRANCH OF CASE} pPortB : BEGIN SetPortA(mpEntree); SetPortB(mpSortie); SetPortC(mpEntree); EcritPortB(EtatPort); END; {BRANCH OF CASE} pPortC : BEGIN SetPortA(mpEntree); SetPortB(mpEntree); SetPortC(mpSortie); EcritPortC(EtatPort); END; {BRANCH OF CASE} END; {CASE OF} {-- C'est parti !! pour le chenillard style K2000 } FStopChenillard := FALSE; REPEAT IF Sens > 0 THEN BEGIN { Déplacement de la LED allumée } NoBit := NoBit + 1; IF NoBit > 8 THEN BEGIN { Débordement ? } Sens := -1; { Oui, alors changement de sens } NoBit := NoBit - 2; END; {IF} END {IF} ELSE BEGIN NoBit := NoBit - 1; IF NoBit < 1 THEN BEGIN { Débordement ? } Sens := +1; { Oui, alors changement de sens } NoBit := NoBit + 2; END; {IF} END; {ELSE} {1.06 Remplace le ClearBitB par un := 0, car sinon, on affiche n'importe quoi ! } {ClearBitB(EtatPort, NoBit); { RAZ du bit } EtatPort := 0; {1.03 NoBit-1, pas NoBit, car SetBitB va de 0 à 7 et non pas de 1 à 8 } SetBitB(EtatPort, NoBit-1); { Mise à un du bit } CASE FPortChenillard OF { Sortie sur le port } pPortA : EcritPortA(EtatPort); pPortB : EcritPortB(EtatPort); pPortC : EcritPortC(EtatPort); END; {CASE OF} IF Assigned(FOnChenillardBouge) THEN BEGIN FOnChenillardBouge(Self); { Signale que ça a bougé en déclenchant.. ..l'evénement OnChenillardBouge } END; {IF} IF Delay(FDelaiChenillard) THEN BEGIN { On attend un moment... } {Il a été demandé de quitter l'application, alors on arrête ! } FStopChenillard := TRUE; END; {IF} { -- Laisse Windows faire son boulot. Cette ligne est OBLIGATOIRE, sinon on Windows ne pourra jamais prendre exécuter le code d'un contrôle qui met la variable FStopChenillard à TRUE, donc arrête le chenillard... } Application.ProcessMessages; UNTIL FStopChenillard; { On arrête ? } CASE FPortChenillard OF { Met la valeur du port à 0 } pPortA : EcritPortA(0); pPortB : EcritPortB(0); pPortC : EcritPortC(0); END; {CASE OF} IF Assigned(FOnChenillardBouge) THEN BEGIN FOnChenillardBouge(Self); { Signale que ça a bougé } END; {IF} END; {PROCEDURE Chenillard} {-----------------------------------------------------------------------------} { PATTERN ----------------------------------------------------------- Pattern } {-----------------------------------------------------------------------------} PROCEDURE TPPI8255.SetFPortsPattern(Valeur:TPortPattern); {----------------------------------------------------------------------------- BUT ........... : Choix des ports à utiliser pour le test de pattern ENTREE ........ : Valeur = les différents ports à utiliser pour le test SORTIE ........ : -- EFFETS DE BORDS : FPortsPattern est initialisé à Valeur REMARQUE(S) ... : Si le test est déjà en cours de fonctionnement, l'arrête -----------------------------------------------------------------------------} BEGIN {1.09 C'est pas le chenillard qu'il faut arrêter, mais le pattern ! } (*{ Arrête le chenillard s'il était en train de tourner } SetFStopChenillard(TRUE); *) SetFStopPattern(TRUE); { Choix des ports à utiliser pour le test de pattern } FPortsPattern := Valeur; END; {PROCEDURE SetFPortsPattern} PROCEDURE TPPI8255.SetFStopPattern(Stop:BOOLEAN); {----------------------------------------------------------------------------- BUT ........... : Arrête (peut-être) le test de transmission de Pattern ENTREE ........ : Stop = TRUE si on veut arrêter le test, sinon FALSE SORTIE ........ : -- EFFETS DE BORDS : - FStopPattern est initialisé à la valeur de Stop - Le test n'est arrêté que si FStopPattern vaut TRUE REMARQUE(S) ... : -- -----------------------------------------------------------------------------} BEGIN FStopPattern := Stop; END; {PROCEDURE SetFStopPattern} PROCEDURE TPPI8255.Pattern; {----------------------------------------------------------------------------- BUT ........... : Test de transfert de données entre deux ports ENTREE ........ : -- SORTIE ........ : -- EFFETS DE BORDS : -- REMARQUE(S) ... : - Pour arrêter le test une fois qu'il est lancé, il faut mettre à TRUE la variable FStopPattern via la propriété PatternStop - A chaque changement d'état du chenillard, l'événement OnChenillardBouge est déclenché -----------------------------------------------------------------------------} VAR NoPattern : INTEGER; { No du pattern à transmettre } LuA, LuB, LuC : BYTE; { Valeur réellement lues } MessageErr : STRING; { Message d'erreur en cas de transmission loupée } BEGIN { On ne commence pas si le chenillard ou le test de pattern sont déjà en cours d'exécution } IF NOT FStopChenillard THEN BEGIN {1.09 Il n'y a pas besoin de l'arrêter ! on ne commence pas quelque chose de nouveau, c'est tout } {SetFStopChenillard(TRUE);} {1.07 Quitte la procédure si le chenillard est en cours de fonctionnement } Exit; END {IF} ELSE IF NOT FStopPattern THEN BEGIN {1.07 Quitte la procédure si le test de pattern est déjà activé } Exit; END; {IF} { Set des ports en fonction du port choisi pour le pattern } {1.07 Nouvelles configurations possibles, en utilisant que 2 ports au lieu de trois } CASE FPortsPattern OF ppAB, ppAC, ppABC : BEGIN { A => B, A => C ou A => B et C } SetPortA(mpSortie); SetPortB(mpEntree); SetPortC(mpEntree); END; {BRANCH OF CASE} ppBA, ppBC, ppBAC : BEGIN { B => A, B => C ou B => A et C } SetPortA(mpEntree); SetPortB(mpSortie); SetPortC(mpEntree); END; {BRANCH OF CASE} ppCA, ppCB, ppCAB : BEGIN { C => A, C => B ou C => A et B } SetPortA(mpEntree); SetPortB(mpEntree); SetPortC(mpSortie); END; {BRANCH OF CASE} END; {CASE OF} FNbErrPattern := 0; { Pas encore d'erreur } FNbOkPattern := 0; FMsgErrPattern:= ''; NoPattern := 1; { Commence avec le premier pattern } LuA := 0; LuB := 0; LuC := 0; { Rien vu, rien bu, rien lu } { C'est parti !! } FStopPattern := FALSE; REPEAT CASE FPortsPattern OF ppABC : BEGIN { -------------------------------------------- A => B & C } { Ecrit une valeur } EcritPortA(patterntest[NoPattern]); { Lit ce qu'il y a sur les autres ports } LuB := LitPortB; LuC := LitPortC; IF ((patternTest[NoPattern] <> LuB) OR { Compare } (patternTest[NoPattern] <> LuC)) THEN BEGIN { IL Y A UN BOGUE !! } Inc(FNbErrPattern); { MAJ du nombre d'erreurs } { Création du message d'erreur } MessageErr := ' A('+IntToHex(patterntest[NoPattern],2)+'h)'; MessageErr := MessageErr+' -> B('+IntToHex(LuB,2)+'h)'; MessageErr := MessageErr+' & C('+IntToHex(LuC, 2) + 'h)'; FMsgErrPattern := MessageErr; IF Assigned(FOnErrorPattern) THEN BEGIN FOnErrorPattern(Self); { Notification de l'erreur } END; {IF} END {IF} ELSE BEGIN Inc(FNbOkPattern); { Transfert OK } END; {ELSE} END; {BRANCH OF CASE} ppBAC : BEGIN { Pattern B => A & C } EcritPortB(patterntest[NoPattern]); LuA := LitPortA; LuC := LitPortC; IF ((patternTest[NoPattern] <> LuA) OR (patternTest[NoPattern] <> LuC)) THEN BEGIN {-- Erreur lors du transfert } Inc(FNbErrPattern); { Une erreur de plus ... } MessageErr := ' B('+IntToHex(patterntest[NoPattern],2)+'h)'; MessageErr := MessageErr+' -> A('+IntToHex(LuA,2)+'h)'; MessageErr := MessageErr+' & C('+IntToHex(LuC, 2) + 'h)'; FMsgErrPattern := MessageErr; IF Assigned(FOnErrorPattern) THEN BEGIN FOnErrorPattern(Self); { Notification de l'erreur } END; {IF} END {IF} ELSE BEGIN {-- Transfert OK } Inc(FNbOkPattern); END; {ELSE} END; {BRANCH OF CASE} ppCAB : BEGIN { Pattern C => A & B } EcritPortC(patterntest[NoPattern]); LuA := LitPortA; LuB := LitPortB; IF ((patternTest[NoPattern] <> LuA) OR (patternTest[NoPattern] <> LuB)) THEN BEGIN {-- Erreur lors du transfert } Inc(FNbErrPattern); { Une erreur de plus ... } MessageErr := ' C('+IntToHex(patterntest[NoPattern],2)+'h)'; MessageErr := MessageErr+' -> A('+IntToHex(LuA,2)+'h)'; MessageErr := MessageErr+' & B('+IntToHex(LuB, 2) + 'h)'; FMsgErrPattern := MessageErr; IF Assigned(FOnErrorPattern) THEN BEGIN FOnErrorPattern(Self); { Notification de l'erreur } END; {IF} END {IF} ELSE BEGIN {-- Transfert OK } Inc(FNbOkPattern); END; {ELSE} END; {BRANCH OF CASE} {1.07 Nouvelles configurations possibles } ppAB : BEGIN { Pattern A => B } EcritPortA(patterntest[NoPattern]); LuB := LitPortB; IF (patternTest[NoPattern] <> LuB) THEN BEGIN {-- Erreur lors du transfert } Inc(FNbErrPattern); { Une erreur de plus ... } MessageErr := ' A('+IntToHex(patterntest[NoPattern],2)+'h)'; MessageErr := MessageErr+' -> B('+IntToHex(LuB,2)+'h)'; FMsgErrPattern := MessageErr; IF Assigned(FOnErrorPattern) THEN BEGIN FOnErrorPattern(Self); { Notification de l'erreur } END; {IF} END {IF} ELSE BEGIN {-- Transfert OK } Inc(FNbOkPattern); END; {ELSE} END; {BRANCH OF CASE} ppAC : BEGIN { Pattern A => C } EcritPortA(patterntest[NoPattern]); LuC := LitPortC; IF (patternTest[NoPattern] <> LuC) THEN BEGIN {-- Erreur lors du transfert } Inc(FNbErrPattern); { Une erreur de plus ... } MessageErr := ' A('+IntToHex(patterntest[NoPattern],2)+'h)'; MessageErr := MessageErr+' -> C('+IntToHex(LuC,2)+'h)'; FMsgErrPattern := MessageErr; IF Assigned(FOnErrorPattern) THEN BEGIN FOnErrorPattern(Self); { Notification de l'erreur } END; {IF} END {IF} ELSE BEGIN {-- Transfert OK } Inc(FNbOkPattern); END; {ELSE} END; {BRANCH OF CASE} ppBA : BEGIN { Pattern B => A } EcritPortB(patterntest[NoPattern]); LuA := LitPortA; IF (patternTest[NoPattern] <> LuA) THEN BEGIN {-- Erreur lors du transfert } Inc(FNbErrPattern); { Une erreur de plus ... } MessageErr := ' B('+IntToHex(patterntest[NoPattern],2)+'h)'; MessageErr := MessageErr+' -> A('+IntToHex(LuA,2)+'h)'; FMsgErrPattern := MessageErr; IF Assigned(FOnErrorPattern) THEN BEGIN FOnErrorPattern(Self); { Notification de l'erreur } END; {IF} END {IF} ELSE BEGIN {-- Transfert OK } Inc(FNbOkPattern); END; {ELSE} END; {BRANCH OF CASE} ppBC : BEGIN { Pattern B => C } EcritPortB(patterntest[NoPattern]); LuC := LitPortC; IF (patternTest[NoPattern] <> LuC) THEN BEGIN {-- Erreur lors du transfert } Inc(FNbErrPattern); { Une erreur de plus ... } MessageErr := ' B('+IntToHex(patterntest[NoPattern],2)+'h)'; MessageErr := MessageErr+' -> C('+IntToHex(LuC,2)+'h)'; FMsgErrPattern := MessageErr; IF Assigned(FOnErrorPattern) THEN BEGIN FOnErrorPattern(Self); { Notification de l'erreur } END; {IF} END {IF} ELSE BEGIN {-- Transfert OK } Inc(FNbOkPattern); END; {ELSE} END; {BRANCH OF CASE} ppCA : BEGIN { Pattern C => A } EcritPortC(patterntest[NoPattern]); LuA := LitPortA; IF (patternTest[NoPattern] <> LuB) THEN BEGIN {-- Erreur lors du transfert } Inc(FNbErrPattern); { Une erreur de plus ... } MessageErr := ' C('+IntToHex(patterntest[NoPattern],2)+'h)'; MessageErr := MessageErr+' -> A('+IntToHex(LuB,2)+'h)'; FMsgErrPattern := MessageErr; IF Assigned(FOnErrorPattern) THEN BEGIN FOnErrorPattern(Self); { Notification de l'erreur } END; {IF} END {IF} ELSE BEGIN {-- Transfert OK } Inc(FNbOkPattern); END; {ELSE} END; {BRANCH OF CASE} ppCB : BEGIN { Pattern C => B } EcritPortC(patterntest[NoPattern]); LuB := LitPortB; IF (patternTest[NoPattern] <> LuB) THEN BEGIN {-- Erreur lors du transfert } Inc(FNbErrPattern); { Une erreur de plus ... } MessageErr := ' C('+IntToHex(patterntest[NoPattern],2)+'h)'; MessageErr := MessageErr+' -> B('+IntToHex(LuB,2)+'h)'; FMsgErrPattern := MessageErr; IF Assigned(FOnErrorPattern) THEN BEGIN FOnErrorPattern(Self); { Notification de l'erreur } END; {IF} END {IF} ELSE BEGIN {-- Transfert OK } Inc(FNbOkPattern); END; {ELSE} END; {BRANCH OF CASE} END; {CASE OF} {-- Passe au pattern suivant } Inc(NoPattern); IF NoPattern > nbpas THEN BEGIN { Tout a été transmis, on recommence au départ } NoPattern := 1; END; {IF} { -- Laisse Windows faire son boulot. Cette ligne est OBLIGATOIRE, sinon on Windows ne pourra jamais prendre exécuter le code d'un contrôle qui met la variable FStopChenillard à TRUE, donc arrête le chenillard... } Application.ProcessMessages; IF Application.Terminated THEN BEGIN { Il a été demandé d'arrêter l'application, alors on fait ce qui a été demandé, on arrête.} FStopPattern := TRUE; END; {IF} UNTIL FStopPattern; END; {PROCEDURE Pattern} {-----------------------------------------------------------------------------} { THAT'S ALL -------------------------------------------------------- The end } {-----------------------------------------------------------------------------} INITIALIZATION END. {UNIT Vcl8255}
start/eti/carte/sources/vcl8255.txt · Last modified: 2016/07/24 01:23 by admin