unit1.pas

这是一个用DELPHI编写的汽车动态的在地图上运动轨迹的例子.

{$A8,B-,C+,D+,E-,F-,G+,H+,I+,J-,K-,L+,M-,N+,O+,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y+,Z1}
{$MINSTACKSIZE $00004000}
{$MAXSTACKSIZE $00100000}
{$IMAGEBASE $00400000}
{$APPTYPE GUI}
{$WARN SYMBOL_DEPRECATED ON}
{$WARN SYMBOL_LIBRARY ON}
{$WARN SYMBOL_PLATFORM ON}
{$WARN UNIT_LIBRARY ON}
{$WARN UNIT_PLATFORM ON}
{$WARN UNIT_DEPRECATED ON}
{$WARN HRESULT_COMPAT ON}
{$WARN HIDING_MEMBER ON}
{$WARN HIDDEN_VIRTUAL ON}
{$WARN GARBAGE ON}
{$WARN BOUNDS_ERROR ON}
{$WARN ZERO_NIL_COMPAT ON}
{$WARN STRING_CONST_TRUNCED ON}
{$WARN FOR_LOOP_VAR_VARPAR ON}
{$WARN TYPED_CONST_VARPAR ON}
{$WARN ASG_TO_TYPED_CONST ON}
{$WARN CASE_LABEL_RANGE ON}
{$WARN FOR_VARIABLE ON}
{$WARN CONSTRUCTING_ABSTRACT ON}
{$WARN COMPARISON_FALSE ON}
{$WARN COMPARISON_TRUE ON}
{$WARN COMPARING_SIGNED_UNSIGNED ON}
{$WARN COMBINING_SIGNED_UNSIGNED ON}
{$WARN UNSUPPORTED_CONSTRUCT ON}
{$WARN FILE_OPEN ON}
{$WARN FILE_OPEN_UNITSRC ON}
{$WARN BAD_GLOBAL_SYMBOL ON}
{$WARN DUPLICATE_CTOR_DTOR ON}
{$WARN INVALID_DIRECTIVE ON}
{$WARN PACKAGE_NO_LINK ON}
{$WARN PACKAGED_THREADVAR ON}
{$WARN IMPLICIT_IMPORT ON}
{$WARN HPPEMIT_IGNORED ON}
{$WARN NO_RETVAL ON}
{$WARN USE_BEFORE_DEF ON}
{$WARN FOR_LOOP_VAR_UNDEF ON}
{$WARN UNIT_NAME_MISMATCH ON}
{$WARN NO_CFG_FILE_FOUND ON}
{$WARN MESSAGE_DIRECTIVE ON}
{$WARN IMPLICIT_VARIANTS ON}
{$WARN UNICODE_TO_LOCALE ON}
{$WARN LOCALE_TO_UNICODE ON}
{$WARN IMAGEBASE_MULTIPLE ON}
{$WARN SUSPICIOUS_TYPECAST ON}
{$WARN PRIVATE_PROPACCESSOR ON}
{$WARN UNSAFE_TYPE OFF}
{$WARN UNSAFE_CODE OFF}
{$WARN UNSAFE_CAST OFF}
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, OleCtrls, MapXLib_TLB,Registry, ComCtrls,
  ToolWin;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Map1: TMap;
    BitBtn1: TBitBtn;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button6: TButton;
    Button7: TButton;
    Button8: TButton;
    OpenDialog1: TOpenDialog;
    Button5: TButton;
    Button9: TButton;
    Button10: TButton;
    Button11: TButton;
    Button12: TButton;
    StatusBar1: TStatusBar;
    Button14: TButton;
    Button15: TButton;
    Button16: TButton;
    Button17: TButton;
    Button18: TButton;
    ColorDialog1: TColorDialog;
    Button19: TButton;
    TrackBar1: TTrackBar;
    Label1: TLabel;
    ToolBar1: TToolBar;
    Button13: TButton;
    Button20: TButton;
    Button21: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Map1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure carTrack(Longitude: double;Latitude: double); //汽车行驶轨迹声明

    // 创建 自定义 工具 用于测量两坐标点的距离
    procedure Map1ToolUsed(Sender: TObject; ToolNum: Smallint; X1, Y1, X2,
                        Y2, Distance: Double; Shift, Ctrl: Wordbool;
                                 var EnableDefault: Wordbool);
    procedure Button9Click(Sender: TObject);
    procedure Button10Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button11Click(Sender: TObject);
    procedure Button12Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button13Click(Sender: TObject);
    procedure Button15Click(Sender: TObject);
    procedure Button16Click(Sender: TObject);
    procedure Button17Click(Sender: TObject);
    procedure Button18Click(Sender: TObject);
    procedure Button14Click(Sender: TObject);
    procedure Button19Click(Sender: TObject);
    procedure TrackBar1Change(Sender: TObject);
    procedure Map1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button20Click(Sender: TObject);
    procedure Map1PolyToolUsed(ASender: TObject; ToolNum: Smallint;
      Flags: Integer; const Points: IDispatch; bShift, bCtrl: WordBool;
      var EnableDefault: WordBool);
    procedure Button21Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses Unit2;

{$R *.dfm}

var
  ptFlagForDist : boolean; // 临时
  pts : Points;   //  临时

  loadGeoFlag: boolean;

  ptsAll: Points;
  ptsLine: Points;
  ptsCircular: Points;

  fCir : Feature;
  fCirs : Features;

  regionColor : Cardinal;
  lineColor : Cardinal;
  coverScale : integer;
  carPicName : string;

  lyrCover: Layer;
  lyrTrack: Layer;
  layerName : string;


procedure TForm1.FormCreate(Sender: TObject);
var
 RegIniFile : TRegIniFile;
 GeoSetDir : string;
 rColor : string;
 lColor : string;
 cScale : string;
begin
    Memo1.Clear;   // 临时
    Memo1.Clear;   // 临时
    ptFlagForDist := False;
    pts := CoPoints.Create(); // 临时
    // ///////////////////////////////
    loadGeoFlag := false;
    coverScale := 200;

    Map1.CreateCustomTool(1, miToolTypeLine, miSizeCursor, EmptyParam,
                          EmptyParam,EmptyParam);
    Map1.CreateCustomTool(2, miToolTypeMarquee, miSizeCursor, EmptyParam,
                          EmptyParam,EmptyParam);
    Map1.CreateCustomTool(4, miToolTypePoly, miSizeCursor, EmptyParam,
                          EmptyParam,EmptyParam);

    ptsAll := CoPoints.Create();
    ptsLine:= CoPoints.Create();
    ptsCircular:= CoPoints.Create();

    // 操作注册表, 加载初始化地图
    RegIniFile := TRegIniFile.Create;
    RegIniFile.RootKey := HKEY_LOCAL_MACHINE;
    try
  	 if RegIniFile.OpenKey('\SOFTWARE\',FALSE) then
	    if RegIniFile.KeyExists('PHS ID') then
        begin
		     GeoSetDir := RegIniFile.ReadString('PHS ID','DIR','FALSE');
         if not CompareStr(GeoSetDir,'FALSE')=1 then
            begin
              Map1.Geoset := GeoSetDir;
              loadGeoFlag := true;
              RegIniFile.CloseKey;
          end
        end
     finally
	     RegIniFile.Free
     end;

     // 创建 应用图层，进行相应设置
    if loadGeoFlag then
    begin
      layerName := 'Cover_layer';
      lyrCover := Map1.Layers.CreateLayer(layerName,EmptyParam,1,
           EmptyParam,EmptyParam);
      lyrCover.Visible := True;
      lyrCover.Selectable := False;
      lyrCover.Editable := True;
     // Map1.Layers.AnimationLayer := lyrCover;

      layerName := 'Track_layer';
      lyrTrack := Map1.Layers.CreateLayer(layerName,EmptyParam,1,
           EmptyParam,EmptyParam);
      lyrTrack.Visible := True;
      lyrTrack.Selectable := True;
      lyrTrack.Editable := True;

      loadGeoFlag:= false;
    end;

    // 操作注册表 进行覆盖区域，车辆轨迹，车辆等属性的设置
    RegIniFile := TRegIniFile.Create;
    RegIniFile.RootKey := HKEY_LOCAL_MACHINE;
    try
  	 if RegIniFile.OpenKey('\SOFTWARE\',FALSE) then
	    if RegIniFile.KeyExists('PHS ID') then
        begin
          rColor := RegIniFile.ReadString('PHS ID','RegionColor','FALSE');
          regionColor := StrToInt(rColor);
          lColor := RegIniFile.ReadString('PHS ID','LineColor','FALSE');
          lineColor := StrToInt(lColor);
          cScale := RegIniFile.ReadString('PHS ID','CoverScale','FALSE');
          coverScale := StrToInt(cScale);
          carPicName := RegIniFile.ReadString('PHS ID','CarPicName','FALSE');
          RegIniFile.CloseKey;
        end
     finally
	     RegIniFile.Free
     end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Map1.CurrentTool := miZoomInTool;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
   Map1.CurrentTool := miZoomOutTool;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  Map1.CurrentTool := MiPanTool;
end;

procedure TForm1.Button9Click(Sender: TObject);
begin
  Map1.Layers.LayersDlg(1,1);
end;

procedure TForm1.Button10Click(Sender: TObject);
begin
     Map1.CurrentTool := MiRectSelectTool;
end; 

procedure TForm1.Button17Click(Sender: TObject);
begin
   Map1.CurrentTool := MiCenterTool;
end;

procedure TForm1.Button18Click(Sender: TObject);
begin
  Map1.CurrentTool := MiArrowTool;
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
  Memo1.Clear;
  Memo1.Lines.Append('Height  :'+FloatToStr(Map1.MapScreenHeight));
  Memo1.Lines.Append('Width  :'+FloatToStr(Map1.MapScreenWidth));
end;

procedure TForm1.Map1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  xx, yy : Single;
  Mapx, Mapy: Double;
  
begin
 if (Map1.CurrentTool = 4) then
  begin
  xx := X;
  yy := Y;

  // 屏幕坐标 到 地图坐标 转换
  Map1.ConvertCoord(xx,yy,Mapx,Mapy,miScreenToMap);

  end;

end;

procedure TForm1.Map1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  xx, yy : Single;
  Mapx, Mapy: Double;
  str : String;
begin
  xx := X;
  yy := Y;

  // 屏幕坐标 到 地图坐标 转换
  Map1.ConvertCoord(xx,yy,Mapx,Mapy,miScreenToMap);

  str := '经度：'+FloatToStr(Mapx)+'  纬度：'+FloatToStr(Mapy);

  Map1.Hint:= str;

  StatusBar1.Panels[0].Text :='经度：'+ FloatToStr(Mapx);
  StatusBar1.Panels[1].Text :='纬度：'+ FloatToStr(Mapy);
end;

procedure TForm1.Button4Click(Sender: TObject);
var
  FileName :TFileName;
  RegIniFile : TRegIniFile;
begin   // 打开GEOSET文件
   RegIniFile := TRegIniFile.Create;
   RegIniFile.RootKey := HKEY_LOCAL_MACHINE;

   if OpenDialog1.Execute then begin
       FileName := OpenDialog1.FileName;
       Map1.Geoset := FileName;
       loadGeoFlag := true;
       Memo1.Lines.Append(FileName);   // 临时
   end;

   try  // 写注册表 更改初始化地图
	   if RegIniFile.OpenKey('\SOFTWARE\',FALSE) then
       if RegIniFile.KeyExists('PHS ID') then begin
         RegIniFile.WriteString('PHS ID','DIR',FileName);
         RegIniFile.CloseKey;
       end
     else begin
       if RegIniFile.CreateKey('PHS ID') then
          RegIniFile.WriteString('PHS ID','Dir',FileName);
          RegIniFile.CloseKey;
       end
    finally
	    RegIniFile.Free
    end;

     // 创建 应用图层，进行相应设置
    if loadGeoFlag then
    begin
     layerName := 'Cover_layer';
      lyrCover := Map1.Layers.CreateLayer(layerName,EmptyParam,1,
           EmptyParam,EmptyParam);
      lyrCover.Visible := True;
      lyrCover.Selectable := False;
      lyrCover.Editable := True;
     // Map1.Layers.AnimationLayer := lyrCover;

      layerName := 'Track_layer';
      lyrTrack := Map1.Layers.CreateLayer(layerName,EmptyParam,1,
           EmptyParam,EmptyParam);
      lyrTrack.Visible := True;
      lyrTrack.Selectable := True;
      lyrTrack.Editable := True;

      loadGeoFlag:= false;
    end;
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
   Map1.CurrentTool := 1;
end;

procedure TForm1.Button16Click(Sender: TObject);
begin
    Map1.CurrentTool := 2;
end;

procedure TForm1.Button13Click(Sender: TObject);
begin
    Map1.CurrentTool := 4;
end;

procedure TForm1.Map1ToolUsed(Sender: TObject; ToolNum: Smallint; X1, Y1,
            X2, Y2, Distance: Double; Shift, Ctrl: Wordbool;
                       var EnableDefault: Wordbool);
var


  distStr : string;
  pt1,pt2 : Point;
begin
  pt1 := CoPoint.Create;
  pt2 := CoPoint.Create;

  case ToolNum of
	       	1:
             begin
               distStr := FloatToStrF(Distance, ffFixed, 12, 4);
               ShowMessage(distStr+' KiloMeter');
             end;
          2:
            begin
              ShowMessage('X1、Y1、X2、Y2 :'+FloatToStr(X1)+'**'+
                FloatToStr(Y1)+'**'+FloatToStr(X2)+'**'+FloatToStr(Y2));
            end;
  end;
end;

procedure TForm1.Button8Click(Sender: TObject);
var
  numberLayer: integer;
  numberFtr: integer;
  ftrs: Features;
begin
   ftrs := lyrCover.AllFeatures;
   numberFtr := ftrs.Count;
   numberLayer := Map1.Layers.Count;
   Memo1.Lines.Append('图元数'+InttoStr(numberFtr));
   Memo1.Lines.Append('图层数'+IntToStr(numberLayer));