UNIT Uecrit; {----------------------------------------------------------------------------- NOM DE L'UNITE : UECRIT.PAS BUT : Ecrit une valeur 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 - Affichage des valeurs en binaire - Regroupé l'affichage des valeurs dans une seule procédure - Réassignation de la procédure Ecrit aux boutons bitbtnEcritB et bitbtnEcritC (oui, ça c'est un bogue qui vient d'être corrigé) MODIFIE LE : RAISON : REMARQUES : -----------------------------------------------------------------------------} {=============================================================================} INTERFACE {============================================== I N T E R F A C E } {=============================================================================} USES SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, DigDisp, StdCtrls, Buttons; TYPE TfrmEcrire = CLASS(TForm) digdspTitre: TDigitalDisplay; bitbtnOK: TBitBtn; bitbtnAide: TBitBtn; grpbxPortA: TGroupBox; bitbtnEcritA: TBitBtn; scrlbarA: TScrollBar; lblDecimalA: TLabel; lblHexadecimalA: TLabel; grpbxPortB: TGroupBox; lblDecimalB: TLabel; lblHexadecimalB: TLabel; bitbtnEcritB: TBitBtn; scrlbarB: TScrollBar; grpbxPortC: TGroupBox; lblDecimalC: TLabel; lblHexadecimalC: TLabel; bitbtnEcritC: TBitBtn; scrlbarC: TScrollBar; lblValeurA: TLabel; lblValeurB: TLabel; lblValeurC: TLabel; lblBinaireA: TLabel; lblBinaireB: TLabel; lblBinaireC: TLabel; PROCEDURE ChangeValeur(Sender: TObject); PROCEDURE FormActivate(Sender: TObject); PROCEDURE Ecrit(Sender: TObject); PRIVATE { Private-déclarations } PUBLIC { Public-déclarations } PROCEDURE AfficheValeur(Sender: TObject; LePort:CHAR); END; {CLASS} VAR frmEcrire: TfrmEcrire; {=============================================================================} IMPLEMENTATION {================================= I M P L E M E N A T I O N } {=============================================================================} {$R *.DFM} USES UPrincpl, Vcl8255; PROCEDURE TfrmEcrire.AfficheValeur(Sender: TObject; LePort:CHAR); {----------------------------------------------------------------------------- BUT ........... : Initialisation de la fiche en fonction des paramètres actuels du programme ENTREE ........ : LePort = Port à traiter SORTIE ........ : -- EFFETS DE BORDS : -- REMARQUE(S) ... : Cette procédure a été crée lors de l'EDT:01 -----------------------------------------------------------------------------} VAR ValHexa : STRING[2]; { Valeur hexa affichée } ValBin : STRING; { Valeur binaire affichée } FUNCTION HexBin(Hexa:STRING):STRING; {----------------------------------------------------------------------------- BUT ........... : Conversion en binaire d'uu nombre hexadécimal ENTREE ........ : Hexa = valeur hexadécimale sur 2 digits SORTIE ........ : La valeur en binaire sous la forme 0010'0101 EFFETS DE BORDS : -- REMARQUE(S) ... : Cette procédure a été crée lors de l'EDT:01 -----------------------------------------------------------------------------} CONST valbin : ARRAY [0..$F] OF STRING = ('0000', '0001', '0010', '0011', '0100', '0101', '0110', '0111', '1000', '1001', '1010', '1011', '1100', '1101', '1110', '1111'); VAR Valeur, Erreur : INTEGER; BEGIN {FUNCTION HexBin} Val('$' + Hexa[1], Valeur, Erreur); { Conversion quartet haut } Result := valbin[Valeur]; Result := Result + ''''; Val('$' + Hexa[2], Valeur, Erreur); { Conversion quartet bas } Result := Result + valbin[Valeur]; END; {FUNCTION HexBin} BEGIN {PROCEDURE AfficheValeur} CASE LePort OF 'A' : BEGIN lblDecimalA.Caption := IntToStr(scrlbarA.Position); ValHexa := IntToHex(scrlbarA.Position,2); lblHexadecimalA.Caption := ValHexa + ' h'; ValBin := HexBin(ValHexa); lblBinaireA.Caption := ValBin + ' b'; END; {BRANCH OF CASE} 'B' : BEGIN lblDecimalB.Caption := IntToStr(scrlbarB.Position); ValHexa := IntToHex(scrlbarB.Position,2); lblHexadecimalB.Caption := ValHexa + ' h'; ValBin := HexBin(ValHexa); lblBinaireB.Caption := ValBin + ' b'; END; {BRANCH OF CASE} 'C' : BEGIN lblDecimalC.Caption := IntToStr(scrlbarC.Position); ValHexa := IntToHex(scrlbarC.Position,2); lblHexadecimalC.Caption := ValHexa + ' h'; ValBin := HexBin(ValHexa); lblBinaireC.Caption := ValBin + ' b'; END; {BRANCH OF CASE} END; {CASE OF} END; {PROCEDURE AfficheValeur} PROCEDURE TfrmEcrire.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; scrlbarA.ShowHint := affichehint; { Affichage des Hints } bitbtnEcritA.ShowHint := affichehint; scrlbarB.ShowHint := affichehint; bitbtnEcritB.ShowHint := affichehint; scrlbarC.ShowHint := affichehint; bitbtnEcritC.ShowHint := affichehint; AfficheValeur(Sender, 'A'); { MAJ des dernières valeurs écrites } AfficheValeur(Sender, 'B'); AfficheValeur(Sender, 'C'); END; {PROCEDURE FormActivate} PROCEDURE TfrmEcrire.ChangeValeur(Sender: TObject); {----------------------------------------------------------------------------- BUT ........... : Change une valeur à écrire sur un des ports, et la converti en héxa ENTREE ........ : -- SORTIE ........ : -- EFFETS DE BORDS : -- REMARQUE(S) ... : -- -----------------------------------------------------------------------------} BEGIN (*EDT:01 Simplifié l'affichage des valeurs CASE (Sender AS TScrollBar).Tag OF 1 : BEGIN lblDecimalA.Caption := IntToStr(scrlbarA.Position); lblHexadecimalA.Caption := IntToHex(scrlbarA.Position,2)+'h'; END; {BRANCH OF CASE} 2 : BEGIN lblDecimalB.Caption := IntToStr(scrlbarB.Position); lblHexadecimalB.Caption := IntToHex(scrlbarB.Position,2)+'h'; END; {BRANCH OF CASE} 3 : BEGIN lblDecimalC.Caption := IntToStr(scrlbarC.Position); lblHexadecimalC.Caption := IntToHex(scrlbarC.Position,2)+'h'; END; {BRANCH OF CASE} END; {CASE OF} *) AfficheValeur(Sender, Chr(64 + ((Sender AS TScrollBar).Tag))); END; {PROCEDURE ChangeValeur} PROCEDURE TfrmEcrire.Ecrit(Sender: TObject); {----------------------------------------------------------------------------- BUT ........... : Ecrit une valeur sur un des ports ENTREE ........ : -- SORTIE ........ : -- EFFETS DE BORDS : -- REMARQUE(S) ... : Le port est configuré en sortie juste avant l'écriture -----------------------------------------------------------------------------} BEGIN IF NOT debugmode THEN BEGIN CASE (Sender AS TBitBtn).Tag OF 1 : BEGIN frmMain.PPI8255.ModePortA := mpSortie; frmMain.PPI8255.PortA := scrlbarA.Position; END; {BRANCH OF CASE} 2 : BEGIN frmMain.PPI8255.ModePortB := mpSortie; frmMain.PPI8255.PortB := scrlbarB.Position; END; {BRANCH OF CASE} 3 : BEGIN frmMain.PPI8255.ModePortC := mpSortie; frmMain.PPI8255.PortC := scrlbarC.Position; END; {BRANCH OF CASE} END; {CASE OF} END; {IF} END; {PROCEDURE Ecrit} {=============================================================================} { INITIALISATIONS ------------------------------------------- Initialisations } {=============================================================================} INITIALIZATION END. {UNIT Uecrit}