⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 mapnavigation.pas

📁 地图MapX50鹰眼
💻 PAS
字号:
unit MapNavigation;

interface

uses
  Windows, Messages, SysUtils, Classes,Graphics,Controls,Forms,Dialogs,Olectrls,
  OleServer,ActiveX,StdVCL,Variants,MapXLib_TLB,ComObj,contnrs,extctrls;


type
  TMapNavigation = class(TComponent)
  private
    { Private declarations }
    FMainMap            :TMap;
    FNavigationMap      :TMap;
    FCurrentMainMapZoom :Double;

    procedure SetMainMap(Value :TMap);
    procedure SetNavigationMap(Value :TMap);
    procedure MapNavigationMouseUp(Sender:TObject;Button:TMouseButton;Shift:TShiftState;X,Y:integer);
    procedure MainMapViewChanged(Sender:TObject);
    procedure DeleteAllFeatures(NavName:string);


    
  protected
    { Protected declarations }
  public
    { Public declarations }
    constructor Create(AOwner:TComponent);Override;
    Destructor  Destroy;Override;
    procedure  Open;


  published
    { Published declarations }
    property MainMap      :TMap read FMainMap       write SetMainMap;
    property Navigation   :TMap read FNavigationMap write SetNavigationMap;

  end;

  
procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('MyMap', [TMapNavigation]);
end;


constructor TMapNavigation.Create(AOwner:TComponent);
begin
  inherited Create(AOwner);
end;

Destructor  TMapNavigation.Destroy;
begin
  inherited Destroy;
end;

procedure TMapNavigation.Open;
var
  newLayer:CMapxLayer;
  i:integer;
  flag:boolean;
begin
  //如果必要,可以将导航图全图显示,主地图默认配置显示
  FCurrentMainMapZoom      := MainMap.Zoom;   //主地图初始化视野
  FNavigationMap.OnMouseUp := MapNavigationMouseUp;
  //如果导航图层不存在,则建立一个导航图层
  flag := False;
  for i:=1 to Navigation.Layers.Count do
   begin
     if Navigation.Layers.item(i).Name='NavLayer' then
       flag := True;
   end;
  if not flag then
   begin
     newLayer := Navigation.Layers.CreateLayer('NavLayer',Emptyparam,Emptyparam,Emptyparam,Emptyparam);
   end;
  Navigation.Layers.AnimationLayer := FNavigationMap.Layers.Item('NavLayer');
  MainMap.OnMapViewChanged := MainMapViewChanged;
  
end;

procedure TMapNavigation.SetMainMap(Value:TMap);
begin
  FMainMap := Value;
end;

procedure TMapNavigation.SetNavigationMap(Value :TMap);
begin
  FNavigationMap := Value;
end;

procedure TMapNavigation.MapNavigationMouseUp(Sender:TObject;Button:TMouseButton;Shift:TShiftState;X,Y:integer);
var
  X1,Y1:single;
  X_Position,Y_Position:Double;
begin
  //导航功能实现
  X1 := X;
  Y1 := Y;
  FNavigationMap.ConvertCoord(X1,Y1,X_Position,Y_Position,miScreenToMap);
  FMainMap.ZoomTo(FMainMap.Zoom,X_Position,Y_Position);
end;

procedure TMapNavigation.MainMapViewChanged(Sender:TObject);
var
  rect      :CMapXRectangle;
  newPoint  :CMapXPoint;
  newPoints :CMapXPoints;
begin
  Navigation.Layers.Item('NavLayer').Editable := False;
  Navigation.Layers.AnimationLayer := Navigation.Layers.Item('NavLayer');
  rect      := MainMap.Bounds;
  newPoint  := CoPoint.Create;
  newPoints := CoPoints.Create;
  newPoint.Set_(rect.XMin ,rect.YMin );
  newPoints.Add(newPoint,1);
  newPoint.Set_(rect.XMax ,rect.YMin );
  newPoints.Add(newPoint,2);
  newPoint.Set_(rect.XMax ,rect.YMax );
  newPoints.Add(newPoint,3);
  newPoint.Set_(rect.XMin ,rect.YMax );
  newPoints.Add(newPoint,4);
  newPoint.Set_(rect.XMin ,rect.YMin );
  newPoints.Add(newPoint,5);
  DeleteAllFeatures('NavLayer');
  Navigation.DefaultStyle.LineWidth := 2;
  Navigation.DefaultStyle.LineColor := RGB(255,0,0);
  Navigation.Layers.Item('NavLayer').AddFeature(Navigation.FeatureFactory.CreateLine(newPoints,Navigation.DefaultStyle),EmptyParam);
end;

procedure TMapNavigation.DeleteAllFeatures(NavName:string);
var
  newFeatures :CMapXFeatures;
  i:integer;
begin
  try
    newFeatures := Navigation.Layers.Item(NavName).AllFeatures;
  except
  end;
  if newFeatures.Count>0 then
    begin
      for i:=0 to newFeatures.Count do
       Navigation.Layers.Item(NavName).DeleteFeature(NewFeatures.Item(i)); 
    end;

end;



end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -