ucommtest.~pas

DELPHI串口通讯程序

  try
    Ini.WriteInteger( '串口通信', '波特率', BaudRate);
    Ini.WriteString( '串口通信', '发送串口', SendComm);
    Ini.WriteString( '串口通信', '接收串口', RecvComm );
    Ini.WriteBool( '串口通信', '奇偶校验', Parity);
    Ini.WriteString( '串口通信', '字节长度', ByteSize);
    Ini.WriteString( '串口通信', '停止位', StopBits);
  finally
    Ini.Free;
  end;
end;

procedure TCommTestFrm.BTNResetCommSetClick(Sender: TObject);
begin
  Ini := TIniFile.Create(ExtractFilePath(ParamStr(0)) + 'CommSet.ini');
  try
    BaudRate := Ini.ReadInteger( '串口通信', '波特率', 9600);
    SendComm := Ini.ReadString( '串口通信', '发送串口', 'Com2');
    RecvComm := Ini.ReadString( '串口通信', '接收串口', 'Com3' );
    Parity   := Ini.ReadBool( '串口通信', '奇偶校验', False);
    ByteSize := Ini.ReadString( '串口通信', '字节长度', '_8');
    StopBits := Ini.ReadString( '串口通信', '停止位', '_1');
    EditAck1.Text := Ini.ReadString( '串口测试', '握手信号1', 'F0');
    EditAck2.Text := Ini.ReadString( '串口测试', '握手信号2', '01');
    EditAck3.Text := Ini.ReadString( '串口测试', '握手信号3', 'FF');
    EditAck4.Text := Ini.ReadString( '串口测试', '握手信号4', 'FF');
    EditAck5.Text := Ini.ReadString( '串口测试', '握手信号5', '01');
    EditAck6.Text := Ini.ReadString( '串口测试', '握手信号6', 'F0');
  finally
    Ini.Free;
  end;
//设置串口通信界面
  if BaudRate = 1200 then CmbBaudRate.ItemIndex :=0
  else if BaudRate = 2400 then CmbBaudRate.ItemIndex :=1
  else if BaudRate = 4800 then CmbBaudRate.ItemIndex :=2
  else if BaudRate = 9600 then CmbBaudRate.ItemIndex :=3
  else if BaudRate = 19200 then CmbBaudRate.ItemIndex :=4
  else if BaudRate = 38400 then CmbBaudRate.ItemIndex :=5
  else if BaudRate = 57600 then CmbBaudRate.ItemIndex :=6
  else CmbBaudRate.ItemIndex :=7;
  if SendComm = 'Com1' then CmbSendComm.ItemIndex :=0
  else if SendComm = 'Com2' then CmbSendComm.ItemIndex :=1
  else if SendComm = 'Com3' then CmbSendComm.ItemIndex :=2
  else CmbSendComm.ItemIndex :=3;
  if RecvComm = 'Com1' then CmbRecvComm.ItemIndex :=0
  else if RecvComm = 'Com2' then CmbRecvComm.ItemIndex :=1
  else if RecvComm = 'Com3' then CmbRecvComm.ItemIndex :=2
  else CmbRecvComm.ItemIndex :=3;
  if Parity  then
      RadioParity.ItemIndex := 0
  else  RadioParity.ItemIndex := 1;
  if ByteSize = '_8' then
      RadioByteSize.ItemIndex :=0
  else  RadioByteSize.ItemIndex := 1;
  if StopBits = '_1' then
      RadioStopBits.ItemIndex := 0
  else  if StopBits = '_1_5' then
      RadioStopBits.ItemIndex := 1
  else  RadioStopBits.ItemIndex := 2;
  //设置COMM1
  Comm1.CommName := SendComm;
  Comm1.BaudRate := BaudRate;
  if ByteSize = '_8' then  Comm1.ByteSize := _8
  else  Comm1.ByteSize := _7;
  if StopBits = '_1' then Comm1.StopBits := _1
  else if StopBits = '_1_5' then Comm1.StopBits := _1_5
  else Comm1.StopBits := _2;
  Comm1.ParityCheck := Parity;
  //设置COMM2
  Comm2.CommName := RecvComm;
  Comm2.BaudRate := BaudRate;
  if ByteSize = '_8' then  Comm2.ByteSize := _8
  else  Comm1.ByteSize := _7;
  if StopBits = '_1' then Comm2.StopBits := _1
  else if StopBits = '_1_5' then Comm2.StopBits := _1_5
  else Comm2.StopBits := _2;
  Comm2.ParityCheck := Parity;
end;

procedure TCommTestFrm.FormCreate(Sender: TObject);
begin
  BTNResetCommSetClick(Sender);
  Comm1.StartComm;
  Comm2.StartComm;
end;

procedure TCommTestFrm.BTNSaveAckClick(Sender: TObject);
var
  Ini: TIniFile;
  AckSet1, AckSet2,AckSet3,AckSet4,AckSet5,AckSet6: string;
