⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 mainform.pas

📁 usb4711A数据采集卡的DI转换通道程序
💻 PAS
字号:
unit MainForm;

interface

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

type
  TfrmMain = class(TForm)
    Label6: TLabel;
    GroupBox1: TGroupBox;
    txtDeviceName: TStaticText;
    GroupBox2: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    txtTimer: TEdit;
    txtDIData: TEdit;
    btnStart: TButton;
    btnStop: TButton;
    txtPort: TEdit;
    GroupBox3: TGroupBox;
    Label4: TLabel;
    Label5: TLabel;
    radNormal: TRadioButton;
    radCritical: TRadioButton;
    txtCount: TEdit;
    txtIntRate: TEdit;
    btnDisable: TButton;
    btnEnable: TButton;
    btnExit: TButton;
    btnSelect: TButton;
    tmrRead: TTimer;
    tmrCount: TTimer;
    procedure btnSelectClick(Sender: TObject);
    procedure btnStartClick(Sender: TObject);
    procedure tmrReadTimer(Sender: TObject);
    procedure btnStopClick(Sender: TObject);
    procedure btnEnableClick(Sender: TObject);
    procedure btnDisableClick(Sender: TObject);
    procedure CheckEvent;
    procedure tmrCountTimer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btnExitClick(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;
    DIValue : Smallint;
    Thread : CheckThread;
    dwStartTime : DWORD;

  public
    { Public declarations }
    hDeviceHandle          : Longint;       {Device handle for every device}
    lErrCde                : Longint;
    EventCount             : Longint;
  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.btnSelectClick(Sender: TObject);
var
  szDeviceName : array[0..100] of char;
  lErrCde      : Longint;
begin
  {Select devcie from device list}
  lErrCde := DRV_SelectDevice( Handle, True, lDeviceNumber, szDeviceName);
  if( DoesErr(lErrCde) = 1 ) then Exit;
  txtDeviceName.Caption := AnsiString(szDeviceName);
    if( hDeviceHandle <>0 ) then
       DRV_DeviceClose(hDeviceHandle);

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



end;

procedure TfrmMain.btnStartClick(Sender: TObject);
begin
      tmrRead.Interval := StrToInt(txtTimer.text);
      tmrRead.Enabled := true;
      btnStart.Enabled := false;
      btnStop.Enabled := true;
end;

procedure TfrmMain.tmrReadTimer(Sender: TObject);
begin
   ptDioReadPortByte.port := StrToInt(txtPort.Text);
   ptDioReadPortByte.value := @DIValue;

   lErrCde := DRV_DioReadPortByte(hDeviceHandle,
                ptDioReadPortByte);
    if( DoesErr(lErrCde) = 1 ) then
    begin
      tmrRead.Enabled := false;
      Exit;
    End
    else
    begin
      txtDIData.Text := IntToHex(DIValue,2);
    end;
end;

procedure TfrmMain.btnStopClick(Sender: TObject);
begin
      tmrRead.Enabled := false;
      btnStart.Enabled := true;
      btnStop.Enabled := false;
end;

procedure TfrmMain.btnEnableClick(Sender: TObject);
begin
    ptEnableEvent.EventType := ADS_EVT_INTERRUPT;
    ptEnableEvent.Enabled := 1;
    ptEnableEvent.Count := StrToInt(txtCount.Text);
    lErrCde := DRV_EnableEvent( hDeviceHandle, ptEnableEvent );
    if( DoesErr(lErrCde) = 1 ) then
    begin
      Exit;
    End;
    EventCount := 0;
    Thread := CheckThread.Create(true);

    if( radNormal.Checked ) then
        Thread.Priority := tpNormal
    else
       Thread.Priority := tpTimeCritical;
    Thread.Resume();
    btnEnable.Enabled := false;
    btnDisable.Enabled := true;
    tmrCount.Enabled := true;
    btnSelect.Enabled := false;
    btnExit.Enabled := false;
end;

procedure TfrmMain.btnDisableClick(Sender: TObject);
var
     EventSetting   : PT_EnableEvent;
     dwExitCode     : DWORD;
begin
    btnSelect.Enabled := true;
    btnExit.Enabled := true;
    EventSetting.EventType := ADS_EVT_INTERRUPT;
    EventSetting.Enabled := 0;
    EventSetting.Count := StrToInt(txtCount.Text);
    lErrCde := DRV_EnableEvent( hDeviceHandle, EventSetting );
    if( DoesErr(lErrCde) = 1 ) then
    begin
      Exit;
    End;
    tmrCount.Enabled := false;

    Thread.Terminate();

    GetExitCodeThread( Thread.Handle ,dwExitCode) ;
    if(dwExitCode = STILL_ACTIVE ) then
        TerminateThread( Thread.Handle, dwExitCode);

    btnEnable.Enabled := true;
    btnDisable.Enabled := false;
end;
procedure TfrmMain.CheckEvent();
begin
   ptCheckEvent.EventType := @CheckEventType;
   ptCheckEvent.Milliseconds :=  1000;

    lErrCde := DRV_CheckEvent(hDeviceHandle, ptCheckEvent);
   if(lErrCde = 0) then
        EventCount:=EventCount+1;


end;

procedure TfrmMain.tmrCountTimer(Sender: TObject);
begin

    if( dwStartTime <> 0 ) then
    txtIntRate.Text := FormatFloat('0.0000',EventCount*1000.0/(GetTickCount()-dwStartTime));
    EventCount := 0;
    dwStartTime := GetTickCount();
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  hDeviceHandle :=0;
  btnSelectClick (Sender);
end;

procedure TfrmMain.btnExitClick(Sender: TObject);
begin
   Close();
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -