unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    eCOMPort: TEdit;
    Label1: TLabel;
    e1: TEdit;
    e2: TEdit;
    e3: TEdit;
    eLoadCell: TEdit;
    eAD: TEdit;
    eDA: TEdit;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Shape1: TShape;
    Shape2: TShape;
    Shape3: TShape;
    Shape4: TShape;
    Shape5: TShape;
    Shape6: TShape;
    Shape7: TShape;
    Shape8: TShape;
    Shape9: TShape;
    Do01: TShape;
    Do02: TShape;
    Do03: TShape;
    Do04: TShape;
    Do05: TShape;
    Do11: TShape;
    Do12: TShape;
    Do13: TShape;
    Do14: TShape;
    Label8: TLabel;
    Label9: TLabel;
    List1: TListBox;
    lDemo1: TLabel;
    lDemo2: TLabel;
    Timer1: TTimer;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormDblClick(Sender: TObject);
    procedure lDemo1Click(Sender: TObject);
    procedure lDemo2Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
    procedure NAP7000Error(lErrorCode: Integer);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses I7000, I7000u;
Var
   wTaskNo : Integer;
   ErrCnt  : LongInt;
   bProcessing: Boolean;
   wRtn    : Integer;
   wt      : Word;

{$R *.DFM}

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

procedure TForm1.Button1Click(Sender: TObject);
begin
     Close;
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
    gszSend := StrAlloc( 80 );
    gszReceive := StrAlloc( 80 );
    Button2.Caption    := 'Active';
    Timer1.Enabled     := False;
    Timer1.Interval    := 1000;
    ErrCnt             := 0;
    bProcessing        := False;
end;

procedure TForm1.NAP7000Error(lErrorCode: Integer);
begin
    if lErrorCode = 0 then exit;

    ErrCnt := ErrCnt + 1;
    If ErrCnt > 50 Then  //Clear the error messages
    begin
        ErrCnt := 1;
        List1.Items.Clear;
    End;

    List1.Items.Add( 'TaskNo:' + IntToStr(wTaskNo) );
    List1.Items.Add( 'ErrNo :' + IntToStr(lErrorCode) );
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
    If Button2.Caption = 'Stop' Then
    begin
        Timer1.Enabled := False;
        Button2.Caption := 'Active';
        exit;
    End;

    List1.Items.Clear;
    wTaskNo := 0;
    Button2.Caption := 'Stop';
    Timer1.Enabled  := True;
    gcPort := Char(StrToInt( eCOMPort.Text ));
    wRtn := IOpenCOM( gcPort, 57600 );
    NAP7000Error( wRtn );
end;

procedure TForm1.FormDblClick(Sender: TObject);
begin
    List1.Visible := Not List1.Visible ;
end;


procedure TForm1.lDemo1Click(Sender: TObject);
begin
    strCopy( gszSend, '@91' );
    wRtn := Send_Receive_Cmd(gcPort, gszSend, gszReceive, 200, 0, wt );
    NAP7000Error( wRtn );
end;

procedure TForm1.lDemo2Click(Sender: TObject);
begin
    strCopy( gszSend, '@92' );
    wRtn := Send_Receive_Cmd(gcPort, gszSend, gszReceive, 200, 0, wt );
    NAP7000Error( wRtn );
end;

procedure TForm1.Timer1Timer(Sender: TObject);
Var
    sRtn :String;
    wVal :Integer;
    i    :Integer;
