main.~pas

新改的串口delphi 很任性化的界面

  ComboBox4.Enabled := true;
  ComboBox5.Enabled := true;
  btnSend.Enabled   := false;
  ImageOn.Visible   := false;
  ImageOff.Visible  :=true;
  end;
Timer1.Enabled := cbAutoSend.Checked;
ShowStatus;
end;

procedure TFrmMain.BitBtn1Click(Sender: TObject);
begin
  Close;
end;

procedure TFrmMain.Button6Click(Sender: TObject);
begin
  Memo1.Clear;
end;

procedure TFrmMain.FormCreate(Sender: TObject);
var myMenu : HMENU;
begin
  FrmMain.Constraints.MinHeight := minHeight;
  FrmMain.Constraints.MinWidth  := minWidth;

  FShowText:=True;
  FRXNum:=0;
  FTXNum:=0;
  EnumComPorts(ComboBox1.Items);    //得到串口列表
  ComboBox1.ItemIndex := 0;
  Comm1.CommName := ComboBox1.Text;
  ComboBox2.ItemIndex := 6;
  Comm1.BaudRate := StrToInt(ComboBox2.Text);
  ComboBox3.ItemIndex := 0;
  Comm1.Parity := None;
  ComboBox4.ItemIndex := 3;
  Comm1.ByteSize := _8;
  ComboBox5.ItemIndex := 0;
  Comm1.StopBits := _1;

  myMenu :=  GetSystemMenu(Handle, False);
  AppendMenu(myMenu, MF_SEPARATOR, 0, '');
  AppendMenu(myMenu, MF_STRING, idAbout, '关于');

end;

procedure TFrmMain.ShowRX;
begin
  edRX.Text:='Rx:'+IntTostr(FRXNum);
end;

procedure TFrmMain.ShowStatus;
begin
  if btnSwitch.Caption = '关闭串口' then
  begin
    edStatus.Text:=Format(' STATUS: %s Opened %s %s %s %s',[ComboBox1.Text,
      {ComboBox2.Text,}IntToStr(Comm1.BaudRate),ComboBox3.Text,ComboBox4.Text,ComboBox5.Text]);
  end
  else edStatus.Text:=' STATUS: COM Port Closed';
end;

procedure TFrmMain.ShowTX;
begin
  edTx.Text:='Tx:'+IntTostr(FTXNum);
end;

procedure TFrmMain.Button5Click(Sender: TObject);
begin
  FRXNum:=0;
  FTXNum:=0;
  ShowRX;
  ShowTX;
end;

procedure TFrmMain.Button1Click(Sender: TObject);
begin
  Memo2.Clear;
end;

procedure TFrmMain.SpinEdit1Change(Sender: TObject);
begin
  Timer1.Interval:=SpinEdit1.Value;
end;

procedure TFrmMain.cbAutoSendClick(Sender: TObject);
begin
  Timer1.Enabled:=cbAutoSend.Checked;
  SpinEdit1.Enabled := not cbAutoSend.Checked;
end;

procedure TFrmMain.Timer1Timer(Sender: TObject);
begin
  if Memo2.Text<>'' then
    btnSend.Click;
end;

procedure TFrmMain.btnStopShowClick(Sender: TObject);
begin
  FShowText:=not FShowText;
  if FShowText then
    btnStopShow.Caption:='停止显示'
  else btnStopShow.Caption:='继续显示';
end;

procedure TFrmMain.Button9Click(Sender: TObject);
var
  Dir: string;
begin
  if SelectDirectory(FrmMain.Handle,'请选择要保存接收数据的目录',' ',Dir) then
    edPath.Text := Dir;
end;

procedure TFrmMain.Button8Click(Sender: TObject);
var
  S:string;
begin
  S := edPath.Text;
  if not DirectoryExists(S) then
    CreateDir(S);
  S:=S+'Rec'+FormatDateTime('yymmddhhssnn',Now)+'.txt';
  Memo1.Lines.SaveToFile(S);
  Application.MessageBox(pchar(s+#13#13#9+'已保存'),'信息',MB_ICONWARNING or MB_OK);
end;

procedure TFrmMain.Button3Click(Sender: TObject);
begin
  if OpenDialog1.Execute then
    edSendFile.Text:=OpenDialog1.FileName;
end;

procedure TFrmMain.Button4Click(Sender: TObject);
begin
  if FileExists(edSendFile.Text) then
    SendFile(edSendFile.Text);
end;

procedure TFrmMain.SendFile(const filename: string);
var
  S:TStringList;
begin
  S:=TStringList.Create;
  try
    S.LoadFromFile(filename);
    SendString(S.Text);
  finally
    S.Free;
  end;
end;

function HexStrToStr(const S:string):string;
//16进制字符串转换成字符串
var
  t:Integer;
  ts:string;
  M,Code:Integer;
begin
  t:=1;
  Result:='';
  while t<=Length(S) do
  begin   //xlh 2006.10.21
    while (t<=Length(S)) and (not (S[t] in ['0'..'9','A'..'F','a'..'f'])) do
      inc(t);
    if (t+1>Length(S))or(not (S[t+1] in ['0'..'9','A'..'F','a'..'f'])) then
      ts:='$'+S[t]
    else
      ts:='$'+S[t]+S[t+1];
    Val(ts,M,Code);
    if Code=0 then
      Result:=Result+Chr(M);
    inc(t,2);
  end;
end;

procedure TFrmMain.btnSendClick(Sender: TObject);
begin
  if cbsendHex.Checked then
    SendString(HexStrToStr(Memo2.Text))
  else
    SendString(Memo2.Text);
end;

procedure TFrmMain.SendString(const str: string);

begin
  if Comm1.WriteCommData(Pchar(str),Length(str)) then
    begin
    FTXNum:=FTXNum+Length(str);
    ShowTX;
    end;
end;

function StrToHexStr(const S:string):string;
//字符串转换成16进制字符串
var
  I:Integer;
begin
  for I:=1 to Length(S) do
  begin
    if I=1 then
      Result:=IntToHex(Ord(S[1]),2)
    else Result:=Result+' '+IntToHex(Ord(S[I]),2);
  end;
end;

procedure TFrmMain.Comm1ReceiveData(Sender: TObject; Buffer: Pointer;
  BufferLength: Word);
var str :string;
begin
  //Memo自动清空
  if cbAutoClean.Checked and (Memo1.Lines.Count > 50) then
     Memo1.Clear;
     
  SetLength(Str,BufferLength);
  move(buffer^,pchar(@Str[1])^,bufferlength);
  if FShowText then
  begin
    if cbRecHex.Checked then
      Memo1.Text:=Memo1.Text+StrToHexStr(Str)+' '
    else
      Memo1.Text := Memo1.Text + Str;
  Memo1.SelStart := Length(Memo1.Text);
  Memo1.SelLength:= 0;
  Memo1.Perform(EM_SCROLLCARET,0,0);
  end;
  FRXNum:=FRXNum+bufferlength;
  ShowRX;
end;

procedure TFrmMain.ComboBox1Change(Sender: TObject);
begin
  Comm1.CommName:=ComboBox1.Text;
end;

procedure TFrmMain.ComboBox2Change(Sender: TObject);
var  BaudRate : Integer;
begin
  if ComboBox2.Text = 'Custom' then
    begin
      ComboBox2.Style := csDropDown;
      ComboBox2.SetFocus;
    end
  else begin
    if  ComboBox2.ItemIndex >0 then
      ComboBox2.Style := csDropDownList;
    if TryStrToInt(ComboBox2.Text,BaudRate) then
           Comm1.BaudRate := BaudRate;
  end;
end;

procedure TFrmMain.ComboBox3Change(Sender: TObject);
begin
  //TParity = ( None, Odd, Even, Mark, Space );
  Comm1.Parity := TParity(ComboBox3.ItemIndex);
end;

procedure TFrmMain.ComboBox4Change(Sender: TObject);
begin
   //TByteSize = ( _5, _6, _7, _8 );
   Comm1.ByteSize :=  TByteSize(ComboBox4.ItemIndex);
end;

procedure TFrmMain.ComboBox5Change(Sender: TObject);
begin
  //TStopBits = ( _1, _1_5, _2 );
  Comm1.StopBits := TStopBits(ComboBox5.ItemIndex);
end;

procedure TFrmMain.ComboBox2KeyPress(Sender: TObject; var Key: Char);
begin
 if not (Key in ['0'..'9',#8]) then Key := #0;
end;

procedure TFrmMain.Memo2KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
if (Shift=[ssAlt]) and (key=Ord('S')) and (btnSend.Enabled) then   //快捷键 ALT + S
   btnSend.Click;
end;

procedure TFrmMain.WMSysCommand(var Message: TWMSysCommand);
begin
  Inherited;
  if Message.CmdType = idAbout then
    Application.MessageBox('==  低速率测试 11.11  == '+#13#13+
                           '           '+#13+
                           '     '+#13+
                           '      '+#13#13+
                           '       '+#13+
                           ' '+#13#13+
                           '原作者：Sky    Email:[e-mail]'+#13+
                           '原作者：谢利洪 Email:[e-mail]'+#13+
                           '现作者：[e-mail]'
                           ,'关于')
end;

end.