echo2003
点子王
点子王
  • 注册日期2003-07-28
  • 发帖数2453
  • QQ76947571
  • 铜币5473枚
  • 威望1点
  • 贡献值0点
  • 银元0个
  • GIS帝国居民
60楼#
发布于:2003-12-18 10:29
[转载]
Delphi的鹰眼源码![推荐]
unit MapNavigation;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
OleCtrls, MapXLib_TLB, ComObj, contnrs, extctrls;

type
TMapNavigation = class(TComponent)
private
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
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('HTGPS', [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 := 1 to NewFeatures.Count do
Navigation.Layers.Item(NavName).DeleteFeature(NewFeatures.Item(i));
end;
end;


end.


[此贴子已经被作者于2003-12-18 10:29:44编辑过]
举报 回复(0) 喜欢(0)     评分
echo2003
点子王
点子王
  • 注册日期2003-07-28
  • 发帖数2453
  • QQ76947571
  • 铜币5473枚
  • 威望1点
  • 贡献值0点
  • 银元0个
  • GIS帝国居民
61楼#
发布于:2003-12-18 10:27
在 delphi 中紧缩表

//紧缩表
procedure PackTable(LayerName:string;SourceMap:TMap;PackMap:TMap);
var
  lyr:CMapXLayer;
  Ds:CMapXDataSet;
  LayerInfo:CMapXLayerInfo;
  TempLayerName,Path:String;
begin
Try
   TempLayerName := 'TempPackTable';
   Lyr := SourceMap.Layers.Item(LayerName);
   ds := SourceMap.Datasets.Item(LayerName);

   //选定图层的存放路径
   Path := SourceMap.Layers.Item(LayerName).Filespec;

   //创建临时表
   LayerInfo := CoLayerInfo.Create;
   LayerInfo.Type_ := miLayerInfoTypeTemp;
   LayerInfo.AddParameter ('filespec', path);
   LayerInfo.AddParameter ('Name', TempLayerName);
   LayerInfo.AddParameter ('Fields', ds.Fields);
   LayerInfo.AddParameter ('Features', lyr.AllFeatures);
   LayerInfo.AddParameter ('AutoCreateDataset', 1);
   LayerInfo.AddParameter ('datasetname', TempLayerName);

   PackMap.Layers.add (LayerInfo, 0);
   PackMap.Refresh;

   //移出图层
   SourceMap.Datasets.Remove (LayerName);
   SourceMap.Layers.Remove (LayerName);
   SourceMap.Refresh;

   //删除 Tab 表文件
   DeleteFile(Path);

   //重新绑定
   Lyr := PackMap.Layers.Item(TempLayerName);
   ds := PackMap.Datasets.Item(TempLayerName);

   //创建表
   LayerInfo := CoLayerInfo.Create;
   LayerInfo.Type_ := miLayerInfoTypeNewTable;
   LayerInfo.AddParameter ('filespec', path);
   LayerInfo.AddParameter ('Name', layername);
   LayerInfo.AddParameter ('Fields', ds.Fields);
   LayerInfo.AddParameter ('Features', lyr.AllFeatures);
   LayerInfo.AddParameter ('AutoCreateDataset', 1);
   LayerInfo.AddParameter ('datasetname', LayerName);

   SourceMap.Layers.add (LayerInfo, 0);
   SourceMap.Refresh;

   //移出图层
   PackMap.Datasets.Remove (TempLayerName);
   PackMap.Layers.Remove (TempLayerName);
   PackMap.Refresh;

except
   on E:Exception do ShowMessage(E.message);
end;

end;
举报 回复(0) 喜欢(0)     评分
xiaonai
路人甲
路人甲
  • 注册日期2003-11-27
  • 发帖数87
  • QQ
  • 铜币418枚
  • 威望0点
  • 贡献值0点
  • 银元0个
62楼#
发布于:2003-12-17 17:22
[DELPHI+MAPX]专栏(只允许贴码跟贴)
var
s_sql:string;
rs:_RecordSet;
flds,fileds :CMapXFields;
dst:CMapxdataset;
//制作等级专题图的代码共享
s_sql='select filed1,filed2 from tablename';
  with ADOQuery1 do
    begin
      Close;
      sql.Clear;
      sql.add(s_sql);
      Open;
      rs:=ADOQuery1.Recordset;
      if rs.RecordCount<>0 then
       begin
         rs.MoveLast;
         fileds:= cofields.Create;
         flds := cofields.Create;
         flds.add('filed1','filed1',miAggregationAuto,0);
         flds.add('filed2','filed2',miAggregationAuto,3);
         dst:=w_gis_show.Map1.Datasets.Add(miDatasetADO,rs,emptyparam,'filed1',emptyparam,emptyparam,flds,false);
         fileds.add('filed2','filed2',miAggregationAuto, 3);
         dst.Themes.add(MiThemeGradSymbol,fileds,'filed2',emptyparam);
         dst.Themes.Item('filed2').Properties.SymbolStyle.SymbolFontShadow:=true;
         dst.Themes.Item('filed2').Properties.SymbolStyle.SymbolType:=miSymbolTypeBitmap;
         dst.Themes.Item('filed2').Properties.SymbolStyle.SymbolBitmapName:='bmpname.bmp';
         dst.Themes.Item(1).legend.title:='等级专题图';
         dst.Themes.Item(1).legend.subtitle:='图例';
         dst.Themes.Item(1).legend.ShowCount := false;
         dst.Themes.Item(1).legend.left:=1;
         dst.Themes.Item(1).legend.top:=0;
       end;
    end;
举报 回复(0) 喜欢(0)     评分
上一页 下一页
游客

返回顶部