📄 unit1.pas
字号:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, StdCtrls, Driver, Event, Paras, GetEvent;
type
TForm1 = class(TForm)
GroupBox1: TGroupBox;
editDevName: TEdit;
btnSelDev: TButton;
GroupBox2: TGroupBox;
cmbCounter: TComboBox;
GroupBox3: TGroupBox;
Label2: TLabel;
Label3: TLabel;
editStartPort: TEdit;
editPortCount: TEdit;
GroupBox4: TGroupBox;
Label4: TLabel;
Label5: TLabel;
editStartCntr: TEdit;
editCntrCount: TEdit;
GroupBox5: TGroupBox;
lsvCntr: TListView;
lsvDI: TListView;
btnStart: TButton;
btnStop: TButton;
btnClose: TButton;
editCompData: TEdit;
Label1: TLabel;
Label6: TLabel;
Label7: TLabel;
cmbInt: TComboBox;
procedure FormCreate(Sender: TObject);
procedure btnSelDevClick(Sender: TObject);
procedure btnStartClick(Sender: TObject);
procedure btnStopClick(Sender: TObject);
procedure CheckEvent();
procedure btnCloseClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
m_ErrCde: Longint;
m_DriverHandle: Longint;
m_szErrMsg: array [0..79] of char;
m_ulDevNum: Longint;
m_bContinue: Boolean;
m_CurCounter: SHORT;
m_InterruptSrc: Longint;
m_StartPort: Longint;
m_PortCount: Longint;
m_StartCntr: Longint;
m_CntrCount: Longint;
Thread : TCheckThread;
ptEnableEvent : PT_EnableEvent; // Enable event
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
var
DeviceName: array [0..49] of char;
begin
m_ulDevNum := 0;
DRV_SelectDevice(Handle, FALSE, m_ulDevNum, DeviceName);
editDevName.Text := DeviceName;
m_ErrCde := DRV_DeviceOpen(m_ulDevNum, m_DriverHandle);
if (m_ErrCde <> SUCCESS) then
begin
DRV_GetErrorMessage(m_ErrCde, @m_szErrMsg[0]);
MessageBox(Handle, m_szErrMsg, 'Device Open', MB_OK);
end;
cmbCounter.ItemIndex := 0;
cmbInt.ItemIndex := 0;
btnStop.Enabled := False;
end;
procedure TForm1.btnSelDevClick(Sender: TObject);
var
DeviceName: array [0..49] of char;
begin
DRV_SelectDevice(Handle, FALSE, m_ulDevNum, DeviceName);
editDevName.Text := DeviceName;
m_ErrCde := DRV_DeviceOpen(m_ulDevNum, m_DriverHandle);
if (m_ErrCde <> SUCCESS) then
begin
DRV_GetErrorMessage(m_ErrCde, @m_szErrMsg[0]);
MessageBox(Handle, m_szErrMsg, 'Device Open', MB_OK);
end;
end;
procedure TForm1.btnStartClick(Sender: TObject);
var
dwEventID: Longint;
ulSize: Longint;
iSize: Integer;
pCompData: array of Longint;
begin
lsvDI.Items.Clear();
lsvCntr.Items.Clear();
m_StartPort := StrToInt(editStartPort.Text);
m_PortCount := StrToInt(editPortCount.Text);
m_StartCntr := StrToInt(editStartCntr.Text);
m_CntrCount := StrToInt(editCntrCount.Text);
m_CurCounter := cmbCounter.ItemIndex;
dwEventID := 0;
case cmbInt.ItemIndex of
0: dwEventID := ADS_EVT_OVERFLOW_CNT0 + m_CurCounter;
1: dwEventID := ADS_EVT_UNDERFLOW_CNT0 + m_CurCounter;
2: dwEventID := ADS_EVT_INDEX_CNT0 + m_CurCounter;
3: dwEventID := ADS_EVT_OVERCOMPARE_CNT0 + m_CurCounter;
4: dwEventID := ADS_EVT_UNDERCOMPARE_CNT0 + m_CurCounter;
5: dwEventID := ADS_EVT_DI_INTERRUPT0;
6: dwEventID := ADS_EVT_DI_INTERRUPT1;
7: dwEventID := ADS_EVT_DI_INTERRUPT2;
8: dwEventID := ADS_EVT_DI_INTERRUPT3;
9: dwEventID := ADS_EVT_INTERRUPT_TIMER4;
end;
m_InterruptSrc := dwEventID;
if ((dwEventID >= ADS_EVT_DI_INTERRUPT0) and (dwEventID <= ADS_EVT_DI_INTERRUPT3 )) then
begin
m_ErrCde := AdxDioEnableEventAndSpecifyDiPorts(m_DriverHandle,
dwEventID, m_StartPort, m_PortCount);
m_ErrCde := AdxDioEnableEventAndSpecifyEventCounter(m_DriverHandle,
dwEventID, m_StartCntr, m_CntrCount);
end
else
begin
m_ErrCde := AdxCntrEnableEventAndSpecifyEventCounter(m_DriverHandle,
dwEventID, m_StartCntr, m_CntrCount);
end;
if (m_ErrCde <> SUCCESS) then
begin
DRV_GetErrorMessage(m_ErrCde, @m_szErrMsg[0]);
MessageBox(Handle, m_szErrMsg, 'Driver Message', MB_OK);
end;
if ((dwEventID = ADS_EVT_OVERCOMPARE_CNT0 + m_CurCounter) or (dwEventID = ADS_EVT_UNDERCOMPARE_CNT0 + m_CurCounter)) then
begin
// Set Compare Data
m_ErrCde := DRV_DeviceGetProperty(m_DriverHandle, CFG_CntrCompareData, NIL, ulSize);
if (m_ErrCde = SUCCESS) then
begin
iSize := ulSize div SizeOf(ulSize);
SetLength(pCompData, iSize);
m_ErrCde := DRV_DeviceGetProperty(m_DriverHandle, CFG_CntrCompareData, @pCompData[0], ulSize);
pCompData[m_CurCounter] := StrToInt(editCompData.Text);
m_ErrCde := DRV_DeviceSetProperty(m_DriverHandle, CFG_CntrCompareData, @pCompData[0], ulSize);
end;
end;
btnSelDev.Enabled := false;
btnStart.Enabled := false;
btnStop.Enabled := true;
btnClose.Enabled := false;
m_bContinue := true;
Thread := TCheckThread.Create(False);
end;
procedure TForm1.btnStopClick(Sender: TObject);
var
dwEventID: Longint;
begin
dwEventID := m_InterruptSrc;
if ((dwEventID >= ADS_EVT_DI_INTERRUPT0) and (dwEventID <= ADS_EVT_DI_INTERRUPT3)) then
m_ErrCde := AdxDioDisableEvent(m_DriverHandle, dwEventID)
else
m_ErrCde := AdxCntrDisableEvent(m_DriverHandle, dwEventID);
if (m_ErrCde <> SUCCESS) then
begin
DRV_GetErrorMessage(m_ErrCde, @m_szErrMsg[0]);
MessageBox(Handle, m_szErrMsg, 'Driver Message', MB_OK);
end;
m_bContinue := false;
if (Thread <> Nil) then
Thread.Terminate;
btnSelDev.Enabled := true;
btnStart.Enabled := true;
btnStop.Enabled := false;
btnClose.Enabled := true;
end;
procedure TForm1.CheckEvent();
var
ptCheckEvent: PT_CheckEvent;
usEventType: Word;
pData: array[0..2] of Byte;
pCntrData: array[0..3] of Longint;
i: SHORT;
usTmp: SHORT;
pListItem: TListItem;
ulTmp: Longint;
begin
ptCheckEvent.EventType := @usEventType;
ptCheckEvent.Milliseconds := 1000;
while ( m_bContinue) do
begin
if (DRV_CheckEvent(m_DriverHandle, ptCheckEvent) = SUCCESS) then
begin
if ((usEventType >= ADS_EVT_DI_INTERRUPT0) and (usEventType <= ADS_EVT_DI_INTERRUPT3)) then
begin
AdxDioGetLatestEventDiPortsState(m_DriverHandle, usEventType, pData[0], m_PortCount);
lsvDI.Items.Clear();
for i := 0 to m_PortCount - 1 do
begin
usTmp := i + m_StartPort;
pListItem := lsvDI.Items.Add();
pListItem.Caption := Format('Port%d',[usTmp]);
usTmp := pData[i];
pListItem.SubItems.Add(Format('%d', [usTmp]));
end;
end;
if ((usEventType <> ADS_EVT_NO_EVENT) and (usEventType <> ADS_EVT_TIME_OUT) ) then
begin
AdxCntrGetLatestEventCounterValue(m_DriverHandle, usEventType, pCntrData[0], m_CntrCount);
lsvCntr.Items.Clear();
for i := 0 to m_CntrCount - 1 do
begin
usTmp := i + m_StartCntr;
pListItem := lsvCntr.Items.Add();
pListItem.Caption := Format('Counter%d', [usTmp]);
ulTmp := pCntrData[i];
pListItem.SubItems.Add (IntToStr(ulTmp));
end;
end;
end;
end;
end;
procedure TForm1.btnCloseClick(Sender: TObject);
begin
Close;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
m_bContinue := FALSE;
if (Thread <> Nil) then
Thread.Terminate;
if ( m_DriverHandle <> NULL ) then
DRV_DeviceClose(m_DriverHandle);
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -