?? formmain.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 + -