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, Event, paras, ComCtrls, EventThread, DISetForm,
   ExtCtrls;

type
   TfrmMain = class(TForm)
      GroupBox1: TGroupBox;
      txtDeviceName: TEdit;
      btnSelDev: TButton;
      GroupBox3: TGroupBox;
      Label1: TLabel;
      Label2: TLabel;
      Label3: TLabel;
      editScanTime: TEdit;
      editScanData: TEdit;
      btnStart: TButton;
      btnStop: TButton;
      cmbPort: TComboBox;
      GroupBox2: TGroupBox;
      lstIntChannel: TListView;
      btnFalling: TButton;
      btnRising: TButton;
      btnStopAll: TButton;
      GroupBox4: TGroupBox;
      txtFilterCounter: TEdit;
      btnFilter: TButton;
      btnExit: TButton;
      IntTimer: TTimer;
      ScanTimer: TTimer;
      Label4: TLabel;
      Label5: TLabel;
      Label6: TLabel;
      labFilterHz: TLabel;
      procedure btnSelDevClick(Sender: TObject);
      procedure SetlstTrigger();
      procedure SetlstFilter();
      procedure btnRisingClick(Sender: TObject);
      procedure btnFallingClick(Sender: TObject);
      procedure btnFilterClick(Sender: TObject);
      procedure lstIntChannelChange(Sender: TObject; Item: TListItem;
         Change: TItemChange);
      procedure CheckEventProc();
      procedure IntTimerTimer(Sender: TObject);
      procedure btnStopAllClick(Sender: TObject);
      procedure btnExitClick(Sender: TObject);
      procedure ScanTimerTimer(Sender: TObject);
      procedure btnStartClick(Sender: TObject);
      procedure btnStopClick(Sender: TObject);
      procedure FormCreate(Sender: TObject);
      procedure txtFilterCounterChange(Sender: TObject);

   private
      { Private declarations }
   public
      { Public declarations }
      m_ErrCde: Longint; { Return error code }
      m_DeviceHandle: Longint; { driver handle }
      m_ptDioReadPortByte: PT_DioReadPortByte;
      m_DeviceFeatures: DEVFEATURES;
      m_szErrMsg: array[0..79] of char; { Use for MESSAGEBOX function }
      m_bHiPriority: Boolean; { Evnt thread's priority }
      m_ulDevNum: Longint;
      DIRisingTrigger: array[0..15] of Byte;
      DIFallingTrigger: array[0..15] of Byte;
      DIFilterEnable: array[0..15] of Byte;
      DIInterruptEnable: array[0..15] of Byte;

      m_FilterCounter: DWORD;
      m_DIChanNum: Longint;
      chkThread: CheckThread;
      ptEnableEvent: PT_EnableEvent; // Enable event
      m_DeviceNum: Longint;
      ulDataLength: Integer;
      m_DIPortNum: Integer;
      dwEventCount: array[0..127] of DWORD;
      bDIEnableINT: array[0..127] of Boolean;
   end;

var
   frmMain: TfrmMain;
   i: Integer;
   j: Integer;
   szBuff: string;
   dwStartTime, dwCurrentTime, dwTime: DWORD;

implementation

{$R *.dfm}

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;

procedure TfrmMain.btnSelDevClick(Sender: TObject);
var
   DeviceName: array[0..100] of char;
   dwCount: Longint;
   ExitCode: DWORD;
   i: integer;
   lstItem: TListItem;
   ptGetFeatures: PT_DeviceGetFeatures;
begin
   if (m_DeviceHandle <> 0) then
   begin
      btnStopAllClick(Sender);
      if (Assigned(chkThread)) then
      begin
         GetExitCodeThread(chkThread.Handle, ExitCode);
         if (ExitCode = STILL_ACTIVE) then
            TerminateThread(chkThread.Handle, ExitCode);

         chkThread.Terminate();
         chkThread := nil;
      end;
      DRV_DeviceClose(m_DeviceHandle);
   end;

   for i:= 0 to 127 do
   bDIEnableINT[i]:= False;
   DRV_SelectDevice(Handle, FALSE, m_DeviceNum, DeviceName);
   txtDeviceName.Text := DeviceName;

   m_ErrCde := DRV_DeviceOpen(m_DeviceNum, m_DeviceHandle);
   if (DoesErr(m_ErrCde) = 1) then
      Exit;

   ptGetFeatures.buffer := @m_DeviceFeatures;
   ptGetFeatures.size := sizeof(DEVFEATURES);
   DRV_DeviceGetFeatures(m_DeviceHandle, ptGetFeatures);
   m_DIChanNum := m_DeviceFeatures.usMaxDIChl;
   m_DIPortNum := m_DIChanNum div 8;

   ulDataLength := sizeof(DWORD) * 4;
   m_ErrCde := DRV_DeviceGetProperty(m_DeviceHandle, CFG_DiTriggerEnableRisingForAll,
      @(DIRisingTrigger[0]), ulDataLength);
   m_ErrCde := DRV_DeviceGetProperty(m_DeviceHandle, CFG_DiTriggerEnableFallingForAll,
      @(DIFallingTrigger[0]), ulDataLength);
   m_ErrCde := DRV_DeviceGetProperty(m_DeviceHandle, CFG_DiFilterEnableForAll,
      @(DIFilterEnable[0]), ulDataLength);
   ulDataLength := sizeof(DWORD);
   m_ErrCde := DRV_DeviceGetProperty(m_DeviceHandle, CFG_DiFilterIntervalCounter,
      @m_FilterCounter, ulDataLength);

   if (DoesErr(m_ErrCde) = 1) then
      Exit;
   txtFilterCounter.Text := Format('%d', [m_FilterCounter]);
   lstIntChannel.Clear();
   for i := 0 to m_DIChanNum - 1 do
   begin
      lstItem := lstIntChannel.Items.Add;
      szBuff := Format('Port%x_%2.2d', [i div 8, i mod 8]);
      lstItem.Caption := szBuff;
      lstItem.SubItems.Add('None');
      lstItem.SubItems.Add('No');
      lstItem.SubItems.Add('0');
   end;
   cmbPort.Clear;
   for i := 0 to m_DIPortNum - 1 do
   begin
      szBuff := Format('Port%x', [i]);
      cmbPort.Items.Add(szBuff);
   end;
   cmbPort.ItemIndex := 0;

   SetlstTrigger();
   SetlstFilter();
end;

procedure TfrmMain.SetlstTrigger();
var
   lstItem: TListItem;
   DIPort: Integer;
   DIPortBit: Integer;

begin
   for i := 0 to m_DIChanNum - 1 do
   begin
      lstItem := lstIntChannel.Items[i];
      DIPort := i div 8;
      DIPortBit := 1 shl (i mod 8);
      if (((DIRisingTrigger[DIPort] and DIPortBit) <> 0) and
         ((DIFallingTrigger[DIPort] and DIPortBit) <> 0)) then
      begin
         szBuff := 'Rising & Falling edge';
      end
      else if ((DIRisingTrigger[DIPort] and DIPortBit) <> 0) then
      begin
         szBuff := 'Rising edge';
      end
      else if ((DIFallingTrigger[DIPort] and DIPortBit) <> 0) then
      begin
         szBuff := 'Falling edge';
      end
      else
         szBuff := 'None';
      lstItem.SubItems[0] := szBuff;
   end;

end;

procedure TfrmMain.SetlstFilter();
var
   lstItem: TListItem;
   DIPort: Integer;
   DIPortBit: Integer;
begin
   for i := 0 to m_DIChanNum - 1 do
   begin
      lstItem := lstIntChannel.Items[i];
      DIPort := i div 8;
      DIPortBit := 1 shl (i mod 8);
      if ((DIFilterEnable[DIPort] and DIPortBit) <> 0) then
         szBuff := 'Yes'
      else
         szBuff := 'No';

      lstItem.SubItems[1] := szBuff;
   end;

end;

procedure TfrmMain.btnRisingClick(Sender: TObject);
var
   DiDlg: TDISettingDlg;
begin
   Application.CreateForm(TDISettingDlg, DiDlg);
   for i := 0 to m_DIPortNum - 1 do
   begin
      if (DIRisingTrigger[i] = $FF) then
         DiDlg.chklstPort.Checked[i] := True;

      for j := 0 to 7 do
      begin
         if ((DIRisingTrigger[i] and (1 shl j)) <> 0) then
            DiDlg.chklstChan.Checked[i * 8 + j] := True
         else
            DiDlg.chklstChan.Checked[i * 8 + j] := False;
      end;
   end;
   DiDlg.labInfo.Caption := 'Enable or disable Rising trigger for every DI channel:';
   if( DiDlg.ShowModal() = mrOK )  then
   begin
      for i := 0 to m_DIChanNum - 1 do
      begin
         if (DiDlg.chklstChan.Checked[i]) then
            DIRisingTrigger[i div 8] := DIRisingTrigger[i div 8] or (1 shl (i mod 8))
         else
            DIRisingTrigger[i div 8] := DIRisingTrigger[i div 8] and (not (1 shl (i mod 8)));
      end;
      SetlstTrigger();
      ulDataLength := sizeof(Byte) * 16;
      DRV_DeviceSetProperty(m_DeviceHandle, CFG_DiTriggerEnableRisingForAll,
         @(DIRisingTrigger[0]), ulDataLength);
      //or
   {
      ulDataLength := sizeof(Byte) ;
      for i:=0 to 15 do
         DRV_DeviceSetProperty( m_DeviceHandle, CFG_DiTriggerEnableRisingPort0+i,
         &(DIRisingTrigger[i]) , ulDataLength);