MAPX控件的鹰眼图实现(100分)

  • 主题发起人 zqs10597249
  • 开始时间
Z

zqs10597249

Unregistered / Unconfirmed
GUEST, unregistred user!
最好有delphi的源代码。
谢谢!
 
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, OleCtrls, MapXLib_TLB, ExtCtrls, StdCtrls,Comobj;

type
TForm1 = class(TForm)
Panel1: TPanel;
Splitter1: TSplitter;
Panel2: TPanel;
GroupBox1: TGroupBox;
Map1: TMap;
GroupBox2: TGroupBox;
Map2: TMap;
procedure Map1MapViewChanged(Sender: TObject);
procedure Map2MouseDown(Sender: TObject;
Button: TMouseButton;
Shift: TShiftState;
X, Y: Integer);
procedure FormShow(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
m_Layer :Layer;
//'鹰眼图上临时图层
m_Fea :Feature;
// '鹰眼图上反映主地图窗口位置的Feature
P_Create :boolean;
Procedure Form_Load;//在Map2创建图层
public
{ Public declarations }
end;


var
Form1: TForm1;

implementation

{$R *.dfm}

{ TForm1 }

procedure TForm1.Form_Load;
begin

map2.Layers.RemoveAll;
m_Layer :=Map2.Layers.CreateLayer('Rectlayer', EmptyParam,1,
EmptyParam, EmptyParam);
P_Create :=true;
end;


procedure TForm1.Map1MapViewChanged(Sender: TObject);
var
tempFea : CMapXFeature;// '声明Feature变量
tempPnts : CMapXPoint;// '声明Points变量
tempStyle : CMapXStyle;// '声明Style变量

begin

if P_Create=false then
exit;
//'矩形边框还没有创建时
If m_Layer.AllFeatures.Count = 0 then

begin

//'设置矩形边框样式
tempStyle :=CoStyle.create;//'创建Style对象
tempStyle.RegionPattern := miPatternNoFill;// '设置Style的矩形内部填充样式
tempStyle.RegionBorderColor := 255;// '设置Style的矩形边框颜色
tempStyle.RegionBorderWidth := 2;// '设置Style的矩形边框宽度
//'在图层创建大小为Map1的边界的Rectangle对象
tempFea := Map2.FeatureFactory.CreateRegion(Map1.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(Map1.Bounds.XMin,Map1.Bounds.YMin,EmptyParam);
m_Fea.Parts.Item(1).AddXY(Map1.Bounds.XMax,Map1.Bounds.YMin,EmptyParam);
m_Fea.Parts.Item(1).AddXY(Map1.Bounds.XMax,Map1.Bounds.YMax,EmptyParam);
m_Fea.Parts.Item(1).AddXY(Map1.Bounds.XMin,Map1.Bounds.YMax,EmptyParam);
m_Fea.Update(EmptyParam, EmptyParam)// '更新显示
end;


end;


//鹰眼图上鼠标单击用来导航主图,其方法是把鼠标处的坐标设置为主图的中心
procedure TForm1.Map2MouseDown(Sender: TObject;
Button: TMouseButton;
Shift: TShiftState;
X, Y: Integer);
var
ScreenX,ScreenY :Single;
MapX :Double;// '定义x坐标变量
MapY :Double;// '定义y坐标变量

begin

//'把屏幕坐标转换为地图坐标
ScreenX := X;
ScreenY := Y;
Map2.ConvertCoord(ScreenX,ScreenY, MapX, MapY, miScreenToMap);
//'设置主图的中心x坐标和y坐标
Map1.CenterX := MapX;
Map1.CenterY := MapY;
end;


procedure TForm1.FormShow(Sender: TObject);
begin

Form_Load;
end;


procedure TForm1.FormCreate(Sender: TObject);
begin

P_Create :=false;
end;


end.

上面的实现鹰眼图只是个矩形框,请问有谁能把他变成主图的小比例图,
并能互相定位和控制,谢谢!
 
procedure TForm1.Form_Load;
begin

//map2.Layers.RemoveAll;把这行删除
m_Layer :=Map2.Layers.CreateLayer('Rectlayer', EmptyParam,1,
EmptyParam, EmptyParam);
P_Create :=true;
end;

再加
主图上鼠标单击导航鹰眼图,方法把鼠标处的坐标设置为鹰眼图的中心
procedure TForm1.Map1MouseDown(Sender: TObject;
Button: TMouseButton;
Shift: TShiftState;
X, Y: Integer);
var
ScreenX,ScreenY :Single;
MapX :Double;// '定义x坐标变量
MapY :Double;// '定义y坐标变量

begin

//'把屏幕坐标转换为地图坐标
ScreenX := X;
ScreenY := Y;
Map1.ConvertCoord(ScreenX,ScreenY, MapX, MapY, miScreenToMap);
//'设置主图的中心x坐标和y坐标
Map2.CenterX := MapX;
Map2.CenterY := MapY;
end;

 
外行:请问如何DOWN下这些帖子?
 
楼上的帖子是在哪里下载的?跟我一个同事的一样。
 
zqs10597249,曾庆顺吧,呵呵,原来是你啊,我还以为是谁呢,你这些代码都是自己研究出来的吗?
还是参考了别人的?怎么好象我们两都爱把自己花了很多心血研究摸索出来的代码拿出来共享呢,呵呵
 
谢谢啦!哈哈
 

Similar threads

顶部