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

📄 unit1.~pas

📁 讲述了delphi环境下cec488接口的数据采集程序通过burst和normal两种模式进行采集
💻 ~PAS
字号:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, IEEEDEL, Buttons, ExcelXP, Excel97,Comctrls,OleCtnrs,ComObj,
  OleServer;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    lblStatus: TLabel;
    List1: TListBox;
    cmdSetup: TBitBtn;
    cmdread: TBitBtn;
    BitBtn4: TBitBtn;
    Gpibaddr: TEdit;
    txtNumPts: TEdit;
    cmdsave: TBitBtn;
    SaveDialog1: TSaveDialog;
    ExcelApplication1: TExcelApplication;
    ExcelWorkbook1: TExcelWorkbook;
    ExcelWorksheet1: TExcelWorksheet;
    Edit1: TEdit;
    Edit2: TEdit;
    procedure cmdSetupClick(Sender: TObject);
    procedure cmdreadClick(Sender: TObject);
    procedure BitBtn4Click(Sender: TObject);
    procedure cmdsaveClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
    XlsApp,XlsSheet,XlsWBk : Variant;
  end;

var
  Form1: TForm1;

implementation

var
  status,datalength:Integer;
  ParsedData:array of String;
  times:integer;

//  l : word;  //length of read

{$R *.dfm}

procedure TForm1.cmdSetupClick(Sender: TObject);
begin
 //Return Model 2001 to default configuration.

    //send(strtoint(GPIBaddr.Text), 'syst:cle', status);
    //send(strtoint(GPIBaddr.Text), 'SYST:KEY 7', status);
    send(strtoint(GPIBaddr.Text), 'SYSTem:PRESet', status);

    send(strtoint(GPIBaddr.Text), 'VOLTage:DC:RANGe 2', status);

    send(strtoint(GPIBaddr.Text), 'SENSe:FUNCtion "VOLT:DC"', status);

    send(strtoint(GPIBaddr.Text), 'TRACe:EGRoup COMPact', status);

    send(strtoint(GPIBaddr.Text), 'TRACe:CLEar', status);

    send(strtoint(GPIBaddr.Text), 'TRACe:FEED SENSe1;POINts 2027', status);
    //Set up SRQ on buffer full

    send(strtoint(GPIBaddr.Text), '*SRE 1', status);

    send(strtoint(GPIBaddr.Text),'STAT:MEAS:PTR 32767;NTR 0;ENAB 512', status);

    send(strtoint(GPIBaddr.Text), 'FORM:ELEM READ', status);
      //Specify data elements (reading, reading number,units, and status).
    send(strtoint(GPIBaddr.Text), 'INIT:CONT OFF', status);

    send(strtoint(GPIBaddr.Text), 'ABORT', status);

    send(strtoint(GPIBaddr.Text), 'SYST:AMET BURS', status);

    cmdread.Enabled := True;
    cmdSetup.Enabled := False;
end;

procedure TForm1.cmdreadClick(Sender: TObject);
var
 i:Integer;
 read :String;
 list: TStrings;
 Len:longint;    //为了解决enter函数中语法问题而设的一个过渡变量
begin
  List1.Clear;
  send(strtoint(GPIBaddr.Text), 'init', status);  //start the measurements....
  send(strtoint(GPIBaddr.Text), '*sre 0', status);
  Beep;
  Beep;
  sleep(2000);
  send(strtoint(GPIBaddr.Text), 'trac:data?', status); //tell it to send us the buffer
  // use enter to get the buffer

  enter(read, 750000, len, StrToInt(GPIBaddr.Text), status);
  //将字符串read转换成一维数组
  list:=TStringList.Create;
  list.Delimiter:=',';
  list.DelimitedText:=read;
  setlength(ParsedData,list.Count);
  datalength:=list.Count;

  For i:= 0 To strtoint(txtNumPts.text)-1  do
  begin
  ParsedData[i]:=list[i];
  List1.Items.Add('Reading #   '+inttostr(i)+':   '+ParsedData[i]);
  end;

  list.Free;
  cmdread.Enabled:= False;
  cmdSetup.Enabled:= True;
  cmdsave.Enabled:= True;
end;

procedure TForm1.BitBtn4Click(Sender: TObject);
begin
//put instr back to local
 send(strtoint(GPIBaddr.Text), 'syst:cle', status);
 send(strtoint(GPIBaddr.Text), 'SYST:KEY 7', status);
 close;
end;

procedure TForm1.cmdsaveClick(Sender: TObject);
var
 i,j: integer;
begin
if VarIsEmpty(XlsApp) then
XlsApp := CreateOleObject('Excel.Application');
XLsApp.Workbooks.Add;
XlsSheet := XLsApp.Worksheets['Sheet1'];
times:=strtoint(edit2.Text);
for j:=1 to times-1 do
 begin
 edit1.Text:=inttostr(j);
 for i:= 0 to strtoint(txtNumPts.text)-1 do
 XlsSheet.Cells[i+1,j] :=ParsedData[i];
 cmdread.Click;
 sleep(20000);
 end;
 for i:= 0 to strtoint(txtNumPts.text)-1 do
 XlsSheet.Cells[i+1,times] :=ParsedData[i];
XlsApp.Visible := true;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
    initialize(21, 0);
    send(strtoint(GPIBaddr.Text), '*RST', status);
  //*RST:returns the2001 to the *RST defanlt conditions(Clears registers)
    send(strtoint(GPIBaddr.Text), 'syst:cle', status);
    //send(strtoint(GPIBaddr.Text), 'SYST:KEY 7', status);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin 
if not VarIsEmpty(XlsApp) then
begin
XlsApp.DisplayAlerts := True; // 7Discard unsaved files....
try 
XlsApp.Application.Quit;
except 
end; 
end; 
end;

end.

⌨️ 快捷键说明

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