tfrmeagleeyeclass.pas

用Delphi实现GIS的鹰眼图功能

{-----------------------------------------------------------------------------
 Unit Name: TFrmEagleEyeClass
 Author:    杜长宇 [e-mail]  msn:[e-mail]
 Purpose: mapx鹰眼类
 History:2005-9-14 11:36:36

 开发环境： MapX 50.2.38 + delphi7 + Windows xp sp2

 用法说明(附示例)：

1. uses TFrmEagleEyeClass

2. 声明全局变量
 var
     frmEagleEye : TfrmEagleEye;

3.事件处理函数

 procedure TForm1.BitBtn1Click(Sender: TObject);
begin
  if frmEagleEye = nil then
  begin
    frmEagleEye := TfrmEagleEye.Create(Application);
    frmEagleEye.Initiate(m_MainMap,'map\eagle.gst')
  end;

  frmEagleEye.Show;

end;



许可：
    您可以自由的使用本代码进行学习或非商业、商业应用，
    你可以自由更改本代码以便更适合你的应用，但请保留原作者版权信息；
    如果你对本代码作过修改优化，请添加详细注释后重新发布到网上，并发给原作者一份拷贝，以利于大家共同进步；

鸣谢：
  －－ ljb
  网络上其他未具名的大侠们
-----------------------------------------------------------------------------}


unit TFrmEagleEyeClass;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, OleCtrls, MapXLib_TLB, Menus;

type
  TfrmEagleEye = class(TForm)
    EgMap: TMap;
    PopupMenu1: TPopupMenu;
    H1: TMenuItem;
    T1: TMenuItem;
    A1: TMenuItem;
    N1: TMenuItem;
    procedure EgMapMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure A1Click(Sender: TObject);
    procedure H1Click(Sender: TObject);
    procedure T1Click(Sender: TObject);
  private
    { Private declarations }
    m_MainMap : TMap;
    m_sEagleEyeMapGeoset : string;
    m_Layer : CMapXLayer;  //显示线框的图层
    m_Fea : CMapXFeature;

    //MainMapEvent
    m_IriMapMouseDown : TMouseEvent;
    m_IriMapViewChanged : TNotifyEvent;


    procedure MapMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
    procedure MapViewChanged(Sender: TObject);

  public
    { Public declarations }
    function Initiate(aMainMap : TMap; aEagleMapGeoset : string):boolean;
  end;

var
  frmEagleEye: TfrmEagleEye;

implementation

{$R *.dfm}


procedure TfrmEagleEye.EgMapMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
 //定义地图坐标变量
  Screanx,Screany:Single;
 //定义x,y坐标变量
  Mapx:Double;
  Mapy:Double;
begin
  if Showing then
  begin
    //将屏幕坐标设置成地图坐标
    Screanx:=x;
    Screany:=y;
    EgMap.ConvertCoord(Screanx,Screany,Mapx,Mapy,miScreenToMap);
    //设置map1的中心坐标x,y
    m_MainMap.CenterX:= Mapx;
    m_MainMap.CenterY:= Mapy;
  end;
end;

procedure TfrmEagleEye.MapMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
Var
 ScreanX,ScreanY:Single;
 MapX:Double;
 MapY:Double;
begin
  //catch the mainMap Mouse down Event
  if Showing then
  begin
    ScreanX:=X;
    ScreanY:=y;
    m_MainMap.ConvertCoord(ScreanX,Screany,MapX,MapY,MiScreenToMap);
   //'设置鹰眼窗体的中心坐标
    EgMap.CenterX:=MapX;
    EgMap.CenterY:=MapY;
  end;

  //pop up event for the mainMap
  if @m_IriMapMouseDown <> nil then
    m_IriMapMouseDown(Sender,Button,Shift,X, Y);
end;


