unit1.~pas

RS232串口通讯随书源码

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    GroupBox1: TGroupBox;
    rdVoltage: TRadioButton;
    rdCurrent: TRadioButton;
    rdResist: TRadioButton;
    Label1: TLabel;
    txtCmd: TEdit;
    mReceive: TMemo;
    Button1: TButton;
    Comm1: TComm;
    Button2: TButton;
    procedure Comm1ReceiveData(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure rdVoltageClick(Sender: TObject);
    procedure rdCurrentClick(Sender: TObject);
    procedure rdResistClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure txtCmdKeyPress(Sender: TObject; var Key: Char);
    procedure Button2Click(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  Procedure TimeDelay(DT:DWORD);

implementation

{$R *.DFM}

procedure TForm1.Comm1ReceiveData(Sender: TObject);
begin
  //接收数据，并将Memo组件标志移至最下方
  mReceive.Text := mReceive.Text + Comm1.Input ;
  mReceive.SelStart := Length(mReceive.Text);
  mReceive.SelLength :=0;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  //打开通信端口
  Comm1.PortOpen := True;
end;

procedure TForm1.rdVoltageClick(Sender: TObject);
begin
  //若选项被选中，先关闭Fcunction，
  //再针对本项作设置的指令送出动作
  if rdVoltage.Checked then
   begin
    Comm1.OutputString('SENS:FUNC:OFF:ALL' + Chr(13));
    Comm1.OutputString('SENS:FUNC:ON "VOLT"' + Chr(13));
    Comm1.OutputString(':SYST:LOC' + Chr(13));
   end;
end;

procedure TForm1.rdCurrentClick(Sender: TObject);
begin
  //若选项被选中，先关闭Fcunction，
  //再针对本项作设置的指令送出动作
  if rdCurrent.Checked then
   begin
    Comm1.OutputString('SENS:FUNC:OFF:ALL' + Chr(13));
    Comm1.OutputString('SENS:FUNC:ON "CURR"' + Chr(13));
    Comm1.OutputString(':SYST:LOC' + Chr(13));
   end;
end;

procedure TForm1.rdResistClick(Sender: TObject);
begin
  //若选项被选中，先关闭Fcunction，
  //再针对本项作设置的指令送出动作
  if rdResist.Checked then
   begin
    Comm1.OutputString('SENS:FUNC:OFF:ALL' + Chr(13));
    Comm1.OutputString('SENS:FUNC:ON "RES"' + Chr(13));
    Comm1.OutputString(':SYST:LOC' + Chr(13));
   end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Buf:String;
begin
  //不触发事件
  Comm1.RThreshold := 0;
  //取得盘面上的读值
  Comm1.OutputString(':DISP:DATA?'+ Chr(13));
  TimeDelay(200);
  mReceive.Text := mReceive.Text + Comm1.Input + Chr(13) + Chr(10);
  mReceive.SelStart := Length(mReceive.Text);
  mReceive.SelLength :=0;
  //恢复测量
  Comm1.OutputString(':SYST:LOC'+Chr(13));
  TimeDelay(100);
  Buf := Comm1.Input;
end;


//以下是延迟函数，单位毫秒
Procedure TimeDelay(DT:DWORD);
var
 TT:DWORD;
begin
  //取得现在的Tick值
  TT:=GetTickCount();
  //计算Tick差值是否超过设置值
  while GetTickCount()-TT<DT do
   Application.ProcessMessages; //释放控制权
end;


procedure TForm1.txtCmdKeyPress(Sender: TObject; var Key: Char);
begin
  Comm1.RThreshold := 1;
  if Ord(Key)=13 then
    Comm1.OutputString(txtCmd.Text + Chr(13));
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
 Close;
end;

end.