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

脑经急转弯

菜农 发表于 2006-10-20 23:57:00 //菜农HotPower@126.com   2003.1.18 写于西安大雁塔村队部



//使用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 := ',';

  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).Caption + ',';

      if TCheckBox(GroupBox2.Controls).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);

    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);

    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);

    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);

    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);

    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);

    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);

    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);

    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);

    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);

    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.