sport.pas

合成实验的上位机程序

unit SPort;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, jpeg, ExtCtrls, StdCtrls, Buttons, SPComm;

type
  TSPortFrm = class(TForm)
    CaptionLbl: TLabel;
    Bevel1: TBevel;
    Label1: TLabel;
    ComboBox1: TComboBox;
    Label2: TLabel;
    ComboBox2: TComboBox;
    Label3: TLabel;
    ComboBox3: TComboBox;
    Label4: TLabel;
    ComboBox4: TComboBox;
    Label5: TLabel;
    ComboBox5: TComboBox;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    ComboBox6: TComboBox;
    ComboBox7: TComboBox;
    CheckBox1: TCheckBox;
    Label9: TLabel;
    CheckBox2: TCheckBox;
    Label10: TLabel;
    SpeedButton1: TSpeedButton;
    Memo1: TMemo;
    Label11: TLabel;
    SpeedButton2: TSpeedButton;
    Memo2: TMemo;
    Comm1: TComm;
    SpeedButton3: TSpeedButton;
    SpeedButton4: TSpeedButton;
    ClsSpdBtn: TSpeedButton;
    Bevel5: TBevel;
    procedure ComboBox7KeyPress(Sender: TObject; var Key: Char);
    procedure SpeedButton4Click(Sender: TObject);
    procedure ClsSpdBtnClick(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ComboBox2Change(Sender: TObject);
    procedure ComboBox3Change(Sender: TObject);
    procedure ComboBox4Change(Sender: TObject);
    procedure ComboBox5Change(Sender: TObject);
    procedure ComboBox6Change(Sender: TObject);
    procedure ComboBox7Change(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure Comm1ReceiveData(Sender: TObject; Buffer: Pointer;
      BufferLength: Word);
    procedure FormCreate(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
  private
    procedure CMMOUSEENTER(var msg: TMessage); message CM_MOUSEENTER;
    procedure CMMOUSELEAVE(var msg: TMessage); message CM_MOUSELEAVE;
  public
    //为窗口增加一个任务栏显示
    procedure CreateParams(Var Param:TCreateParams);override;
  end;

var
  SPortFrm: TSPortFrm;

implementation
uses ParaAdd;

{$R *.dfm}


procedure TSPortFrm.CreateParams(Var Param:TCreateParams);
begin
  //增加一个任务栏显示
  Inherited CreateParams(Param);
  Param.wndParent:= GetDesktopWindow;
end;

procedure TSPortFrm.CMMOUSEENTER(var msg: TMessage);
begin
  //如果鼠标进入关闭主窗体按钮
  if Integer(ClsSpdBtn)=msg.LParam then
  begin
    Bevel5.Visible:=True;
    ClsSpdBtn.BringToFront;
  end
end;

procedure TSPortFrm.CMMOUSELEAVE(var msg: TMessage);
begin
  //如果鼠标离开关闭主窗体按钮
  if Integer(ClsSpdBtn)=msg.LParam then
    Bevel5.Visible:=False;
end;

procedure TSPortFrm.ComboBox7KeyPress(Sender: TObject; var Key: Char);
begin
  //时间值必须为整数
  Key:=ParaAddFrm.IsInt(ComboBox7.Text,Key);
end;

procedure TSPortFrm.SpeedButton4Click(Sender: TObject);
begin
  //关闭窗体
  Close;
end;

procedure TSPortFrm.ClsSpdBtnClick(Sender: TObject);
begin
  //关闭窗体
  SPortFrm.SpeedButton4Click(Sender);
end;

procedure TSPortFrm.SpeedButton1Click(Sender: TObject);
begin
  //清空接收区
  Memo1.Clear;
end;

procedure TSPortFrm.SpeedButton2Click(Sender: TObject);
begin
  //清空发送区
  Memo2.Clear;
end;
      
procedure TSPortFrm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  //关闭Comm1
  Comm1.StopComm;
  //清空回显
  if CheckBox2.Checked=True then
    Memo1.Clear;
end;

procedure TSPortFrm.ComboBox2Change(Sender: TObject);
begin
  //设置波特率
  Comm1.BaudRate:=StrToInt(ComboBox2.Text);
end;

procedure TSPortFrm.ComboBox3Change(Sender: TObject);
begin
  //设置校验位
  case ComboBox3.ItemIndex of
    0: begin
         Comm1.ParityCheck:=False;
         Comm1.Parity:=None;
       end;
    else
      begin
        Comm1.ParityCheck:=True;
        With ComboBox3 do
          if Text='Odd' then
            Comm1.Parity:=Odd else
          if Text='Even' then
            Comm1.Parity:=Even else
          if Text='Mark' then
            Comm1.Parity:=Mark else
          if Text='Space' then
            Comm1.Parity:=Space;
      end;
  end;
end;

procedure TSPortFrm.ComboBox4Change(Sender: TObject);
begin
  //设置数据位
  case ComboBox4.ItemIndex of
    0: Comm1.ByteSize:=_5;
    1: Comm1.ByteSize:=_6;
    2: Comm1.ByteSize:=_7;
    3: Comm1.ByteSize:=_8;
  end;
end;

procedure TSPortFrm.ComboBox5Change(Sender: TObject);
begin
  //设置停止位
  case ComboBox5.ItemIndex of
    0: Comm1.StopBits:=_1;
    1: Comm1.StopBits:=_1_5;
    2: Comm1.StopBits:=_2;
  end;
end;

procedure TSPortFrm.ComboBox6Change(Sender: TObject);
begin
  //设置输出数据
  case ComboBox6.ItemIndex of
    0: Memo2.Text:='h'+ComboBox7.Text;
    1: Memo2.Text:='a'+ComboBox7.Text;
  end;
end;

procedure TSPortFrm.ComboBox7Change(Sender: TObject);
begin
  //设置输出数据
  SPortFrm.ComboBox6Change(Sender);
end;

procedure TSPortFrm.SpeedButton3Click(Sender: TObject);
var
  Str: String;
begin
  //串口写
  Str:=Trim(Memo2.Text);
  Comm1.WriteCommData(pChar(Str),Length(Str));
  //等待传输完毕
  Screen.Cursor:=crHourGlass;
  Sleep(1500);
end;

procedure TSPortFrm.Comm1ReceiveData(Sender: TObject; Buffer: Pointer;
  BufferLength: Word);
var
  RevP: array [1..2048] of Byte;
  I: Integer;
  CommRevStr: String;
begin
  //数据回显
  SetLength(CommRevStr,BufferLength);          
  Move(Buffer^,RevP,BufferLength);
  for I:=1 to BufferLength do
    CommrevStr[I]:=Char(RevP[I]);
  if CheckBox1.Checked=True then
  begin
    if Trim(Memo1.Text)='' then
      Memo1.Text:=CommRevStr
    else
      Memo1.Text:=Memo1.Text+#13+#10+CommRevStr;
  end
  else
    Memo1.Text:=Memo1.Text+CommRevStr;
  Screen.Cursor:=crDefault;
end;

procedure TSPortFrm.FormCreate(Sender: TObject);
var
  I: Integer;
  flgComExist: Boolean;
begin
  //检测可用的串口
  with ComboBox1.Items do
  begin
    Clear;
    BeginUpdate;
    try
      for I:=1 to 1 do
      begin
        try
          Comm1.StopComm;
          flgComExist:=True;
          Comm1.CommName:='COM'+IntToStr(I);
          Comm1.StartComm;
        except
          Comm1.StopComm;
          flgComExist:=False;
        end;       
        if flgComExist=True then
        begin
          Add('COM'+IntToStr(I));
          Comm1.StopComm;
        end;
      end;
    finally
      EndUpdate;
      if Count>0 then
        ComboBox1.ItemIndex:=0
      else
        MessageBox(SPortFrm.Handle,'检测不到可用的串口！',
          '警告',MB_ICONWARNING+MB_OK+MB_DEFBUTTON1);
    end;
  end;
end;

procedure TSPortFrm.ComboBox1Change(Sender: TObject);
begin
  //选择传输用的COM口
  Comm1.StopComm;
  Comm1.CommName:=ComboBox1.Text;
  Comm1.StartComm;
end;

end.