mainfrm.pas

usb4711A数据采集卡的DI转换通道程序

unit Mainfrm;

interface

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

type
  TfrmMain = class(TForm)
    GroupBox1: TGroupBox;
    cmdSelectDevice: TButton;
    ctlDeviceName: TStaticText;
    GroupBox2: TGroupBox;
    txtPort: TEdit;
    ctlSpinPort: TUpDown;
    GroupBox3: TGroupBox;
    GroupBox4: TGroupBox;
    Label1: TLabel;
    txtScanTime: TEdit;
    Label2: TLabel;
    Label3: TLabel;
    ctlData: TStaticText;
    Label4: TLabel;
    cmdStart: TButton;
    cmdStop: TButton;
    cmdClose: TButton;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    cmdEnableDI0: TButton;
    cmdDisableDI0: TButton;
    cmdEnableDI16: TButton;
    cmdDisableDI16: TButton;
    txtEvtCntDI0: TEdit;
    txtEvtCntDI16: TEdit;
    ctlEvtFrqDI0: TStaticText;
    ctlEvtFrqDI16: TStaticText;
    Timer1: TTimer;

    procedure cmdCloseClick(Sender: TObject);
    procedure cmdSelectDeviceClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ctlSpinPortClick(Sender: TObject; Button: TUDBtnType);
    procedure txtPortChange(Sender: TObject);
    procedure cmdStartClick(Sender: TObject);
    procedure cmdStopClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure CheckEvent();
    procedure cmdEnableDI0Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure cmdDisableDI0Click(Sender: TObject);
    procedure cmdEnableDI16Click(Sender: TObject);
    procedure cmdDisableDI16Click(Sender: TObject);
  private
    { Private declarations }
    lDeviceNumber   : Longint;
    ptEnableEvent   : PT_EnableEvent;       {Enable event}
    DevFeatures     : DEVFEATURES;    // structure for device features
    ptDevFeatures   : PT_DeviceGetFeatures;  // Devfeatures table
    CheckEventType  : Longint ;
    ptCheckEvent    : PT_CheckEvent;
    ptDioReadPortByte : PT_DioReadPortByte;
    PortChannel     : Smallint;
    dwStartTime     : DWORD;
    dwCurrentTime   : DWORD;
    dwTime          : DWORD;
    Thread : CheckThread;
  public
    { Public declarations }
    hDeviceHandle          : Longint;       {Device handle for every device}
    lErrCde                : Longint;
    EventCountDI0          : Longint;
    EventCountDI16         : Longint;
    gbStart                : Boolean;
    gbEnableDI0            : Boolean;
    gbEnableDI16           : Boolean;
  end;

var
  frmMain: TfrmMain;

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.cmdCloseClick(Sender: TObject);
begin
  if (gbStart or gbEnableDI0 or gbEnableDI16) then
  begin
      Application.MessageBox('The timer or event is enabled, close them before close device!','Demo Message',MB_OK);
      Exit;
  end;
  if( hDeviceHandle <>0 ) then
       DRV_DeviceClose(hDeviceHandle);
  Close();
end;

procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if (gbStart or gbEnableDI0 or gbEnableDI16) then
  begin
      Application.MessageBox('The timer or event is enabled, close them before close device!','Demo Message',MB_OK);
      Action := caNone;
      Exit;
  end;
  if( hDeviceHandle <>0 ) then
       DRV_DeviceClose(hDeviceHandle);
  Action := caFree;
end;

procedure TfrmMain.cmdSelectDeviceClick(Sender: TObject);
var
  szDeviceName : array[0..100] of char;
  lErrCde      : Longint;
begin
  if (gbStart or gbEnableDI0 or gbEnableDI16) then
  begin
      Application.MessageBox('The timer or event is enabled, close them before select device!','Demo Message',MB_OK);
      Exit;
  end;
  if( hDeviceHandle <>0 ) then
       DRV_DeviceClose(hDeviceHandle);

  lErrCde := DRV_SelectDevice( Handle, True, lDeviceNumber, szDeviceName);
  if( DoesErr(lErrCde) = 1 ) then Exit;

  ctlDeviceName.Caption := AnsiString(szDeviceName);

  lErrCde := DRV_DeviceOpen(lDeviceNumber, hDeviceHandle);
  if( DoesErr(lErrCde) = 1 ) then   Exit;

   // get device features
  ptDevFeatures.buffer := @DevFeatures;
  ptDevFeatures.size := sizeof(DEVFEATURES);
  lErrCde := DRV_DeviceGetFeatures(hDeviceHandle,ptDevFeatures);
  if( DoesErr(lErrCde) = 1 ) then
  begin
    DRV_DeviceClose(hDeviceHandle);
    Exit;
  end;

  ctlSpinPort.Max := Trunc(DevFeatures.usMaxDIChl / 8-1);
  ctlSpinPort.min := 0;
  ctlSpinPort.Position :=0;
  ctlSpinPortClick(Sender,btPrev);

  cmdStart.Enabled :=True;
  cmdEnableDI0.Enabled :=True;
  cmdEnableDI16.Enabled := True;

end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
   hDeviceHandle :=0;
   gbStart := False;
   gbEnableDI0 := False;
   gbEnableDI16 := False;
   ctlEvtFrqDI0.Caption := '0';
   ctlEvtFrqDI16.Caption := '0';
   cmdSelectDeviceClick(Sender);
end;

procedure TfrmMain.ctlSpinPortClick(Sender: TObject; Button: TUDBtnType);
begin
  txtPort.Text := IntToStr( ctlSpinPort.position);
end;

procedure TfrmMain.txtPortChange(Sender: TObject);
var
  lPort : Smallint;
begin
  try
  lPort := StrToInt(txtPort.Text );
  if((lPort >ctlSpinPort.Max) or (lPort< ctlSpinPort.Min))  then
  begin
    txtPort.Text := IntToStr(ctlSpinPort.Min)
  end
  else
    PortChannel := StrToInt(txtPort.Text);
  except
        txtPort.Text := IntToStr(ctlSpinPort.Min);
  end;
end;

procedure TfrmMain.cmdStartClick(Sender: TObject);
  var scantime : Smallint;
begin
  try
    scantime := StrToInt(txtScanTime.Text );
    if((scantime<1) or (scantime>10000))   then
    begin
        ShowMessage('ScanTime must be a integer between 1 and 10000');
        Exit;
    end;
    Timer1.Interval :=scantime;
    Timer1.Enabled := True;
    cmdStart.Enabled := False;
    cmdStop.Enabled :=True;
    gbStart := True;
  except
     txtScanTime.Text := IntToStr(1000);
  end;
end;

procedure TfrmMain.cmdStopClick(Sender: TObject);
begin
  cmdStop.Enabled := False;
  cmdStart.Enabled := True;
  Timer1.Enabled :=False;
  gbStart := False;
end;

procedure TfrmMain.Timer1Timer(Sender: TObject);
var
   gwValue : Smallint;
begin
   ptDioReadPortByte.port := PortChannel;
   ptDioReadPortByte.value := @gwValue;
   lErrCde := DRV_DioReadPortByte(hDeviceHandle,ptDioReadPortByte);
   if( DoesErr(lErrCde) = 1 ) then
   begin
   cmdStopClick(Sender);
   Exit;
   end;
   ctlData.Caption := IntToHex(gwValue,2);
end;

