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

📄 mainform.pas

📁 16 relay output channels and 16 isolated digital input channels LED indicators to show activated
💻 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 + -