begin

    if bProcessing = True then
       exit;
    bProcessing := True;

    wTaskNo   := 1;
    strCopy( gszSend, '@0' );
    wRtn := Send_Receive_Cmd(gcPort, gszSend, gszReceive, 200, 0, wt );
    NAP7000Error( wRtn );
    sRtn := Copy(gszReceive, 3, Length(gszReceive) - 2);
    try
        StrToFloat(sRtn);
        e1.Text := sRtn;  //PT-100-1
    except
        e1.Text := 'Error';
    end;
    Application.ProcessMessages;


    wTaskNo := 2;
    strCopy( gszSend, '@1' );
    wRtn := Send_Receive_Cmd(gcPort, gszSend, gszReceive, 200, 0, wt );
    NAP7000Error( wRtn );
    sRtn    := Copy(gszReceive, 3, Length(gszReceive) - 2);
    try
        StrToFloat(sRtn);
        e2.Text := sRtn;  //PT-100-2
    except
        e2.Text := 'Error';
    end;
    Application.ProcessMessages;


    wTaskNo := 3;
    strCopy( gszSend, '@2' );
    wRtn := Send_Receive_Cmd(gcPort, gszSend, gszReceive, 200, 0, wt );
    NAP7000Error( wRtn );
    sRtn    := Copy(gszReceive, 3, Length(gszReceive) - 2);
    try
        StrToFloat(sRtn);
        e3.Text := sRtn;  //PT-100-3
    except
        e3.Text := 'Error';
    end;
    Application.ProcessMessages;


    wTaskNo := 4;
    strCopy( gszSend, '@3' );
    wRtn := Send_Receive_Cmd(gcPort, gszSend, gszReceive, 200, 0, wt );
    NAP7000Error( wRtn );
    sRtn    := Copy(gszReceive, 3, Length(gszReceive) - 2);
    try
        StrToFloat(sRtn);
        eLoadCell.Text := sRtn;  //LoadCell
    except
        eLoadCell.Text := 'Error';
    end;
    Application.ProcessMessages;


    //************************************
    wTaskNo := 5;
    strCopy( gszSend, '@4' );
    wRtn := Send_Receive_Cmd(gcPort, gszSend, gszReceive, 200, 0, wt );
    NAP7000Error( wRtn );
    try
        wVal := StrToInt(Copy(gszReceive, 3, Length(gszReceive) - 2));
    except
        wVal := 0;
    end;

    //wVal := $1F
    for i:=1 To 5 do
    begin
        if (wVal And round(Power(2 ,(i - 1))) ) <> 0 Then
            (FindComponent('Do0' + IntToStr(i)) As TShape).Brush.Color := clRed
        Else
            (FindComponent('Do0' + IntToStr(i)) As TShape).Brush.Color := clBlack;
    end;
    Application.ProcessMessages;

    wTaskNo := 6;
    strCopy( gszSend, '@5' );
    wRtn := Send_Receive_Cmd(gcPort, gszSend, gszReceive, 200, 0, wt );
    NAP7000Error( wRtn );
    sRtn    := Copy(gszReceive, 3, Length(gszReceive) - 2);
    If sRtn = '1' Then
    begin
        lDemo1.Color := clRed;
        lDemo2.Color := clLime;
    end
    Else
    begin
        lDemo1.Color := clLime;
        lDemo2.Color := clRed;
    End;

    Application.ProcessMessages;


    //************************************
    wTaskNo := 7;
    strCopy( gszSend, '@6' );
    wRtn := Send_Receive_Cmd(gcPort, gszSend, gszReceive, 200, 0, wt );
    NAP7000Error( wRtn );
    sRtn    := Copy(gszReceive, 3, Length(gszReceive) - 2);
    try
        StrToFloat(sRtn);
        eDA.Text := sRtn
    except
        eDA.Text := 'Error';
    end;
    Application.ProcessMessages;

    wTaskNo := 8;
    strCopy( gszSend, '@7' );
    wRtn := Send_Receive_Cmd(gcPort, gszSend, gszReceive, 200, 0, wt );
    NAP7000Error( wRtn );
    sRtn    := Copy(gszReceive, 3, Length(gszReceive) - 2);
    try
        StrToFloat(sRtn);
        eAD.Text := sRtn;
    except
        eAD.Text := 'Error';
    End;
    Application.ProcessMessages;


    //************************************
    wTaskNo := 9;
    strCopy( gszSend, '@8' );
    wRtn := Send_Receive_Cmd(gcPort, gszSend, gszReceive, 200, 0, wt );
    NAP7000Error( wRtn );
    try
        wVal := StrToInt('$' + Copy(gszReceive, 3, Length(gszReceive) - 2) );
    except
        wVal := 0;
    end;

    //wVal = $3
    For i := 1 To 4 do
    begin
        If (wVal And Round(Power(2, (i - 1))) ) <> 0 Then
            (FindComponent('Do1' + IntToStr(i)) As TShape).Brush.Color := clRed
        Else
            (FindComponent('Do1' + IntToStr(i)) As TShape).Brush.Color := clBlack;
    end;
    Application.ProcessMessages;
    bProcessing := False;
end;

end.
