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

📄 mainform.pas

📁 16 relay output channels and 16 isolated digital input channels LED indicators to show activated
💻 PAS
📖 第 1 页 / 共 2 页
字号:
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 + -