⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 dchymapmodule.~pas

📁 Purpose: 量距离工具 History: 2005-05-21 开发环境: delphi7+mapX 5.02.38 windows XP Sp2
💻 ~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;
      function CreateServerLayer(var currentMap,layerName,serverName,userName,password: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 + -