📄 mainform.pas
字号:
unit MainForm;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Driver, Event, paras, EventThread, ExtCtrls;
type
TfrmMain = class(TForm)
GroupBox1: TGroupBox;
txtDeviceName: TEdit;
btnSelDev: TButton;
btnExit: TButton;
GBDO: TGroupBox;
chkDI0: TCheckBox;
chkDI1: TCheckBox;
chkDI2: TCheckBox;
chkDI3: TCheckBox;
chkDI4: TCheckBox;
chkDI5: TCheckBox;
chkDI6: TCheckBox;
chkDI7: TCheckBox;
cmbPort: TComboBox;
btnWrite: TButton;
btnRead: TButton;
GBWatchdog: TGroupBox;
Label2: TLabel;
txtWatchdogStatus: TEdit;
btnStart: TButton;
btnStop: TButton;
btnFeed: TButton;
chkAutoFeed: TCheckBox;
Label3: TLabel;
txtWatchdogCounter: TEdit;
Label4: TLabel;
Label5: TLabel;
txtAutoTimer: TEdit;
Label6: TLabel;
labWatchTime: TLabel;
AutoFeedTimer: TTimer;
txtPortStatus: TEdit;
Label1: TLabel;
GBPresetValue: TGroupBox;
txtP1: TEdit;
txtP2: TEdit;
txtP3: TEdit;
txtP4: TEdit;
txtP5: TEdit;
txtP6: TEdit;
txtP7: TEdit;
txtP8: TEdit;
Label7: TLabel;
Label8: TLabel;
Label9: TLabel;
Label10: TLabel;
Label11: TLabel;
Label12: TLabel;
Label13: TLabel;
Label14: TLabel;
Label16: TLabel;
GBWatchdogSet: TGroupBox;
Label15: TLabel;
Label17: TLabel;
Label18: TLabel;
Label19: TLabel;
Label20: TLabel;
Label21: TLabel;
Label22: TLabel;
Label23: TLabel;
Label24: TLabel;
txtWP1: TEdit;
txtWP2: TEdit;
txtWP3: TEdit;
txtWP4: TEdit;
txtWP5: TEdit;
txtWP6: TEdit;
txtWP7: TEdit;
txtWP8: TEdit;
btnSetPreset: TButton;
btnWatchdogSet: TButton;
labWatchdogTimer: TLabel;
procedure btnSelDevClick(Sender: TObject);
procedure btnFeedClick(Sender: TObject);
procedure btnStartClick(Sender: TObject);
procedure btnStopClick(Sender: TObject);
procedure CheckEventProc();
procedure chkAutoFeedClick(Sender: TObject);
procedure AutoFeedTimerTimer(Sender: TObject);
procedure btnWriteClick(Sender: TObject);
procedure btnReadClick(Sender: TObject);
procedure cmbPortChange(Sender: TObject);
procedure btnExitClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure txtP1Change(Sender: TObject);
procedure textEditChange(Sender: TEdit);
procedure txtP1KeyPress(Sender: TObject; var Key: Char);
procedure txtEditKeyPress(var Key: Char);
procedure txtP2Change(Sender: TObject);
procedure txtP2KeyPress(Sender: TObject; var Key: Char);
procedure txtP3Change(Sender: TObject);
procedure txtP4Change(Sender: TObject);
procedure txtP5Change(Sender: TObject);
procedure txtP6Change(Sender: TObject);
procedure txtP7Change(Sender: TObject);
procedure txtP8Change(Sender: TObject);
procedure txtP3KeyPress(Sender: TObject; var Key: Char);
procedure txtP4KeyPress(Sender: TObject; var Key: Char);
procedure txtP5KeyPress(Sender: TObject; var Key: Char);
procedure txtP6KeyPress(Sender: TObject; var Key: Char);
procedure txtP7KeyPress(Sender: TObject; var Key: Char);
procedure txtP8KeyPress(Sender: TObject; var Key: Char);
procedure txtWP1Change(Sender: TObject);
procedure txtWP1KeyPress(Sender: TObject; var Key: Char);
procedure txtWP2KeyPress(Sender: TObject; var Key: Char);
procedure txtWP3KeyPress(Sender: TObject; var Key: Char);
procedure txtWP4KeyPress(Sender: TObject; var Key: Char);
procedure txtWP5KeyPress(Sender: TObject; var Key: Char);
procedure txtWP6KeyPress(Sender: TObject; var Key: Char);
procedure txtWP7KeyPress(Sender: TObject; var Key: Char);
procedure txtWP8KeyPress(Sender: TObject; var Key: Char);
procedure txtWP2Change(Sender: TObject);
procedure txtWP3Change(Sender: TObject);
procedure txtWP4Change(Sender: TObject);
procedure txtWP5Change(Sender: TObject);
procedure txtWP6Change(Sender: TObject);
procedure txtWP7Change(Sender: TObject);
procedure txtWP8Change(Sender: TObject);
procedure btnSetPresetClick(Sender: TObject);
procedure btnWatchdogSetClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure txtWatchdogCounterChange(Sender: TObject);
procedure txtAutoTimerChange(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
m_ErrCde: Longint; { Return error code }
m_DeviceNum: Longint;
m_DeviceHandle: Longint; { driver handle }
m_ptDioWirtePortByte: PT_DioWritePortByte;
m_DeviceFeatures: DEVFEATURES;
m_szErrMsg: array[0..79] of char; { Use for MESSAGEBOX function }
m_bContinue: Boolean;
m_bFlag: Boolean; { thread flag }
DOWatchdogStatus: array[0..15] of Byte;
DOpresetStatus: array[0..15] of Byte;
WatchdogCounter: DWORD;
m_DOChanNum: Longint;
chkThread: CheckThread;
ptEnableEvent: PT_EnableEvent; // Enable event
ulDataLength: Integer;
m_DOPortNum: Integer;
end;
var
frmMain: TfrmMain;
i: Integer;
j: Integer;
szBuff: string;
dwExitCode: 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;
ptGetFeatures: PT_DeviceGetFeatures;
dwBoardID: DWORD;
begin
GBPresetValue.Enabled := False;
GBWatchdogSet.Enabled := False;
GBDO.Enabled := False;
GBWatchdog.Enabled := False;
if (m_DeviceHandle <> 0) then
begin
if (Assigned(chkThread)) then
begin
GetExitCodeThread(chkThread.Handle, ExitCode);
if (ExitCode = STILL_ACTIVE) then
TerminateThread(chkThread.Handle, ExitCode);
chkThread.Terminate;
chkThread.Free;
chkThread := nil;
end;
DRV_DeviceClose(m_DeviceHandle);
end;
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_DOChanNum := m_DeviceFeatures.usMaxDOChl;
m_DOPortNum := m_DOChanNum div 8;
if (m_DOChanNum = 0) then
begin
Application.MessageBox('The Device does not support DO function!', 'DO', MB_OK);
DRV_DeviceClose(m_DeviceHandle);
Exit;
end;
ulDataLength := sizeof(DWORD);
m_ErrCde := DRV_DeviceGetProperty(m_DeviceHandle, CFG_BoardID,
@dwBoardID, ulDataLength);
if (DoesErr(m_ErrCde) = 1) then
Exit;
if ((dwBoardID <> BD_PCI1758UDO) and (dwBoardID <> BD_PCI1758UDIO)) then
begin
Application.MessageBox('The Device does not support Watchdog function!', 'DO', MB_OK);
DRV_DeviceClose(m_DeviceHandle);
exit;
end;
ulDataLength := sizeof(DWORD);
m_ErrCde := DRV_DeviceGetProperty(m_DeviceHandle, CFG_WatchdogCounter,
@WatchdogCounter, ulDataLength);
ulDataLength := sizeof(BYTE) * 16;
m_ErrCde := DRV_DeviceGetProperty(m_DeviceHandle, CFG_DoWatchdogValue,
@(DOWatchdogStatus[0]), ulDataLength);
m_ErrCde := DRV_DeviceGetProperty(m_DeviceHandle, CFG_DoPresetValue,
@(DOpresetStatus[0]), ulDataLength);
if (DoesErr(m_ErrCde) = 1) then
Exit;
txtWatchdogCounter.Text := Format('%d',[WatchdogCounter]);
txtP1.Text := Format('%2.2x%2.2x', [DOpresetStatus[1], DOpresetStatus[0]]);
txtP2.Text := Format('%2.2x%2.2x', [DOpresetStatus[3], DOpresetStatus[2]]);
txtP3.Text := Format('%2.2x%2.2x', [DOpresetStatus[5], DOpresetStatus[4]]);
txtP4.Text := Format('%2.2x%2.2x', [DOpresetStatus[7], DOpresetStatus[6]]);
txtP5.Text := Format('%2.2x%2.2x', [DOpresetStatus[9], DOpresetStatus[8]]);
txtP6.Text := Format('%2.2x%2.2x', [DOpresetStatus[11], DOpresetStatus[10]]);
txtP7.Text := Format('%2.2x%2.2x', [DOpresetStatus[13], DOpresetStatus[12]]);
txtP8.Text := Format('%2.2x%2.2x', [DOpresetStatus[15], DOpresetStatus[14]]);
txtWP1.Text := Format('%2.2x%2.2x', [DOWatchdogStatus[1], DOWatchdogStatus[0]]);
txtWP2.Text := Format('%2.2x%2.2x', [DOWatchdogStatus[3], DOWatchdogStatus[2]]);
txtWP3.Text := Format('%2.2x%2.2x', [DOWatchdogStatus[5], DOWatchdogStatus[4]]);
txtWP4.Text := Format('%2.2x%2.2x', [DOWatchdogStatus[7], DOWatchdogStatus[6]]);
txtWP5.Text := Format('%2.2x%2.2x', [DOWatchdogStatus[9], DOWatchdogStatus[8]]);
txtWP6.Text := Format('%2.2x%2.2x', [DOWatchdogStatus[11], DOWatchdogStatus[10]]);
txtWP7.Text := Format('%2.2x%2.2x', [DOWatchdogStatus[13], DOWatchdogStatus[12]]);
txtWP8.Text := Format('%2.2x%2.2x', [DOWatchdogStatus[15], DOWatchdogStatus[14]]);
cmbPort.Clear;
for i := 0 to m_DOPortNum - 1 do
begin
szBuff := Format('Port%x', [i]);
cmbPort.Items.Add(szBuff);
end;
cmbPort.ItemIndex := 0;
GBPresetValue.Enabled := True;
GBWatchdogSet.Enabled := True;
GBDO.Enabled := True;
GBWatchdog.Enabled := True;
end;
procedure TfrmMain.btnFeedClick(Sender: TObject);
begin
m_ErrCde := DRV_WatchdogFeed(m_DeviceHandle);
if (DoesErr(m_ErrCde) = 1) then
Exit;
end;
procedure TfrmMain.btnStartClick(Sender: TObject);
var
ptEnableEvent: PT_EnableEvent; // Enable event
ptWatchdogStart: PT_WatchdogStart;
begin
ulDataLength := sizeof(DWORD);
DRV_DeviceSetProperty(m_DeviceHandle, CFG_WatchdogCounter,
@WatchdogCounter, ulDataLength);
btnStart.Enabled := False;
btnStop.Enabled := True;
ptEnableEvent.EventType := ADS_EVT_WATCHDOG_OVERRUN;
ptEnableEvent.Enabled := 1;
ptEnableEvent.Count := 1;
txtWatchdogStatus.Text := '';
m_ErrCde := DRV_EnableEvent(m_DeviceHandle, ptEnableEvent);
if(chkAutoFeed.Checked) then
AutoFeedTimer.Enabled:=True
else
AutoFeedTimer.Enabled:=False ;
if (DoesErr(m_ErrCde) = 1) then
Exit;
if (Assigned(chkThread) = False) then
begin
chkThread := CheckThread.Create(False);
end;
m_ErrCde := DRV_WatchdogStart(m_DeviceHandle, ptWatchdogStart);
if (DoesErr(m_ErrCde) = 1) then
Exit;
end;
procedure TfrmMain.btnStopClick(Sender: TObject);
var
ptEnableEvent: PT_EnableEvent; // Enable event
begin
if (Assigned(chkThread)) then
begin
GetExitCodeThread(chkThread.Handle, dwExitCode);
if (dwExitCode = STILL_ACTIVE) then
begin
TerminateThread(chkThread.Handle, dwExitCode);
chkThread.Terminate();
chkThread.Destroy;
chkThread := nil;
end;
end;
btnStart.Enabled := True;
btnStop.Enabled := False;
txtWatchdogStatus.Text := '';
m_ErrCde := DRV_WatchdogStop(m_DeviceHandle);
if (DoesErr(m_ErrCde) = 1) then
Exit;
ptEnableEvent.EventType := ADS_EVT_WATCHDOG_OVERRUN;
ptEnableEvent.Enabled := 0;
ptEnableEvent.Count := 1;
m_ErrCde := DRV_EnableEvent(m_DeviceHandle, ptEnableEvent);
end;
procedure TfrmMain.CheckEventProc();
var
ptCheckEvent: PT_CheckEvent;
usEventType: Smallint;
indx: Smallint;
begin
ptCheckEvent.EventType := @usEventType;
ptCheckEvent.Milliseconds := INFINITE;
while (true) do
begin
DRV_CheckEvent(m_DeviceHandle, ptCheckEvent);
if (usEventType = ADS_EVT_WATCHDOG_OVERRUN) then
txtWatchdogStatus.Text := 'Overrun';
end;
end;
procedure TfrmMain.chkAutoFeedClick(Sender: TObject);
begin
AutoFeedTimer.Interval := StrToInt(txtAutoTimer.Text);
if (chkAutoFeed.Checked) then
AutoFeedTimer.Enabled := True
else
AutoFeedTimer.Enabled := False;
end;
procedure TfrmMain.AutoFeedTimerTimer(Sender: TObject);
begin
m_ErrCde := DRV_WatchdogFeed(m_DeviceHandle);
end;
procedure TfrmMain.btnWriteClick(Sender: TObject);
var
ptDioWritePortByte: PT_DioWritePortByte; // DioWritePortByte table
chValue: SmallInt;
begin
chValue := 0;
if (chkDI0.Checked) then
chValue := chValue or 1 shl 0;
if (chkDI1.Checked) then
chValue := chValue or 1 shl 1;
if (chkDI1.Checked) then
chValue := chValue or 1 shl 1;
if (chkDI2.Checked) then
chValue := chValue or 1 shl 2;
if (chkDI3.Checked) then
chValue := chValue or 1 shl 3;
if (chkDI4.Checked) then
chValue := chValue or 1 shl 4;
if (chkDI5.Checked) then
chValue := chValue or 1 shl 5;
if (chkDI6.Checked) then
chValue := chValue or 1 shl 6;
if (chkDI7.Checked) then
chValue := chValue or 1 shl 7;
ptDioWritePortByte.port := cmbPort.ItemIndex;
ptDioWritePortByte.mask := $FF;
ptDioWritePortByte.state := chValue;
m_ErrCde := DRV_DioWritePortByte(m_DeviceHandle, ptDioWritePortByte);
if (DoesErr(m_ErrCde) = 1) then
Exit;
end;
procedure TfrmMain.btnReadClick(Sender: TObject);
var
ptDioGetCurrentDOByte: PT_DioGetCurrentDOByte; // DioWritePortByte table
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -