📄 mapnavigation.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 + -