📄 mainform.pas
字号:
unit MainForm;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Driver, Thread;
type
TfrmMain = class(TForm)
Label6: TLabel;
labDevice: TLabel;
GroupBox1: TGroupBox;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label7: TLabel;
Label8: TLabel;
Label9: TLabel;
edtCounter0: TEdit;
edtCounter1: TEdit;
edtCounter2: TEdit;
btnSelectDevice: TButton;
GroupBox2: TGroupBox;
Label4: TLabel;
Label5: TLabel;
radNormal: TRadioButton;
radTimeCritical: TRadioButton;
edtCount: TEdit;
btnEnable: TButton;
btnDisable: TButton;
edtCout: TEdit;
GroupBox3: TGroupBox;
chkInterrupt: TCheckBox;
chkGroup0: TCheckBox;
chkGroup1: TCheckBox;
btnExit: TButton;
procedure FormCreate(Sender: TObject);
procedure btnSelectDeviceClick(Sender: TObject);
procedure btnEnableClick(Sender: TObject);
procedure btnDisableClick(Sender: TObject);
procedure btnExitClick(Sender: TObject);
procedure CheckEvent();
private
{ Private declarations }
chkThread : CheckThread;
public
{ Public declarations }
end;
var
frmMain: TfrmMain;
m_DriverHandle : integer; // driver handle
m_szErrMsg : array[0..80] of char; // Use for MESSAGEBOX function
m_bHiPriority : Boolean; // Evnt thread's priority
m_bContinue : Boolean;
m_ulDevNum : integer;
m_ErrCde : Longint;
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.FormCreate(Sender: TObject);
begin
btnSelectDeviceClick (nil);
end;
procedure TfrmMain.btnSelectDeviceClick(Sender: TObject);
var
DeviceName : array[0..50] of char;
begin
// TODO: Add your control notification handler code here
DRV_SelectDevice( Handle, FALSE, m_ulDevNum, DeviceName );
labDevice.Caption := DeviceName;
end;
procedure TfrmMain.btnEnableClick(Sender: TObject);
var
EventSetting : PT_EnableEvent;
CounterSetting : PT_TimerCountSetting;
CounterVal : integer;
begin
//
m_ErrCde := DRV_DeviceOpen( m_ulDevNum, m_DriverHandle);
// Test if Supportted Device!!!
CounterSetting.counter := 2;
CounterSetting.Count := 2;
m_ErrCde := DRV_TimerCountSetting(m_DriverHandle, CounterSetting);
if( DoesErr(m_ErrCde) = 1 ) then
Exit;
// Real Start
EventSetting.EventType := 0;
if( chkInterrupt.Checked ) then
EventSetting.EventType := EventSetting.EventType or ADS_EVT_INTERRUPT;
if( chkGroup0.Checked ) then
EventSetting.EventType := EventSetting.EventType or ADS_EVT_PORT0;
if( chkGroup1.Checked ) then
EventSetting.EventType := EventSetting.EventType or ADS_EVT_PORT1;
// Counter Value Set
CounterSetting.counter := 2;
CounterSetting.Count := StrToInt( edtCounter2.Text );
m_ErrCde := DRV_TimerCountSetting(m_DriverHandle, CounterSetting);
if( DoesErr(m_ErrCde) = 1 ) then
Exit;
CounterVal := StrToInt( edtCounter0.Text ) shl 16 + StrToInt( edtCounter1.Text );
CounterSetting.counter := 1;
CounterSetting.Count := CounterVal;
m_ErrCde := DRV_TimerCountSetting(m_DriverHandle, CounterSetting);
if( DoesErr(m_ErrCde) = 1 ) then
Exit;
CounterSetting.counter := 0;
m_ErrCde := DRV_TimerCountSetting(m_DriverHandle, CounterSetting);
if( DoesErr(m_ErrCde) = 1 ) then
Exit;
// Enable Event
EventSetting.Enabled := 1;
EventSetting.Count := StrToInt(edtCount.Text);
m_ErrCde := DRV_EnableEvent( m_DriverHandle, EventSetting );
if( DoesErr(m_ErrCde) = 1 ) then
Exit;
btnEnable.Enabled := false;
btnDisable.Enabled := true;
btnSelectDevice.Enabled := false;
btnExit.Enabled := false;
m_bContinue := true;
chkThread := CheckThread.Create(true);
if ( radNormal.Checked ) then
chkThread.Priority := tpNormal
else
chkThread.Priority := tpTimeCritical;
chkThread.Resume();
end;
procedure TfrmMain.btnDisableClick(Sender: TObject);
var
EventSetting : PT_EnableEvent;
begin
btnSelectDevice.Enabled := true;
btnExit.Enabled := true;
btnEnable.Enabled := true;
btnDisable.Enabled := false;
EventSetting.EventType := ADS_EVT_INTERRUPT;
EventSetting.Enabled := 0;
EventSetting.Count := 1;
m_ErrCde := DRV_EnableEvent( m_DriverHandle, EventSetting );
m_bContinue := false;
Sleep(100);
chkThread.Terminate;
if( DoesErr(m_ErrCde) = 1 ) then
Exit;
m_ErrCde := DRV_DeviceClose( m_DriverHandle);
if( DoesErr(m_ErrCde) = 1 ) then
Exit;
end;
procedure TfrmMain.btnExitClick(Sender: TObject);
begin
Close();
end;
procedure TfrmMain.CheckEvent();
var
dwStartTime : LongInt;
dwCurrentTime : LongInt;
dwTime : LongInt;
dwEventCount : LongInt ;
ratio : single;
usEventType : integer;
ptCheckEvent : PT_CheckEvent;
begin
ptCheckEvent.EventType := @usEventType;
ptCheckEvent.Milliseconds := 1000;
dwStartTime := GetTickCount();
dwEventCount :=0;
while ( m_bContinue ) do
begin
if (DRV_CheckEvent( m_DriverHandle, ptCheckEvent ) = 0) then
dwEventCount := dwEventCount+1;
dwCurrentTime := GetTickCount();
dwTime := dwCurrentTime - dwStartTime;
if ( dwTime > 1000) then
begin
ratio := dwEventCount* 1000.0 / dwTime ;
edtCout.Text := FloatToStrF(ratio, ffFixed, 6,3 );
dwStartTime := GetTickCount();
dwEventCount := 0;
end;
end;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -