📄 formstar.pas
字号:
unit Formstar;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Driver, Global, Paras;
type
Tfrmstart = class(TForm)
labSelDev: TLabel;
lstDevice: TListBox;
labModule: TLabel;
lstModule: TListBox;
cmdRun: TButton;
labChannel: TLabel;
lstChannel: TListBox;
lstVoltageRange: TListBox;
labVoltageRange: TLabel;
cmdExit: TButton;
Label1: TLabel;
labExpChl: TLabel;
lstExpChl: TListBox;
labThermocouple: TLabel;
lstThermocouple: TListBox;
Label2: TLabel;
cmbBTEnable: TComboBox;
procedure cmdExitClick(Sender: TObject);
procedure cmdRunClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure lstDeviceClick(Sender: TObject);
procedure lstModuleClick(Sender: TObject);
procedure lstChannelClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
frmstart: Tfrmstart;
implementation
uses formrun;
var
lpDevFeatures : DEVFEATURES;
lpDevConfig_AI : DEVCONFIG_AI;
gnNumOfSubdevices : Smallint;
Response : Integer;
uTypeValue : Array[0..6] of integer = (JTC, KTC, STC, TTC, BTC, RTC, ETC);
BurnOutProperty : Array[0..7] of Longint; // 8 channels. Only for USB-4718,
// for other devices,
// please refer to the hardware manual
// and the software manual for correct
// channel number
BurnOutSupport : Boolean;
{$R *.DFM}
procedure Tfrmstart.cmdExitClick(Sender: TObject);
begin
if bRun then
DRV_DeviceClose(DeviceHandle);
close;
end;
procedure Tfrmstart.cmdRunClick(Sender: TObject);
var
tempNum : Integer;
BoardID : Longint;
Length : Longint;
begin
ptTCMuxRead.DasChan := lstChannel.ItemIndex;
{ No gain code for ADAM series }
BoardID := lpDevConfig_AI.Daughter[lstChannel.ItemIndex].dwBoardID;
If gnNumOfSubdevices = 0 Then
begin
If( (BoardID > 0) And (BoardID <> BD_PCLD8710 )) Then
begin
tempNum := lstChannel.ItemIndex;
ptTCMuxRead.DasGain :=
Trunc(lpDevConfig_AI.Daughter[tempNum].fGain);
{ the gain for expand card is set in device installation }
ptTCMuxRead.ExpChan := lstExpChl.ItemIndex;
end
Else
begin
tempNum := lstVoltageRange.ItemIndex;
ptTCMuxRead.DasGain := lpDevFeatures.glGainList[tempNum].usGainCde;
ptTCMuxRead.ExpChan := 0
end;
end;
if BurnOutSupport = True then
begin
Length := sizeof(BurnOutProperty);
BurnOutProperty[ptTCMuxRead.DasChan] := cmbBTEnable.ItemIndex;
ErrCde := DRV_DeviceSetProperty(DeviceHandle, CFG_BURNTEST, @BurnOutProperty[0], Length);
If (ErrCde <> 0) Then
begin
DRV_GetErrorMessage(ErrCde, pszErrMsg);
Response := Application.MessageBox(pszErrMsg, 'Error!!', MB_OK);
DRV_DeviceClose(DeviceHandle);
Exit;
end;
end;
ptTCMuxRead.TCType := uTypeValue[lstThermocouple.ItemIndex];
FormRun.frmRun.Show;
FormRun.frmRun.cmdRead.SetFocus;
Formrun.frmrun.tmrRead.Enabled := True;
end;
procedure Tfrmstart.FormCreate(Sender: TObject);
var
MaxEntries, OutEntries : Smallint;
i, j : Integer;
tempStr : String;
begin
bRun := False;
{ Add type of PC Laboratory Card }
ErrCde := DRV_DeviceGetList(DeviceList[0], MaxEntries, OutEntries);
If (ErrCde <> 0) Then
begin
DRV_GetErrorMessage(ErrCde, pszErrMsg);
Response := Application.MessageBox(pszErrMsg, 'Error!!', MB_OK);
Exit;
end;
{ Here MaxEntries = OutEntries }
ErrCde := DRV_DeviceGetNumOfList(MaxEntries);
If (ErrCde <> 0) Then
begin
DRV_GetErrorMessage(ErrCde, pszErrMsg);
Response := Application.MessageBox(pszErrMsg, 'Error!!', MB_OK);
Exit;
end;
For i := 0 To (MaxEntries - 1) do
begin
tempStr := '';
For j := 0 To MaxDevNameLen do
tempStr := tempStr + DeviceList[i].szDeviceName[j];
lstDevice.Items.Add(tempStr);
end;
lstThermocouple.Items.Add('J type');
lstThermocouple.Items.Add('K type');
lstThermocouple.Items.Add('S type');
lstThermocouple.Items.Add('T type');
lstThermocouple.Items.Add('B type');
lstThermocouple.Items.Add('R type');
lstThermocouple.Items.Add('E type');
lstThermocouple.ItemIndex :=0;
{ Disable module in this example }
lstModule.Enabled := False;
labModule.Enabled := False;
labChannel.Enabled := False;
lstChannel.Enabled := False;
lstVoltageRange.Enabled := False;
labVoltageRange.Enabled := False;
cmdRun.Enabled := False;
end;
procedure Tfrmstart.lstDeviceClick(Sender: TObject);
var
tempNum, i, ii : Integer;
nOutEntries : Smallint;
TestRes : Boolean;
TempStr : String;
dwDeviceNum : Longint;
lpAIGetConfig : PT_AIGetConfig;
Length : Longint;
begin
lstModule.Items.Clear;
lstChannel.Items.Clear;
lstVoltageRange.Items.Clear;
lstExpChl.Clear;
tempNum := Pos('DEMO', lstDevice.Items[lstDevice.ItemIndex]);
if (tempNum <> 0) then
TestRes := True
else
TestRes := False;
{ Avoid to open Advantech Demo Card }
If (TestRes) Then
begin
labModule.Enabled := False;
lstModule.Enabled := False;
labChannel.Enabled := False;
lstChannel.Enabled := False;
labVoltageRange.Enabled := False;
lstVoltageRange.Enabled := False;
{labExpChl.Enabled := False;}
{lstExpChl.Enabled := False;}
{labThermoCouple.Enabled := False;}
{lstThermoCouple.Enabled := False;}
lstChannel.Items.Add('No Use');
cmdRun.Enabled := False;
end;
If (Not TestRes) Then
begin
{ Check if there is any device attached on this COM or CAN }
gnNumOfSubdevices := DeviceList[lstDevice.ItemIndex].nNumOfSubdevices;
if (gnNumOfSubdevices > MaxDev) then
gnNumOfSubdevices := MaxDev;
dwDeviceNum := DeviceList[lstDevice.ItemIndex].dwDeviceNum;
{ COM and CAN bus }
if (gnNumOfSubdevices <> 0) then
begin
ErrCde := DRV_DeviceGetSubList(dwDeviceNum, SubDeviceList[0], gnNumOfSubdevices, nOutEntries);
If (ErrCde <> 0) Then
begin
DRV_GetErrorMessage(ErrCde, pszErrMsg);
Response := Application.MessageBox(pszErrMsg, 'Error!!', MB_OK);
Exit;
end;
For i := 0 To (gnNumOfSubdevices - 1) do
begin
tempStr := '';
For ii := 0 To MaxDevNameLen do
tempStr := tempStr + SubDevicelist[i].szDeviceName[ii];
lstModule.Items.Add(tempStr);
end;
lstModule.Enabled := True;
labModule.Enabled := True;
labChannel.Enabled := True;
lstChannel.Enabled := True;
lstChannel.ItemIndex := 0;
labVoltageRange.Enabled := True;
lstVoltageRange.Enabled := True;
cmdRun.Enabled := True;
end;
{ PCL DAS & DIO card }
if (gnNumOfSubdevices = 0) then
begin
ErrCde := DRV_DeviceOpen(dwDeviceNum, DeviceHandle);
If (ErrCde <> 0) Then
begin
DRV_GetErrorMessage(ErrCde, pszErrMsg);
Response := Application.MessageBox(pszErrMsg, 'Error!!', MB_OK);
Exit;
end
else
bRun := True;
ptDevGetFeatures.buffer := @lpDevFeatures;
ErrCde := DRV_DeviceGetFeatures(DeviceHandle, ptDevGetFeatures);
{ Add analog input channel item }
lpAIGetConfig.buffer := @lpDevConfig_AI;
ErrCde := DRV_AIGetConfig(DeviceHandle, lpAIGetConfig);
If (ErrCde <> 0) Then
begin
DRV_GetErrorMessage(ErrCde, pszErrMsg);
Response := Application.MessageBox(pszErrMsg, 'Error!!', MB_OK);
DRV_DeviceClose(DeviceHandle);
Exit;
end;
tempNum := lpDevFeatures.usMaxAISiglChl ;
if (tempNum < lpDevFeatures.usMaxAIDiffChl) then
begin
tempNum := lpDevFeatures.usMaxAIDiffChl;
end;
if (tempNum > 0) then
begin
For i := 0 To (tempNum - 1) do
begin
tempStr := 'Chan#' + IntToStr(i);
lstChannel.Items.Add(tempStr);
end;
labChannel.Enabled := True;
lstChannel.Enabled := True;
lstChannel.ItemIndex := 0;
lstChannelClick(nil);
{lstChannel.Text := lstChannel.Items[0];}
end;
if (lpDevFeatures.usNumGain > 0) then
begin
For i := 0 To (lpDevFeatures.usNumGain - 1) do
begin
tempStr := '';
For ii := 0 To 15 do
tempStr := tempStr + lpDevFeatures.glGainList[i].szGainStr[ii];
lstVoltageRange.Items.Add(tempStr);
end;
labVoltageRange.Enabled := True;
lstVoltageRange.Enabled := True;
lstVoltageRange.ItemIndex :=0;
end;
{Burn out support ?}
cmbBTEnable.Clear();
Length := sizeof(BurnOutProperty);
ErrCde := DRV_DeviceGetProperty(DeviceHandle, CFG_BURNTEST, @BurnOutProperty[0], Length);
If (ErrCde = InvalidInputParam) Then
begin
ErrCde := DRV_DeviceGetProperty(DeviceHandle, CFG_BURNTEST, @BurnOutProperty[0], Length);
end;
if (ErrCde = FunctionNotSupported) then
begin
cmbBTEnable.Enabled := False;
BurnOutSupport := False;
end
else if (ErrCde = 0)then
begin
cmbBTEnable.Items.Add('Disable');
cmbBTEnable.Items.Add('888888');
cmbBTEnable.Items.Add('-888888');
cmbBTEnable.Items.Add('Maximum value');
cmbBTEnable.Items.Add('Minimum value');
cmbBTEnable.ItemIndex := BurnOutProperty[lstChannel.ItemIndex];
BurnOutSupport := True;
end
else
begin
DRV_GetErrorMessage(ErrCde, pszErrMsg);
Response := Application.MessageBox(pszErrMsg, 'Error!!', MB_OK);
DRV_DeviceClose(DeviceHandle);
Exit;
end;
{ Since you have selected a PC-Lab Card, you can choose the channel and gain code as you want}
cmdRun.Enabled := True;
end;
end;
end;
procedure Tfrmstart.lstModuleClick(Sender: TObject);
var
tempNum, i : Integer;
dwDeviceNum : Longint;
TempStr : String;
begin
lstChannel.Items.Clear;
lstVoltageRange.Items.Clear;
{lstExpChl.Clear;}
{ open COM device or CAN device }
dwDeviceNum := SubDevicelist[lstModule.ItemIndex].dwDeviceNum;
ErrCde := DRV_DeviceOpen(dwDeviceNum, DeviceHandle);
If (ErrCde <> 0) Then
begin
DRV_GetErrorMessage(ErrCde, pszErrMsg);
Response := Application.MessageBox(pszErrMsg, 'Error!!', MB_OK);
Exit;
end
Else
bRun := True;
ptDevGetFeatures.buffer := @lpDevFeatures;
ErrCde := DRV_DeviceGetFeatures(DeviceHandle, ptDevGetFeatures);
If (ErrCde <> 0) Then
begin
DRV_GetErrorMessage(ErrCde, pszErrMsg);
Response := Application.MessageBox(pszErrMsg, 'Error!!', MB_OK);
Exit;
end;
ptAIGetConfig.buffer := @lpDevConfig_AI;
ErrCde := DRV_AIGetConfig(DeviceHandle, ptAIGetConfig);
If (ErrCde <> 0) Then
begin
DRV_GetErrorMessage(ErrCde, pszErrMsg);
Response := Application.MessageBox(pszErrMsg, 'Error!!', MB_OK);
DRV_DeviceClose(DeviceHandle);
Exit;
end;
{ Add analog input channel item }
If (lpDevConfig_AI.ulChanConfig = 0) Then
tempNum := lpDevFeatures.usMaxAISiglChl
Else
tempNum := lpDevFeatures.usMaxAIDiffChl;
For i := 0 To (tempNum - 1) do
begin
tempStr := 'Chan#' + IntToStr(i);
lstChannel.Items.Add(tempStr);
end;
cmdRun.enabled := True;
{ WARNING : No gain code list for ADAM series}
end;
procedure Tfrmstart.lstChannelClick(Sender: TObject);
var
i : Integer;
TempStr : String;
begin
labExpChl.enabled := False;
lstExpChl.enabled := False;
lstExpChl.Items.Clear;
{ Add Expansion card channel }
If (lpDevConfig_AI.Daughter[lstChannel.ItemIndex].dwBoardID > 0) Then
begin
For i := 0 To (lpDevConfig_AI.Daughter[lstChannel.ItemIndex].usNum - 1) do
begin
tempStr := 'Chan#' + IntToStr(i);
lstExpChl.Items.Add(tempStr);
end;
lstExpChl.ItemIndex :=0;
labExpChl.enabled := True;
lstExpChl.enabled := True;
end;
if(BurnOutSupport = True) then
begin
cmbBTEnable.ItemIndex := BurnOutProperty[lstChannel.ItemIndex];
end;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -