📄 main.pas
字号:
2:
begin
if (sWaveCh2.wWaveform <> 4) then
begin
usEnabledChannel := usEnabledChannel or $04;
SetRealBuffer(lpVoltageBuf[2], gulConvNum, @sWaveCh2);
usChannelCount := usChannelCount + 1;
end
else
continue;
end;
3:
begin
if (sWaveCh3.wWaveform <> 4) then
begin
usEnabledChannel := usEnabledChannel or $08;
SetRealBuffer(lpVoltageBuf[3], gulConvNum, @sWaveCh3);
usChannelCount := usChannelCount + 1;
end
else
continue;
end;
end;
{ call FAOScale for transfer voltage to binary data }
with ptFAOScale do
begin
tempPtr := lpVoltageBuf[i];
VoltArray := tempPtr;
tempPtr := lpBuf[i];
BinArray := tempPtr;
chan := i;
count := gulConvNum;
end;
ErrCde := DRV_FAOScale(DriverHandle, ptFAOScale);
if (DoesErr(ErrCde) <> 0) then
begin
MyFreeBuffer();
DRV_DeviceClose(DriverHandle);
exit;
end;
end;
{ Allocate memory for common buffer of 4 channel }
hCommonBuf := GlobalAlloc(GHND, sizeof(SHORT) * gulConvNum * usChannelCount);
if(hCommonBuf = 0) then
begin
Application.MessageBox('Not enough memory for buffer', 'High Speed', MB_OK);
MyFreeBuffer();
DRV_DeviceClose(DriverHandle);
exit;
end;
{ Lock down buffer }
lpCommonBuf := GlobalLock(hCommonBuf);
if (lpCommonBuf = NIL) then
begin
Application.MessageBox('Not enough memory for buffer', 'High Speed', MB_OK);
MyFreeBuffer();
GlobalFree(hCommonBuf);
DRV_DeviceClose(DriverHandle);
exit;
end;
{ set 4 buffer to 1 common buffer }
SetMultiToOneBuffer(usEnabledChannel, gulConvNum);
{ Step 3: Enable event feature }
with ptEnableEvent do
begin
EventType := ADS_EVT_INTERRUPT or
ADS_EVT_BUFCHANGE or
ADS_EVT_TERMINATED or
ADS_EVT_OVERRUN;
Enabled := gwEvtFlag;
Count := 1;
end;
ErrCde := DRV_EnableEvent(DriverHandle, ptEnableEvent);
if (DoesErr(ErrCde) <> 0) then
begin
MyFreeBuffer();
DRV_DeviceClose(DriverHandle);
exit;
end;
{ Step 4: call FAOWaveFormStart for start action }
{ Default setting - }
{ conversion number = 2048 * 4 }
{ Enabled Channel = 0,1,2,3 }
{ pacer rate = 1000 Hz }
{ output waveform number = 30 }
with ptFAOWaveFormStart do
begin
TrigSrc := gwExtTrig; { triggering }
SampleRate := gdwPacerRate; { pacer rate = 1K }
Count := gulConvNum * usChannelCount; { DA conversion number }
WaveCount := gwWaveFormCount; { Waveform number }
tempPtr := PINT(lpCommonBuf); { analog output data }
Buffer := tempPtr;
EnabledChannel := usEnabledChannel; { which channel }
end;
ErrCde := DRV_FAOWaveFormStart(DriverHandle, ptFAOWaveFormStart);
if (DoesErr(ErrCde) <> 0) then
begin
MyFreeBuffer();
GlobalUnlock(hCommonBuf);
GlobalFree(hCommonBuf);
DRV_DeviceClose(DriverHandle);
exit;
end;
{ if event feature is enabled , then create one thread. }
if (gwEvtFlag <> 0) then
begin
TGetEvent.Create(False);
bThreadloop := TRUE;
end;
Run.Enabled := FALSE;
Stop.Enabled := TRUE; { Enable stop buttons }
{ if event feature is enabled }
{ Start up timer }
if (gwEvtFlag <> 0) then
begin
Tmr.Enabled := TRUE;
bRunTimer := TRUE;
end;
end;
procedure TFrmMain.StopClick(Sender: TObject);
var
bflag: Boolean;
begin
{ Stop D/A conversion }
ErrCde := DRV_FAOTerminate(DriverHandle);
if (ErrCde <> 0) then
begin
DoesErr(ErrCde);
MyFreeBuffer();
GlobalUnlock(hCommonBuf);
GlobalFree(hCommonBuf);
DRV_DeviceClose(DriverHandle);
exit;
end;
end;
procedure TFrmMain.TmrTimer(Sender: TObject);
var
ptFAOCheck: PT_FAOCheck;
gwActiveBuf: SHORT; { return by FAOCheck }
gwStopped: SHORT; { return by FAOCheck }
ulCurrentCount: ULONG; { return by FAOCheck }
gwOverrun: SHORT; { return by FAOCheck }
gwHalfReady: SHORT; { return by FAOCheck }
begin
gwActiveBuf := 0; { return by FAOCheck }
gwStopped := 0; { return by FAOCheck }
ulCurrentCount := 0; { return by FAOCheck }
gwOverrun := 0; { return by FAOCheck }
gwHalfReady := 0; { return by FAOCheck }
{ Get transfer status }
ptFAOCheck.ActiveBuf := @gwActiveBuf;
ptFAOCheck.stopped := @gwStopped;
ptFAOCheck.CurrentCount := @ulCurrentCount;
ptFAOCheck.overrun := @gwOverrun;
ptFAOCheck.HalfReady := @gwHalfReady;
ErrCde := DRV_FAOCheck(DriverHandle, ptFAOCheck);
if (ErrCde <> 0) then
begin
DoesErr(ErrCde);
MyFreeBuffer();
GlobalUnlock(hCommonBuf);
GlobalFree(hCommonBuf);
DRV_DeviceClose(DriverHandle);
exit;
end;
{ Display Data }
WaveCountText.Text := IntToStr(ulCurrentCount);
{ if thread finish run stop instruction }
if (not bThreadloop) then
begin
{ if A/O process finish --> call DRV_FAOStop }
if (gwStopped <>0 ) then
begin
{ Step 2: Free buffer }
MyFreeBuffer();
GlobalUnlock(hCommonBuf);
GlobalFree(hCommonBuf);
{ Step 3: Close driver }
DRV_DeviceClose(DriverHandle);
{ Stop Timer }
if (bRunTimer) then
begin
Tmr.Enabled := FALSE;
bRunTimer := FALSE;
end;
Run.Enabled := TRUE;
end
end;
end;
procedure TFrmMain.FormCreate(Sender: TObject);
begin
if (gwSelectDevice = 0) then
begin
{ Select Device }
ErrCde := DRV_SelectDevice(Handle, FALSE, dwDeviceNum, @szDescript[0]);
if (ErrCde <> SUCCESS) then
begin
DoesErr(ErrCde);
exit;
end;
gwSelectDevice := 1;
FrmMain.Run.Enabled := TRUE;
end;
{ Show device description to Button text }
DevSel.Caption := szDescript;
{ Initialize Conversion Number }
Conv.Text := IntToStr(gulConvNum);
{ Initialize Pacer Rate }
Pacer.Text := IntToStr(gdwPacerRate);
{ Initialize wave form count }
if (gwWaveFormCount = INFINITE) then
WaveCount.Text := 'INFINITE'
else
WaveCount.Text := IntToStr(gwWaveFormCount);
{ Initialize Triggering }
if (gwExtTrig <> 0) then
ExtTrig.Checked := True
else
IntTrig.Checked := True;
{ Initialize Message Flag }
if (gwEvtFlag <> 0) then
EvtEnable.Checked := True
else
EvtDisable.Checked := True;
end;
procedure TFrmMain.DevSelClick(Sender: TObject);
begin
{ Select Device }
ErrCde := DRV_SelectDevice(Handle, FALSE, dwDeviceNum, @szDescript[0]);
if (ErrCde <> SUCCESS) then
begin
DoesErr(ErrCde);
exit;
end;
{ Show device description to Button text }
DevSel.Caption := szDescript;
end;
procedure TFrmMain.PacerChange(Sender: TObject);
begin
gdwPacerRate := StrToInt(Pacer.Text);
end;
procedure TFrmMain.ConvChange(Sender: TObject);
begin
gulConvNum := StrToInt(Conv.Text);
end;
procedure TFrmMain.WaveCountChange(Sender: TObject);
var
szBuf: string[40];
begin
szBuf := WaveCount.Text;
if(szBuf = 'INFINITE') then
gwWaveFormCount := INFINITE
else
gwWaveFormCount := StrToInt(szBuf);
end;
procedure TFrmMain.IntTrigClick(Sender: TObject);
begin
gwExtTrig := 0;
end;
procedure TFrmMain.ExtTrigClick(Sender: TObject);
begin
gwExtTrig := 1;
end;
procedure TFrmMain.EvtEnableClick(Sender: TObject);
begin
gwEvtFlag := 1;
end;
procedure TFrmMain.EvtDisableClick(Sender: TObject);
begin
gwEvtFlag := 0;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -