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

📄 unitmainform.~pas

📁 此代码是关于mapgis的在
💻 ~PAS
📖 第 1 页 / 共 4 页
字号:
end;

procedure TForm_Main.N32Click(Sender: TObject);
var
  aLyr:Layer;
begin
  aLyr:=GetLayerFromTreeNode(tvLayers.Selected);
  if aLyr=nil then Exit;
  if aLyr.Selection.Count=0 then Exit;
  MyGIS.GMapTools.MapX.Bounds := aLyr.Selection.Bounds;
end;


procedure TForm_Main.N38Click(Sender: TObject);
var
  aLyr:Layer;
begin
  aLyr:=GetLayerFromTreeNode(tvLayers.Selected);
  if aLyr=nil then Exit;
  with MyGIS.GMapTools.m_Layer do
  begin
    Layer:=aLyr;
    SelectAll;
  end;
end;

procedure TForm_Main.N35Click(Sender: TObject);
var
  aLyr:Layer;
begin
  aLyr:=GetLayerFromTreeNode(tvLayers.Selected);
  if aLyr=nil then Exit;
  with MyGIS.GMapTools.m_Layer do
  begin
    Layer:=aLyr;
    UnSelectAll;
  end;
end;

procedure TForm_Main.NBreakLineClick(Sender: TObject);
begin
  CheckEditLayer;
  SetCurrentMapTool('TBreakLineMapTool', DoOnTurnTool);
end;

procedure TForm_Main.NBreakClick(Sender: TObject);
var
  i:Integer;
  Cancel:Boolean;
begin
  CheckEditLayer;

  MyGIS.DoBeginAction(ID_ACTION_COMBINE, Cancel);
  if Cancel then Exit;
  
  if EditLayer.Selection.Count=0 then
  begin
    MyDefInformation('请选择要分解的图形!');
    Exit;
  end;
  with MyGIS.GMapTools.m_Layer do
  begin
    BeforeDeleteFeature:=DoBeforeDeleteFeature;
    OnFeatureCreate:=DoOnFeatureCreate;
    Layer:=EditLayer;
    for i:=1 to EditLayer.Selection.Count do
      SeparateFeature(EditLayer.Selection.Item[i]);
  end;

  MyGIS.DoEndAction(ID_ACTION_COMBINE);
end;

procedure TForm_Main.NEllipseClick(Sender: TObject);
begin
  CheckEditLayer;
  SetCurrentMapTool('TAddEllipseMapTool', DoOnTurnTool);
end;

procedure TForm_Main.N42Click(Sender: TObject);
var
  oDatum:CMapXDatum;
begin
  oDatum:=CoDatum.Create;
  oDatum.Set_( 28, 0, 0, 0, 0, 0, 0, 0, 0);
  MyGIS.GMapTools.MapX.DisplayCoordSys.Set_(miTransverseMercator,oDatum,miUnitDegree,
                          EmptyParam,
                          EmptyParam,
                          EmptyParam,EmptyParam,EmptyParam,EmptyParam,
                          EmptyParam,EmptyParam,
                          EmptyParam,EmptyParam,EmptyParam);
  MyGIS.GMapTools.MapX.NumericCoordSys:=MyGIS.GMapTools.MapX.DisplayCoordSys;
end;

procedure TForm_Main.MapXObject1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  case Key of
    Ord('C'):begin
      if Shift=[ssCtrl] then NCopyClick(NCopy);
    end;
    Ord('V'):begin
      if Shift=[ssCtrl] then NPasteClick(NPaste);
    end;
    46:begin
      if (EditLayer<>nil)and(EditLayer.Selection.Count>0) then
      begin
        MyGIS.GMapTools.m_Map.DoBeforeSelectionDeleted(Sender, EditLayer);
        if EditLayer.Selection.Count>0 then
          DoBeforeSelectionDeleted(Sender, EditLayer);
      end;
    end;
  end;
end;

procedure TForm_Main.N36Click(Sender: TObject);
var
  aLyr:Layer;
begin
  aLyr:=GetLayerFromTreeNode(tvLayers.Selected);
  if aLyr=nil then Exit;
  with MyGIS.GMapTools.m_Layer do
  begin
    Layer:=aLyr;
    InvertSelection;
  end;
end;

procedure TForm_Main.PNEditableClick(Sender: TObject);
var
  Index:Integer;
  aLyr:Layer;
begin
  //-----------------------------------------------------------------------//
  //检查是否有权操作//
  if not MyGIS.CheckFunction(ID_ACTION_EDITLAYER) then Exit;
  //-----------------------------------------------------------------------//
  aLyr:=GetLayerFromTreeNode(tvLayers.Selected);
  if aLyr=nil then Exit;
  Index:=GetLayerIndex(MyGIS.GMapTools.MapX, aLyr);
  SetLayerEditable(Index, not aLyr.Editable);
end;

procedure TForm_Main.NAlignLeftClick(Sender: TObject);
begin
  CheckEditLayer;
  AlignLeft(EditLayer.Selection);
end;

procedure TForm_Main.NAlignRightClick(Sender: TObject);
begin
  CheckEditLayer;
  AlignRight(EditLayer.Selection);
end;

procedure TForm_Main.NAlignTopClick(Sender: TObject);
begin
  CheckEditLayer;
  AlignTop(EditLayer.Selection);
end;

procedure TForm_Main.NAlignBottomClick(Sender: TObject);
begin
  CheckEditLayer;
  AlignBottom(EditLayer.Selection);
end;

procedure TForm_Main.NAlignVCenterClick(Sender: TObject);
begin
  CheckEditLayer;
  AlignCenter_X(EditLayer.Selection);
end;

procedure TForm_Main.NAlignHCenterClick(Sender: TObject);
begin
  CheckEditLayer;
  AlignCenter_Y(EditLayer.Selection);
end;

procedure TForm_Main.WMEndTracking(var Message: TMessage);
var
  aToolObj:TBaseMapTool;
  Ft:Feature;
begin
  aToolObj:=MyGIS.GMapTools.m_Map.GetCurrentToolObject;
  Ft:=TAddObjectMapTool(aToolObj).EditFeature;
  if Ft<>nil then
    SelectFeature(MyGIS.GMapTools.MapX, Ft);
end;

procedure TForm_Main.DoAfterSetCurrentTool(Sender: TObject;
  AToolObj: TBaseMapTool);
begin
  SBar.Panels[1].Text:=AToolObj.Caption;
end;

procedure TForm_Main.N59Click(Sender: TObject);
var
  ALyr:Layer;
begin
  //-----------------------------------------------------------------------//
  //检查是否有权操作//
  if not MyGIS.CheckFunction(ID_ACTION_FEATUREPROPERTIES) then Exit;
  //-----------------------------------------------------------------------//
  ALyr:=MyGIS.GMapTools.m_Map.GetSingleSelectedLayer;
  if (ALyr=nil)or(ALyr.Selection.Count<>1) then
  begin
    MyDefInformation('请选择一个图形!');
    Exit;
  end;
  with MyGIS.GMapTools.m_Layer do
  begin
    Layer:=ALyr;
    ShowPropDialog(ALyr.Selection.Item[1]);
  end;
end;

procedure TForm_Main.tvLayersDragDrop(Sender, Source: TObject; X,
  Y: Integer);
var
  i:Integer;
  SourceNode, TargetNode:TTreeNode;
  FromIndex, ToIndex:Integer;
begin
  TargetNode:=GetTargetNode(tvLayers, X,Y);
  if (TargetNode<>nil)and(TargetNode.Data<>nil) then
  begin
    {如果源节点在图层组内,则取图层组为源节点}
    SourceNode:=tvLayers.Selected;
    if SourceNode.Level=2 then
    begin
      SourceNode:=SourceNode.Parent;
      FromIndex:=-1;
    end
    else
      FromIndex:=GetLayerIndex(MyGIS.GMapTools.MapX, TLayerTreeNodeRecord(SourceNode.Data).Name);
    {如果目标节点在图层组内,则取图层组为目标节点}
    if TargetNode.Level=2 then
    begin
      TargetNode:=TargetNode.Parent;
      ToIndex:=GetLayerIndex(MyGIS.GMapTools.MapX, TLayerTreeNodeRecord(TargetNode.Item[0].Data).Name);
    end
    else
      ToIndex:=GetLayerIndex(MyGIS.GMapTools.MapX, TLayerTreeNodeRecord(TargetNode.Data).Name);
    if FromIndex<ToIndex then Dec(ToIndex);
    {移动图层}
    if SourceNode.Level=1 then
      MyGIS.GMapTools.MapX.Layers.Move(FromIndex, ToIndex)
    else
      for i:=SourceNode.Count-1 downto 0 do
      begin
        FromIndex:=GetLayerIndex(MyGIS.GMapTools.MapX, TLayerTreeNodeRecord(SourceNode.Item[i].Data).Name);
        MyGIS.GMapTools.MapX.Layers.Move(FromIndex, ToIndex);
      end; 
    {移动节点}
    TreeViewDragDrop(tvLayers, TargetNode, SourceNode, mtBrotherPrior);
  end;
end;

procedure TForm_Main.tvLayersDragOver(Sender, Source: TObject; X,
  Y: Integer; State: TDragState; var Accept: Boolean);
begin
  TreeViewDragOver(Sender, Source, X, Y, State, Accept);
end;


procedure TForm_Main.NAddToProjectClick(Sender: TObject);
var
  aLayerInfo:TLayerTreeNodeRecord;
  aLyr:Layer;
  LayerName:string;
  FilePath:string;
begin
  //-----------------------------------------------------------------------//
  //检查是否有权操作//
  if not MyGIS.CheckFunction(ID_ACTION_ADDTOPROJECT) then Exit;
  //-----------------------------------------------------------------------//
  if (tvLayers.Selected=nil)or(tvLayers.Selected.Data=nil) then
  begin
    MyDefInformation('请选择要操作的图层!');
    Exit;
  end;
  aLayerInfo:=tvLayers.Selected.Data;
  if aLayerInfo.NodeType<>LTN_LAYER then
  begin
    MyDefInformation('请请选择要操作的图层!');
    Exit;
  end;
  aLyr:=MyGIS.GMapTools.m_Layers.FindByName(aLayerInfo.Name);
  if aLayerInfo.IsSystem then
  begin
    SaveDialog1.Filter:='Map Info 图层文件|*.tab';
    if not SaveDialog1.Execute then Exit;
    LayerName:=ExtractFileNameNoExt(SaveDialog1.FileName);
    if MyGIS.GMapTools.m_Layers.FindByName(LayerName)<>nil then
    begin
      MyDefInformation('该名称已被引用,请重新命名!');
      Exit;
    end;
    FilePath:=ExtractFilePath(SaveDialog1.FileName);
    if not DirectoryExists(FilePath) then ForceDirectories(FilePath);
    MyGIS.DownloadProjectLayer(aLyr, aLayerInfo, LayerName, FilePath);
  end
  else
    MyGIS.AddLayerToProject(aLyr, aLayerInfo, 8);
end;

procedure TForm_Main.NCopyLayerClick(Sender: TObject);
var
  aLayerInfo:TLayerTreeNodeRecord;
  aLyr:Layer;
  LayerName:string;
  Path:string;
begin
  if (tvLayers.Selected=nil)or(tvLayers.Selected.Data=nil) then
  begin
    MyDefInformation('请选择要操作的图层!');
    Exit;
  end;
  aLayerInfo:=tvLayers.Selected.Data;
  if aLayerInfo.NodeType<>LTN_LAYER then
  begin
    MyDefInformation('请请选择要操作的图层!');
    Exit;
  end;
  aLyr:=MyGIS.GMapTools.m_Layers.FindByName(aLayerInfo.Name);
  SaveDialog1.Filter:='Map Info 图层文件|*.tab';
  if SaveDialog1.Execute then
  begin
    LayerName:=ExtractFileNameNoExt(SaveDialog1.FileName);
    if MyGIS.GMapTools.m_Layers.FindByName(LayerName)<>nil then
    begin
      MyDefInformation('该名称已被引用,请重新命名!');
      Exit;
    end;
    Path:=ExtractFilePath(SaveDialog1.FileName);
    if not DirectoryExists(Path) then ForceDirectories(Path);
    aLyr:=MyGIS.GMapTools.m_Layers.CopyLayer(aLyr, 1, SaveDialog1.FileName,
                 False, 1, True, UNION_FEATURE_ALL);
    AddLayerNode(SysTree, SysTreeRoot, naAddChildFirst,
                 -1, aLyr.Name, SaveDialog1.FileName, False, 2, -1, 3);
  end;
end;

procedure TForm_Main.NCloseClick(Sender: TObject);
begin
  Close;
end;

procedure TForm_Main.NShowEagleEyeClick(Sender: TObject);
var
  Pt:TPoint;
begin
  Pt:=MapXObject1.Parent.ClientToScreen(Classes.Point(20, 10));
  FrmEagleEye.Left:=Pt.x;
  FrmEagleEye.Top:=Pt.y;
  FrmEagleEye.Visible:=not FrmEagleEye.Visible;