procedure TfrmMain.CheckEvent();
begin
   ptCheckEvent.EventType := @CheckEventType;
   ptCheckEvent.Milliseconds :=  1000;

   lErrCde := DRV_CheckEvent(hDeviceHandle, ptCheckEvent);
   if(lErrCde = 0) then
   begin
       if(CheckEventType=ADS_EVT_INTERRUPT_DI0) then
             EventCountDI0:=EventCountDI0+1;
       if(CheckEventType=ADS_EVT_INTERRUPT_DI16) then
             EventCountDI16:=EventCountDI16+1;
   end
   else
   begin
        if(gbEnableDI0 or gbEnableDI16) then
            DoesErr(lErrCde);
   end;
   dwCurrentTime := GetTickCount();
   dwTime := dwCurrentTime - dwStartTime;
   if(dwTime >=1000) then
   begin
      if(gbEnableDI0) then
        ctlEvtFrqDI0.Caption := FormatFloat('0.0000',EventCountDI0 *1000.0 /dwTime);
      if(gbEnableDI16) then
         ctlEvtFrqDI16.Caption := FormatFloat('0.0000',EventCountDI16 *1000.0 /dwTime);
      EventCountDI0 :=0;
      EventCountDI16 :=0;
      dwStartTime := GetTickCount();
   end;
end;

procedure TfrmMain.cmdEnableDI0Click(Sender: TObject);
begin
    try
    ptEnableEvent.EventType := ADS_EVT_INTERRUPT_DI0;
    ptEnableEvent.Enabled := 1;
    ptEnableEvent.Count := StrToInt(txtEvtCntDI0.Text);
    lErrCde := DRV_EnableEvent( hDeviceHandle, ptEnableEvent );
    if( DoesErr(lErrCde) = 1 ) then
    begin
      Exit;
    End;
    EventCountDI0 := 0;
    gbEnableDI0 := True;
    if(gbEnableDI16 = False) then
    begin
        dwStartTime := GetTickCount();
        Thread := CheckThread.Create(False);
    end;


    cmdEnableDI0.Enabled := False;
    cmdDisableDI0.Enabled := True;
    except
        {if you want to process the exception,add code here}
    end;
end;



procedure TfrmMain.cmdDisableDI0Click(Sender: TObject);
begin
    try
    ptEnableEvent.EventType := ADS_EVT_INTERRUPT_DI0;
    ptEnableEvent.Enabled := 0;
    ptEnableEvent.Count := StrToInt(txtEvtCntDI0.Text);
    lErrCde := DRV_EnableEvent( hDeviceHandle, ptEnableEvent );
    if( DoesErr(lErrCde) = 1 ) then
    begin
      Exit;
    End;

    gbEnableDI0 := False;

    cmdEnableDI0.Enabled := True;
    cmdDisableDI0.Enabled := False;
    ctlEvtFrqDI0.Caption := '0';
    except
            {if you want to process the exception,add code here}
    end;
end;

procedure TfrmMain.cmdEnableDI16Click(Sender: TObject);
begin
    try
    ptEnableEvent.EventType := ADS_EVT_INTERRUPT_DI16;
    ptEnableEvent.Enabled := 1;
    ptEnableEvent.Count := StrToInt(txtEvtCntDI16.Text);
    lErrCde := DRV_EnableEvent( hDeviceHandle, ptEnableEvent );
    if( DoesErr(lErrCde) = 1 ) then
    begin
      Exit;
    End;
    EventCountDI16 := 0;
    if(gbEnableDI0 = False) then
    begin
        dwStartTime := GetTickCount();
        Thread := CheckThread.Create(False);
    end;
    gbEnableDI16 := True;

    cmdEnableDI16.Enabled := False;
    cmdDisableDI16.Enabled := True;
    except
        {if you want to process the exception,add code here}
    end;
end;

procedure TfrmMain.cmdDisableDI16Click(Sender: TObject);
begin
    try
    ptEnableEvent.EventType := ADS_EVT_INTERRUPT_DI16;
    ptEnableEvent.Enabled := 0;
    ptEnableEvent.Count := StrToInt(txtEvtCntDI16.Text);
    lErrCde := DRV_EnableEvent( hDeviceHandle, ptEnableEvent );
    if( DoesErr(lErrCde) = 1 ) then
    begin
      Exit;
    End;

    gbEnableDI16 := False;

    cmdEnableDI16.Enabled := True;
    cmdDisableDI16.Enabled := False;
    ctlEvtFrqDI16.Caption := '0';
    except
            {if you want to process the exception,add code here}
    end;
end;

end.