main.pas

TGPS 控件是利用串行端口连接全球卫星定位系统设备 ( GPS ) 取得地理位置信息的控件 ( 1.04 版

unit Main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, GPS, CommDriver, ComCtrls, ExtCtrls, GPSSatData, SatDataBase,
  ShellAPI, Registry;

type
  TForm1 = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    GPS1: TGPS;
    GroupBox1: TGroupBox;
    Button1: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    edGGA1: TEdit;
    edGGA2: TEdit;
    edGGA5: TEdit;
    edGGA6: TEdit;
    edGGA7: TEdit;
    Button2: TButton;
    lblStat: TLabel;
    TabSheet2: TTabSheet;
    edGGA3: TEdit;
    edGGA4: TEdit;
    rgComPort: TRadioGroup;
    rgComSpeed: TRadioGroup;
    edGGA8: TEdit;
    Label8: TLabel;
    TabSheet3: TTabSheet;
    GPSSatData1: TGPSSatData;
    GroupBox2: TGroupBox;
    Label9: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    Label12: TLabel;
    Label13: TLabel;
    edBOD1: TEdit;
    edBOD2: TEdit;
    edBOD3: TEdit;
    edBOD5: TEdit;
    GroupBox3: TGroupBox;
    Label14: TLabel;
    Label15: TLabel;
    Label16: TLabel;
    edGLL3: TEdit;
    edGLL1: TEdit;
    edGLL2: TEdit;
    Label17: TLabel;
    edGLL4: TEdit;
    edBOD4: TEdit;
    GroupBox4: TGroupBox;
    Label19: TLabel;
    Label20: TLabel;
    Label21: TLabel;
    Label22: TLabel;
    Label23: TLabel;
    Label24: TLabel;
    edRMC1: TEdit;
    edRMC2: TEdit;
    edRMC3: TEdit;
    edRMC4: TEdit;
    edRMC5: TEdit;
    edRMC6: TEdit;
    GroupBox5: TGroupBox;
    edRMB3: TEdit;
    edRMB2: TEdit;
    edRMB1: TEdit;
    edRMB6: TEdit;
    edRMB5: TEdit;
    edRMB4: TEdit;
    edRMB9: TEdit;
    edRMB8: TEdit;
    edRMB7: TEdit;
    edRMB10: TEdit;
    Label25: TLabel;
    Label26: TLabel;
    Label27: TLabel;
    Label28: TLabel;
    Label29: TLabel;
    Label30: TLabel;
    Label31: TLabel;
    Label32: TLabel;
    Label33: TLabel;
    Label34: TLabel;
    GroupBox6: TGroupBox;
    Label35: TLabel;
    Label36: TLabel;
    edUnh2: TEdit;
    edUnh1: TEdit;
    lvWaypoints: TListView;
    rgDatabits: TRadioGroup;
    rgStopbits: TRadioGroup;
    rgParity: TRadioGroup;
    GroupBox7: TGroupBox;
    Label37: TLabel;
    Label38: TLabel;
    Label39: TLabel;
    edDOP4: TEdit;
    edDOP1: TEdit;
    edDOP2: TEdit;
    edDOP3: TEdit;
    edDOP5: TEdit;
    Label40: TLabel;
    Label41: TLabel;
    Label42: TLabel;
    GroupBox8: TGroupBox;
    edBWC7: TEdit;
    edBWC6: TEdit;
    edBWC5: TEdit;
    edBWC1: TEdit;
    edBWC2: TEdit;
    edBWC3: TEdit;
    edBWC4: TEdit;
    Label43: TLabel;
    Label44: TLabel;
    Label45: TLabel;
    Label46: TLabel;
    Label48: TLabel;
    Label49: TLabel;
    Label50: TLabel;
    GPSSatSignals1: TGPSSatSignals;
    TabSheet4: TTabSheet;
    Button3: TButton;
    Button4: TButton;
    Label47: TLabel;
    edFilename: TEdit;
    dlgSave: TSaveDialog;
    Button5: TButton;
    lblStatus: TStaticText;
    Button6: TButton;
    lblAutoDetect: TLabel;
    Label18: TLabel;
    Label51: TLabel;
    Label52: TLabel;
    Label53: TLabel;
    lblURL: TLabel;
    cbDTR: TCheckBox;
    cbRTS: TCheckBox;
    Label54: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure GPS1Position(Sender: TObject; FixTime: TDateTime; Latitude,
      Longitude: Double; Quality: TGPSQuality; SatCount: Integer; HDOP,
      Altitude, GeodidHeight: Double);
    procedure Button2Click(Sender: TObject);
    procedure GPS1Status(Sender: TObject; Status: TNMEAStatus);
    procedure FormCreate(Sender: TObject);
    procedure rgComPortClick(Sender: TObject);
    procedure rgComSpeedClick(Sender: TObject);
    procedure GPS1Bearing(Sender: TObject; BearingTrue, BearingMag: Double;
      NameOrigin, NameDest: String; Valid: Boolean);
    procedure GPS1GeoPosition(Sender: TObject; Valid: Boolean;
      FixTime: TDateTime; Latitude, Longitude: Double);
    procedure GPS1MinGPSData(Sender: TObject; Warning: Boolean;
      FixDateTime: TDateTime; Latitude, Longitude, Speed, Course,
      MagVariation: Double);
    procedure GPS1Unhandled(Sender: TObject; Talker, ID: String;
      Data: TStringList);
    procedure GPS1ActiveRoute(Sender: TObject; RouteNo: Integer;
      Waypoints: TWaypointList);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure rgDatabitsClick(Sender: TObject);
    procedure rgStopbitsClick(Sender: TObject);
    procedure rgParityClick(Sender: TObject);
    procedure GPS1NavigationInfo(Sender: TObject; Warning,
      Arrived: Boolean; CTE: Double; OriginWaypoint, DestWaypoint: String;
      DestLat, DestLon, RangeDest, BearingDest, Velocity: Double);
    procedure GPS1DOP(Sender: TObject; AutoSelect, Fix3D: Boolean; PDOP,
      HDOP, VDOP: Double);
    procedure GPS1BearingDistance(Sender: TObject; Time: TDateTime;
      Waypoint: String; Latitude, Longitude, BearingTrue, BearingMag,
      Distance: Double);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure lblURLClick(Sender: TObject);
    procedure cbDTRClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin
  Close;
end;

procedure TForm1.GPS1Position(Sender: TObject; FixTime: TDateTime;
  Latitude, Longitude: Double; Quality: TGPSQuality; SatCount: Integer;
  HDOP, Altitude, GeodidHeight: Double);
begin
  edGGA1.Text := TimeToStr(FixTime);
  edGGA2.Text := Format('%.4f',[Latitude]);
  edGGA3.Text := Format('%.4f',[Longitude]);
  case Quality of
    gpsqNone:
      edGGA4.Text := 'None';
    gpsqNormal:
      edGGA4.Text := 'Normal';
    gpsqDifferential:
      edGGA4.Text := 'Diff';
  end;
  edGGA5.Text := Format('%.2f',[HDOP]);
  edGGA6.Text := Format('%.2f',[Altitude]);
  edGGA7.Text := Format('%.2f',[GeodidHeight]);
  edGGA8.Text := IntToStr(SatCount);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  GPS1.Connected := True;
end;

procedure TForm1.GPS1Status(Sender: TObject; Status: TNMEAStatus);
begin
  case Status of
    nsNoPort:
      lblStatus.Caption := 'No comm port';
    nsNoComm:
      lblStatus.Caption := 'No communication';
    nsComm:
      lblStatus.Caption := 'Communication';
    nsSentence:
      lblStatus.Caption := 'NMEA';
    nsSentenceGPS:
      lblStatus.Caption := 'NMEA GPS';
  end;
  if GPS1.AutodetectOn then
    lblAutoDetect.Caption := 'Checking COM' + IntToStr(Ord(GPS1.Port) + 1) + ', ' + IntToStr(GPS1.PortBaud);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  rgComPort.ItemIndex := 0;
  rgComSpeed.ItemIndex := 5;
  rgDatabits.ItemIndex := 1;
  rgStopBits.ItemIndex := 0;
  rgParity.ItemIndex := 0;
end;

procedure TForm1.GPS1Bearing(Sender: TObject; BearingTrue,
  BearingMag: Double; NameOrigin, NameDest: String; Valid: Boolean);
begin
  edBOD1.Text := Format('%.2f',[BearingTrue]);
  edBOD4.Text := Format('%.2f',[BearingMag]);
  edBOD2.Text := NameOrigin;
  edBOD3.Text := NameDest;
  if Valid then
    edBOD5.Text := 'Yes'
  else
    edBOD5.Text := 'No';
end;

procedure TForm1.GPS1GeoPosition(Sender: TObject; Valid: Boolean;
  FixTime: TDateTime; Latitude, Longitude: Double);
begin
  edGLL1.Text := Format('%.4f',[Latitude]);
  edGLL2.Text := Format('%.4f',[Longitude]);
  edGLL3.Text := TimeToStr(FixTime);
  if Valid then
    edGLL4.Text := 'Yes'
  else
    edGLL4.Text := 'No';
end;

procedure TForm1.GPS1MinGPSData(Sender: TObject; Warning: Boolean;
  FixDateTime: TDateTime; Latitude, Longitude, Speed, Course,
  MagVariation: Double);
begin
  edRMC1.Text := DateTimeToStr(FixDateTime);
  edRMC2.Text := Format('%.4f',[Latitude]);
  edRMC3.Text := Format('%.4f',[Longitude]);
  if Warning then
    edRMC4.Text := 'Yes'
  else
    edRMC4.Text := 'No';
  edRMC5.Text := Format('%.2f',[Speed]);
  edRMC6.Text := Format('%.2f',[Course]);
end;

procedure TForm1.GPS1Unhandled(Sender: TObject; Talker, ID: String; Data: TStringList);
begin
  edUnh1.Text := Talker;
  edUnh2.Text := ID;
end;

procedure TForm1.GPS1ActiveRoute(Sender: TObject; RouteNo: Integer; Waypoints: TWaypointList);
var
  i: integer;
begin
  if Waypoints.Changed then begin
    lvWaypoints.Items.Clear;
    for i := 0 to Waypoints.Count - 1 do begin
       with lvWaypoints.Items.Add do begin
         Caption := Waypoints.ID[i];
         SubItems.Add(Format('%.4f',[Waypoints.Latitude[i]]));
         SubItems.Add(Format('%.4f',[Waypoints.Longitude[i]]));
         SubItems.Add(Format('%.2f',[Waypoints.Range[i]]));
       end;
    end;
    Waypoints.Changed := False;
  end;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  GPS1.WriteLog('d:\temp\test.txt',16384);
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  GPS1.Connected := False;
  GPS1.ReadLog(edFilename.Text);
end;

procedure TForm1.rgComPortClick(Sender: TObject);
begin
  case rgComPort.ItemIndex of
    0: GPS1.Port := cnCOM1;
    1: GPS1.Port := cnCOM2;
    2: GPS1.Port := cnCOM3;
    3: GPS1.Port := cnCOM4;
  end;
end;

procedure TForm1.rgComSpeedClick(Sender: TObject);
begin
  case rgComSpeed.ItemIndex of
    0: GPS1.PortBaud := 300;
    1: GPS1.PortBaud := 600;
    2: GPS1.PortBaud := 1200;
    3: GPS1.PortBaud := 2400;
    4: GPS1.PortBaud := 4800;
    5: GPS1.PortBaud := 9600;
    6: GPS1.PortBaud := 19200;
  end;
end;

procedure TForm1.rgDatabitsClick(Sender: TObject);
begin
  case rgDatabits.ItemIndex of
    0: GPS1.PortDatabits := 7;
    1: GPS1.PortDatabits := 8;
  end;
end;

procedure TForm1.rgStopbitsClick(Sender: TObject);
begin
  case rgDatabits.ItemIndex of
    0: GPS1.PortStopBits := 1;
    1: GPS1.PortStopBits := 2;
  end;
end;

procedure TForm1.rgParityClick(Sender: TObject);
begin
  case rgParity.ItemIndex of
    0: GPS1.PortParity := cpNone;
    1: GPS1.PortParity := cpOdd;
    2: GPS1.PortParity := cpEven;
    3: GPS1.PortParity := cpMark;
    4: GPS1.PortParity := cpSpace;
  end;
end;

procedure TForm1.GPS1NavigationInfo(Sender: TObject; Warning,
  Arrived: Boolean; CTE: Double; OriginWaypoint, DestWaypoint: String;
  DestLat, DestLon, RangeDest, BearingDest, Velocity: Double);
begin
  if Warning then
    edRMB1.Text := 'Yes'
  else
    edRMB1.Text := 'No';
  if Arrived then
    edRMB6.Text := 'Yes'
  else
    edRMB6.Text := 'No';
  edRMB9.Text := Format('%.2f',[CTE]);
  edRMB2.Text := Format('%.4f',[DestLat]);
  edRMB3.Text := Format('%.4f',[DestLon]);
  edRMB4.Text := Format('%.2f',[BearingDest]);
  edRMB5.Text := Format('%.2f',[RangeDest]);
  edRMB7.Text := OriginWaypoint;
  edRMB8.Text := DestWaypoint;
  edRMB10.Text := Format('%.2f',[Velocity]);
end;

procedure TForm1.GPS1DOP(Sender: TObject; AutoSelect, Fix3D: Boolean; PDOP,
  HDOP, VDOP: Double);
begin
  if AutoSelect then
    edDOP4.Text := 'Yes'
  else
    edDOP4.Text := 'No';
  if Fix3D then
    edDOP5.Text := 'Yes'
  else
    edDOP5.Text := 'No';
  edDOP1.Text := Format('%.2f',[PDOP]);
  edDOP2.Text := Format('%.2f',[HDOP]);
  edDOP3.Text := Format('%.2f',[VDOP]);
end;

procedure TForm1.GPS1BearingDistance(Sender: TObject; Time: TDateTime;
  Waypoint: String; Latitude, Longitude, BearingTrue, BearingMag,
  Distance: Double);
begin
  edBWC1.Text := TimeToStr(Time);
  edBWC2.Text := Format('%.4f',[Latitude]);
  edBWC3.Text := Format('%.4f',[Longitude]);
  edBWC4.Text := Waypoint;
  edBWC5.Text := Format('%.2f',[BearingTrue]);
  edBWC6.Text := Format('%.2f',[BearingMag]);
  edBWC7.Text := Format('%.2f Nm',[Distance]);
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
  dlgSave.FileName := edFilename.Text;
  if dlgSave.Execute then
    edFilename.Text := dlgSave.FileName;
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
  GPS1.Autodetect;
end;

procedure TForm1.lblURLClick(Sender: TObject);
var
  Param : PChar;
  
function GetProgramPathFromExt(const Ext: string): string;
var
  S: string;
begin
  Result := '';
  with TRegistry.Create do
  try
    RootKey := HKEY_CLASSES_ROOT;

    If OpenKey('\'+Ext,False) then begin
      S := ReadString('');
      if S <> '' then begin
        if OpenKey('\'+S+'\shell\open\command',False) then begin
          S := ReadString('');
          if S <> '' then begin
            Result := S;
            Exit;
          end;
        end;
      end
      else begin
        if OpenKey('\'+Ext+'\shell\open\command',False) then begin
          S := ReadString('');
          if S <> '' then begin
            Result := S;
            Exit;
          end;
        end;
      end;
    end;
  finally
    Free;
  end;
end;

begin
  if (GetProgramPathFromExt('.html') <> '') and (GetProgramPathFromExt('.htm') <> '') then begin
    Param := StrAlloc(Length(lblURL.Caption));
    try
      StrPCopy(Param,lblURL.Caption + #0);
      ShellExecute(0,'open',Param,nil,nil,SW_SHOWNORMAL);
    finally
      StrDispose(Param);
    end;
  end;
end;

procedure TForm1.cbDTRClick(Sender: TObject);
begin
  GPS1.SetDTR(cbDTR.Checked);
  GPS1.SetRTS(cbRTS.Checked);
end;

end.