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 ;

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;
    btShow: 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);
    procedure btShowClick(Sender: TObject);
  private
    { Private declarations }

  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

uses SettingForm, GetEvent, ShowDataForm;

{$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 start type}
  lErrCde := DRV_DeviceGetProperty(ghDev, CFG_DiStartMethod, @gdwDIStartMode, gdwCount);
  if( DoesErr(lErrCde) = 1 ) then
      Exit;

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

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

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

  {Get Pattern Match value}
  lErrCde := DRV_DeviceGetProperty(ghDev, CFG_DiPatternMatchValue, @gdwDIMatchValue, gdwCount);
  if( DoesErr(lErrCde) = 1 ) then
      Exit;

  { Get DI DMA mode}
  if gdwBoardId = BD_MIC3755 then
  begin
     lErrCde := DRV_DeviceGetProperty(ghDev, CFG_DiTransferRequestMode, @gdwDiDmaMode, gdwCount);
  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);

begin

    gdwDIBufferChangeCounter := 0;
    gdwDIOverRunCounter  := 0;
    gdwDITerminateCounter := 0;
    EditBufferChange.Text := '0';
    EditOverrun.Text := '0';
    EditTerminate.Text := '0';
    txtBuffName.Text :='';

    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
    if(hUserBuf <> nil) then
    begin
      VirtualFree( hUserBuf, dwUserBufferSize, MEM_DECOMMIT );
      VirtualFree( hUserBuf, 0, MEM_RELEASE);
    end;
    // hGUserBuf:=GlobalAlloc(GPTR, dwUserBufferSize);
   // hGUserBuf:=GlobalAlloc(GPTR, dwUserBufferSize);
 //   hUserBuf := Pointer(GlobalLock(hGUserBuf));
    hUserBuf := VirtualAlloc( nil,                    // region to reserve or commit
                             dwUserBufferSize,          // size of region
                             MEM_COMMIT,  // type of allocation
                             PAGE_READWRITE );        // type of access protection
    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_DI_OVERRUN;
    lErrCde := DRV_EnableEvent(ghDev, ptEnableEvent);
    ptEnableEvent.EventType := ADS_EVT_DI_LOBUFREADY;
    lErrCde := DRV_EnableEvent(ghDev, ptEnableEvent);
    ptEnableEvent.EventType := ADS_EVT_DI_HIBUFREADY;
    lErrCde := DRV_EnableEvent(ghDev, ptEnableEvent);
    ptEnableEvent.EventType := ADS_EVT_DI_TERMINATED;
    lErrCde := DRV_EnableEvent(ghDev, ptEnableEvent);
    if( DoesErr(lErrCde) = 1 ) then
    begin
      VirtualFree( hUserBuf, dwUserBufferSize, MEM_DECOMMIT );
      VirtualFree( hUserBuf, 0, MEM_RELEASE);
      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 parameters
    lErrCde := DRV_DeviceSetProperty(ghDev, CFG_CounterCountValue, @gdwCounterValue[0], 12);
    lErrCde := DRV_DeviceSetProperty(ghDev, CFG_DioFdioDirection, @gdwDataWidth, 4);
    lErrCde := DRV_DeviceSetProperty(ghDev, CFG_DiOperationMode, @gdwDIOperationMode, 4);
    lErrCde := DRV_DeviceSetProperty(ghDev, CFG_DiStartMethod, @gdwDIStartMode, 4);
    lErrCde := DRV_DeviceSetProperty(ghDev, CFG_DiStopMethod, @gdwDIStopMode, 4);
    lErrCde := DRV_DeviceSetProperty(ghDev, CFG_DiPatternMatchValue, @gdwDIMatchValue, 4);
    lErrCde := DRV_DeviceSetProperty(ghDev, CFG_DiPacerSource, @gdwDITriggerSource, 4);
    if gdwBoardId = BD_MIC3755 then
    begin
       lErrCde := DRV_DeviceSetProperty(ghDev, CFG_DiTransferRequestMode, @gdwDiDmaMode, 4);
    end;
 
    if( DoesErr(lErrCde) = 1 ) then
    begin
      VirtualFree( hUserBuf, dwUserBufferSize, MEM_DECOMMIT );
      VirtualFree( hUserBuf, 0, MEM_RELEASE);
      Exit;
    end;

    // Start fast DI
    lErrCde := DRV_FDIStart(ghDev, gdwCyclicMode, dwCount, hUserBuf);
    if( DoesErr(lErrCde) = 1 ) then
    begin
      VirtualFree( hUserBuf, dwUserBufferSize, MEM_DECOMMIT );
      VirtualFree( hUserBuf, 0, MEM_RELEASE);
      Exit;
    end;

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

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

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

     BtRun.Enabled  := TRUE;
     BtStop.Enabled := FALSE;
     BtExit.Enabled := TRUE;
     btShow.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_DI_OVERRUN;
    lErrCde := DRV_EnableEvent(ghDev, ptEnableEvent);
    ptEnableEvent.EventType := ADS_EVT_DI_LOBUFREADY;
    lErrCde := DRV_EnableEvent(ghDev, ptEnableEvent);
    ptEnableEvent.EventType := ADS_EVT_DI_HIBUFREADY;
    lErrCde := DRV_EnableEvent(ghDev, ptEnableEvent);
    ptEnableEvent.EventType := ADS_EVT_DI_TERMINATED;
    lErrCde := DRV_EnableEvent(ghDev, ptEnableEvent);
      VirtualFree( hUserBuf, dwUserBufferSize, MEM_DECOMMIT );
      VirtualFree( hUserBuf, 0, MEM_RELEASE);

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

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

procedure TfrmMain.btShowClick(Sender: TObject);
begin
    frmShowData.Show;
end;

end.