end;

procedure TForm_Main.N40Click(Sender: TObject);
var
  aLayerInfo:TLayerTreeNodeRecord;
  aLyr:Layer;
  LayerName:string;
  Path:string;
begin
  if (tvLayers.Selected=nil)or(tvLayers.Selected.Data=nil) then
  begin
    MyDefInformation('请选择要操作的图层!');
    Exit;
  end;
  aLayerInfo:=tvLayers.Selected.Data;
  if aLayerInfo.NodeType<>LTN_LAYER then
  begin
    MyDefInformation('请请选择要操作的图层!');
    Exit;
  end;
  aLyr:=MyGIS.GMapTools.m_Layers.FindByName(aLayerInfo.Name);
  SaveDialog1.Filter:='Map Info 图层文件|*.tab';
  if SaveDialog1.Execute then
  begin
    LayerName:=ExtractFileNameNoExt(SaveDialog1.FileName);
    if MyGIS.GMapTools.m_Layers.FindByName(LayerName)<>nil then
    begin
      MyDefInformation('该名称已被引用,请重新命名!');
      Exit;
    end;
    Path:=ExtractFilePath(SaveDialog1.FileName);
    if not DirectoryExists(Path) then ForceDirectories(Path);
    aLyr:=MyGIS.GMapTools.m_Layers.CopyLayer(aLyr, 1, SaveDialog1.FileName,
                 False, 1, True, UNION_FEATURE_SELECTED);
    AddLayerNode(SysTree, SysTreeRoot, naAddChildFirst,
                 -1, aLyr.Name, SaveDialog1.FileName, False, 2, -1, 3);
  end;
end;

procedure TForm_Main.DoOnFeatureDblClick(Sender: TObject; Ft: Feature);
begin
  MyGIS.DoFeatureDblClick(Sender, Ft);
end;

procedure TForm_Main.DoCanExecute_EditShape(Sender, Trigger: TObject;
  var CanExec: Boolean);
begin
  try
    CheckEditLayer;
    CanExec:=True;
  except
    CanExec:=False;
  end;
end;

procedure TForm_Main.SetRadioCommand(MainObj:TObject);
var
  RadioIndex:Integer;
begin
  RadioIndex:=CmdToolGroups.Items[0].IndexByObject(MainObj);
  if RadioIndex>-1 then
    CmdToolGroups.Items[0].SetRadioIndex(RadioIndex);
end;

procedure TForm_Main.cb_MapsChange(Sender: TObject);
begin
  if cb_Maps.ItemIndex<>-1 then
  begin
    MyGIS.LoadMaps(cb_Maps.ItemIndex);
    //查询窗口加载图层//
    if Frame_Search1<>nil then
    begin
      Frame_Search1.LoadLayers;
      DebugLog.Add('DB500TS-C', ['查询窗口配置完成']);
    end;
  end;
end;

procedure TForm_Main.DoBeforeSelectionDeleted(ASender: TObject;
  ALayer: CMapXLayer);
var
  i:Integer;
  Cancel:Boolean;
begin
  for i:=1 to ALayer.Selection.Count do
    DoBeforeDeleteFeature(ASender, ALayer.Selection.Item[i], ID_ACTION_DELETE, Cancel);
end;

procedure TForm_Main.DoBeforeDeleteFeature(Sender: TObject; Ft: Feature;
  ActionId:Integer; var Cancel:Boolean);
begin
  MyGIS.DoBeforeDelete(Ft, ActionId);
end;

procedure TForm_Main.DoOnFeatureCreate(Sender: TObject; ActionId:Integer;
  Ft: Feature);
begin
  MyGIS.DoFeatureCreate(Ft, ActionId);
end;

procedure TForm_Main.DoOnTurnTool(Sender: TObject);
begin
  SetRadioCommand(TBtnSelectTool);
end;

procedure TForm_Main.ApplayFunctions;
begin
  MyGIS.DoApplayFunctions;
end;

class function TForm_Main.GetModuleID: DWORD;
begin
  Result:=ID_MODULE_MAIN;
end;

procedure TAppModule_Main.ShowViewModule;
begin
end;

procedure TAppModule_Main.UnViewModule;
begin
end;
  
procedure TForm_Main.N3Click(Sender: TObject);
begin
  Form_About.ShowModal;
end;

end.

⌨️ 快捷键说明

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