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

📄 unitqcprojecttools.~pas

📁 此代码是关于mapgis的在
💻 ~PAS
字号:
unit UnitQCProjectTools;

interface

uses
  Classes, Windows, SysUtils, StdCtrls, MapXLib_TLB, Variants, Graphics,
  Dialogs, Controls, Forms, MapXTools, MapXStyles, MapXBase, MapXConsts,
  UnitQCGISProject;

const
  STYLE_SUBSTATION = STYLE_USER + 1;
  STYLE_SDLINE     = STYLE_USER + 2;
  STYLE_KG         = STYLE_USER + 3;

const
  MAP_TOOL_USER_ADDSUBSTATION = MAP_TOOL_USER + 1;
  MAP_TOOL_USER_ADDSDLINE     = MAP_TOOL_USER + 2;
  MAP_TOOL_USER_ADDKG         = MAP_TOOL_USER + 3;
  MAP_TOOL_USER_LINKTOPOWER   = MAP_TOOL_USER + 4;
  
type
  TAddSubStationMapTool=class(TAddSymbolMapTool)
  protected
    procedure InitTool;override;
  public
    constructor Create(aCollection:TToolList); override;
  end;

  TAddSDLineMapTool=class(TAddLineMapTool)
  protected
    procedure InitTool;override;
  public
    constructor Create(aCollection:TToolList); override;
  end;

  TAddKGLineMapTool=class(TAddLineMapTool)
  protected
    procedure InitTool;override;
  public
    constructor Create(aCollection:TToolList); override;
  end;
  
  TLinkToPowerMapTool=class(TLayerMapTool)
  private
    LineFts:Features;
    FProject: TqcGISProject;
    IsWorking:Boolean;
  protected
    procedure InitTool;override;
    procedure RegisterMethodProc; override;
    function CheckSelection:Boolean;
  public
    constructor Create(aCollection:TToolList); override;
    class function IsUserMapTool:Boolean; override;
    function IsComplete:Boolean; override;
  published
    procedure DoMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure DoMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    property Project:TqcGISProject read FProject write FProject; 
  end;
  
implementation

uses
  BusinessDialogs, ComCtrls, MapXContainer, UnitShellAPIs, UnitQCConsts;
  
{ TAddSubStationMapTool }

constructor TAddSubStationMapTool.Create(aCollection: TToolList);
begin
  inherited Create(aCollection);
  SymbolIndex:=STYLE_SUBSTATION;
end;

procedure TAddSubStationMapTool.InitTool;
begin
  inherited InitTool;
  UserType:=MAP_TOOL_USER_ADDSUBSTATION;
end;

{ TAddSDLineMapTool }

constructor TAddSDLineMapTool.Create(aCollection: TToolList);
begin
  inherited Create(aCollection);
  SymbolIndex:=STYLE_SDLINE;
end;

procedure TAddSDLineMapTool.InitTool;
begin
  inherited InitTool;
  UserType:=MAP_TOOL_USER_ADDSDLINE;
end;

{ TAddKGLineMapTool }

constructor TAddKGLineMapTool.Create(aCollection: TToolList);
begin
  inherited Create(aCollection);
  SymbolIndex:=STYLE_KG;
end;

procedure TAddKGLineMapTool.InitTool;
begin
  inherited InitTool;
  UserType:=MAP_TOOL_USER_ADDKG;
end;

{ TLinkToPowerMapTool }

function TLinkToPowerMapTool.CheckSelection:Boolean;
var
  i:Integer;
  linecount:Integer;
  sel:Selection;
begin
  Result:=False;
  sel:=LayerManager.Layer.Selection;
  if sel.Count<1 then
  begin
    MyDefInformation('请选择要操作的输电线路!');
    EndTheTool;
    Exit;
  end;
  linecount:=0;
  for i:=1 to sel.Count do
    if sel.Item[i].type_=miFeatureTypeLine then Inc(linecount);
  if linecount=0 then
  begin
    MyDefInformation('选择集合内没有输电线路!');
    EndTheTool;
    Exit;
  end;
  Result:=True;
end;

constructor TLinkToPowerMapTool.Create(aCollection: TToolList);
begin
  inherited Create(aCollection);
  FAutoToolId:=False;
  IsWorking:=False;
end;

procedure TLinkToPowerMapTool.DoMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  i:Integer;
  sel:Selection;
begin
  if (ssLeft in Shift) and IsLocalCurrentTool then
  begin
    if (FProject=nil)or(not CheckSelection) then Exit;
    IsWorking:=True;
    sel:=LayerManager.Layer.Selection;
    LineFts:=LayerManager.Layer.NoFeatures;
    for i:=1 to sel.Count do
      if sel.Item[i].type_=miFeatureTypeLine then
        LineFts.Add(sel.Item[i]);
  end;
end;

procedure TLinkToPowerMapTool.DoMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  i:Integer;
  ALyr:Layer;
  LayerNode:TTreeNode;
  DotId:Integer;
begin
  if (ssLeft in Shift) and IsLocalCurrentTool then
  begin
    if (FProject=nil)or(LineFts.Count=0) then Exit;
    ALyr:=GetLayer(LAYER_SYS_POWER, LayerNode);
    if (ALyr<>nil)and(ALyr.Selection.Count=1)and
       (ALyr.Selection.Item[1].type_=miFeatureTypeLine)and
       (ALyr.Selection.Item[1].KeyValue<>'')
    then begin
      DotId:=StrToInt(ALyr.Selection.Item[1].KeyValue);
      with FProject.DefDBPoster do
      begin
        DeleteRecord('t_DotLines', 'DotId='+IntToStr(DotId));
        TableName:='t_DotLines';
        SetInsertFields('DotID,LineID');
        for i:=1 to LineFts.Count do
        begin
          SetCustomValue('DotID',DotId);
          SetCustomValue('LineID', StrToInt(LineFts.Item[i].KeyValue));
          InsertPost;
        end;
      end;
      IsWorking:=False;
      EndTheTool;
    end;
  end;
end;

procedure TLinkToPowerMapTool.InitTool;
begin
  inherited InitTool;
  Caption:='设置线路的开关';
  ToolId:=miSelectTool;
  ToolType:=miToolTypePoint;
  CursorType:=miDefaultCursor;
  UserType:=MAP_TOOL_USER_LINKTOPOWER;
end;

function TLinkToPowerMapTool.IsComplete: Boolean;
begin
  Result:=not IsWorking;
end;

class function TLinkToPowerMapTool.IsUserMapTool: Boolean;
begin
  Result:=False;
end;

procedure TLinkToPowerMapTool.RegisterMethodProc;
var
  pProc1:TMouseEvent;
  pProc2:TMouseEvent;
begin
  pProc1:=DoMouseDown;
  MapManager.RegisterEventProc(Self, @pProc1, PROC_MOUSEDOWN);

  pProc2:=DoMouseUp;
  MapManager.RegisterEventProc(Self, @pProc2, PROC_MOUSEUP);
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -