mainform.pas

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

unit MainForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Driver, Thread;

type
  WAVE_PROPERTY = Record
    iType      : word;     {0: Sine, 1: Triangle, 2: Square}
    fMagnitude : Single;
    fOffset    : Single;
    wPeriod    : word;
  end;
  TSingleArray = array[0..MaxInt div sizeof(Single)-1] of Single;

  TfrmMain = class(TForm)
    labDevice: TLabel;
    Label13: TLabel;
    Label14: TLabel;
    Label15: TLabel;
    GroupBox1: TGroupBox;
    radCyclic: TRadioButton;
    radNoCyclic: TRadioButton;
    GroupBox2: TGroupBox;
    radInternal: TRadioButton;
    radExternal: TRadioButton;
    GroupBox3: TGroupBox;
    radEnable: TRadioButton;
    eadDisable: TRadioButton;
    Select: TButton;
    Start: TButton;
    GroupBox4: TGroupBox;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    cmbWaveForm: TComboBox;
    edtMagnitude: TEdit;
    edtOffset: TEdit;
    edtPeriod: TEdit;
    edtRate: TEdit;
    edtConv: TEdit;
    cmbChannel: TComboBox;
    butExit: TButton;
    procedure StartClick(Sender: TObject);
    procedure SelectClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure butExitClick(Sender: TObject);
    procedure MakeWaveForm( var fWaveBuf : array of single;
                            lCount : Longint;
                            wavProperty : WAVE_PROPERTY);
    procedure  StopCheck();
  private
    { Private declarations }

  public
    { Public declarations }
     lErrCde        : Longint;
     lDeviceNum     : Longint;                     //Advantech Device Number in your system
     lDriverHandle  : Longint;                  //Driver handle
     glDmaBufPtr    : Longint;       {DMA buffer pointer}
     gpBinOutBuf    : Pointer;
     glConvCounts   : Longint;
     pFloatBuf      : ^TSingleArray;
     DevFeatures            : DEVFEATURES;           // structure for device features
     ptDevGetFeatures        : PT_DeviceGetFeatures;// structure for DeviceGetFeatures
     ptFAODmaStart           : PT_FAODmaStart;     // FAODMAStart table
     ptFAOLoad               : PT_FAOLoad;         // FAOLoad table
     ptFAOScale              : PT_FAOScale;        // FAOScale table
     ptFAOCheck              : PT_FAOCheck;        // FAOCheck table
     ptEnableEvent           : PT_EnableEvent;     // Enable event
     ptCheckEvent            : PT_CheckEvent;      // Check event
     ptAllocateDMABuffer     : PT_AllocateDMABuffer;  // buffer table
     gwavOut        : WAVE_PROPERTY;
     chkThread      : CheckThread;
     gwChannel      : integer;             // output channel
     gdwPacerRate   : Longint;    // pacer rate
     gulConvNum     : Longint;      // conversion number
     gwCyclicMode   : integer;        // cyclic or non-cylic mode
     gwBufferMode   : integer;        // buffer: single or double
     gwEvtFlag      : integer;           // event enable(0)
     gwExtTrig      : integer;
     bThreadloop    : boolean;

  end;
  Function DoesErr(var lErrCode: LongInt): integer;

var
  frmMain: TfrmMain;

implementation
uses CheckForm, EVENT;

{$R *.dfm}
{*************************************************************
 * 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;
{************************************************************************
 * Function : According to the desired wave form property transfering to
 *            voltage and saving them to buffer.
 *            It can support Sine wave, triangle wave and square wave.
 * Input :    fWavBuf, Output, for storing the voltage after converting.
 *            lCount, Input, Total count of this buffer size.
 *            wavProperty, Input, the desired waveform property.
 * return :   none
 *************************************************************************}
procedure TfrmMain.MakeWaveForm( var fWaveBuf : array of single;
                                 lCount : Longint;
                                 wavProperty : WAVE_PROPERTY);
var
  l      : Longint;
  fSlope : Single;
  wHalf, wNow  : Word;
begin

  case wavProperty.iType of
    0 : {Sine}
    begin
      for l := 0 to lCount - 1 do
      begin
        fWaveBuf[l] := wavProperty.fMagnitude *
                       sin( 6.28318 * l / wavProperty.wPeriod) +
                       wavProperty.fOffset;
        end;
      end;

      1 : {Triangle}
      begin
        fSlope := wavProperty.fMagnitude * 4.0 / wavProperty.wPeriod;
        wHalf := wavProperty.wPeriod div 2;

        for l := 0 to lCount - 1 do
        begin
          wNow := l mod wavProperty.wPeriod;
          if wNow <= wHalf then
            fWaveBuf[l] := fSlope * wNow
                         - wavProperty.fMagnitude + wavProperty.fOffset
          else
            fWaveBuf[l] := fSlope * (wavProperty.wPeriod - wNow)
                         - wavProperty.fMagnitude + wavProperty.fOffset;
        end;
      end;

      2 : {Square}
      begin
        wHalf := wavProperty.wPeriod div 2;
        for l := 0 to lCount - 1 do
        begin
          wNow := l mod wavProperty.wPeriod;
        if wNow <= wHalf then
          fWaveBuf[l] := wavProperty.fOffset - wavProperty.fMagnitude
        else
          fWaveBuf[l] := wavProperty.fOffset + wavProperty.fMagnitude;
      end;
    end;
  end;
end;

procedure TfrmMain.StartClick(Sender: TObject);
var
  lActualBufSize : Longint;
begin

  gwChannel := cmbChannel.ItemIndex;
  bThreadloop := true;
  gwEvtFlag := Word(radEnable.Checked);
  gwCyclicMode := Word(radCyclic.Checked);
  gwExtTrig := Word(radExternal.Checked);
  glConvCounts := StrToInt( edtConv.Text);
  gdwPacerRate := StrToInt( edtRate.Text);

 {1. Device Open}
  lErrCde := DRV_DeviceOpen( lDeviceNum, lDriverHandle);
  if( DoesErr(lErrCde) = 1 ) then
     exit;

  {2. Allocate DMA buffer for DMA transfer}
  {  2.1 Fill paramater for calling DRV_AllocateDMABuffer}
  with ptAllocateDMABuffer do
  begin
    CyclicMode := Smallint(radCyclic.Checked);
    RequestBufSize := glConvCounts * 2;
    ActualBufSize := @lActualBufSize;       {return acture allocated buffer size}
    buffer := @glDmaBufPtr;
  end;

  {  2.2 Call API function to allocate DMA buffer.}
  lErrCde := DRV_AllocateDMABuffer(lDriverHandle, ptAllocateDMABuffer);
  if( DoesErr(lErrCde) = 1 ) then
  begin
    DRV_DeviceClose(lDriverHandle);
 //   exit;
  end;

  {3. Make Analog output data}
  {  3.1 Make wave form (in floating data format)}
  GetMem(pFloatBuf, SizeOf(Single) * glConvCounts);

  gwavOut.iType := cmbWaveForm.ItemIndex;
  gwavOut.fMagnitude := StrToFloat(edtMagnitude.Text);
  gwavOut.fOffset := StrToFloat(edtOffset.Text);
  gwavOut.wPeriod := StrToInt(edtPeriod.Text);
  MakeWaveForm( pFloatBuf^, glConvCounts, gwavOut);

  {  3.2 Fill Record for transfering voltage to binary data}
  gpBinOutBuf := Pointer(GlobalAlloc( GPTR,
                                      SizeOf(word) * glConvCounts));
  if gpBinOutBuf = nil then
  begin
    Application.MessageBox('Allocate memory for waveofrm error!', 'Error!!', MB_OK);
    FreeMem(pFloatBuf);
    DRV_FreeDMABuffer(lDriverHandle, @glDmaBufPtr);

    DRV_DeviceClose(lDriverHandle);
    exit;
  end;

  with ptFAOScale do
  begin
    chan      := gwChannel;
    count     := glConvCounts;
    VoltArray := Pointer(pFloatBuf);
    BinArray  := gpBinOutBuf;
  end;

  {  3.3 Transfer voltag to binary data}
  lErrCde := DRV_FAOScale(lDriverHandle, ptFAOScale);
  if( DoesErr(lErrCde) = 1 ) then
  begin
    DRV_FreeDMABuffer(lDriverHandle, @glDmaBufPtr);
    GlobalFree(Longint(gpBinOutBuf));
    DRV_DeviceClose(lDriverHandle);
    exit;
  end;
     FreeMem(pFloatBuf);

  {4. Enable Event feature}
  with ptEnableEvent do
  begin
    EventType := ADS_EVT_AO_INTERRUPT;
    Enabled := gwEvtFlag;
    Count   := 1;
  end;

  lErrCde := DRV_EnableEvent(lDriverHandle, ptEnableEvent);
  if DoesErr(lErrCde) = 1  then
  begin
    DRV_FreeDMABuffer(lDriverHandle, @glDmaBufPtr);
    GlobalFree(Longint(gpBinOutBuf));

    DRV_DeviceClose(lDriverHandle);
    exit;
  end;

  ptEnableEvent.EventType := ADS_EVT_AO_BUFCHANGE;
   lErrCde := DRV_EnableEvent(lDriverHandle, ptEnableEvent);
  if DoesErr(lErrCde) = 1  then
  begin
    DRV_FreeDMABuffer(lDriverHandle, @glDmaBufPtr);
    GlobalFree(Longint(gpBinOutBuf));

    DRV_DeviceClose(lDriverHandle);
    exit;
  end;

  ptEnableEvent.EventType := ADS_EVT_AO_TERMINATED;
  lErrCde := DRV_EnableEvent(lDriverHandle, ptEnableEvent);
  if DoesErr(lErrCde) = 1  then
  begin
    DRV_FreeDMABuffer(lDriverHandle, @glDmaBufPtr);
    GlobalFree(Longint(gpBinOutBuf));

    DRV_DeviceClose(lDriverHandle);
    exit;
  end;

  ptEnableEvent.EventType := ADS_EVT_AO_UNDERRUN;
  lErrCde := DRV_EnableEvent(lDriverHandle, ptEnableEvent);
  if DoesErr(lErrCde) = 1  then
  begin
    DRV_FreeDMABuffer(lDriverHandle, @glDmaBufPtr);
    GlobalFree(Longint(gpBinOutBuf));

    DRV_DeviceClose(lDriverHandle);
    exit;
  end;
  {5. Start Analog output/DMA transfer action}

  {5.1 Fill action Record }
  with ptFAODmaStart do
  begin
    TrigSrc     := gwExtTrig;
    SampleRate  := gdwPacerRate;
    chan        := gwChannel;
    count       := glConvCounts;
    buffer      := gpBinOutBuf;
  end;

  {5.2 Call Advantech API function to start conversion}
  lErrCde := DRV_FAODmaStart( lDriverHandle, ptFAODmaStart);
  if DoesErr(lErrCde) = 1 then
  begin
    DRV_FreeDMABuffer(lDriverHandle, @glDmaBufPtr);
    GlobalFree(Longint(gpBinOutBuf));
    DRV_DeviceClose(lDriverHandle);
    exit;
  end;

  {5. Enable Thread for getting message.}

  if( gwEvtFlag = 1) then
  chkThread :=CheckThread.Create( ptFAODmaStart.count * 1000 div ptFAODmaStart.SampleRate + 1000,
                           radCyclic.Checked);
                           
    frmCheck.labBuffChange.Caption := '0';
    frmCheck.labInterrupt.Caption := '0';
    frmCheck.labOverrun.Caption := '0';

    frmCheck.ShowModal();
    
end;

procedure TfrmMain.SelectClick(Sender: TObject);
var
  szDeviceName : array[0..100] of char;
  szTmp : String;
  i     : Smallint;
begin

  {Select devcie from device list}
  lErrCde := DRV_SelectDevice( Handle, False, lDeviceNum,
             @szDeviceName[0]);
  if( DoesErr(lErrCde) = 1 ) then
    Exit;

  labDevice.Caption := szDeviceName;

  {Get device features for filling every control's items}
  lErrCde := DRV_DeviceOpen( lDeviceNum, lDriverHandle);
  if( DoesErr(lErrCde) = 1 ) then
    Exit;

  lErrCde := DRV_DeviceGetFeatures(lDriverHandle, ptDevGetFeatures);
  if( DoesErr(lErrCde) = 1 ) then
  begin
    DRV_DeviceClose(lDriverHandle);
    Exit;
  end;

  {make the items of output channel selection.}
  cmbChannel.Clear;
  for i := 0 to DevFeatures.usMaxAOChl - 1 do
  begin
    szTmp := IntToStr(i);
    cmbChannel.items.Add(szTmp);
  end;
  cmbChannel.ItemIndex := 0;

  {Close the device}
  DRV_DeviceClose(lDriverHandle);
  lDriverHandle := 0;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  ptDevGetFeatures.buffer := @DevFeatures;
  ptDevGetFeatures.size := SizeOf(DEVFEATURES);
  cmbWaveForm.ItemIndex := 0;

  SelectClick(nil);

end;

procedure TfrmMain.butExitClick(Sender: TObject);
begin
    Close();
end;
procedure TfrmMain.StopCheck();
var
  EcitCode  : DWORD;
  bOk       : boolean;
begin

  if ( gwEvtFlag = 1) then
  begin
    chkThread.Terminate();
    Sleep(100);
    bOk := GetExitCodeThread(chkThread.Handle, EcitCode);
    if (EcitCode = STILL_ACTIVE) and (bOk = True) then
    begin
      TerminateThread(chkThread.Handle, 0);
      CloseHandle(chkThread.Handle);
    end;
    Sleep(0);
   end; 

  {Close device}
  GlobalFree(Longint(gpBinOutBuf));
  DRV_FreeDMABuffer(lDriverHandle, @(glDmaBufPtr));
  DRV_DeviceClose(lDriverHandle);

  frmCheck.Close;
end;
end.