用Delphi实现MapX中类似AutoCAD的平滑移动的Pen工具

百花草

用Delphi实现MapX中类似AutoCAD的平滑移动的Pen工具
//类文件
unit TFlowPenClass;
interface
uses Controls,Classes,MapXLib_TLB;
type
  TFlowPen=Class(TObject)
  protected
    m_IriMouseMoveEvent:TMouseMoveEvent;
    m_IriMouseUpEvent:TMouseEvent;
    m_IriMouseDownEvent:TMouseEvent;
    m_pMap:Tmap;
    m_bMosueDown:Boolean;
    m_sPenInX:Single;
    m_sPenInY:Single;
  protected
    procedure MapMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure MapMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure MapMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
  public
    Function CreateFlowPenTool(pMap:TMap):Integer;
    Function InstallFlowPenTool():Boolean;
    Function UnInstallFlowPenTool():Boolean;
    Function GetToolNum():Integer;
end;
const
  MAP_TOOL_FLOWPEN=1;
implementation
  procedure TFlowPen.MapMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  begin
    If (m_pMap.CurrentTool=MAP_TOOL_FLOWPEN) And (Not m_bMosueDown) Then
    begin
      m_bMosueDown:=True;
      m_sPenInX:=X;
      m_sPenInY:=Y;
    end;
    if @m_IriMouseDownEvent<>nil then
      m_IriMouseDownEvent(Sender,Button,Shift,X,Y);
  end;
  procedure TFlowPen.MapMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  begin
    If (m_pMap.CurrentTool=MAP_TOOL_FLOWPEN) And m_bMosueDown Then
      m_bMosueDown:=False;
    if @m_IriMouseUpEvent<>nil then
      m_IriMouseUpEvent(Sender,Button,Shift,X,Y);
  end;
procedure TFlowPen.MapMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
  dX1,dX2,dY1,dY2ouble;
  sX,sY:Single;
begin
  If (m_pMap.CurrentTool=MAP_TOOL_FLOWPEN) And m_bMosueDown Then
  begin
    sX:=X;sY:=y;
    m_pMap.ConvertCoord(sX,sY,dX1,dY1,miScreenToMap);
    m_pMap.ConvertCoord(m_sPenInX,m_sPenInY,dX2,dY2,miScreenToMap);
    m_pMap.CenterX:=m_pMap.CenterX-(dX1-dX2);
    m_pMap.CenterY:=m_pMap.CenterY-(dY1-dY2);
    m_sPenInX:=X;
    m_sPenInY:=Y;
  End;
  if @m_IriMouseMoveEvent<>nil then
    m_IriMouseMoveEvent(Sender,Shift,X,Y);
end;
Function TFlowPen.CreateFlowPenTool(pMap:Tmap):Integer;
begin
    m_pMap:=pMap;
    if m_pMap<>nil then
    begin
      m_pMap.CreateCustomTool(MAP_TOOL_FLOWPEN,miToolTypePoint,miPanCursor,miPanCursor,miPanCursor);
      InstallFlowPenTool;
      result:=MAP_TOOL_FLOWPEN;
    end
    else
      result:=-1;
end;
Function TFlowPen.InstallFlowPenTool():boolean;
begin
    if m_pMap<>nil then
    begin
      m_IriMouseMoveEvent:=m_pMap.OnMouseMove;
      m_IriMouseUpEvent:=m_pMap.OnMouseUp;
      m_IriMouseDownEvent:=m_pMap.OnMouseDown;
      m_pMap.OnMouseMove:=MapMouseMove;
      m_pMap.OnMouseUp:=MapMouseUp;
      m_pMap.OnMouseDown:=MapMouseDown;
      m_bMosueDown:=False;
      result:=True;
    end
    else
      result:=False;
end;
Function TFlowPen.UnInstallFlowPenTool():Boolean;
begin
    if m_pMap<>nil then
    begin
      m_pMap.OnMouseMove:=m_IriMouseMoveEvent;
      m_pMap.OnMouseUp:=m_IriMouseUpEvent;
      m_pMap.OnMouseDown:=m_IriMouseDownEvent;
      m_IriMouseMoveEvent:=nil;
      m_IriMouseUpEvent:=nil;
      m_IriMouseDownEvent:=nil;
      m_pMap:=nil;
      result:=True;
    end
    else
      result:=False;
end;
Function TFlowPen.GetToolNum():Integer;
begin
  result:=MAP_TOOL_FLOWPEN;
end;
end.
//使用时初试化
  m_FlowPenTool:=TFlowPen.Create;
  m_FlowPenTool.CreateFlowPenTool(Map1);
//开始使用FlowPen
Map1.CurrentTool:=m_FlowPenTool.GetToolNum();
//MapX.RedrawInterval设置为30或更大效果会比较好

xz_5961

楼主辛苦了

jxqkd123

探矿者软件可以提高矿体的命中率，减少找矿的成本和难度，主要功能：数据管理、二维制图、三维建模、储量估算、三维立体预测等，有需要免费试用可以联系负责人邓帅15377311476（微信同号），软件针对单位或者企业试用，不面向个人试用