地图鹰眼

unit  MapNavigation ;
{* |<PRE>
================================================================================
* 软件名称：FHT GPS车辆监控管理系统
* 单元名称：地图鹰眼单元
* 单元作者：HsuChong@hotmail.com
* 备    注：
* 开发平台：PWin2003Standard + Delphi 7.1
* 修改记录：
*           2007.01.27 添加MainMapMouseMove事件和ConversionToCoordinate方法
*           2006.10.07 添加ZoomMax和ZoomMin属性
*           2006.10.01 创建单元
*
================================================================================
|</PRE>}

interface

uses
   Windows ,  Classes ,  Controls ,  OleCtrls ,  MapXLib_TLB ;

type
   TMapNavigation  =  class ( TComponent )
   private
     FMainMap :  TMap ;
     FNavigationMap :  TMap ;
     FCurrentMainMapZoom :  Double ;
     FZoomMax ,  FZoomMin :  Double ;
   protected
     procedure  SetMainMap ( Value :  TMap );
     procedure  SetNavigationMap ( Value :  TMap );
     procedure  SetZoomMax ( Value :  Double );
     procedure  SetZoomMin ( Value :  Double );
     procedure  MapNavigationMouseUp ( Sender :  TObject ;  Button :  TMouseButton ;  Shift :  TShiftState ;  X ,  Y :  Integer );
     // procedure MainMapMouseMove(Sender: TObject; Shift: TShiftState;X, Y: Integer);
     procedure  MainMapViewChanged ( Sender :  TObject );

     function  CreateNavLayer :  Boolean ;
     function  DeleteAllFeatures ( const  LayerName :  string ):  Boolean ;
   public
     constructor  Create ( AOwner :  TComponent );  override ;
     destructor  Destroy ;  override ;
     procedure  Open ;
     procedure  Close ;
     //function ConversionToCoordinate(LongOrLat: Double): string;
     {返回经度或纬度换算为坐标格式：如:(205°23'44.1"，57°55'56.6")}
   published
     property  MainMap :  TMap  read  FMainMap  write  SetMainMap ;
     property  Navigation :  TMap  read  FNavigationMap  write  SetNavigationMap ;
     property  ZoomMax :  Double  read  FZoomMax  write  SetZoomMax ;
     property  ZoomMin :  Double  read  FZoomMin  write  SetZoomMin ;
   end ;

procedure  Register ;

implementation

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

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

destructor  TMapNavigation . Destroy ;
begin
   inherited  Destroy ;
end ;

procedure  TMapNavigation . Open ;
begin
   CreateNavLayer ;
   FCurrentMainMapZoom  :=  MainMap . Zoom ;
   FNavigationMap . OnMouseUp  :=  MapNavigationMouseUp ;
   // FMainMap.OnMouseMove := MainMapMouseMove;
   MainMap . OnMapViewChanged  :=  MainMapViewChanged ;
end ;

procedure  TMapNavigation . Close ;
begin
   FNavigationMap . Visible  :=  False ;
end ;

procedure  TMapNavigation . SetMainMap ( Value :  TMap );
begin
   if  FMainMap  <>  Value  then
     FMainMap  :=  Value ;
end ;

procedure  TMapNavigation . setNavigationMap ( Value :  TMap );
begin
   if  FNavigationMap  <>  Value  then
     FNavigationMap  :=  Value ;
end ;

procedure  TMapNavigation . SetZoomMax ( Value :  Double );
begin
   if  FZoomMax  <>  Value  then
     FZoomMax  :=  Value ;
end ;

procedure  TMapNavigation . SetZoomMin ( Value :  Double );
begin
   if  FZoomMin  <>  Value  then
     FZoomMin  :=  Value ;
end ;

procedure  TMapNavigation . MapNavigationMouseUp ( Sender :  TObject ;
   Button :  TMouseButton ;  Shift :  TShiftState ;  X ,  Y :  Integer );
var
   ScreenX ,  ScreenY :  Single ;
   MapX ,  MapY :  Double ;
begin
   ScreenX  :=  X ;
   ScreenY  :=  Y ;
   FNavigationMap . ConvertCoord ( ScreenX ,  ScreenY ,  MapX ,  MapY ,  miScreenToMap );
   FMainMap . ZoomTo ( FMainMap . Zoom ,  MapX ,  MapY );
end ;

{procedure TMapNavigation.MainMapMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
var
  ScreenX, ScreenY: Single;
  MapX, MapY: Double;
begin
  if MainMap.ShowHint then
  begin
    ScreenX := X;
    ScreenY := Y;
    FMainMap.ConvertCoord(ScreenX, ScreenY, MapX, MapY, MiScreenToMap);
    FMainMap.Hint := '东经：' + ConversionToCoordinate(MapX) + #13#10
      + '北纬：' + ConversionToCoordinate(MapY);
  end;
end; }

procedure  TMapNavigation . MainMapViewChanged ( Sender :  TObject );
var
   rect :  Rectangle ;
   newPoint :  Point ;
   newPoints :  Points ;
begin
   if  FNavigationMap . Visible  then
   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 ;
   if  ( FZoomMax  >  0 )  and  ( MainMap . Zoom  >  FZoomMax )  then
     MainMap . Zoom  :=  FZoomMax ;
   if  ( FZoomMin  >  0 )  and  ( MainMap . Zoom  <  FZoomMin )  then
     MainMap . Zoom  :=  FZoomMin ;
end ;

function  TMapNavigation . DeleteAllFeatures ( const  LayerName :  string ):  Boolean ;
var
   TempFeatures :  Features ;
   I :  Integer ;
begin
   Result  :=  True ;
   try
     TempFeatures  :=  Navigation . Layers . Item ( LayerName ). AllFeatures ;
     if  TempFeatures . Count  >  0  then
       for  I  :=  1  to  TempFeatures . Count  do
         Navigation . Layers . Item ( LayerName ). DeleteFeature ( TempFeatures . Item ( I ));
   except
     Result  :=  False ;
   end ;
end ;

{function TMapNavigation.ConversionToCoordinate(LongOrLat: Double): string;
var
  TempMinute: Double;
  Degree, Minute, Second: Integer;
begin
  Result := '';
  Degree := Trunc(LongOrLat);
  TempMinute := (LongOrLat - Degree) * 60;
  Minute := Trunc(TempMinute);
  Second := Trunc((TempMinute - Minute) * 60);
  Result := Format('%d°%d’%d"', [Degree, Minute, Second]);
end; }

function  TMapNavigation . CreateNavLayer :  Boolean ;
var
   I :  Integer ;
   NavLayerExist :  Boolean ;
begin
   Result  :=  True ;
   NavLayerExist  :=  False ;
   for  I  :=  1  to  Navigation . Layers . Count  do
   begin
     if  Navigation . Layers . Item ( i ). Name  =  'NavLayer'  then
     begin
       NavLayerExist  :=  True ;
       Break ;
     end ;
   end ;
   //若导航图层不存在,则创建一个导航图层
   if  not  NavLayerExist  then
     with  Navigation . Layers  do
     begin
       try
         CreateLayer ( 'NavLayer' ,  EmptyParam ,  EmptyParam ,  EmptyParam ,  EmptyParam );
         AnimationLayer  :=  FNavigationMap . Layers . Item ( 'NavLayer' );
       except
         Result  :=  False ;
       end ;
     end ;
end ;

end .