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编辑过]
|
|
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; |
|
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; |
|
上一页
下一页