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

📄 foutform.pas

📁 16 relay output channels and 16 isolated digital input channels LED indicators to show activated
💻 PAS
字号:
unit FoutForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,Driver;

type
  TfrmFout = class(TForm)
    grpDeviceSelection: TGroupBox;
    labDeviceName: TLabel;
    btnSelectDevice: TButton;
    btnStart: TButton;
    btnStop: TButton;
    btnExit: TButton;
    grpChannel: TGroupBox;
    cmbChannel: TComboBox;
    grpFoutSrc: TGroupBox;
    cmbFoutSrc: TComboBox;
    grpDivider: TGroupBox;
    txtDivider: TEdit;
    procedure FormCreate(Sender: TObject);
    procedure btnSelectDeviceClick(Sender: TObject);
    procedure btnStartClick(Sender: TObject);
    procedure btnStopClick(Sender: TObject);
    procedure btnExitClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    lDriverHandle: Longint;                      //Driver handle
    szErrMsg: array[0..80] of  Char;             // Use for MESSAGEBOX function
    ErrCde: LRESULT;                             // Return error code

   lDeviceNum: Longint;                          //Advantech Device Number in your system
   szDescription: array[0..80] of Char;          //description for Select Device
   DevFeatures: DEVFEATURES;                     // structure for device features
   ptDevGetFeatures: PT_DeviceGetFeatures;
   ptFreqOutStart: PT_FreqOutStart;
   gwFoutSrc: Shortint;                         // frequency output source
   dwBoardID: DWORD;
   usMaxFoutChanNum: Integer;

   bRun: Boolean;
    { Public declarations }
  end;

var
  frmFout: TfrmFout;

implementation

{$R *.dfm}

procedure TfrmFout.FormCreate(Sender: TObject);
var
   i: Integer;
begin
  //1. Select Device
    If(DRV_SelectDevice(Handle, False, lDeviceNum, szDescription)=1) Then
    Begin
        Application.MessageBox('Can not Open Select Device Dialog', 'Error');
    End;
   labDeviceName.Caption := szDescription;
   //2. Open Device
   ErrCde := DRV_DeviceOpen(lDeviceNum, lDriverHandle);
   if(ErrCde <> SUCCESS)then
   begin
        DRV_GetErrorMessage(ErrCde, @szErrMsg);
        Application.MessageBox(szErrMsg, 'Driver Message', MB_OK);
        Exit;
   end;
   //3. Get Device Features
   ptDevGetFeatures.buffer := @DevFeatures;
   ptDevGetFeatures.size   := sizeof(DEVFEATURES);
   ErrCde := DRV_DeviceGetFeatures(lDriverHandle,ptDevGetFeatures);
   if (ErrCde <> SUCCESS)then
   begin
       DRV_GetErrorMessage(ErrCde,@szErrMsg);
       Application.MessageBox(szErrMsg,'Driver Message', MB_OK);
       DRV_DeviceClose(lDriverHandle);
       Exit;
   end;
   ErrCde := DRV_DeviceClose(lDriverHandle);
   
   //4. Record some device specific parameters
   dwBoardID := DevFeatures.dwBoardID;
   if (dwBoardID = BD_USB4751)then
   begin
      usMaxFoutChanNum := 2;
   end
   else
   begin
      usMaxFoutChanNum := 4
   end;

   //5. Init UI
   cmbChannel.Clear;

   If(usMaxFoutChanNum > 0)Then
   Begin
      for i:=0 to usMaxFoutChanNum-1 do
      begin
         cmbChannel.Items.Add(IntToStr(i));
      end;
      cmbchannel.ItemIndex := 0;
   end
   else
   begin
      Application.MessageBox('Function Not Supported', 'Warning');
      Exit
   End;

   cmbFoutSrc.Clear;

   cmbFoutSrc.Items.Add('External Clock');
   cmbFoutSrc.Items.Add('20MHZ');
   cmbFoutSrc.Items.Add('10MHZ');
   cmbFoutSrc.Items.Add('5MHZ');
   cmbFoutSrc.Items.Add('1MHZ');
   cmbFoutSrc.Items.Add('100KHZ');

   cmbFoutSrc.ItemIndex := 0;
   bRun := False;
   btnStop.Enabled := False;
