mainform.pas

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

unit MainForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Driver,  PARAS, EVENT, StdCtrls, Global,GetEvent ;

type
  TfrmMain = class(TForm)
    GroupBox1: TGroupBox;
    txtDevice: TEdit;
    BtSelect: TButton;
    BtRun: TButton;
    BtStop: TButton;
    BtExit: TButton;
    GroupBox2: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    EditBufferChange: TEdit;
    EditOverrun: TEdit;
    EditTerminate: TEdit;
    BtSetting: TButton;
    txtBuffName: TEdit;
    Label4: TLabel;
    procedure BtSelectClick(Sender: TObject);
    procedure BtSettingClick(Sender: TObject);
    procedure BtRunClick(Sender: TObject);
    procedure BtStopClick(Sender: TObject);
    procedure BtExitClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    ThreadEvent : TGetEvent ;

  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

uses SettingForm;

{$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;
  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;

procedure TfrmMain.BtSelectClick(Sender: TObject);
var
  szDeviceName : array[0..100] of char;
  lErrCde      : Longint;
begin
  {Select devcie from device list}
  lErrCde := DRV_SelectDevice( Handle, False, lDeviceNumber,
             @szDeviceName[0]);
  if( DoesErr(lErrCde) = 1 ) then
      Exit;
  if( lDeviceNumber = -1 ) then
      Exit;
  {Get the device number}
  txtDevice.Text := szDeviceName;

  {Open the device, get device handle}
  lErrCde := DRV_DeviceOpen(lDeviceNumber, ghDev);
  if( DoesErr(lErrCde) = 1 ) then
      Exit;

  {Get device feature}
  ptDevFeatures.buffer := @dfCurDevice;
  ptDevFeatures.size := sizeof(DEVFEATURES);
  lErrCde := DRV_DeviceGetFeatures(ghDev, ptDevFeatures);
  if( DoesErr(lErrCde) = 1 ) then
  begin
    DRV_DeviceClose(ghDev);
    Exit;
  end;

  {Get properties}
  gdwCount := sizeof(Longint);

  {Get board ID}
  lErrCde := DRV_DeviceGetProperty(ghDev, CFG_BoardID, @gdwBoardId, gdwCount);
  if( DoesErr(lErrCde) = 1 ) then
      Exit;

  {Get data width}
  lErrCde := DRV_DeviceGetProperty(ghDev, CFG_DioFdioDirection, @gdwDataWidth, gdwCount);
  if( DoesErr(lErrCde) = 1 ) then
      Exit;

  {Get trigger source}
  lErrCde := DRV_DeviceGetProperty(ghDev, CFG_DoPacerSource, @gdwDOTriggerSource, gdwCount);
  if( DoesErr(lErrCde) = 1 ) then
      Exit;

  {Get Operation Mode value}
  lErrCde := DRV_DeviceGetProperty(ghDev, CFG_DoOperationMode , @gdwDOOperationMode, gdwCount);
  if( DoesErr(lErrCde) = 1 ) then
      Exit;

  {Get stop type}
  lErrCde := DRV_DeviceGetProperty(ghDev, CFG_DoStopMethod, @gdwDOStopMode, gdwCount);
  if( DoesErr(lErrCde) = 1 ) then
      Exit;

  {Get DO DMA mode}
  if gdwBoardId = BD_MIC3755 then
  begin
     lErrCde := DRV_DeviceGetProperty(ghDev, CFG_DoTransferRequestMode, @gdwDoDmaMode, dwCount);
     if( DoesErr(lErrCde) = 1 ) then
        exit;
  end;

  {Get counter value}
  gdwCount := 3 * sizeof(Longint);
  lErrCde := DRV_DeviceGetProperty(ghDev, CFG_CounterCountValue, @gdwCounterValue, gdwCount);
  if( DoesErr(lErrCde) = 1 ) then
      Exit;

  BtRun.Enabled := TRUE;
  BtSetting.Enabled := TRUE;

end;

procedure TfrmMain.BtSettingClick(Sender: TObject);
begin
     frmSetting.Visible := TRUE;
end;

procedure TfrmMain.BtRunClick(Sender: TObject);
var
    i : LongInt;
    pUserbuff : Pointer;
begin

    gdwDOBufferChangeCounter := 0;
    gdwDOOverRunCounter  := 0;
    gdwDOTerminateCounter := 0;

    If gdwUserBufferSize = 0 Then     // 1 mega
        dwUserBufferSize := Mega
    Else If gdwUserBufferSize = 1 Then  // 2 mega
        dwUserBufferSize := 2 * Mega
    Else If gdwUserBufferSize = 2 Then  // 4 mega
        dwUserBufferSize := 4 * Mega
    Else If gdwUserBufferSize = 3 Then  // 8 mega
        dwUserBufferSize := 8 * Mega;
    // Else If gdwUserBufferSize = 4 Then  ' 16 mega
    //    dwUserBufferSize = 16 * Mega

    // allocate user buffer
    GlobalUnlock(hGUserBuf);
    GlobalFree(hGUserBuf);
    hGUserBuf:=GlobalAlloc(GPTR, dwUserBufferSize);
    hUserBuf := Pointer(GlobalLock(hGUserBuf));
    if ( hUserBuf = nil ) then
    begin
        Application.MessageBox('Allocate memory error!', 'Error!!', MB_OK);
         DRV_DeviceClose(ghDev);
        Exit
    end;
    // enable event
    ptEnableEvent.Enabled := 1;
    ptEnableEvent.Count := 1;
    ptEnableEvent.EventType := ADS_EVT_DO_UNDERRUN;
    lErrCde := DRV_EnableEvent(ghDev, ptEnableEvent);
    ptEnableEvent.EventType := ADS_EVT_DO_LOBUFTRANS;
    lErrCde := DRV_EnableEvent(ghDev, ptEnableEvent);
    ptEnableEvent.EventType := ADS_EVT_DO_HIBUFTRANS;
    lErrCde := DRV_EnableEvent(ghDev, ptEnableEvent);
    ptEnableEvent.EventType := ADS_EVT_DO_TERMINATED;
    lErrCde := DRV_EnableEvent(ghDev, ptEnableEvent);
    if( DoesErr(lErrCde) = 1 ) then
    begin
      GlobalUnlock(hGUserBuf);
      GlobalFree(hGUserBuf);
      Exit;
    end;

    // calculate the count
    If gdwDataWidth = 3 Then                // 8-bit
        dwCount := dwUserBufferSize
    Else If gdwDataWidth = 2 Then           // 16- bit
        dwCount := dwUserBufferSize div 2
    Else                                    // 32-bit
        dwCount := dwUserBufferSize div 4;
    // Set the buff value
    pUserBuff:= hUserBuf;
    for i:=0 to dwCount-1 do
    begin
        if( gdwDataWidth = 1 ) then  //32 DO
        begin
           Longword(pUserBuff^):= gdwDigitalValue;
           Longint(pUserBuff) := Longint(pUserBuff) + 4;
        end;
        if( gdwDataWidth = 2 ) then   //16 DO
        begin
           Word(pUserBuff^):= gdwDigitalValue;
           Longint(pUserBuff) := Longint(pUserBuff) + 2;
        end;
        if( gdwDataWidth = 3 ) then      //8 DO
        begin
           BYTE(pUserBuff^):= gdwDigitalValue;
           Longint(pUserBuff) := Longint(pUserBuff) + 1;
        end;
   end;
    // set the parameters
    lErrCde := DRV_DeviceSetProperty(ghDev, CFG_CounterCountValue, @gdwCounterValue[0], 12);
    lErrCde := DRV_DeviceSetProperty(ghDev, CFG_DioFdioDirection, @gdwDataWidth, 4);
    lErrCde := DRV_DeviceSetProperty(ghDev, CFG_DoStartMethod, @gdwDOStartMode, 4);
    lErrCde := DRV_DeviceSetProperty(ghDev, CFG_DoStopMethod, @gdwDOStopMode, 4);
    lErrCde := DRV_DeviceSetProperty(ghDev, CFG_DoPacerSource, @gdwDOTriggerSource, 4);
    lErrCde := DRV_DeviceSetProperty(ghDev, CFG_DoOperationMode, @gdwDOOperationMode, 4);
    if gdwBoardId = BD_MIC3755 then
    begin
       lErrCde := DRV_DeviceSetProperty(ghDev, CFG_DoTransferRequestMode, @gdwDoDmaMode, 4);
    end;


    if( DoesErr(lErrCde) = 1 ) then
    begin
      GlobalUnlock(hGUserBuf);
      GlobalFree(hGUserBuf);
      Exit;
    end;

    // Start fast DI
    lErrCde := DRV_FDOStart(ghDev, gdwCyclicMode, dwCount, hUserBuf);
    if( DoesErr(lErrCde) = 1 ) then
    begin
      GlobalUnlock(hGUserBuf);
      GlobalFree(hGUserBuf);
      Exit;
    end;

    ptCheckEvent.EventType := @usEventType;
    ptCheckEvent.Milliseconds := 10000;
    // creat thread to check event
    usThreadLoop := 1;
    ThreadEvent := TGetEvent.Create( );

    // gray the button
    BtRun.Enabled  := FALSE;
    BtStop.Enabled := TRUE;
    BtExit.Enabled := FALSE;
end;

procedure TfrmMain.BtStopClick(Sender: TObject);
begin
     usThreadLoop := 0;
     lErrCde := DRV_FDOStop( ghDev );
     if( DoesErr(lErrCde) = 1 ) then
     begin
       Exit;
     end;

     BtRun.Enabled  := TRUE;
     BtStop.Enabled := FALSE;
     BtExit.Enabled := TRUE;
end;

procedure TfrmMain.BtExitClick(Sender: TObject);
begin
   if ( ghDev = 0 ) then
   begin
      close;
   end;

     // disable event
    ptEnableEvent.Enabled := 0;
    ptEnableEvent.EventType := ADS_EVT_DO_UNDERRUN;
    lErrCde := DRV_EnableEvent(ghDev, ptEnableEvent);
    ptEnableEvent.EventType := ADS_EVT_DO_LOBUFTRANS;
    lErrCde := DRV_EnableEvent(ghDev, ptEnableEvent);
    ptEnableEvent.EventType := ADS_EVT_DO_HIBUFTRANS;
    lErrCde := DRV_EnableEvent(ghDev, ptEnableEvent);
    ptEnableEvent.EventType := ADS_EVT_DO_TERMINATED;
    lErrCde := DRV_EnableEvent(ghDev, ptEnableEvent);
        GlobalUnlock(hGUserBuf);
      GlobalFree(hGUserBuf);

    if ( ghDev <> 0 ) then
        DRV_DeviceClose( ghDev );
    close;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
    BtSelectClick(Sender);
end;



end.