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;
    memEvent: TMemo;
    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;

    ptFAIWatchDogCheck : PT_FAIWatchDogCheck;
    iWhichBuf  : Smallint;
    iTriggered : Smallint;
    iTrigChan  : Smallint;
    lTrigIndex : Longint;
    fTrigData  : Single;
    wRawData   : Word;
  public
    { Public declarations }
    gbCyclic         : 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;
    iRet       : integer;
begin
     {Check the pressed error code}
    If (lErrCode <> 0) Then
    begin
        pszErrMsg := @szErrMsg;
        DRV_GetErrorMessage(lErrCode, pszErrMsg);
        iRet := 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
  {Stop Timer action}
  tmrDataCounts.Enabled := False;

  {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 watchdog status}
  lErrCde := DRV_FAIWatchdogCheck(frmInit.ghDev, ptFAIWatchdogCheck);
  if DoesErr(lErrCde) = 1 then
  begin
    DRV_FreeDMABuffer(frmInit.ghDev, @(frmInit.glDmaBufPtr));
    DRV_DeviceClose(frmInit.ghDev);
    Exit;
  end;

  {Display the Data Show Form}
  frmDataShow.Show;
  frmDataShow.memStatus.Show;
  frmConverting.Hide;

  {Display watchdog status to DataShow form}
  frmDataShow.memStatus.Lines.Clear;
  with frmInit.gptFWDC do
  begin
    if TrigMode <> FREE_RUN then
    begin
      if TrigMode = PRE_TRIG then
        frmDataShow.memStatus.Lines.Append('Acquisition mode: pre-trig')
      else if TrigMode = POST_TRIG then
        frmDataShow.memStatus.Lines.Append('Acquisition mode: post-trig')
      else
        frmDataShow.memStatus.Lines.Append('Acquisition mode: position-trig');
      if iTriggered <> 1 then
        frmDataShow.memStatus.Lines.Append('Watchdog status: failure')
      else
      begin
        {condition satisfiled, display more information}
        frmDataShow.memStatus.Lines.Append('Watchdog status: Satisfied');

        {Which buffer?}
        if iWhichBuf = 0 then
          frmDataShow.memStatus.Lines.Append('Satisfied buffer: A')
        else
          frmDataShow.memStatus.Lines.Append('Satisfied buffer: B');

        {Which channel?}
        frmDataShow.memStatus.Lines.Append('Satisfied channel: '+IntToStr(iTrigChan));

        {Which one?}
        frmDataShow.memStatus.Lines.Append('Satisfied index: '+IntToStr(lTrigIndex));

        {What value?}
        if ptFAIWatchdogCheck.DataType = 0 then
          frmDataShow.memStatus.Lines.Append('Satisfied data: '+IntToStr(wRawData)+'H')
        else
          frmDataShow.memStatus.Lines.Append('Satisfied data: '+FloatToStr(fTrigData));
      end;
    end;
  end;

  {Get the AI conversion data}
  With ptFaiData do
  begin
    ActiveBuf  := 0;               {Read buffer A}
    overrun    := @wOverrun;
    count      := frmInit.giConvCount;
    start      := 0;               {Start from buffer begging}
    DataType   := Word(frmInit.chkFloatData.Checked);

    {If want floating data}
    if DataType = 1 Then
      i := SizeOf(single)
    {Else need Raw data}
    else
      i := SizeOf(Word);
    GetMem(DataBuffer, i* count );    {Alolocate memory for data}
  end;

  {  Read buffer A data}
  lErrCde := DRV_FAITransfer(frmInit.ghDev, ptFaiData);
  if DoesErr(lErrCde) = 1 then
  begin
    FreeMem(ptFaiData.DataBuffer);
    DRV_FreeDMABuffer(frmInit.ghDev, @(frmInit.glDmaBufPtr));
    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;

  {store to buffer A}
  frmDataShow.memBufA.Lines.Clear;
  for i:=0 to lRetrieved  do
  begin
    if ptFaiData.DataType = 1 then
    begin
      {Converting to Floating data}
      frmDataShow.memBufA.Lines.Append(IntToStr(i)+': '+FloatToStr(Single(p^)));
      Longint(p) := Longint(p) + SizeOf(Single);
    end
    else
    begin
      {Convert to Hex data}
      frmDataShow.memBufA.Lines.Append(IntToStr(i)+': '+IntToHex(Word(p^), 16) );
      Longint(p) := Longint(p) + SizeOf(Word);
    end;
  end;

  { Read buffer B data}
  ptFaiData.ActiveBuf  := 1;       {Read buffer B}
  lErrCde := DRV_FAITransfer(frmInit.ghDev, ptFaiData);
  if DoesErr(lErrCde) = 1 then
  begin
    FreeMem(ptFaiData.DataBuffer);
    DRV_FreeDMABuffer(frmInit.ghDev, @(frmInit.glDmaBufPtr));
    DRV_DeviceClose(frmInit.ghDev);
    Exit;
  end;

  {store to buffer B}
  frmDataShow.memBufB.Lines.Clear;
  p := ptFaiData.DataBuffer;
  for i:=0 to lRetrieved  do
  begin
    if ptFaiData.DataType = 1 then
    begin
      {Converting to Floating data}
      frmDataShow.memBufB.Lines.Append(IntToStr(i)+': '+FloatToStr(Single(p^)) );
      Longint(p) := Longint(p) + SizeOf(Single);
    end
    else
    begin
      {Convert to Hex data}
      frmDataShow.memBufB.Lines.Append(IntToStr(i)+': '+IntToHex(Word(p^), 16) );
      Longint(p) := Longint(p) + SizeOf(Word);
    end;
  end;


  {Free data buffer}
  FreeMem(ptFaiData.DataBuffer);
  DRV_FreeDMABuffer(frmInit.ghDev, @(frmInit.glDmaBufPtr));

  {Close device}
  DRV_DeviceClose(frmInit.ghDev);
  frmInit.Enabled := True;
end;

procedure TfrmConverting.butTerminateClick(Sender: TObject);
var
  lErrCde   : Longint;
begin
  lErrCde := DRV_FAITerminate(frmInit.ghDev);
  if DoesErr(lErrCde) = 1 then
  begin
    DRV_FreeDMABuffer(frmInit.ghDev, @(frmInit.glDmaBufPtr));
    DRV_DeviceClose(frmInit.ghDev);
    Exit;
  end;
  if not frmInit.chkEventEnable.Checked then
  begin
    Close;
  end;
end;

procedure TfrmConverting.tmrDataCountsTimer(Sender: TObject);
var
  lErrCde : Longint;
  iRet    : Integer;
begin
  lErrCde := DRV_FAICheck(frmInit.ghDev, ptAiCheck);
  if DoesErr(lErrCde) = 1 then
  begin
    tmrDataCounts.Enabled := False;
    iRet := Application.MessageBox('Stop to get conversion status!',
                                   'Converting & transfering data message',
                                    MB_OK);
    Exit;
  end;
  prgsDataCounts.Position := ptAiCheck.retrieved^;
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;

  with ptFAIWatchdogCheck do
  begin
    DataType   := word(frmInit.chkFloatData.Checked);
    ActiveBuf  := @iWhichBuf;
    triggered  := @iTriggered;
    TrigChan   := @iTrigChan;
    TrigIndex  := @lTrigIndex;
    if DataType = 1 then
      TrigData := @fTrigData
    else
      TrigData := @wRawData;
  end;  
  ghThreadGetEvent := 0;         {Still not create thread}
end;

end.