{ -------------------------------------------------------------------- *
*                                                                      *
*   3333   CCCC      CCCC  OOOO  N     N  CCCC  EEEEE  PPPP  TTTTTTT   *
*       3 C         C     O    O NN    N C      E      P   P    T      *
*       3 C         C     O    O N N   N C      E      P   P    T      *
*   3333  C         C     O    O N  N  N C      EEEE   PPPP     T      *
*       3 C         C     O    O N   N N C      E      P        T      *
*       3 C         C     O    O N    NN C      E      P        T      *
*   3333   CCCC      CCCC  OOOO  N     N  CCCC  EEEEE  P        T      *
*                                                                      *
*         PROGRAMME DE DEMONSTRATION POUR MODULE TC/USB-4I             *
*                                                                      *
*                     (c)2007 3C CONCEPT S.A.                          *
*                                                                      *
* -------------------------------------------------------------------- *
*   Version     Date      Auteur  Modifs
*   1.00        15/05/06  T.B     Creation
*   1.01        04/10/06  J.T     Modifs suite mise au point sur module TC/USB-4I
*   1.02        05/10/07  D.B     Modifs gestion erreur octet recus
*   1.03        17/07/14  D.B     Transfert vers Delphi 2009
*}
unit UDemoTCUSB4I;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus, ImgList, ToolWin, ComCtrls, StdCtrls, ExtCtrls, ActnList, Buttons,
  VrControls, VrRaster, VrLcd, VrCheckLed, VrSwitch, VrNavigator, VrButtons,
  VrLeds, VrCounter, VrDisplay, VrMatrix;

{$INCLUDE TCUSB4I.INC}

