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

📄 formstar.pas

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