procedure TfrmEagleEye.MapViewChanged(Sender: TObject);
var
  tempFea : CMapXFeature;// '声明Feature变量
  tempPnts : CMapXPoint;// '声明Points变量
  tempStyle : CMapXStyle;// '声明Style变量
begin
  if Showing then
  begin
    EgMap.Zoom := m_MainMap.Zoom * 5;
    //'矩形边框还没有创建时
    If m_Layer.AllFeatures.Count = 0 Then
    begin
      //'设置矩形边框样式
      tempStyle :=CoStyle.create;//'创建Style对象
      tempStyle.RegionPattern := miPatternNoFill;// '设置Style的矩形内部填充样式
      tempStyle.RegionBorderColor := 255;// '设置Style的矩形边框颜色
      tempStyle.RegionBorderWidth := 2;// '设置Style的矩形边框宽度
      //'创建矩形框
      tempFea := EgMap.FeatureFactory.CreateRegion(m_MainMap.Bounds, tempStyle);
      m_Fea := m_Layer.AddFeature(tempFea,EmptyParam);// '添加矩形边框
    end
      Else //否则，根据Map1的视野变化改变矩形边框的大小和位置
        begin
          m_Fea.Parts.Item[1].RemoveAll;//'除去已有的矩形边框的顶点
          //'添加大小和位置已变化的矩形边框的四个顶点
          m_Fea.Parts.Item[1].AddXY(M_MainMap.Bounds.XMin,M_MainMap.Bounds.YMin,EmptyParam);
          m_Fea.Parts.Item[1].AddXY(M_MainMap.Bounds.XMax,M_MainMap.Bounds.YMin,EmptyParam);
          m_Fea.Parts.Item[1].AddXY(M_MainMap.Bounds.XMax,M_MainMap.Bounds.YMax,EmptyParam);
          m_Fea.Parts.Item[1].AddXY(M_MainMap.Bounds.XMin,M_MainMap.Bounds.YMax,EmptyParam);
          m_Fea.Update(EmptyParam, EmptyParam)// '更新显示
       end;
  end;

  //pop up event for the mainMap
  if @m_IriMapViewChanged <> nil then
    m_IriMapViewChanged(Sender);
end;

procedure TfrmEagleEye.A1Click(Sender: TObject);
begin
  MessageDlg(' Author:    杜长宇 [e-mail]'+#13+#10+' Msn : [e-mail]'+#13+#10+' Purpose: mapx鹰眼类'+#13+#10+' History:2005-9-14 '+#13+#10+''+#13+#10+' 开发环境： MapX 50.2.38 + delphi7 + Windows xp sp2', mtInformation, [mbOK], 0);
end;

procedure TfrmEagleEye.H1Click(Sender: TObject);
begin
  Close;
end;

procedure TfrmEagleEye.T1Click(Sender: TObject);
begin
  if T1.Checked then
    self.FormStyle := fsNormal
  else
    self.FormStyle := fsStayOnTop;

  T1.Checked := not T1.Checked ;

end;

function TfrmEagleEye.Initiate(aMainMap: TMap; aEagleMapGeoset: string):boolean;
begin
  try
    m_MainMap := aMainMap;
    EgMap.GeoSet := aEagleMapGeoset;
    m_Layer:=EgMap.Layers.CreateLayer('Rectlayer',Emptyparam,1,Emptyparam,Emptyparam); //创建图层
    EgMap.Layers.AnimationLayer := m_Layer;

    result := true;

    //保存原先的事件处理函数状态
    m_IriMapMouseDown := m_MainMap.OnMouseDown;
    m_IriMapViewChanged := m_MainMap.OnMapViewChanged;

    m_MainMap.OnMouseDown := MapMouseDown;
    m_MainMap.OnMapViewChanged := MapViewChanged;

  except
    on Ex : Exception do
    begin
      MessageDlg('初始化失败！'+#13+#10+'错误信息：'+ex.Message, mtError, [mbOK], 0);
      result := false;
    end;
  end;
end;

end.