type
  TFrmTest = class(TForm)
    Timer1: TTimer;
    CptPoscourant: TGroupBox;
    LblVoie1: TLabel;
    LblVoie2: TLabel;
    LblVoie3: TLabel;
    LblVoie4: TLabel;
    StaticText1: TStaticText;
    StaticText2: TStaticText;
    RazCod1: TBitBtn;
    RazCod2: TBitBtn;
    RazCod3: TBitBtn;
    RazCod4: TBitBtn;
    GBoxEtat: TGroupBox;
    LblEtatV1: TLabel;
    LblEtatV2: TLabel;
    LblEtatV3: TLabel;
    LblEtatV4: TLabel;
    VrRaster1: TVrRaster;
    Label3: TLabel;
    VrRaster2: TVrRaster;
    VrRaster3: TVrRaster;
    VrRaster4: TVrRaster;
    GBoxLatch: TGroupBox;
    EtatLed1: TVrRaster;
    Label6: TLabel;
    RAZlatchBtn: TBitBtn;
    LatchBtn: TBitBtn;
    BasetpsBox: TGroupBox;
    StaticText3: TStaticText;
    StaticText4: TStaticText;
    GroupBoxAutoManu: TGroupBox;
    AutoRefreshBtn: TBitBtn;
    RefreshBtn: TBitBtn;
    GroupBox3: TGroupBox;
    Label4: TLabel;
    Label5: TLabel;
    GroupBox1: TGroupBox;
    RadioFreq: TRadioGroup;
    GroupBox2: TGroupBox;
    BoxInhibV1: TCheckBox;
    BoxInhibV2: TCheckBox;
    BoxInhibV3: TCheckBox;
    BoxInhibV4: TCheckBox;
    GroupBoxOffset: TGroupBox;
    LblVoieO1: TLabel;
    LblVoieO2: TLabel;
    LblVoieO3: TLabel;
    LblVoieO4: TLabel;
    EditOffset1: TEdit;
    EditOffset2: TEdit;
    EditOffset3: TEdit;
    EditOffset4: TEdit;
    SpeedButton1: TSpeedButton;
    Label1: TLabel;
    Version: TLabel;
    Label2: TLabel;
    Version_lib: TLabel;
    EditCycle: TEdit;
    EditErreur: TEdit;
    ValCod1: TEdit;
    ValCod2: TEdit;
    ValCod3: TEdit;
    ValCod4: TEdit;
    LatchCod1: TEdit;
    LatchCod2: TEdit;
    LatchCod3: TEdit;
    LatchCod4: TEdit;
    ValTemps: TEdit;
    LatchTemps: TEdit;
    EtatLed: TShape;
    procedure Timer1Timer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormActivate(Sender: TObject);
    procedure LatchBtnClick(Sender: TObject);
    procedure RAZlatchBtnClick(Sender: TObject);
    procedure AutoRefreshBtnClick(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure ValidConfBtnClick(Sender: TObject);
    procedure RazCod1Click(Sender: TObject);
    procedure RazCod2Click(Sender: TObject);
    procedure RazCod3Click(Sender: TObject);
    procedure RazCod4Click(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FrmTest: TFrmTest;

implementation

uses uSetup;

var
 NumSer: PChar;
 cycle : longword;
 err   : integer;
 FLConf: Boolean;
 SerialNumber: string;
 SerialNumberN: DWord;

{$R *.DFM}

procedure Erreur(err:integer;str:string);
begin
  if err=erNoModule then
  begin
    MessageDlg('Pas de module TCUSB4I détecté', mtError, [mbOk], 0);
    Application.Terminate;
  end;
  if err=erModule then
  begin
    MessageDlg('N° de module incorrect : '+str, mtError, [mbOk], 0);
    Application.Terminate;
  end;
  if err=erNumSerie then
  begin
    MessageDlg('Numero de serie incorrect', mtError, [mbOk], 0);
    Application.Terminate;
  end;
  if err=erVoie then
  begin
    MessageDlg('N° de voie incorrect : '+str, mtError, [mbOk], 0);
    Application.Terminate;
  end;
  if err=erNbrec then
  begin
    FrmTest.Timer1.Enabled:=False;
    //MessageDlg('Erreur Lecture "Nb Octets Recus" : '+str, mtError, [mbOk], 0);
    if MessageDlg('Erreur Lecture "Nb Octets Recus" : '+str +' Quitter?',mtConfirmation, [mbYes, mbNo], 0) = mrYes then
                    begin
                    MessageDlg('Fin du prog demo TCUSB4I ', mtInformation,[mbOk], 0);
                    Application.Terminate;
                    end
    else FrmTest.Timer1.Enabled:=True;

  end;
end;

procedure TFrmTest.FormActivate(Sender: TObject);
var  i : Byte;
begin
  SerialNumber:=GetSerial;
  NumSer:=PChar(SerialNumber);
  SerialNumberN:=StrToInt64Def(SerialNumber,0);
//  i:= TCUSB4I_Open(1,NumSer);
  i:= TCUSB4I_OpenN(1,SerialNumberN);
  SerialNumber:=IntToStr(SerialNumberN);
  if i<>erNoError then Erreur(i,'Ouverture')
  else
    begin
      FrmTest.Caption:=FrmTest.Caption+' - N/S Module='+SerialNumber;
      Timer1.Enabled:=True;
    end;
end;

procedure TFrmTest.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  TCUSB4I_Close(1);
end;

procedure TFrmTest.LatchBtnClick(Sender: TObject);
begin
  TCUSB4I_Latch(1);
end;

procedure TFrmTest.RAZlatchBtnClick(Sender: TObject);
begin
  TCUSB4I_RAZLatch(1);
end;

procedure TFrmTest.AutoRefreshBtnClick(Sender: TObject);
begin
  Timer1.Enabled:=not(Timer1.Enabled);
  if Timer1.Enabled then
    begin
      RefreshBtn.Enabled:=False;
      AutoRefreshBtn.Caption:='Auto OFF';
    end
  else
    begin
      RefreshBtn.Enabled:=True;
      AutoRefreshBtn.Caption:='Auto ON';
    end;
end;

procedure TFrmTest.Timer1Timer(Sender: TObject);
var i,voie,Pos:integer;
    Latch,Etat: byte;
    VersionFW,VersionDLL:byte;
    Ans : longword;
begin
  {-------------------------- Refresh -------------------------}
  inc(cycle);
  EditCycle.text:=inttostr(cycle);
  i:=TCUSB4I_Refresh(1);
  if i>erNoError then
    begin
      inc(err);
      Erreur(i,'Refresh');
      EditErreur.text:=inttostr(err);
    end;


  {--------------------------- Temps ---------------------------}
  i:=TCUSB4I_Time(1,Ans);
  if i=erNoError then ValTemps.Text:=IntToStr(Ans) else Erreur(i,'Lecture Temps');

  {-------------------------- Voie 1 à 4 -----------------------}
  for voie:=1 to 4 do
    begin
     i:=TCUSB4I_Pos(1,voie,Pos);
     if i=erNoError then TVrMatrix(Findcomponent('ValCod'+IntToStr(voie))).Text:=IntToStr(Pos) else Erreur(i,'Lecture Voie '+inttostr(voie));
    end;

  {---------------------- Temps Latché -------------------------}
  i:=TCUSB4I_TimeLatch(1,Ans);
  if i=erNoError then LatchTemps.Text:=IntToStr(Ans) else Erreur(i,'Lecture Temps L');

  {-------------------------- Voie 1 à 4 -----------------------}
  for voie:=1 to 4 do
    begin
     i:=TCUSB4I_PosLatch(1,voie,Pos);
     if i=erNoError then TVrMatrix(Findcomponent('LatchCod'+IntToStr(voie))).Text:=IntToStr(Pos) else Erreur(i,'Lecture Voie '+inttostr(voie)+' Latch');
    end;

  {------------------------ Etat Latch -------------------------}
  i:=TCUSB4I_InputLE(1,Latch);
  if i=erNoError then
    if Latch=1 then
      EtatLed.brush.Color:=clLime  //vert clair
      //EtatLed.Items[0].active:=TRUE
    else
      EtatLed.brush.Color:=clGreen //vert foncé
      //EtatLed.Items[0].active:=FALSE
  else Erreur(i,'Lecture Latch');

  {----------------------- Status Voie 1 à 4 -----------------------}
  for voie:=1 to 4 do
    begin
     i:=TCUSB4I_Status(1,voie,Etat);
     if i=erNoError then
       begin
         with TVrRaster(FindComponent('VrRaster'+IntToStr(voie))) do
           for i:=0 to 3 do
             if Etat and (1 shl i)<>0 then Items[3-i].Active := TRUE else Items[3-i].Active := FALSE;
       end
     else Erreur(i,'Lecture Status Voie '+IntToStr(voie));
    end;

  {------------------------ Version Firmware Module -------------------------}
  i:=TCUSB4I_Version(1,VersionFW,VersionDLL);
  if i=erNoError then
     begin
          Version.Caption:=IntToStr(VersionFW);
          Version_lib.Caption:=IntToStr(VersionDLL);
     end
  else Erreur(i,'Lecture Version');

  {------------------------ Etat configuration du Module -------------------------}
  i:=TCUSB4I_GetConfig(1,Etat);
  if i=erNoError then
    begin
      FLConf:=True;
      for i:=1 to 4 do
        if Etat and (1 shl (i-1))<>0 then TCheckBox(FindComponent('BoxInhibV'+IntToStr(i))).Checked:=True
                                     else TCheckBox(FindComponent('BoxInhibV'+IntToStr(i))).Checked:=False;
      Etat:=((Etat shr 4) and $0F);
      for i:=0 to 3 do
        if Etat and (1 shl i)<>0 then RadioFreq.ItemIndex:=i;
      FLConf:=False;
    end
  else Erreur(i,'Lecture Config');
end;

procedure TFrmTest.ValidConfBtnClick(Sender: TObject);
var i: integer;
    err,x : Byte;
    Off : integer;
begin
  if Not(FLConf) then
    begin
      for i:=1 to 4 do
        begin
          Off:=StrToInt(TEdit(FindComponent('EditOffset'+IntToStr(i))).Text);
          err:=TCUSB4I_SetPos(1,i,Off);
        end;
      if err>0 then Erreur(err,'Offset');
      x:=1 shl RadioFreq.ItemIndex;
      TCUSB4I_FreqNum(1,x);
      x:=0;
      for i:=1 to 4 do
        if TCheckBox(FindComponent('BoxInhibV'+IntToStr(i))).checked then x:=x+(1 shl (i-1));
      TCUSB4I_setREF(1,x);
    end;
end;

procedure TFrmTest.SpeedButton1Click(Sender: TObject);
var j,loop,fault: longint;
    i: integer;
begin
  timer1.enabled:=false;
  AutoRefreshBtn.Caption:='Auto ON';
  loop:=0;
  fault:=0;
  for j:=0 to 20000 do
    begin
        i:=TCUSB4I_Refresh(1);
        if i=erNoError then inc(loop)
        else
        begin
           inc(fault);
           break;
        end;
    end;
 EditCycle.text:=inttostr(loop);
 EditErreur.text:=inttostr(fault);
end;

procedure TFrmTest.RazCod1Click(Sender: TObject);
begin
  TCUSB4I_RAZPos(1,1);
end;

procedure TFrmTest.RazCod2Click(Sender: TObject);
begin
  TCUSB4I_RAZPos(1,2);
end;

procedure TFrmTest.RazCod3Click(Sender: TObject);
begin
  TCUSB4I_RAZPos(1,4);
end;

procedure TFrmTest.RazCod4Click(Sender: TObject);
begin
  TCUSB4I_RAZPos(1,8);
end;

end.
