📄 unit1.~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 + -