convert.pas

16 relay output channels and 16 isolated digital input channels LED indicators to show activated

unit Convert;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons, Mask, ComCtrls, ExtCtrls, Gauges,
  Driver;

type
  TfrmConverting = class(TForm)
    butTerminate: TButton;
    prgsDataCounts: TProgressBar;
    tmrDataCounts: TTimer;
    Label1: TLabel;
    Label2: TLabel;
    txtInt: TEdit;
    txtBuffChange: TEdit;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure butTerminateClick(Sender: TObject);
    procedure tmrDataCountsTimer(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    ptAiCheck  : PT_FAICheck;
    wActiveBuf : Word;
    wStopped   : Word;
    lRetrieved : Longint;
    wOverrun   : Word;
    wHalfReady : Word;

  public
    { Public declarations }
    gbCyclic         : Boolean;
    gbConverting     : Boolean;
    ghThreadGetEvent : Longint;
  end;

var
  frmConverting: TfrmConverting;


implementation

uses Init, DataShow;

{*************************************************************
 * Function: Handle the error code. If the input error code > 0,
 *           it means some error apperent.  This function can
 *           show the error message to a message box and stop
 *           this application.
 * Input:    The error code.
 * return:   none
 ************************************************************* }
Function DoesErr(var lErrCode: LongInt): integer;
var
    szErrMsg   : string[100];
    pszErrMsg  : PChar;
begin
     {Check the pressed error code}
    If (lErrCode <> 0) Then
    begin
        pszErrMsg := @szErrMsg;
        DRV_GetErrorMessage(lErrCode, pszErrMsg);
        Application.MessageBox(pszErrMsg, 'Error!!', MB_OK);
        DoesErr := 1;
    end
    else
        DoesErr := 0;
end;


{$R *.DFM}

procedure TfrmConverting.FormClose(Sender: TObject;
  var Action: TCloseAction);
  var
    i         : DWORD;
    lErrCde   : Longint;
    bOk       : Boolean;
    ptFaiData : PT_FAITransfer;
    p         : Pointer;
begin
  {Does Converting action has been stopped?}
  if gbConverting = False then
    Exit;
  gbConverting := False;

  {Stop getting conversion status}
  tmrDataCounts.Enabled := False;
  frmConverting.Enabled := False;
  butTerminate.Caption := 'Waiting...';

  {Stop getEvent thread}
  if ghThreadGetEvent <> 0 then
  begin
    bOk := GetExitCodeThread(ghThreadGetEvent, i);
    if (i = STILL_ACTIVE) and (bOk = True) then
    begin
      TerminateThread(ghThreadGetEvent, 0);
      CloseHandle(ghThreadGetEvent);
    end;
    ghThreadGetEvent := 0;
    Sleep(0);
  end;

  {Get last conversion status}
  lErrCde := DRV_FAICheck(frmInit.ghDev, ptAiCheck);
  if DoesErr(lErrCde) = 1 then
  begin
    GlobalUnlock(frmInit.hBuf);
    GlobalFree(frmInit.hBuf);
    GlobalUnlock(frmInit.hUserbuf);
    GlobalFree(frmInit.hUserbuf);
    DRV_DeviceClose(frmInit.ghDev);
    Exit;
  end;
  {Get AI conversion data}
  With ptFaiData do
  begin
    overrun    := @wOverrun;
    count      := frmInit.giConvCount;
    start      := 0;               {Start from buffer begging}
    DataType   := Word(frmInit.chkFloatData.Checked);
    ActiveBuf  := 0;               {Single buffer}

    {If want floating data}
    if DataType = 1 Then
      i := SizeOf(single)
    {Else need Raw data}
    else
      i := SizeOf(Word);
    DataBuffer := Pointer(GlobalLock(frmInit.hUserbuf));    {Alolocate memory for data}
  end;
  lErrCde := DRV_FAITransfer(frmInit.ghDev, ptFaiData);
  if DoesErr(lErrCde) = 1 then
  begin
    GlobalUnlock(frmInit.hBuf);
    GlobalFree(frmInit.hBuf);
    GlobalUnlock(frmInit.hUserbuf);
    GlobalFree(frmInit.hUserbuf);
    DRV_DeviceClose(frmInit.ghDev);
    Exit;
  end;

  {Save data to data show screen}
  p := ptFaiData.DataBuffer;
  if gbCyclic = True Then
    lRetrieved := ptFaiData.count - 1
  else
    lRetrieved := ptAiCheck.retrieved^ - 1;

  frmDataShow.memData.Lines.Clear;

  for i:=0 to (lRetrieved - 1) do
  begin
    if ptFaiData.DataType = 1 then
    begin
      {Converting to Floating data}
      frmDataShow.memData.Lines.Append(Format('Buff[%d] = %10.6f', [i,Single(p^)]));
      Longint(p) := Longint(p) + SizeOf(Single);
    end
    else
    begin
      {Convert to Hex data}
      frmDataShow.memData.Lines.Append(Format('Buff[%d] = ', [i])+ IntToHex(Word(p^), 3));
      Longint(p) := Longint(p) + SizeOf(Word);
    end;
  end;

  {Free data buffer}

  GlobalUnlock(frmInit.hBuf);
  GlobalFree(frmInit.hBuf);
  GlobalUnlock(frmInit.hUserbuf);
  GlobalFree(frmInit.hUserbuf);

  {Close device}
  DRV_DeviceClose(frmInit.ghDev);

  {Display the Data Show Form}
  frmConverting.Enabled := True;
  butTerminate.Caption := '&Terminate';
  frmDataShow.Show;
  frmInit.Enabled := True;
  frmConverting.Hide;
end;

procedure TfrmConverting.butTerminateClick(Sender: TObject);
var
  lErrCde : longint;
begin
  lErrCde := DRV_FAITerminate(frmInit.ghDev);
  if DoesErr(lErrCde) = 1 then
  begin
    GlobalUnlock(frmInit.hBuf);
    GlobalFree(frmInit.hBuf);
    GlobalUnlock(frmInit.hUserbuf);
    GlobalFree(frmInit.hUserbuf);
    DRV_DeviceClose(frmInit.ghDev);
    Exit;
  end;
  if not frmInit.chkEventEnable.Checked  then
  begin
    Close;
  end;
end;

procedure TfrmConverting.tmrDataCountsTimer(Sender: TObject);
var
    lErrCde : Longint;
begin
    lErrCde := DRV_FAICheck(frmInit.ghDev, ptAiCheck);
    if DoesErr(lErrCde) = 1 then
    begin
        tmrDataCounts.Enabled := False;
        Application.MessageBox('Stop to get conversion status!',
                               'Converting & transfering data message',
                                MB_OK);
        Exit;
    end;

    if (lRetrieved = 0) then
        lRetrieved := 1;

    prgsDataCounts.Position := lRetrieved-1;


end;

procedure TfrmConverting.FormShow(Sender: TObject);
begin
     tmrDataCounts.Enabled := TRUE;
end;

procedure TfrmConverting.FormCreate(Sender: TObject);
begin
    with ptAiCheck do
    begin
        ActiveBuf  := @wActiveBuf;
        stopped    := @wStopped;
        retrieved  := @lRetrieved;
        overrun    := @wOverrun;
        HalfReady  := @wHalfReady;
    end;

    ghThreadGetEvent := 0;         {Still not create thread}
end;

end.