unit FicheTest;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, Buttons, ImpCANLib;

type
  TFichePr = class(TForm)
    Label1: TLabel;
    EditBTR0: TEdit;
    BtnConnect: TBitBtn;
    BtnSendCAN: TBitBtn;
    Bevel1: TBevel;
    Label2: TLabel;
    Label3: TLabel;
    EditData1: TEdit;
    MemoTrace: TMemo;
    EditData2: TEdit;
    EditData3: TEdit;
    EditData4: TEdit;
    EditData5: TEdit;
    EditData6: TEdit;
    EditData7: TEdit;
    EditData8: TEdit;
    EditID: TEdit;
    CheckRTR: TCheckBox;
    Label4: TLabel;
    Label5: TLabel;
    EditDLC: TEdit;
    Label6: TLabel;
    Label7: TLabel;
    EditBTR1: TEdit;
    EditAM: TEdit;
    EditAC: TEdit;
    Label8: TLabel;
    Bevel2: TBevel;
    Bevel3: TBevel;
    Bevel4: TBevel;
    Bevel5: TBevel;
    Bevel6: TBevel;
    Bevel7: TBevel;
    Label9: TLabel;
    InfoBusOff: TLabel;
    Label11: TLabel;
    Label12: TLabel;
    Label13: TLabel;
    Label14: TLabel;
    InfoCANErr: TLabel;
    InfoCANOvr: TLabel;
    BtnHelp: TBitBtn;
    Timer1: TTimer;
    BtnAbort: TBitBtn;
    Function AfficheErreur (IndexErr : Integer; ZoneErr : PChar; TypeMB : Longint) : Integer;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure BtnConnectClick(Sender: TObject);
    procedure BtnSendCANClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure BtnAbortClick(Sender: TObject);
    procedure BtnHelpClick(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
    OldEtat : Word;
    LigneTrace : Integer;
  end;

var
  FichePr: TFichePr;

implementation

{$R *.DFM}

Const
  (* Messages d'erreur *)
  MessErr_DriverRunning = 'Driver is already running';
  MessErr_DriverStopped = 'Driver is not running';
  MessErr_IOLibNotFound = 'Hardware library not found';
  MessErr_CANBoardNotFound = 'CAN adapter not found';
  MessErr_CANActive = 'CAN chip is already active';
  MessErr_CANInactive = 'CAN chip is already in Reset state';
  MessErr_WinRessource = 'Not enough Windows ressources';
  MessErr_RXQueueOverflow = 'RX Queue overflow';
  MessErr_TXQueueOverflow = 'TX Queue overflow';
  MessErr_HWLibNotFound = 'Hardware driver not found';
  MessErr_HWDriverIsOpen = 'Hardware driver is already open';
  MessErr_HWDriverIsClosed = 'Hardware driver is already closed';
  MessErr_BadINIFile = 'Missing or bad configuration file. Starting with default parameters ?';
  MessErr_Unknown = 'Unknown error! Please report it to my developper.';

  NomINI = 'CANTEST.INI';

  MaxLigneTrace = 200;

Function TFichePr.AfficheErreur;

Var
  ChaineErr : String;

Begin
  Str (IndexErr, ChaineErr);
  ChaineErr:=ChaineErr+' : ';
  Case IndexErr of
    -1 : ChaineErr:=ChaineErr+MessErr_DriverRunning;
    -2 : ChaineErr:=ChaineErr+MessErr_DriverStopped;
    -3 : ChaineErr:=ChaineErr+MessErr_IOLibNotFound;
    -4 : ChaineErr:=ChaineErr+MessErr_CANBoardNotFound;
    -5 : ChaineErr:=ChaineErr+MessErr_CANActive;
    -6 : ChaineErr:=ChaineErr+MessErr_CANInactive;
    -7 : ChaineErr:=ChaineErr+MessErr_WinRessource;
    -8 : ChaineErr:=ChaineErr+MessErr_RXQueueOverflow;
    -9 : ChaineErr:=ChaineErr+MessErr_TXQueueOverflow;
    -10 : ChaineErr:=ChaineErr+MessErr_HWLibNotFound;
    -11 : ChaineErr:=ChaineErr+MessErr_HWDriverIsOpen;
    -12 : ChaineErr:=ChaineErr+MessErr_HWDriverIsClosed;
    -13 : ChaineErr:=ChaineErr+MessErr_BadINIFile;
    Else ChaineErr:=ChaineErr+MessErr_Unknown;
  End;
  ChaineErr:=ChaineErr+#0;
  AfficheErreur:=Application.MessageBox (@ChaineErr[1], ZoneErr, TypeMB);
End;

(* ------------------------------------------------------------------------- *)

procedure TFichePr.FormCreate(Sender: TObject);

Const
  ChaineDefaut : PChar = '';
  AdresseBaseDef = $300;
  DriverDef : PChar = 'DIRECT95.DLL';
  LocateErr : PChar = 'Starting app';

Var
  DriverAZT : Array [0..80] of Char;
  AdresseBase : Word;  (* Configuration lue pour la carte CAN *)
  Result : Integer;
  FichierINI : String;

begin
  GetDir(0, FichierINI);
  FichierINI:=FichierINI+'\'+NomINI+#0;
  (* Recherche fichier de paramètres *)
  GetPrivateProfileString ('Config', 'DriverName', @ChaineDefaut, @DriverAZT,
                          SizeOf(DriverAZT)-1, @FichierINI[1]);
  AdresseBase:=GetPrivateProfileInt ('Config', 'BasePort', 0, @FichierINI[1]);

  (* Indication si défaut *)
  If (AdresseBase=0) or (StrPas(DriverAZT)='') then begin
    If AfficheErreur (-13, LocateErr, mb_YesNo+mb_IconQuestion)=idNo then begin
      Application.Terminate;
      Exit;
    End
    Else begin
      AdresseBase:=AdresseBaseDef;
      StrCopy (DriverAZT, DriverDef);
    End;
  End;

  (* Initialisation des variables *)
  OldEtat:=0;
  LigneTrace:=0;

  (* Lancement du driver *)
  Result:=OpenDriver(AdresseBase, DriverAZT);
  If (Result<>0) then begin
    AfficheErreur (Result, LocateErr, mb_Ok);
    If (Result<>-4) then Application.Terminate else BtnConnect.Enabled:=False;
    Exit;
  End;
end;  (* Fin de la méthode Create *)

(* ------------------------------------------------------------------------- *)

procedure TFichePr.FormDestroy(Sender: TObject);
begin
  CloseDriver;
end;  (* Fin de la méthode Destroy *)

(* ------------------------------------------------------------------------- *)

procedure TFichePr.BtnConnectClick(Sender: TObject);
Var
  ValeurAC, ValeurAM, ValeurBT0, ValeurBT1 : Word;
  Result : Integer;
begin
  (* CAN non actif -> on connecte *)
  If (GetCANStatus and $100)=0 then begin
    (* Lecture de la configuration courante et envoi vers le driver *)
    ValeurAC:=StrToIntDef('$'+EditAC.Text, $FF);
    ValeurAM:=StrToIntDef('$'+EditAM.Text, $FF);
    ValeurBT0:=StrToIntDef('$'+EditBTR0.Text, $47);
    ValeurBT1:=StrToIntDef('$'+EditBTR1.Text, $2F);

    ValeurAC:=(ValeurAC shl 8)+ValeurAM;
    ValeurBT0:=(ValeurBT0 shl 8)+ValeurBT1;

    SetCANFilter(ValeurAC);
    SetCANTiming(ValeurBT0);

    Result:=StartCAN;
    If Result<>0 then begin  (* Lancement CAN loupé *)
      AfficheErreur (Result, 'StartCAN', mb_Ok);
    End
    Else begin  (* Lancement CAN réussi *)
      (* Inhibition cases Edit AC, AM, BTR *)
      EditBTR0.Enabled:=False;
      EditBTR1.Enabled:=False;
      EditAC.Enabled:=False;
      EditAM.Enabled:=False;
      (* Validation des touches émission CAN *)
      BtnSendCAN.Enabled:=True;
      BtnAbort.Enabled:=True;
      (* Mise à jour bouton connect *)
      BtnConnect.Caption:='Disconnect CAN';
      (* Effacement fenetre trace et jnit compteur *)
      MemoTrace.Lines.Clear;
      LigneTrace:=0;
    End;
  End
  Else begin  (* Sinon on déconnecte *)
    Result:=StopCAN;
    If Result<>0 then begin  (* Arrêt CAN loupé *)
      AfficheErreur (Result, 'StopCAN', mb_Ok);
    End
    Else begin  (* Arrêt CAN réussi *)
      (* Validation cases Edit AC, AM, BTR *)
      EditBTR0.Enabled:=True;
      EditBTR1.Enabled:=True;
      EditAC.Enabled:=True;
      EditAM.Enabled:=True;
      (* Inhibition des touches émission CAN *)
      BtnSendCAN.Enabled:=False;
      BtnAbort.Enabled:=False;
      (* Mise à jour bouton connect *)
      BtnConnect.Caption:='Connect CAN';
    End;
  End;
end;  (* Fin de la méthode BtnActivateClick *)

(* ------------------------------------------------------------------------- *)

procedure TFichePr.BtnSendCANClick(Sender: TObject);
Var
  MessageCAN : TMessageCAN;
  Result : Integer;
  AdrCAN : Integer;
  DLC : Integer;
begin
  With MessageCAN do begin
    (* Traitement spécifique ID *)
    AdrCAN:=StrToIntDef ('$'+EditID.Text, 0);
    If (AdrCAN>2047) then AdrCAN:=2047;
    If (AdrCAN<0) then AdrCAN:=0;
    EditID.Text:=IntToHex(AdrCAN, 3);

    (* Traitement spécifique DLC *)
    DLC:=StrToIntDef (EditDLC.Text, 0);
    If (DLC>8) then DLC:=8;
    If (DLC<0) then DLC:=0;
    EditDLC.Text:=IntToStr(DLC);

    Descripteur:=DLC;
    If CheckRTR.Checked then Descripteur:=Descripteur or $10;
    Descripteur:=Descripteur or (AdrCAN shl 5);

    Donnees[1]:=StrToIntDef('$'+EditData1.Text, 0);
    Donnees[2]:=StrToIntDef('$'+EditData2.Text, 0);
    Donnees[3]:=StrToIntDef('$'+EditData3.Text, 0);
    Donnees[4]:=StrToIntDef('$'+EditData4.Text, 0);
    Donnees[5]:=StrToIntDef('$'+EditData5.Text, 0);
    Donnees[6]:=StrToIntDef('$'+EditData6.Text, 0);
    Donnees[7]:=StrToIntDef('$'+EditData7.Text, 0);
    Donnees[8]:=StrToIntDef('$'+EditData8.Text, 0);
  End;

  (* Demande transfert *)
  Result:=SendCANMessage (@MessageCAN, 0);
  If Result<>0 then AfficheErreur(Result, 'Send CAN', mb_Ok);
end;  (* Fin de la méthode SendCAN *)

(* ------------------------------------------------------------------------- *)

procedure TFichePr.Timer1Timer(Sender: TObject);

Const
  ChaineOver = '**** Receive Queue Overflow ! ****';

Var
  Etat : Word;
  MessageCAN : TMessageCAN;
  I, Result : Integer;
  ID, DLC : Word;
  ChaineDecode : String;

Procedure GereBoucleTrace;
(* Incremente le compteur de lignes et efface la 1° ligne pour éviter le remplissage *)
Begin
  Inc (LigneTrace);
  If (LigneTrace>MaxLigneTrace) then begin
    MemoTrace.Lines.Delete(0);
  End;
  MemoTrace.Lines.Add(ChaineDecode);
End;

begin
  (* Affiche marqueurs inférieurs *)
  Etat:=GetCANStatus;
  If Etat<>OldEtat then begin
    OldEtat:=Etat;
    If (Etat and $80)<>0 then InfoBusOff.Color:=clBlack else InfoBusOff.Color:=clBtnFace;
    If (Etat and $40)<>0 then InfoCANErr.Color:=clBlack else InfoCANErr.Color:=clBtnFace;
    If (Etat and $02)<>0 then InfoCANOvr.Color:=clBlack else InfoCANOvr.Color:=clBtnFace;
  End;

  (* Affiche messages reçus *)
  Result:=GetCANMessage(@MessageCAN);
  If ((Result=1) or (Result=Err_RXQueueOverflow)) then begin
    Repeat
      (* Affichage saturation file si nécessaire *)
      If (Result=Err_RXQueueOverflow) then begin
        ChaineDecode:=ChaineOver;
        GereBoucleTrace;
      End;

      (* Affichage contenu du message *)
      ID:=MessageCAN.Descripteur shr 5;
      ChaineDecode:=IntToHex(ID, 3)+'  ';

      If (MessageCAN.descripteur and $10)<>0 then ChaineDecode:=ChaineDecode+'1  '
      Else ChaineDecode:=ChaineDecode+'0  ';

      DLC:=MessageCAN.Descripteur and $F;
      If (DLC>8) then DLC:=8;
      ChaineDecode:=ChaineDecode+IntToStr(DLC)+'  ';

      (* Affichage données *)
      If (DLC<>0) then begin
        (* Hexa *)
        For I:=1 to DLC do begin
          ChaineDecode:=ChaineDecode+IntToHex(MessageCAN.Donnees[I], 2)+' ';
        End;

        (* Ajoute espaces de bourrage *)
        While (Length(ChaineDecode)<37) do ChaineDecode:=ChaineDecode+#32;

        (* ASCII *)
        For I:=1 to DLC do begin
          If (MessageCAN.Donnees[I] in [32..126]) then
           ChaineDecode:=ChaineDecode+Chr(MessageCAN.Donnees[I])
          Else ChaineDecode:=ChaineDecode+'.';
        End;
      End;
      GereBoucleTrace;

      (* Vérifie nouveau message disponible *)
      Result:=GetCANMessage(@MessageCAN);
    Until ((Result<>1) and (Result<>Err_RXQueueOverflow));
  End;
end;  (* Fin de la méthode Timer *)

(* ------------------------------------------------------------------------- *)

procedure TFichePr.BtnAbortClick(Sender: TObject);
Var
  Result : Integer;
begin
  Result:=AbortCANTransmission;
  If Result<>0 then AfficheErreur(Result, 'Abort XMIT', mb_Ok);
end;  (* Fin de la méthode AbortCAN *)

(* ------------------------------------------------------------------------- *)

procedure TFichePr.BtnHelpClick(Sender: TObject);
begin
  Application.MessageBox('PC-CAN board'+#13+#10+'Test application V1.01'+#13+#10
   +'Driver PCANLIB.DLL V1.03'+#13+#10+#13+#10+'(c) B.BOUCHEZ 1999', 'About PC-CAN...', mb_Ok+mb_IconInformation);
end;

end.