📄 dchymapmodule.pas
字号:
{-----------------------------------------------------------------------------
Unit Name: dchyMapModule
Author: 杜长宇 du changyu changyudu@163.com ,junqilian@163.com
Purpose: 用于操作mapx控件的相关工具包
History: 创建: 2005-05-20
许可:
您可以自由的使用本代码进行学习或非商业、商业应用,
你可以自由更改本代码以便更适合你的应用,但请保留原作者版权信息;
如果你对本代码作过修改优化,请添加详细注释后重新发布到网上,并发给原作者一份拷贝,以利于大家共同进步;
用法:
1、在需要使用该工具模块的单元里,uses unit :dchyMapModule;
2、定义对象
var
myMapModule : TdchyMapModule;
3、myMapModule.Method();
-----------------------------------------------------------------------------}
unit dchyMapModule;
interface
uses
SysUtils,MapXLib_TLB,Variants,Activex ;
type
TdchyMapModule = class
private
public
{ Private declarations }
procedure LoadLayerFromServer(var currentMap:TMap;layerName,queryString, serverName,userName,password:string);
procedure MoveLayerToTop(var currentMap:TMap;layerName:string);
function GetLayerIndex(var currentMap:TMap;layerName:string):integer;
procedure AutoPan(var currentMap:TMap;mapX,mapY,deltaXScale,deltaYScale:double);
function CreateTempAnimationLayer(var currentMap:TMap;layerName:string):CMapXLayer;
procedure DeleteTempAnimationLayer(var currentMap:TMap;layerName:string);
function GetChineseMapUnit(var currentMap:TMap;mapUnit:TOleEnum):string;
end;
implementation
{ TdchyMapModule }
{-----------------------------------------------------------------------------
Procedure: TdchyMapModule.GetLayerIndex
Author: Administrator
Date: 20-五月-2005
Arguments: var currentMap:TMap; layerName: string
Result: integer
如果result=-1 则表示没有找到指定的图层。
-----------------------------------------------------------------------------}
procedure TdchyMapModule.AutoPan(var currentMap: TMap; mapX, mapY,
deltaXScale, deltaYScale: double);
var
maxX,maxY,minX,minY : double;
deltaX,deltaY : double;
begin
// 当mapX,mapY点到达屏幕距边界还有1/deltaXScale水平和1/deltaYScale垂直时,自动移动屏幕1/deltaXScale(水平)和1/deltaYScale(垂直)
maxX:=currentMap.Bounds.XMax;
minX:=currentMap.Bounds.XMin;
maxY:=currentMap.Bounds.YMax;
minY:=currentMap.Bounds.YMin;
deltaX:=(maxX-minX)/deltaXScale;
deltaY:=(maxY-minY)/deltaYScale;
if (mapX<minX+deltaX) then currentMap.CenterX := currentMap.CenterX-(minX-mapX)-deltaX
else if (mapX>maxX-deltaX) then currentMap.CenterX := currentMap.CenterX+(mapX-maxX)+deltaX;
if (mapY<minY+deltaY) then currentMap.CenterY := currentMap.CenterY-(minY-mapY)-deltaY
else if(mapY>maxY-deltaY) then currentMap.CenterY := currentMap.CenterY+(mapY-maxY)+deltaY;
end;
function TdchyMapModule.CreateTempAnimationLayer(var currentMap: TMap;
layerName: string): CMapXLayer;
var
layerInfo:CMapXLayerInfo;
flds : CMapXFields;
begin
try
flds := CoFields.Create;
flds.AddStringField('ID',254,EmptyParam);
layerInfo := CoLayerInfo.Create;
layerInfo.type_ := miLayerInfoTypeTemp;
layerInfo.AddParameter('FileSpec',layerName);
layerInfo.AddParameter('Name',layerName);
layerInfo.AddParameter('Fields',flds);
currentMap.Layers.Add(layerInfo,1);
currentMap.Layers.AnimationLayer := currentMap.Layers.Item[layerName];
result := currentMap.Layers.Item[layerName];
except
result := nil;
end;
end;
procedure TdchyMapModule.DeleteTempAnimationLayer(var currentMap: TMap;
layerName: string);
var
index : integer;
begin
index := GetLayerIndex(currentMap,layerName);
if not index<0 then currentMap.Layers.Remove(index);
end;
function TdchyMapModule.GetChineseMapUnit(var currentMap: TMap;
mapUnit: TOleEnum): string;
begin
case mapUnit of
miUnitMile : result := '英里';
miUnitKilometer : result := '千米';
miUnitInch : result := '英寸';
miUnitFoot : result := '英尺';
miUnitYard : result := '码';
miUnitMillimeter : result := '毫米';
miUnitCentimeter : result := '厘米';
miUnitMeter : result := '米';
miUnitSurveyFoot : result := 'SurveyFoot';
miUnitNauticalMile : result := '海里';
miUnitTwip : result := '缇';
miUnitPoint : result := '点';
miUnitPica : result := 'Pica';
miUnitDegree : result := '度';
miUnitLink : result := 'Link';
miUnitChain : result := 'Chain';
miUnitRod : result := 'Rod';
end;
end;
function TdchyMapModule.GetLayerIndex(var currentMap:TMap; layerName: string): integer;
var
i : integer;
begin
for i :=1 to currentMap.Layers.Count do begin
if currentMap.Layers.Item[i].Name = layerName then begin
result := i;
break;
end
else begin
//raise Exception.CreateFmt('TdchyMapModule.GetLayerIndex error: 找不到指定的图层:%s',[layerName]);
result := -1;
end;
end;
end;
{-----------------------------------------------------------------------------
Procedure: TForm1.LoadLayerFromServer
Author: Administrator
Date: 20-五月-2005
Arguments: var currentMap:TMap;layerName,whereCondition, serverName, userName, password: string
Result: None
whereCondition 示例:" where objectId > 25 "
-----------------------------------------------------------------------------}
procedure TdchyMapModule.LoadLayerFromServer(var currentMap: TMap;
layerName, queryString, serverName, userName, password: string);
var
//QueryString:string;
LayerInfo:CMapxLayerInfo;
begin
LayerInfo := CoLayerInfo.Create;
LayerInfo.type_ := miLayerInfoTypeServer;
Layerinfo.Type_:=miLayerInfoTypeServer;
LayerInfo.AddParameter('Name',layerName);
LayerInfo.AddParameter('ConnectString','SRVR='+serverName+';UID='+userName+';PWD='+password);
LayerInfo.AddParameter('Query',queryString);
LayerInfo.AddParameter('Toolkit','ORAINET');
LayerInfo.AddParameter('Cache','OFF'); //关闭缓存,以便使客户端及时反映服务器的变化。
//加载到图层列表的最底端
currentMap.Layers.Add(LayerInfo,currentMap.ControlInterface.Layers.Count+1);
end;
{-----------------------------------------------------------------------------
Procedure: TForm1.MoveLayerToTop
Author: Administrator
Date: 20-五月-2005
Arguments: var currentMap: TMap; layerName:string
Result: None
把制定的图层移动到地图图层列表的最顶端
-----------------------------------------------------------------------------}
procedure TdchyMapModule.MoveLayerToTop(var currentMap: TMap;
layerName: string);
var
i : integer;
layerIndex : integer;
begin
layerIndex := self.GetLayerIndex(currentMap,layerName);
if layerIndex>=0 then
currentMap.Layers.Move(layerIndex,1)
else
raise Exception.CreateFmt('TdchyMapModule.MoveLayerToTop error: 找不到指定的图层:%s',[layerName]);
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -