3.txt

GPS串口自适应解码Delphi源程序(SPCOMM控件)

//经过改造的Delphi环境下应用的串口控件SPComm

unit GPSTESTU;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Menus, ComCtrls, Buttons, Grids, SPComm, ExtCtrls;

type
  TForm1 = class(TForm)
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    StatusBar1: TStatusBar;
    GroupBox2: TGroupBox;
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    CheckBox3: TCheckBox;
    CheckBox4: TCheckBox;
    CheckBox5: TCheckBox;
    CheckBox6: TCheckBox;
    CheckBox7: TCheckBox;
    CheckBox8: TCheckBox;
    CheckBox9: TCheckBox;
    CheckBox10: TCheckBox;
    CheckBox11: TCheckBox;
    CheckBox12: TCheckBox;
    CheckBox13: TCheckBox;
    CheckBox14: TCheckBox;
    Label4: TLabel;
    ComboBox1: TComboBox;
    Label5: TLabel;
    ComboBox2: TComboBox;
    BitBtn1: TBitBtn;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    StringGrid1: TStringGrid;
    BitBtn2: TBitBtn;
    BitBtn3: TBitBtn;
    BitBtn4: TBitBtn;
    BitBtn0: TBitBtn;
    Comm1: TComm;
    Label6: TLabel;
    Edit1: TEdit;
    Label7: TLabel;
    Edit2: TEdit;
    Label8: TLabel;
    Edit3: TEdit;
    Label9: TLabel;
    Edit4: TEdit;
    Label10: TLabel;
    Edit5: TEdit;
    Label11: TLabel;
    Edit6: TEdit;
    Edit7: TEdit;
    Label12: TLabel;
    BitBtn5: TBitBtn;
    BitBtn6: TBitBtn;
    TabSheet2: TTabSheet;
    Memo1: TMemo;
    Edit8: TEdit;
    Label13: TLabel;
    Label14: TLabel;
    ComboBox3: TComboBox;
    Label15: TLabel;
    Edit9: TEdit;
    Label16: TLabel;
    Edit10: TEdit;
    Label17: TLabel;
    Label18: TLabel;
    Edit11: TEdit;
    Label19: TLabel;
    Edit12: TEdit;
    Edit13: TEdit;
    Edit14: TEdit;
    Label20: TLabel;
    Label21: TLabel;
    Edit15: TEdit;
    Label22: TLabel;
    Edit16: TEdit;
    Timer1: TTimer;
    Label23: TLabel;
    Edit17: TEdit;
    Edit18: TEdit;
    Button1: TButton;
    Edit19: TEdit;
    procedure BitBtn1Click(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure BitBtn0Click(Sender: TObject);
    function GetGpsMess(MessString: String; MessNum: integer) : String;
    function GpsDateFormat(DateString: String) : String;
    function GpsTimeFormat(TimeString: String) : String;
    procedure BitBtn3Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure Comm1ReceiveData(Sender: TObject; Buffer: PChar;
      BufferLength: Word);
    procedure ComboBox2Change(Sender: TObject);
    procedure BitBtn6Click(Sender: TObject);
    procedure BitBtn5Click(Sender: TObject);
    procedure BitBtn4Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  GPSBuffers: String;
  GPSMessString: String;
implementation

{$R *.DFM}

function TForm1.GpsTimeFormat(TimeString: String) : String;
  function  GpsChnTimeFormat (TimeString: String) : String;
  var
    i: integer;
  begin
    Result := '';
    if length(TimeString) = 2 then
    begin
      i := strtoint(TimeString) + 8;
      if i > 23 then i := 0;
      if i < 10 then Result := '0' + inttostr(i)
      else Result := inttostr(i);
    end;
  end;
begin
  Result := '';
  if length(TimeString) = 6 then
  begin
    Result := GpsChnTimeFormat(copy(TimeString, 1, 2)) + '时' + copy(TimeString, 3, 2) + '分' + copy(TimeString, 5, 2) + '秒';
  end;
end;

function TForm1.GpsDateFormat(DateString: String) : String;
begin
  Result := '';
  if length(DateString) = 6 then
  begin
    Result := '20' + copy(DateString, 5, 2) + '年' + copy(DateString, 3, 2) + '月' + copy(DateString, 1, 2) + '日';
  end;
end;

function TForm1.GetGpsMess(MessString: String; MessNum: integer) : String;
var
  str: String;
  i, k: integer;
  s: byte;
begin
  str := MessString;
  i := Pos('*', str);
  if (i < 10) or (str[1] <> '$') then
  begin
    Result := '';
    Exit;
  end;
  s := 0;
  for k := 2 to i - 1 do
  begin
    s := s xor byte(str[k]);
  end;
  if inttohex(s, 2) <> Copy(str, i + 1, 2) then
  begin
    Result := '';
    Exit;
  end;
  str[1] := ',';
  str[i] := ',';
  k := 0;
  for i := 0 to MessNum do
  begin
    k := Pos(',', str);
    str[k] := #7;
  end;
  i := Pos(',', str);
  str := Copy(str, k + 1, i - k - 1);
  Result := str;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
  Comm1.PortOpen := false;
  Comm1.CommName := ComboBox1.Text;
  Comm1.PortOpen := true;
  if Comm1.PortOpen = true then
  begin
    ComboBox2.Color := clWindow;
    ComboBox2.Enabled := true;
    StatusBar1.Panels.Items[1].Text := '';
  end
  else
  begin
    ComboBox2.Color := clRed;
    ComboBox2.Enabled := false;
    StatusBar1.Panels.Items[1].Text := '无此串口！！！请选择其他串口设备！！！';
  end;
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  Comm1.PortOpen := false;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  i: integer;
begin
  ComboBox1.ItemIndex := 1;//COM2
  ComboBox2.ItemIndex := 2;//4800
  ComboBox3.ItemIndex := 2;//4800
  ComboBox2.Enabled := false;
  ComboBox2.Color := clRed;
//  Comm1.CommPort := 2;
  Comm1.BaudRate := 4800;//波特率4800
  Comm1.ParityCheck := False;//无校验
  Comm1.Parity := None;//无校验
  Comm1.ByteSize := _8;//8位数据位
  Comm1.StopBits := _2;//2位停止位
//  Comm1.PortOpen := true;
  for i := 1 to 5 do
  begin
    Comm1.CommPort := i;
    Comm1.PortOpen := true;
    if Comm1.PortOpen = true then
    begin
      ComboBox1.ItemIndex := i - 1;
      ComboBox2.Color := clWindow;
      ComboBox2.Enabled := true;
      StatusBar1.Panels.Items[1].Text := '串口';
      StatusBar1.Panels.Items[1].Text := StatusBar1.Panels.Items[1].Text + inttostr(i);
      StatusBar1.Panels.Items[1].Text := StatusBar1.Panels.Items[1].Text + '已打开！';
      break;
    end
  end;
  StringGrid1.ColCount := 5;
  StringGrid1.RowCount := 2;
  StringGrid1.Cells[0, 0] := '序号';
  StringGrid1.Cells[1, 0] := '经度';
  StringGrid1.Cells[2, 0] := '纬度';
  StringGrid1.Cells[3, 0] := '速度';
  StringGrid1.Cells[4, 0] := '地点';
  StringGrid1.Cells[0, 1] := inttostr(1);
end;

procedure TForm1.BitBtn0Click(Sender: TObject);
begin
  Comm1.PortOpen := false;
  ComboBox2.Color := clRed;
  ComboBox2.Enabled := false;
  StatusBar1.Panels.Items[1].Text := '';
end;

procedure TForm1.BitBtn3Click(Sender: TObject);
begin
  Edit1.Text := '';
  Edit2.Text := '';
  Edit3.Text := '';
  Edit4.Text := '';
  Edit5.Text := '';
  Edit6.Text := '';
  Edit7.Text := '';
  Edit8.Text := '';
  Edit9.Text := '';
  Edit10.Text := '';
  Edit11.Text := '';
  Edit12.Text := '';
  Edit13.Text := '';
  Edit14.Text := '';
  Edit15.Text := '';
  Edit17.Text := '';
  Memo1.Clear;
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
begin
  if StringGrid1.Cells[1, StringGrid1.RowCount - 1] <> '' then
  begin
    StringGrid1.RowCount := StringGrid1.RowCount + 1;
    StringGrid1.Cells[0, StringGrid1.RowCount - 1] := inttostr(StringGrid1.RowCount - 1);
  end;
  StringGrid1.Cells[1, StringGrid1.RowCount - 1] := Edit4.Text;//经度
  StringGrid1.Cells[2, StringGrid1.RowCount - 1] := Edit5.Text;//纬度
  StringGrid1.Cells[3, StringGrid1.RowCount - 1] := Edit3.Text;//速度
end;

procedure TForm1.Comm1ReceiveData(Sender: TObject; Buffer: PChar;
  BufferLength: Word);
var
  ch: char;
  name: String;
begin
  Timer1.Tag := Timer1.Tag + 1;
//  move(Buffer^, ch, 1);
  ch := Buffer[0];
  if ch >= ' ' then GPSBuffers := GPSBuffers + ch
  else
  begin
    if ch = #10 then GPSBuffers := ''
    else if ch = #13 then
    begin
      if GPSBuffers[1] = '$' then
      begin
        if Memo1.Lines.Count >= 88 then
          Memo1.Lines.Clear;
        Memo1.Lines.Add(GPSBuffers);
        name := GetGpsMess(GPSBuffers, 0);
        if name = 'GPGGA' then
        begin
          Edit2.Text := GpsTimeFormat(GetGpsMess(GPSBuffers, 1));//时间
          Edit4.Text := GetGpsMess(GPSBuffers, 4);//经度
          Edit5.Text := GetGpsMess(GPSBuffers, 2);//纬度
          Edit6.Text := GetGpsMess(GPSBuffers, 7);//星数
          Edit7.Text := GetGpsMess(GPSBuffers, 6);//状态
          Edit8.Text := GetGpsMess(GPSBuffers, 9);//高度
          StatusBar1.Panels.Items[1].Text := '';
        end
        else if name = 'GPRMC' then
        begin
          Edit1.Text := GpsDateFormat(GetGpsMess(GPSBuffers, 9));//日期
          Edit2.Text := GpsTimeFormat(GetGpsMess(GPSBuffers, 1));//时间
          Edit3.Text := GetGpsMess(GPSBuffers, 7);//速度
          Edit17.Text := GetGpsMess(GPSBuffers, 8);//方向
          Edit4.Text := GetGpsMess(GPSBuffers, 5);//经度
          Edit5.Text := GetGpsMess(GPSBuffers, 3);//纬度
          StatusBar1.Panels.Items[1].Text := '';
        end
        else Exit;
        if Edit15.Text = '' then
        begin
          Edit15.Text := Edit2.Text;//时间
          Edit9.Text := Edit4.Text;
          Edit10.Text := Edit4.Text;
          Edit12.Text := Edit5.Text;
          Edit13.Text := Edit5.Text;
        end
        else
        begin
        if Edit9.Text < Edit4.Text then Edit9.Text := Edit4.Text;
          if Edit10.Text > Edit4.Text then Edit10.Text := Edit4.Text;
          if Edit12.Text < Edit5.Text then Edit12.Text := Edit5.Text;
          if Edit13.Text > Edit5.Text then Edit13.Text := Edit5.Text;
          Edit11.Text := inttostr(strtoint(copy(Edit9.Text, 7, 4)) - strtoint(copy(Edit10.Text, 7, 4)));
          Edit14.Text := inttostr(strtoint(copy(Edit12.Text, 6, 4)) - strtoint(copy(Edit13.Text, 6, 4)));
          Edit16.Text := FormatFloat('0.00', 0.1805 * sqrt(sqr(strtoint(Edit11.Text)) + sqr(strtoint(Edit14.Text)))) + '米';
        end;
      end;
    end
    else
    begin
      StatusBar1.Panels.Items[1].Text := '波特率设置错误！！！';
      Comm1.PortOpen := false;
      if ComboBox2.ItemIndex >= (ComboBox2.Items.Count - 1) then ComboBox2.ItemIndex := 0
      else ComboBox2.ItemIndex := ComboBox2.ItemIndex + 1;
      Comm1.BaudRate := strtoint(ComboBox2.Items[ComboBox2.ItemIndex]);//波特率4800
      Comm1.PortOpen := true;
    end;
  end;
end;


procedure TForm1.ComboBox2Change(Sender: TObject);
begin
  Comm1.PortOpen := false;
  Comm1.BaudRate := strtoint(ComboBox2.Items[ComboBox2.ItemIndex]);//波特率4800
  Comm1.PortOpen := true;
  StatusBar1.Panels.Items[1].Text := '';
end;

procedure TForm1.BitBtn6Click(Sender: TObject);
var
  sum: byte;
  i, j: integer;
  str: string;
begin
  if Comm1.PortOpen then
  begin
    for i := 1 to 14 do
    begin
      str := '$PGRMO,' + TCheckBox(GroupBox2.Controls[i]).Caption + ',';
      if TCheckBox(GroupBox2.Controls[i]).Checked then str := str + '1'
      else str := str + '0';
      sum := 0;
      for j := 2 to length(str) do
      begin
        sum := sum xor byte(str[j]);
      end;
      str := str+ '*' + inttohex(sum, 2) + #13#10;
      Comm1.Output := str;
    end;
    sum := 0;
    str := '$PGRMC1,1,,,,,,,N,N';
    for i := 2 to length(str) do
    begin
      sum := sum xor byte(str[i]);
    end;
    str := str+ '*' + inttohex(sum, 2) + #13#10;
    Comm1.Output := str;
  end;
end;

procedure TForm1.BitBtn5Click(Sender: TObject);
var
  i: integer;
  sum: byte;
  str: string;
begin
  if Comm1.PortOpen then
  begin
    sum := 0;
    str := '$PGRMC,A,,,,,,,,,' + inttostr(ComboBox3.ItemIndex + 1) + ',,,1';
    for i := 2 to length(str) do
    begin
      sum := sum xor byte(str[i]);
    end;
    str := str+ '*' + inttohex(sum, 2) + #13#10;
    Comm1.Output := str;
    StatusBar1.Panels.Items[1].Text := '请关闭GPS电源，在上电后新波特率才有效！！！';
  end;
end;

procedure TForm1.BitBtn4Click(Sender: TObject);
var
  i: integer;
  sum: byte;
  str: string;
begin
  if Comm1.PortOpen then
  begin
    sum := 0;
    str := '$PGRMIX';
    for i := 2 to length(str) do
    begin
      sum := sum xor byte(str[i]);
    end;

    str := str+ '*' + inttohex(sum, 2) + #13#10;
    Comm1.Output := str;
    sum := 0;
    str := '$PGRMCX';
    for i := 2 to length(str) do
    begin
      sum := sum xor byte(str[i]);
    end;
    str := str+ '*' + inttohex(sum, 2) + #13#10;
    Comm1.Output := str;

    sum := 0;
    str := '$PGRMC1X';
    for i := 2 to length(str) do
    begin
      sum := sum xor byte(str[i]);
    end;
    str := str+ '*' + inttohex(sum, 2) + #13#10;
    Comm1.Output := str;

    sum := 0;
    str := '$PGRMO,GPALM,1';
    for i := 2 to length(str) do
    begin
      sum := sum xor byte(str[i]);
    end;
    str := str+ '*' + inttohex(sum, 2) + #13#10;
    Comm1.Output := str;
  end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  i: integer;
  sum: byte;
  str: string;
begin
  if Comm1.PortOpen then
  begin
  if Timer1.Tag = 0 then
  begin
    Comm1.PortOpen := false;
    if ComboBox2.ItemIndex >= (ComboBox2.Items.Count - 1) then ComboBox2.ItemIndex := 0
    else ComboBox2.ItemIndex := ComboBox2.ItemIndex + 1;
    Comm1.BaudRate := strtoint(ComboBox2.Items[ComboBox2.ItemIndex]);//波特率4800
    Comm1.PortOpen := true;
    sum := 0;
    str := '$PGRMIX';
    for i := 2 to length(str) do
    begin
      sum := sum xor byte(str[i]);
    end;
    str := str+ '*' + inttohex(sum, 2) + #13#10;
    Comm1.Output := str;
    sum := 0;
    str := '$PGRMCX';
    for i := 2 to length(str) do
    begin
      sum := sum xor byte(str[i]);
    end;
    str := str+ '*' + inttohex(sum, 2) + #13#10;
    Comm1.Output := str;

    sum := 0;
    str := '$PGRMC1X';
    for i := 2 to length(str) do
    begin
      sum := sum xor byte(str[i]);
    end;
    str := str+ '*' + inttohex(sum, 2) + #13#10;
    Comm1.Output := str;

    sum := 0;
    str := '$PGRMO,GPALM,1';
    for i := 2 to length(str) do
    begin
      sum := sum xor byte(str[i]);
    end;
    str := str+ '*' + inttohex(sum, 2) + #13#10;
    Comm1.Output := str;
  end;
//  Timer1.Tag := 0;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  str: String;
  i, k: integer;
  s: byte;
begin
  str := Edit18.Text;
  i := Pos('*', str);
  if (i < 10) or (str[1] <> '$') then
  begin
    Exit;
  end;
  s := 0;
  for k := 2 to i - 1 do
  begin
    s := s xor byte(str[k]);
  end;
  Edit19.Text :=inttohex(s, 2);
end;

end.