begin
  AckSet1 := Copy(EditAck1.Text,1,2);   //前两位有效
  AckSet2 := EditAck2.Text;
  AckSet3 := EditAck3.Text;
  AckSet4 := EditAck4.Text;
  AckSet5 := EditAck5.Text;
  AckSet6 := EditAck6.Text;
  Ini := TIniFile.Create(ExtractFilePath(ParamStr(0)) + 'CommSet.ini');
  try
    Ini.WriteString( '串口测试', '握手信号1', AckSet1);
    Ini.WriteString( '串口测试', '握手信号2', AckSet2);
    Ini.WriteString( '串口测试', '握手信号3', AckSet3);
    Ini.WriteString( '串口测试', '握手信号4', AckSet4);
    Ini.WriteString( '串口测试', '握手信号5', AckSet5);
    Ini.WriteString( '串口测试', '握手信号6', AckSet6);
  finally
    Ini.Free;
  end;
end;
 
//发送按钮的点击事件
procedure TCommTestFrm.StartSendActionExecute(Sender: TObject);
var
  strSend: String;
  i: Integer;
begin
  try
    Comm1.StopComm;
    Comm1.StartComm;
  except
    Messagedlg('无法打开COMM1!', mterror, [mbOK],0);
  end;
  Sleep(50);
  StatusBar1.Panels[1].Text := '串口1已启动';
  for i:= 0 to Memo1.Lines.Count -1 do
  begin
    strSend := Memo1.Lines[i];
    try
    StatusBar1.Panels[1].Text := '串口1正在发送数据';
    Comm1.WriteCommData(PChar(strSend) , Length(strSend));
    except
     Showmessage('发送错误');
    end;
  end;
end;

procedure TCommTestFrm.StopReciveActionExecute(Sender: TObject);
begin
  Comm2.StopComm; //关闭Comm2
  StatusBar1.Panels[2].Text := '串口2已关闭';
end;

procedure TCommTestFrm.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  Comm1.StopComm; //关闭Comm1
  Comm2.StopComm; //关闭Comm2
end;

procedure TCommTestFrm.StopSendActionExecute(Sender: TObject);
begin
  Comm1.StopComm;//关闭Comm1
  StatusBar1.Panels[1].Text := '串口1已关闭';
end;

procedure TCommTestFrm.Comm2ReceiveData(Sender: TObject; Buffer: Pointer;
  BufferLength: Word);
type
  IArr = ^Integer;
  var
    RevP : array [1..4096] of byte;
    i : integer;
    CommRevStr : ShortString;
begin
  SetLength(CommRevStr,BufferLength);
  Move(IArr(buffer)^,Revp,bufferLength);
  For i:=1 to BufferLength do
    begin
     CommrevStr[i] := Char(Revp[i]);
    end;
  Memo2.Lines.Add(CommrevStr);
  StatusBar1.Panels[2].Text := '串口2正在接收数据';
end;

procedure TCommTestFrm.TestCommActionExecute(Sender: TObject);
begin
  if not Testing then
  begin
   Testing := True;
   NextNum := 0;
   Comm1.WriteCommData(Pchar(EditAck1.Text),Length(Pchar(EditAck1.Text)));
   StatusBar1.Panels[1].Text := '串口1正在发送测试数据';
  end;
end;

procedure TCommTestFrm.StartReciveActionExecute(Sender: TObject);
begin
  try
    Comm2.StopComm;
    Comm2.StartComm;
  except
    Messagedlg('无法打开COMM2!', mterror, [mbOK],0);
  end;
  Sleep(50);
  StatusBar1.Panels[2].Text := '串口2已启动';
end;

procedure TCommTestFrm.Comm1ReceiveData(Sender: TObject; Buffer: Pointer;
  BufferLength: Word);
begin
   StatusBar1.Panels[1].Text := '串口1正在接收数据';
end;

procedure TCommTestFrm.SendWinMenuClick(Sender: TObject);
begin
  GroupBox1.Visible:= SendWinMenu.Checked;
end;

procedure TCommTestFrm.CommSetMenuClick(Sender: TObject);
begin
  GroupBox2.Visible := CommSetMenu.Checked;
  Panel1.Visible := CommSetMenu.Checked;
end;

procedure TCommTestFrm.ToolBarMenuClick(Sender: TObject);
begin
  CoolBar1.Visible := ToolBarMenu.Checked;
end;

procedure TCommTestFrm.RecvWinMenuClick(Sender: TObject);
begin
  GroupBox3.Visible := RecvWinMenu.Checked;
  if GroupBox1.Align = alClient then
    begin
      GroupBox1.Align  := alLeft;
      GroupBox1.Width := (CommTestFrm.Width - GroupBox2.Width) div 2;
    end
  else
     GroupBox1.Align := alClient;
end;

procedure TCommTestFrm.Comm1SendDataEmpty(Sender: TObject);
var Str: String;
begin
  if not Testing  then exit;
  NextNum := NextNum+1;
  if NextNum <= 5 then
      begin
       if NextNum = 1 then Str := EditAck2.Text
       else if NextNum = 2 then Str := EditAck3.Text
       else if NextNum = 3 then Str := EditAck4.Text
       else if NextNum = 4 then Str := EditAck5.Text
       else if NextNum = 5 then Str := EditAck6.Text;
       Comm1.WriteCommData(Pchar(Str),Length(Pchar(Str)));
      end
  else
  begin
    StatusBar1.Panels[1].Text := '串口1测试完毕';
    Testing := False;
  end;
end;

procedure TCommTestFrm.Comm2RequestHangup(Sender: TObject);
begin
  StatusBar1.Panels[2].Text := '串口2需要挂起了';
end;

end.