unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    StartAddr: TEdit;
    Label2: TLabel;
    Button1: TButton;
    Button2: TButton;
    Label4: TLabel;
    ComComboBox: TComboBox;
    Label1: TLabel;
    Label3: TLabel;
    EndAddr: TEdit;
    Timer1: TTimer;
    lbCmd: TListBox;
    lbErr: TListBox;
    Label5: TLabel;
    lTtlLoops: TLabel;
    Label6: TLabel;
    lErrCnts: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
    Procedure Opencom ;
    procedure Read7012(i :integer);
    procedure lbCmdAdd(s : String);
    procedure lbErrAdd(s : String);
    procedure lbErrAdd2(s : String);
    Function  GetNS(NS :PChar):String;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

Uses I7000,I7000u;

Var
   bComOpen       : Boolean ;
   iRtn           : Integer;
   bProcessing    : Boolean;
   iLoopCnt       : LongInt;
   iTCnt1, iTCnt2 : LongInt;

{$R *.DFM}

procedure TForm1.Button2Click(Sender: TObject);
begin
     if bComOpen then
        Close_Com( gcPort );
     Close;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
     ComComboBox.ItemIndex       := 0;
     gcDataBit       := Char(8);      // 8 data bit
     gcParity        := Char(0);      // Non Parity
     gcStopBit       := Char(0);      // 0: One Stop Bit
     bCOMOpen        := False;
     gszSend         := StrAlloc( 100 );
     gszReceive      := StrAlloc( 100 );
     Timer1.Enabled  := False;
     Timer1.Interval := 200;
     iLoopCnt        := 0;
end;

Procedure TForm1.OpenCom;
Var
   iRet , iConfirm : Integer ;

Begin
     gcPort := Char(ComComboBox.ItemIndex + 1 );      // Setting Com Port
     gdwBaudRate := 9600;

    iRet := Open_Com(gcPort, gdwBaudRate, gcDataBit, gcParity, gcStopBit);
    If iRet > 0 Then
    Begin
        Beep;
        iConfirm := MessageDlg('OPEN_COM Error Code:' + IntToStr(iRet) + #13 + IGetErrorString(iRet) + #13 + 'Quit this demo?'
                               , mtConfirmation , [mbYes,mbNo] , 0 );
        If iConfirm = mrYes Then
           Close;
    End
    else
    begin
        bCOMOpen := True;
    end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
     if Button1.Caption = 'Stop' then
     begin
         Timer1.Enabled := False;
         Button1.Caption := 'Active';
         Button2.Enabled := True;
         Exit;
     end;

     Button1.Caption := 'Stop';
     Button2.Enabled := False;
     iTCnt1 := 0; iTCnt2 := 0;
     iLoopCnt := 0;
     lTtlLoops.Caption := '0';
     lErrCnts.Caption := '0';
     lbCmd.Items.Clear;
     lbErr.Items.Clear;

     if bComOpen then  // Reopen Com port
     begin
        Close_Com(gcPort);
        bComOpen := False;
     end;
     OpenCom;

     if bComOpen then
          Timer1.Enabled := True;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
     StrDispose(gszSend);
     StrDispose(gszReceive);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
   iStart, iEnd, i : integer;
begin
     if bProcessing = True then          //avoid to reenter this function
        exit
     else
        bProcessing := True;

     Application.ProcessMessages;
     Inc( iLoopCnt );
     lTtlLoops.Caption := IntToStr( iLoopCnt );
     lbCmdAdd('');
     lbCmdAdd('=========== Loop:' + IntToStr(iLoopCnt));
     //lbErrAdd('');
     //lbErrAdd('=========== Loop:' + IntToStr(iLoopCnt));
     //gszSend := '#**' + #13 ;
     StrCopy( gszSend ,'#**') ;                    //Send the synchronise command
     iRtn := Send_Cmd(gcPort, gszSend, 100, 0);
     if iRtn <> NoError then
        lbErrAdd2('Send Cmd:#**   ==> ErrorCode:' + IntToStr(iRtn) )
     else
        lbCmdAdd('Send Cmd:#** ' );

     sleep(200);                           //Sleep 200 mSeconds( 0.2 seconds )
     iStart := StrToInt('$' + StartAddr.Text);
     iEnd := StrToInt('$' + EndAddr.Text);
     for i := iStart to iEnd do
     begin
         Read7012( i );
         Application.ProcessMessages;
         if Button1.Caption = 'Active' then
         begin
            bProcessing := False;
            Exit;
         end;
     end;

     bProcessing := False;
end;

procedure TForm1.Read7012(i :integer);
Var
     sAddr : String;
     //RR    : String;
     //R2    : String;
     wT    : Word;
begin
     Application.ProcessMessages;
     sAddr := IntToHex(i,2);
     StrCopy( gszSend , PChar('$' + sAddr + '4' )) ;             //Read the synchronise value

     //Clear the buffer for debug
     //R2 := 'ABCDEFGHIJKL';
     //RR := Copy(R2,1, 12);
     //gszReceive := PChar(RR);
     StrCopy( gszReceive, '' );

     iRtn := Send_Receive_Cmd(gcPort, gszSend, gszReceive, 200, 0, wT);
     if iRtn = NoError then
         if Copy( gszReceive ,4, 1 ) <> '1' then
             //lbErrAdd2( '$' + sAddr + '4  ==> ' + String(gszReceive) + '  ==>S<>1:NotFirstReading')
             // ********** Module Address ******* Receive String by hex ********* Loop Counters **********
             lbErrAdd2( '$' + sAddr + '4  ==> ' + GetNS(gszReceive) + '  ==>LoopCnt:' + lTtlLoops.Caption )
         else
            lbCmdAdd( '$' + sAddr + '4  ==> ' + String(gszReceive) )
     else
        //lbErrAdd2( '$' + sAddr + '4  ==> ' + String(gszReceive) + '  ==> ErrCode:' + IntToStr(iRtn) );
        // ********** Module Address ***** Receive String by hex ************ Error Code ************* Loop Counters *******
        lbErrAdd2( '$' + sAddr + '4  ==> ' + GetNS(gszReceive) + ' =>ErrCd:' + IntToStr(iRtn) + ' =>LpCnt:' + lTtlLoops.Caption );
end;

//Add string into Command ListBox
procedure TForm1.lbCmdAdd(s : String);
begin
     Inc(iTCnt1);
     if iTcnt1 > 400 then
     begin
        iTCnt1 := 1;
        lbCmd.Items.Clear;
     end;

     lbCmd.Items.Add( s );
end;

//Add string into Error ListBox
procedure TForm1.lbErrAdd(s : String);
begin
     Inc(iTCnt2);
     if iTcnt2 > 400 then
     begin
        iTCnt2 := 1;
        lbErr.Items.Clear;
     end;

     lbErr.Items.Add( s );
end;

//increase the Error Counter
procedure TForm1.lbErrAdd2(s : String);
begin
     lErrCnts.Caption := IntToStr(StrToInt(lErrCnts.Caption) + 1);
     lbErrAdd( s );
end;

//convert the string to hex value's string
Function TForm1.GetNS(NS :PChar):String;
var
   i : integer;
   AStr : String;
   AChar : Char;
begin
   AStr := '';
   for i := 0 to 12 do
   begin
        AChar := NS[i];
        AStr := AStr + IntToHex(Ord(AChar),2);
   end;
   result := AStr ;
end;

end.