end;

procedure TfrmFout.btnSelectDeviceClick(Sender: TObject);
begin
   FormCreate(Sender);
end;

procedure TfrmFout.btnStartClick(Sender: TObject);
begin
     ErrCde := DRV_DeviceOpen(lDeviceNum, lDriverHandle);
     if(ErrCde <> SUCCESS)then
     begin
          DRV_GetErrorMessage(ErrCde, @szErrMsg);
	  Application.MessageBox(szErrMsg, 'Error!!', MB_OK);
          Exit;
     end;


    ptDevGetFeatures.buffer := @DevFeatures;
    ptDevGetFeatures.size   := sizeof(DEVFEATURES);
    ErrCde := DRV_DeviceGetFeatures(lDriverHandle,ptDevGetFeatures);
    if (ErrCde <> SUCCESS)then
    begin
        DRV_GetErrorMessage(ErrCde,@szErrMsg);
        Application.MessageBox(szErrMsg,'Driver Message', MB_OK);
        DRV_DeviceClose(lDriverHandle);
        Exit;
    end;
    if (DevFeatures.usMaxTimerChl = 0)then
    begin
        Application.MessageBox('No Counter Channel','Driver Message', MB_OK);
        DRV_DeviceClose(lDriverHandle);
        Exit;
    end;

    //start Fout
    gwFoutSrc := cmbFoutSrc.ItemIndex;
    case gwFoutSrc of
        0: ptFreqOutStart.usFoutSrc := PA_FOUT_SRC_EXTER_CLK;
        1: ptFreqOutStart.usFoutSrc := PA_FOUT_SRC_CLK_20MHZ;
        2: ptFreqOutStart.usFoutSrc := PA_FOUT_SRC_CLK_10MHZ;
        3: ptFreqOutStart.usFoutSrc := PA_FOUT_SRC_CLK_5MHZ;
        4: ptFreqOutStart.usFoutSrc := PA_FOUT_SRC_CLK_1MHZ;
        5: ptFreqOutStart.usFoutSrc := PA_FOUT_SRC_CLK_100KHZ;
   end;
    ptFreqOutStart.usChannel := StrToInt(cmbChannel.Text);
    ptFreqOutStart.usDivider := StrToInt(txtDivider.Text);
    ErrCde := DRV_FreqOutStart(lDriverHandle,ptFreqOutStart);
    if (ErrCde <> SUCCESS)then
    begin
        DRV_GetErrorMessage(ErrCde,@szErrMsg);
        Application.MessageBox(szErrMsg,'Driver Message', MB_OK);
        DRV_DeviceClose(lDriverHandle);
        Exit;
    end;

    grpDeviceSelection.Enabled := False;
    grpChannel.Enabled := False;
    grpFoutSrc.Enabled := False;
    grpDivider.Enabled := False;
    btnExit.Enabled := False;
    btnStart.Enabled := False;
    btnStop.Enabled := True;
    bRun := True;
end;

procedure TfrmFout.btnStopClick(Sender: TObject);
var
    port: Longint;
begin
    port := StrToInt(cmbChannel.Text);
    ErrCde := DRV_FreqOutReset(lDriverHandle,port);
   if (ErrCde <> SUCCESS)then
    begin
        DRV_GetErrorMessage(ErrCde,@szErrMsg);
        Application.MessageBox(szErrMsg,'Driver Message', MB_OK);
    end;

     DRV_DeviceClose(lDriverHandle);
     bRun := FALSE;
     grpDeviceSelection.Enabled := True;
     grpChannel.Enabled := True;
     grpFoutSrc.Enabled := True;
     grpDivider.Enabled := True;
     btnExit.Enabled := True;
     btnStart.Enabled := True;
     btnStop.Enabled := False;
end;

procedure TfrmFout.btnExitClick(Sender: TObject);
begin
 Application.Terminate;
end;

procedure TfrmFout.FormClose(Sender: TObject; var Action: TCloseAction);
begin
    if(True = bRun)then
    begin
        btnStopClick(Sender);
    end
end;

end.

⌨️ 快捷键说明

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