?? tdistancetoolclass.~pas
字號:
{-----------------------------------------------------------------------------
Unit Name: TDistanceToolClass
Author: 杜長宇 junqilian@163.com
Purpose: 實現量距離工具
History: 2005-05-21
開發環境: delphi7+mapX 5.02.38
windows XP Sp2
用法:
1、主程序中uses ToolButtonDistance;
2、在主程序窗體中放置ToolButtonDistance
3、添加事件處理函數,形如:
procedure TForm1.ToolButtonDistanceClick(Sender: TObject);
var
m_MapDistanceTool : TDistanceTool;
begin
m_MapDistanceTool := TDistanceTool.Create;
m_MapDistanceTool.CreateDistanceTool(map1);
Map1.CurrentTool := m_MapDistanceTool.GetToolNum;
end;
-----------------------------------------------------------------------------}
unit TDistanceToolClass;
interface
uses Controls,Classes,MapXLib_TLB,Variants,TeEngine,windows,SysUtils,
DistanceWindow,Math;
type
TDistanceTool = class(TObject)
protected
m_IriMouseMoveEvent:TMouseMoveEvent;
m_IriMouseClickInMapEvent:TNotifyEvent;
m_IriMouseDoubleClickInMapEvent:TNotifyEvent;
m_pMap:Tmap;
m_bToolInUse:Boolean;
m_sPreviousMapX:Single;
m_sPreviousMapY:Single;
m_sCurrentMapX:Single;
m_sCurrentMapY:Single;
m_dTotalDistance:double;
m_lTotalDistancePoint:integer;
m_bTotalDistanceShow:boolean;
m_lRulePolyLineFeatuerID : integer;
m_lRuleLineFeatuerID : integer;
m_strRuleFlagLayer : string;
m_frmDistanceWindow : TfrmDistanceWindow;
protected
procedure MapMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure MapMouseClick(Sender: TObject);
procedure MapMouseDoubleClick(Sender: TObject);
private
{ Private declarations }
procedure ShowTheResult(dDistance,dTotalDistance:double;sDistanceUnit:string);
public
{ public declarations }
Function CreateDistanceTool(var pMap:TMap):Integer;
Function InstallDistanceTool():Boolean;
Function UnInstallDistanceTool():Boolean;
Function GetToolNum():Integer;
end;
const
MAP_DISTANCE_TOOL = 1;
implementation
uses dchyMapModule;
var
myMapModule : TdchyMapModule;
function TDistanceTool.CreateDistanceTool(var pMap: TMap): Integer;
begin
m_pMap:=pMap;
if m_pMap<>nil then
begin
m_pMap.CreateCustomTool(MAP_DISTANCE_TOOL,miToolTypePoint, miCrossCursor, miCrossCursor, miCrossCursor);
//初始化
m_strRuleFlagLayer :='RulerTempLayer';
m_dTotalDistance:=0.0;
m_lTotalDistancePoint:=0;
InstallDistanceTool;
result:=MAP_DISTANCE_TOOL;
end
else
result:=-1;
end;
function TDistanceTool.GetToolNum: Integer;
begin
result:=MAP_DISTANCE_TOOL;
end;
function TDistanceTool.InstallDistanceTool: Boolean;
begin
if m_pMap<>nil then
begin
//保存原先的事件處理函數狀態
m_IriMouseMoveEvent:=m_pMap.OnMouseMove;
m_IriMouseClickInMapEvent:=m_pMap.OnClick;
m_IriMouseDoubleClickInMapEvent:=m_pMap.OnDblClick;
m_pMap.OnMouseMove:=MapMouseMove;
m_pMap.OnClick:=MapMouseClick;
m_pMap.OnDblClick:=MapMouseDoubleClick;
result:=True;
end
else
result:=False;
end;
procedure TDistanceTool.MapMouseClick(Sender: TObject);
var
dDistance : double;
newobj : CMapXFeature; // Standalone object
obj : CMapXFeature; // to hold object added to layer
style : CMapXStyle;
PolyLinePoints : CMapXPoints;
LinePoints : CMapXPoints;
currentPoint : CMapXPoint;
index : integer;
pointsCount : integer;
layer :CMapXLayer;
begin
if m_pMap.CurrentTool = MAP_DISTANCE_TOOL then begin
if m_lTotalDistancePoint <> 0 then begin
dDistance := m_pMap.Distance(m_sPreviousMapX,m_sPreviousMapY,m_sCurrentMapX,m_sCurrentMapY);
m_dTotalDistance := m_dTotalDistance + dDistance;
end;
m_sPreviousMapX:=m_sCurrentMapX;
m_sPreviousMapY:=m_sCurrentMapY;
m_lTotalDistancePoint:=m_lTotalDistancePoint+1;
m_bTotalDistanceShow:=TRUE;
//創建臨時圖層
if myMapModule.GetLayerIndex(m_pMap,m_strRuleFlagLayer)<0 then
myMapModule.CreateTempAnimationLayer(m_pMap,m_strRuleFlagLayer);
m_pMap.Layers.Item[m_strRuleFlagLayer].Editable := true;
if m_lRulePolyLineFeatuerID = 0 then begin
try
PolyLinePoints := CoPoints.Create;
PolyLinePoints.AddXY(m_sCurrentMapX,m_sCurrentMapY,EmptyParam);
PolyLinePoints.AddXY(m_sCurrentMapX,m_sCurrentMapY,EmptyParam);
newobj := CoFeature.Create;
newobj.Attach(m_pMap.ControlInterface);
newobj.type_ := miFeatureTypeLine;
newobj.Parts.Add(PolyLinePoints);
obj := m_pMap.Layers.Item[m_strRuleFlagLayer].AddFeature(newobj,EmptyParam);
style := m_pMap.Layers.Item[m_strRuleFlagLayer].Style.Clone;
style.LineColor := miColorRed;
style.LineStyle := miLineTypeSimple;
style.LineWidth := 4;
obj.Style := style;
obj.Update(EmptyParam,EmptyParam);
m_lRulePolyLineFeatuerID :=obj.FeatureID;
except
raise;
end;
end
else
try
obj := m_pMap.Layers.Item[m_strRuleFlagLayer].GetFeatureByID(m_lRulePolyLineFeatuerID);
style := m_pMap.Layers.Item[m_strRuleFlagLayer].Style.Clone;
style.LineColor := miColorRed;
style.LineStyle := miLineTypeSimple;
style.LineWidth := 4;
obj.Style := style;
PolyLinePoints := obj.Parts.Item[1];
PolyLinePoints.AddXY(m_sCurrentMapX,m_sCurrentMapY,EmptyParam);
obj.Parts.Add(PolyLinePoints);
obj.Parts.Remove(2);
obj.Update(EmptyParam,EmptyParam);
except
raise;
end;
if m_lRuleLineFeatuerID=0 then begin
try
LinePoints := CoPoints.Create;
LinePoints.AddXY(m_sCurrentMapX,m_sCurrentMapY,EmptyParam);
LinePoints.AddXY(m_sCurrentMapX,m_sCurrentMapY,EmptyParam);
newobj := m_pMap.FeatureFactory.CreateLine(LinePoints,EmptyParam);
obj := m_pMap.Layers.Item[m_strRuleFlagLayer].AddFeature(newobj,EmptyParam);
style := m_pMap.Layers.Item[m_strRuleFlagLayer].Style.Clone;
style.LineColor := miColorRed;
style.LineStyle := miLineTypeSimple;
style.LineWidth := 4;
obj.Style := style;
obj.Update(EmptyParam,EmptyParam);
m_lRuleLineFeatuerID := obj.FeatureID;
except
raise;
end;
end
else begin
obj:=m_pMap.Layers.Item[m_strRuleFlagLayer].GetFeatureByID(m_lRuleLineFeatuerID);
obj.Parts.Item[1].Item[1].Set_(m_sCurrentMapX,m_sCurrentMapY);
obj.Parts.Item[1].Item[2].Set_(m_sCurrentMapX,m_sCurrentMapY);
obj.Update(EmptyParam,EmptyParam);
end;
end;
//just for debuging;
//m_pMap.Layers.LayersDlg(EmptyParam,EmptyParam);
if @m_IriMouseClickInMapEvent<>nil then
m_IriMouseClickInMapEvent(Sender);
end;
procedure TDistanceTool.MapMouseDoubleClick(Sender: TObject);
var
layer : CMapXLayer;
features : CMapXFeatures;
obj : CMapXFeature;
i : integer;
begin
if m_pMap.CurrentTool = MAP_DISTANCE_TOOL then begin
m_lTotalDistancePoint:=0;
m_dTotalDistance:=0.0;
m_bTotalDistanceShow:=FALSE;
m_lRulePolyLineFeatuerID:=0;
m_lRuleLineFeatuerID:=0;
if myMapModule.GetLayerIndex(m_pMap,m_strRuleFlagLayer)<>-1 then begin
layer := m_pMap.Layers.Item[m_strRuleFlagLayer];
features := layer.AllFeatures;
for i:=0 to features.Count-1 do begin
obj:=features.Item[i+1];
layer.DeleteFeature(obj);
end;
end;
m_pMap.CurrentTool := miArrowTool;
myMapModule.DeleteTempAnimationLayer(m_pMap,m_strRuleFlagLayer);
UnInstallDistanceTool;
end;
if @m_IriMouseDoubleClickInMapEvent<>nil then
m_IriMouseDoubleClickInMapEvent(Sender);
end;
procedure TDistanceTool.MapMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
var
dDist,dRectLen,dRectWidth : double;
screenX,screenY : Single;
mapX,mapY : double;
obj : CMapXFeature;
var
myMapModule : TdchyMapModule;
mapUnit : string;
begin
if m_pMap.CurrentTool = MAP_DISTANCE_TOOL then begin
screenX:=X;
screenY:=Y;
m_pMap.ConvertCoord(screenX,screenY,mapX,mapY,miScreenToMap);
m_sCurrentMapX:=mapX;
m_sCurrentMapY:=mapY;
if m_bTotalDistanceShow then begin
dDist:=m_pMap.Distance(m_sPreviousMapX,m_sPreviousMapY,mapX,mapY);
mapUnit := myMapModule.GetChineseMapUnit(m_pMap,m_pMap.MapUnit);
ShowTheResult(dDist,m_dTotalDistance+dDist,mapUnit);
myMapModule.AutoPan(m_pMap,mapX,mapY,24.0,18.0);
if(m_lRuleLineFeatuerID<>0)then begin
obj:=m_pMap.Layers.Item[m_strRuleFlagLayer].GetFeatureByID(m_lRuleLineFeatuerID);
obj.Parts.Item[1].Item[2].Set_(m_sCurrentMapX,m_sCurrentMapY);
obj.Update(EmptyParam,EmptyParam);
end;
end;
end;
if @m_IriMouseMoveEvent<>nil then
m_IriMouseMoveEvent(Sender,Shift,X,Y);
end;
procedure TDistanceTool.ShowTheResult(dDistance, dTotalDistance: double;sDistanceUnit:string);
begin
//激活距離顯示窗口
if m_frmDistanceWindow<>nil then begin
dDistance := RoundTo(dDistance,-2); //四舍五入,保留兩位
dTotalDistance := RoundTo(dTotalDistance,-2);
m_frmDistanceWindow.lblDistance.Caption := floatToStr(dDistance)+sDistanceUnit;
m_frmDistanceWindow.lblTotalDistance.Caption := floatToStr(dTotalDistance)+sDistanceUnit;
m_frmDistanceWindow.Show;
end
else begin
m_frmDistanceWindow:=TfrmDistanceWindow.Create(nil);
m_frmDistanceWindow.Show;
end;
end;
function TDistanceTool.UnInstallDistanceTool: Boolean;
begin
if m_pMap<>nil then
begin
//回復原先的事件處理函數狀態
m_pMap.OnMouseMove:=m_IriMouseMoveEvent;
m_pMap.OnClick := m_IriMouseClickInMapEvent;
m_pMap.OnDblClick := m_IriMouseDoubleClickInMapEvent;
m_IriMouseMoveEvent:=nil;
m_IriMouseClickInMapEvent:=nil;
m_IriMouseDoubleClickInMapEvent:=nil;
m_pMap:=nil;
result:=True;
end
else
result:=False;
end;
end.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -