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

📄 formmain.pas

📁 16 relay output channels and 16 isolated digital input channels LED indicators to show activated
💻 PAS
字号:
{test descrption:
Computer : Pentium II 266Hz
Input Source : function generator
this program can run PCI-1760 safely under 500Hz DI input in Windows NT
but due to OS windows 95, this program only can run PCi-1760 safely under
200 Hz DI input
So if you want more high speed performance please use VC++ language to write
you project or run this program under Windows NT OS
Note: project property in compile item you must select compile to native code}

unit FormMain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons, ExtCtrls, Driver, Thread;

type
  TfrmMain = class(TForm)
    GroupBox1: TGroupBox;
    labDeviceName: TStaticText;
    btnSelectDevice: TButton;
    GroupBox2: TGroupBox;
    GroupBox3: TGroupBox;
    GroupBox4: TGroupBox;
    txtChannelNo: TEdit;
    labValue: TStaticText;
    StaticText3: TStaticText;
    txtScanTime: TEdit;
    StaticText4: TStaticText;
    chkFilter: TCheckBox;
    chkPattern: TCheckBox;
    chkCounter: TCheckBox;
    chkStatus: TCheckBox;
    labPatternMatchCount: TStaticText;
    labMatchChannel: TStaticText;
    StaticText7: TStaticText;
    StaticText8: TStaticText;
    labMatchCount: TStaticText;
    cmdStart: TButton;
    cmdStop: TButton;
    ScanTimer: TTimer;
    BitBtn1: TBitBtn;

    labOverflowChannel: TStaticText;
    StaticText11:       TStaticText;
    labOverflowCount:   TStaticText;
    labStatus:          TStaticText;
    StaticText14:       TStaticText;
    labChannelNo:       TStaticText;
    StaticText16:       TStaticText;
    labStatusCount:     TStaticText;

    procedure chkFilterClick(Sender: TObject);
    procedure chkPatternClick(Sender: TObject);
    procedure chkStatusClick(Sender: TObject);
    procedure chkCounterClick(Sender: TObject);
    procedure btnSelectDeviceClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure cmdStartClick(Sender: TObject);
    procedure cmdStopClick(Sender: TObject);
    procedure txtScanTimeChange(Sender: TObject);
    procedure ScanTimerTimer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  	lDeviceNum    :	Longint;
	lDeviceHandle :	Longint;
  	szDescription :	array[0..81] of Char;

  	bRun     : Boolean;
  	bPattern : Boolean;
  	bStatus  : Boolean;
  	bFilter  : Boolean;
  	bCounter : Boolean;

  	ptFilter          : PT_DIFilter;
  	ptDIPattern       : PT_DIPattern;
  	ptDICounter       : PT_DICounter;
  	ptDIStatus        : PT_DIStatus;
  	ptFDITransfer     : PT_FDITransfer;
  	ptDioReadPortByte : PT_DioReadPortByte;

  	wThread: TWatchThread;
  	TData:   PT_ThreadData;

  	RisingEventCount     :	Integer;
  	FallingEventCount    :	Integer;
  	PatternEventCount    :	Integer;
  	CountMatchEventCount :	Integer;
  	CountOverflowEventCount :	Integer;
  end;

var
  frmMain:	TfrmMain;

implementation

uses FormFilt, FormPatt, FormCoun, FormStat;

{$R *.DFM}



{*************************************************************
 * Function: Handle the error code. If the input error code > 0,
 *           it means some error apperent.  This function can
 *           show the error message to a message box and stop
 *           this application.
 * Input:    The error code.
 * return:   none
 ************************************************************* }
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.chkFilterClick(Sender: TObject);
begin
	If chkFilter.Checked = True Then Begin
		frmFilter.ShowModal;
	   If frmFilter.bCancel = True Then Begin
			chkFilter.Checked := False;
	      bFilter := False;
		End Else Begin
	      bFilter := True;
		End
   End Else
      bFilter := False;
end;


procedure TfrmMain.chkPatternClick(Sender: TObject);
begin
	If chkPattern.Checked = True Then Begin
   	frmPattern.ShowModal;
	   If frmPattern.bCancel = True Then Begin
			chkPattern.Checked := False;
	      bPattern := False;
		End Else Begin
	      bPattern := True;
		End
   End Else
   	bPattern := False;
end;


procedure TfrmMain.chkStatusClick(Sender: TObject);
begin
	If chkStatus.Checked = True then Begin
   	frmStatus.ShowModal;
	   If frmStatus.bCancel = True Then Begin
			chkStatus.Checked := False;
	      bStatus := False;
		End Else Begin
	      bStatus := True;
		End
   End Else
      bStatus := False;
end;


procedure TfrmMain.chkCounterClick(Sender: TObject);
begin
	if chkCounter.Checked = True Then Begin
   	frmCounter.ShowModal;
	   If frmCounter.bCancel = True Then Begin
			chkCounter.Checked := False;
			bCounter := False;
		End Else Begin
			bCounter := True;
		End
   End Else
		bCounter := False;
end;


procedure TfrmMain.btnSelectDeviceClick(Sender: TObject);
begin
	DRV_SelectDevice(Handle, True, lDeviceNum, szDescription);
   labDeviceName.Caption := szDescription;
end;


procedure TfrmMain.FormCreate(Sender: TObject);
begin
	DRV_SelectDevice(Handle, False, lDeviceNum, szDescription);
   labDeviceName.Caption := szDescription;

   bRun     := False;
	bPattern := False;
	bStatus  := False;
	bFilter  := False;
	bCounter := False;

	RisingEventCount        := 0;
   FallingEventCount       := 0;
   PatternEventCount       := 0;
   CountMatchEventCount    := 0;
   CountOverflowEventCount := 0;

end;


procedure TfrmMain.cmdStartClick(Sender: TObject);
var
	lErrCde       : Longint;
begin
	lErrCde := DRV_DeviceOpen( lDeviceNum, lDeviceHandle);
	If ( DoesErr(lErrCde) = 1 ) Then
		Exit;

   If bFilter Then
     Begin
		ptFilter.EventType    := ADS_EVT_FILTER;
		ptFilter.EventEnabled := 1;
		ptFilter.Count        := 1;
		ptFilter.EnableMask   := frmFilter.EnableMask;
		ptFilter.HiValue      := @frmFilter.HiValue[0];
		ptFilter.LowValue     := @frmFilter.LoValue[0];
		lErrCde := DRV_EnableEventEx(lDeviceHandle, @ptFilter);
     End;

   If bPattern Then
     Begin
      ptDIPattern.EventType    := ADS_EVT_PATTERNMATCH;
      ptDIPattern.EventEnabled := 1;
      ptDIPattern.Count        := 1;
      ptDIPattern.EnableMask   := frmPattern.EnableMask;
      ptDIPattern.PatternValue := frmPattern.PatternValue;
      lErrCde := DRV_EnableEventEx(lDeviceHandle, @ptDIPattern);
		if ( DoesErr(lErrCde) = 1 ) then
			Exit;
     End;

   If bCounter Then
     Begin
      ptDICounter.EventType    := ADS_EVT_COUNTER;
      ptDICounter.EventEnabled := 1;
      ptDICounter.Count        := 1;
      ptDICounter.Direction    := frmCounter.Direction;
      ptDICounter.EnableMask   := frmCounter.EnableMask;
      ptDICounter.MatchEnableMask    := frmCounter.MatchEnableMask;
      ptDICounter.OverflowEnableMask := frmCounter.OverflowEnableMask;
      ptDICounter.TrigEdge     := frmCounter.TrigEdge;
      ptDICounter.PresetValue  := @frmCounter.PresetValue[0];
      ptDICounter.MatchValue   := @frmCounter.MatchValue[0];
      lErrCde := DRV_EnableEventEx(lDeviceHandle, @ptDICounter);
		if ( DoesErr(lErrCde) = 1 ) then
			Exit;
      {lErrCde := DRV_DICounterReset(lDeviceHandle, frmCounter.MatchEnableMask);
		if ( DoesErr(lErrCde) = 1 ) then
			Exit;         Eric Lin 3/19/99}
     End;

   If bStatus Then
     Begin
      ptDIStatus.EventType    := ADS_EVT_STATUSCHANGE;
      ptDIStatus.EventEnabled := 1;
      ptDIStatus.Count        := 1;
      ptDIStatus.EnableMask   := frmStatus.EnableMask;
      ptDIStatus.RisingEdge   := frmStatus.RisingEdge;
      ptDIStatus.FallingEdge  := frmStatus.FallingEdge;
      lErrCde := DRV_EnableEventEx(lDeviceHandle, @ptDIStatus);
		if ( DoesErr(lErrCde) = 1 ) then
			Exit;
     End;

   if (bFilter or bPattern or bCounter or bStatus) Then
     Begin

   	TData.lDeviceHandle        := lDeviceHandle;
	   TData.labPatternMatchCount := @labPatternMatchCount;
	   TData.labMatchChannel      := @labMatchChannel;
	   TData.labMatchCount        := @labMatchCount;
	   TData.labOverflowChannel   := @labOverflowChannel;
	   TData.labOverflowCount     := @labOverflowCount;
	   TData.labStatus            := @labStatus;
	   TData.labChannelNo         := @labChannelNo;
	   TData.labStatusCount       := @labStatusCount;

		TData.RisingEventCount        := @RisingEventCount;
		TData.FallingEventCount       := @FallingEventCount;
		TData.PatternEventCount       := @PatternEventCount;
		TData.CountMatchEventCount    := @CountMatchEventCount;
		TData.CountOverflowEventCount := @CountOverflowEventCount;

		wThread := TWatchThread.Create(TData);

     End;

   cmdStart.Enabled  := False;
   cmdStop.Enabled   := True;
   ScanTimer.Enabled := True;
   bRun              := True;
end;


procedure TfrmMain.cmdStopClick(Sender: TObject);
var
	lErrCde       : Longint;
begin
	If Assigned(WThread) Then
   	WThread.Terminate;

{	ptDIPattern.EventType := 0;
	ptDIPattern.EventEnabled := 0;
	lErrCde := DRV_EnableEventEx(lDeviceHandle, @ptDIPattern); }
   ptFilter.EventType := 0;
   ptFilter.EventEnabled := 0;
	lErrCde := DRV_EnableEventEx(lDeviceHandle, @ptFilter);
   DoesErr(lErrCde);

   DRV_DeviceClose(lDeviceHandle);

   cmdStart.Enabled  := True;
   cmdStop.Enabled   := False;
   ScanTimer.Enabled := False;
   bRun              := False;
end;

procedure TfrmMain.txtScanTimeChange(Sender: TObject);
begin
	ScanTimer.Interval := StrToInt(txtScanTime.Text);
end;

procedure TfrmMain.ScanTimerTimer(Sender: TObject);
Var
	lErrCde     : Longint;
   InputData	: Smallint;
begin
   ptDioReadPortByte.Port := StrToInt(txtChannelNo.Text);
   ptDioReadPortByte.Value := @InputData;
   lErrCde := DRV_DioReadPortByte(lDeviceHandle, ptDioReadPortByte);
	if ( DoesErr(lErrCde) = 1 ) then
		Exit;
   labValue.Caption := IntToStr(InputData);
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -