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

📄 unitmainform.pas

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

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, OleCtrls, MapXLib_TLB, Grids, yhbGrid, Buttons, DB,
  ADODB, TFlatEditUnit, ComCtrls, Menus, ExtCtrls, dxNavBar, dxNavBarBase,
  dxNavBarCollns, ToolWin, ImgList, MapXContainer, AppCmdCtrl, jpeg, DBTrees,
  VirtualDBEngine, bsSkinData, BusinessSkinForm, MapXDrv, UnitSearch,
  UnitDrawShape, MapXTools, MapXMessages, MapXBase, OleCtnrs, UnitModuleBase;
  
type
  TAppModule_Main = class(TAppFormModule)
  public
    constructor Create;override;
    procedure CreateViewModule(AParent:TWinControl);override;
    procedure ShowViewModule;override;
    procedure UnViewModule;override;
  end;
  
  TForm_Main = class(TForm_Base)
    OpenDialog1: TOpenDialog;
    Button9: TButton;
    Button10: TButton;
    Button11: TButton;
    Button12: TButton;
    MainMenu1: TMainMenu;
    NCustomDraw: TMenuItem;
    NObjectModify: TMenuItem;
    NSymbol: TMenuItem;
    NLine: TMenuItem;
    NPoly: TMenuItem;
    NCircle: TMenuItem;
    NArc: TMenuItem;
    NRect: TMenuItem;
    NEllipse: TMenuItem;
    NText: TMenuItem;
    N9: TMenuItem;
    NLayerConfig: TMenuItem;
    NNewLayer: TMenuItem;
    NLayerOptions: TMenuItem;
    NRemoveLayer: TMenuItem;
    NSelectAll: TMenuItem;
    NCoordSelect: TMenuItem;
    NInvertSelect: TMenuItem;
    NClearSelect: TMenuItem;
    NCustomTools: TMenuItem;
    NZoomIn: TMenuItem;
    NZoomOut: TMenuItem;
    NPan: TMenuItem;
    NClickSelect: TMenuItem;
    NRectSelect: TMenuItem;
    NPolySelect: TMenuItem;
    N37: TMenuItem;
    NRadiusSelect: TMenuItem;
    NWindow: TMenuItem;
    N42: TMenuItem;
    N43: TMenuItem;
    N44: TMenuItem;
    NCopyLayer: TMenuItem;
    NMergeLayer: TMenuItem;
    NCopy: TMenuItem;
    NPaste: TMenuItem;
    NDelete: TMenuItem;
    NClear: TMenuItem;
    pmMapView: TPopupMenu;
    N2: TMenuItem;
    NDistance: TMenuItem;
    NArea: TMenuItem;
    NMerge: TMenuItem;
    NClearLayers: TMenuItem;
    Panel1: TPanel;
    Panel2: TPanel;
    NHelp: TMenuItem;
    NLoadLayer: TMenuItem;
    Splitter1: TSplitter;
    N64: TMenuItem;
    N65: TMenuItem;
    CoolBar1: TCoolBar;
    N69: TMenuItem;
    Splitter3: TSplitter;
    ImageList1: TImageList;
    NPLine: TMenuItem;
    NLabel: TMenuItem;
    NCenter: TMenuItem;
    NGlobalMap: TMenuItem;
    NCut: TMenuItem;
    Panel5: TPanel;
    MapXObject1: TMapXObject;
    NNavigation: TMenuItem;
    NModifyMode: TMenuItem;
    NModeFeature: TMenuItem;
    NModeNode: TMenuItem;
    NModeAddNode: TMenuItem;
    ToolBarDrawMapTool: TToolBar;
    TBtnSelectTool: TToolButton;
    TBtnRadiusSelectTool: TToolButton;
    TBtnRectSelectTool: TToolButton;
    TBtnPolygonSelectTool: TToolButton;
    TBtnClearSelTool: TToolButton;
    TBtnCUSTOM_SYMBOL_TOOL: TToolButton;
    TBtnCUSTOM_LINE_TOOL: TToolButton;
    TBtnCUSTOM_POLYLINE_TOOL: TToolButton;
    TBtnCUSTOM_RECTANGLE_TOOL: TToolButton;
    TBtnCUSTOM_CIRCULARREGION_TOOL: TToolButton;
    TBtnCUSTOM_REGION_TOOL: TToolButton;
    TBtnCUSTOM_TEXT_TOOL: TToolButton;
    TBtnCUSTOM_LABEL_TOOL: TToolButton;
    TBtnLoadGS: TToolButton;
    TBtnUpLoadGST: TToolButton;
    TBtnPackMap: TToolButton;
    TBtnLayerManage: TToolButton;
    TBtnDrawStyleModify: TToolButton;
    ToolBarMapViewTool: TToolBar;
    TBtnmiPanTool: TToolButton;
    TBtnCUSTOM_ZOOMIN_TOOL: TToolButton;
    TBtnCUSTOM_ZOOMOUT_TOOL: TToolButton;
    TBtnmiCenterTool: TToolButton;
    ToolButton1: TToolButton;
    TBtnNavigation: TToolButton;
    TBtnGlobalMap: TToolButton;
    N7: TMenuItem;
    NToolBar: TMenuItem;
    NStatusBar: TMenuItem;
    CoolBar2: TCoolBar;
    ToolBar1: TToolBar;
    N20: TMenuItem;
    NBOperators: TMenuItem;
    N1: TMenuItem;
    NExport: TMenuItem;
    NExportAsImage: TMenuItem;
    N5: TMenuItem;
    NToRegion: TMenuItem;
    NToLine: TMenuItem;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    ImageList2: TImageList;
    ImageList3: TImageList;
    tvLayers: TTreeView;
    pmFeatureClass: TPopupMenu;
    pmLayer: TPopupMenu;
    pmAllLayers: TPopupMenu;
    PNLoadLayer2: TMenuItem;
    PNNewLayer2: TMenuItem;
    PNRemoveLayer: TMenuItem;
    N18: TMenuItem;
    N23: TMenuItem;
    ImageList4: TImageList;
    PNNewLayer1: TMenuItem;
    PNLoadLayer1: TMenuItem;
    N26: TMenuItem;
    N27: TMenuItem;
    FeatureClass1: TMenuItem;
    N28: TMenuItem;
    N30: TMenuItem;
    N29: TMenuItem;
    N31: TMenuItem;
    N32: TMenuItem;
    N33: TMenuItem;
    N34: TMenuItem;
    N35: TMenuItem;
    N36: TMenuItem;
    N38: TMenuItem;
    N39: TMenuItem;
    N40: TMenuItem;
    PNZoomIn: TMenuItem;
    PNZoomOut: TMenuItem;
    PNCenter: TMenuItem;
    N49: TMenuItem;
    PNNavigation: TMenuItem;
    N51: TMenuItem;
    PNViewBeforeMap: TMenuItem;
    PNGlobalMap: TMenuItem;
    PNIniMap: TMenuItem;
    N57: TMenuItem;
    N59: TMenuItem;
    PNPan: TMenuItem;
    N41: TMenuItem;
    N46: TMenuItem;
    PNClearLayers: TMenuItem;
    N16: TMenuItem;
    N17: TMenuItem;
    PNLayerOptions3: TMenuItem;
    NClipWithRect: TMenuItem;
    N25: TMenuItem;
    N55: TMenuItem;
    N15: TMenuItem;
    NClose: TMenuItem;
    SaveDialog1: TSaveDialog;
    N21: TMenuItem;
    NMakeTarget: TMenuItem;
    NClearTarget: TMenuItem;
    N56: TMenuItem;
    N75: TMenuItem;
    NBreakLine: TMenuItem;
    NBreak: TMenuItem;
    est1: TMenuItem;
    TBtnCUSTOM_ELLIPSE_TOOL: TToolButton;
    TBtnCUSTOM_ARC_TOOL: TToolButton;
    PNEditable: TMenuItem;
    N77: TMenuItem;
    NAlign: TMenuItem;
    NAlignLeft: TMenuItem;
    NAlignRight: TMenuItem;
    NAlignTop: TMenuItem;
    NAlignBottom: TMenuItem;
    NAlignVCenter: TMenuItem;
    NAlignHCenter: TMenuItem;
    N85: TMenuItem;
    NAddToProject: TMenuItem;
    PNAddToProject: TMenuItem;
    N89: TMenuItem;
    N11: TMenuItem;
    PNCopyLayer: TMenuItem;
    N12: TMenuItem;
    N14: TMenuItem;
    TBtnShowEagleEye: TToolButton;
    ToolButton4: TToolButton;
    NShowEagleEye: TMenuItem;
    PNShowEagleEye: TMenuItem;
    Panel_Pages: TPanel;
    SBar: TStatusBar;
    Panel3: TPanel;
    pcControl: TPageControl;
    tsData: TTabSheet;
    ScrollBox1: TScrollBox;
    tsMessage: TTabSheet;
    RichEdit_UserMsg: TRichEdit;
    tsSearch: TTabSheet;
    ScrollBox2: TScrollBox;
    Frame_Search1: TFrame_Search;
    tsDraw: TTabSheet;
    ScrollBox3: TScrollBox;
    Frame_DrawShape1: TFrame_DrawShape;
    ToolBar2: TToolBar;
    TBtnCopy: TToolButton;
    TBtnCut: TToolButton;
    TBtnPaste: TToolButton;
    TBtnMerge: TToolButton;
    TBtnBreak: TToolButton;
    TBtnAlignLeft: TToolButton;
    ToolButton11: TToolButton;
    ToolButton13: TToolButton;
    TBtnAlignRight: TToolButton;
    TBtnAlignTop: TToolButton;
    TBtnAlignBottom: TToolButton;
    TBtnAlignVCenter: TToolButton;
    TBtnAlignHCenter: TToolButton;
    ToolButton2: TToolButton;
    TBtnToLine: TToolButton;
    TBtnToRegon: TToolButton;
    ToolButton3: TToolButton;
    TBtnBreakLine: TToolButton;
    TBtnClipWithRect: TToolButton;
    Panel6: TPanel;
    cb_Maps: TComboBox;
    ToolButton7: TToolButton;
    ToolBar3: TToolBar;
    ToolButton8: TToolButton;
    N3: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure MapXObject1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure MapXObject1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure MapXObject1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure MapXObject1ToolUsed(ASender: TObject; ToolNum: Smallint; X1,
      Y1, X2, Y2, Distance: Double; Shift, Ctrl: WordBool;
      var EnableDefault: WordBool);
    procedure MapXObject1DblClick(Sender: TObject);
    procedure NZoomInClick(Sender: TObject);
    procedure NZoomOutClick(Sender: TObject);
    procedure NPanClick(Sender: TObject);
    procedure NClickSelectClick(Sender: TObject);
    procedure NRectSelectClick(Sender: TObject);
    procedure NPolySelectClick(Sender: TObject);
    procedure NRadiusSelectClick(Sender: TObject);
    procedure NSymbolClick(Sender: TObject);
    procedure NTextClick(Sender: TObject);
    procedure NRectClick(Sender: TObject);
    procedure NDistanceClick(Sender: TObject);
    procedure NLoadLayerClick(Sender: TObject);
    procedure NClearLayersClick(Sender: TObject);
    procedure NMergeClick(Sender: TObject);
    procedure NLineClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure MapXObject1MapViewChanged(Sender: TObject);
    procedure NCenterClick(Sender: TObject);
    procedure NPolyClick(Sender: TObject);
    procedure NModeFeatureClick(Sender: TObject);
    procedure NModeNodeClick(Sender: TObject);
    procedure NModeAddNodeClick(Sender: TObject);
    procedure NSelectAllClick(Sender: TObject);
    procedure NClearSelectClick(Sender: TObject);
    procedure MapXObject1SelectionChanged(Sender: TObject);
    procedure NPLineClick(Sender: TObject);
    procedure NCircleClick(Sender: TObject);
    procedure NLabelClick(Sender: TObject);
    procedure NToolBarClick(Sender: TObject);
    procedure NStatusBarClick(Sender: TObject);
    procedure NGlobalMapClick(Sender: TObject);
    procedure NNavigationClick(Sender: TObject);
    procedure NInvertSelectClick(Sender: TObject);
    procedure NDeleteClick(Sender: TObject);
    procedure NClearClick(Sender: TObject);
    procedure NArcClick(Sender: TObject);
    procedure MapXObject1DrawUserLayer(ASender: TObject;
      const Layer: IDispatch; hOutputDC, hAttributeDC: Cardinal;
      const RectFull, RectInvalid: IDispatch);
    procedure NExportAsImageClick(Sender: TObject);
    procedure tvLayersKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure tvLayersMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure tvLayersContextPopup(Sender: TObject; MousePos: TPoint;
      var Handled: Boolean);
    procedure tvLayersChange(Sender: TObject; Node: TTreeNode);
    procedure NNewLayerClick(Sender: TObject);
    procedure NRemoveLayerClick(Sender: TObject);
    procedure NLayerOptionsClick(Sender: TObject);
    procedure NToRegionClick(Sender: TObject);
    procedure NToLineClick(Sender: TObject);
    procedure NClipWithRectClick(Sender: TObject);
    procedure NMakeTargetClick(Sender: TObject);
    procedure NClearTargetClick(Sender: TObject);
    procedure NPasteClick(Sender: TObject);
    procedure NCopyClick(Sender: TObject);
    procedure NCutClick(Sender: TObject);
    procedure N65Click(Sender: TObject);
    procedure N31Click(Sender: TObject);
    procedure N23Click(Sender: TObject);
    procedure N32Click(Sender: TObject);
    procedure N38Click(Sender: TObject);
    procedure N35Click(Sender: TObject);
    procedure NBreakLineClick(Sender: TObject);
    procedure NBreakClick(Sender: TObject);
    procedure NEllipseClick(Sender: TObject);
    procedure N42Click(Sender: TObject);
    procedure MapXObject1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure N36Click(Sender: TObject);
    procedure PNEditableClick(Sender: TObject);
    procedure NAlignLeftClick(Sender: TObject);
    procedure NAlignRightClick(Sender: TObject);
    procedure NAlignTopClick(Sender: TObject);
    procedure NAlignBottomClick(Sender: TObject);
    procedure NAlignVCenterClick(Sender: TObject);
    procedure NAlignHCenterClick(Sender: TObject);
    procedure N59Click(Sender: TObject);
    procedure tvLayersDragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure tvLayersDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure NAddToProjectClick(Sender: TObject);
    procedure NCopyLayerClick(Sender: TObject);
    procedure NCloseClick(Sender: TObject);
    procedure NShowEagleEyeClick(Sender: TObject);
    procedure N40Click(Sender: TObject);
    procedure cb_MapsChange(Sender: TObject);
    procedure N3Click(Sender: TObject);
  private
    { Private declarations }
    SourceFts:Features;
    PointSelectTool:TPointSelectTool;
    {注册应用程序命令关系}
    procedure RegisterCmdCtrlItems;
    {取得选择图层数量}
    function GetSelectionLayerCount:Integer;
    {重建数据网格}
    procedure RefreshSelectionRecords;
    {地图工具触发事件}
    procedure WMMapToolsEvent(var Message:TMessage);message WM_MAPTOOLSEVENT;
    procedure WMEndTracking(var Message:TMessage);message WM_ENDTRACKING;
    {导航窗口触发导航事件}
    procedure DoOnNavigate(Sender:TObject; Direction:Integer);
    {图层树节点选择状态发生变化}
    procedure DoOnNodeStateChanged(Sender:TObject; aNode:TTreeNode);
    {检查是否可以执行创建图形的命令}
    procedure DoCanExecute_CreateShape(Sender, Trigger:TObject; var CanExec:Boolean);
    {检查是否可以执行编辑图形的命令}
    procedure DoCanExecute_EditShape(Sender, Trigger:TObject; var CanExec:Boolean);
    {设置完当前工具后触发事件}
    procedure DoAfterSetCurrentTool(Sender:TObject; AToolObj:TBaseMapTool);
    {双击事件}
    procedure DoOnFeatureDblClick(Sender:TObject; Ft:Feature);
    {图形被删除前}
    procedure DoBeforeDeleteFeature(Sender:TObject; Ft:Feature; ActionId:Integer;
      var Cancel:Boolean);
    {图形被创建后}
    procedure DoOnFeatureCreate(Sender:TObject; ActionId:Integer; Ft:Feature);
    {选择图形被删除前}
    procedure DoBeforeSelectionDeleted(ASender:TObject; ALayer:CMapXLayer);
    {工具结束返回到某一默认工具时}
    procedure DoOnTurnTool(Sender:TObject);
  protected
    procedure ApplayFunctions;override;
  public
    CmdToolGroups:TCmdCtrlGroupList;
    class function GetModuleID:DWORD;override;
    procedure InitEyeForm;
    {清除用户图层组的项目}
    procedure RemoveUserLayers;
    {清除指定图层}
    procedure RemoveuserLayer(const Index:Integer);
    procedure MoveLayer(const FromIndex, ToIndex:Integer);
    procedure SetLayerVisible(const Index:Integer; const Visible:Boolean);
    procedure SetLayerEditable(const Index:Integer; const Editable:Boolean);
    procedure SetLayerSelectable(const Index:Integer; const Selectable:Boolean);
    procedure SetLayerAutoLabel(const Index:Integer; const AutoLabel:Boolean);
    procedure SetRadioCommand(MainObj:TObject);
  end;

implementation

uses ComObj, ActiveX, WinControl, WinFileSystem, AppDebug, mis_Instance,
  MapXAPIs, MapXAdvance, MapXStyles, MapXConsts, UnitProjectOptions,
  UnitNavigation, UnitSaveAs, BusinessDialogs, UnitLayerControl,
  UnitLayerInfo, UnitRecords, UnitEagleEye, UnitGISShell, UnitShellAPIs,
  UnitAppTypes, UnitAppConsts, UnitAboutForm;
  
{$R *.dfm}

{ TAppModule_Main }

constructor TAppModule_Main.Create;
begin
  inherited Create;
  ModuleID:=ID_MODULE_MAIN;
  ModuleName:='系统主模块';
  ModuleClass:=TForm_Main;
end;

procedure TAppModule_Main.CreateViewModule(AParent: TWinControl);
begin
end;

procedure TForm_Main.FormCreate(Sender: TObject);
begin
  //-------------------------------------------------------------------------//
  AppMsgHandle:=Self.Handle;
  SysTree:=tvLayers;
  //-------------------------------------------------------------------------//
  //加载地图工具设置//
  MyGIS:=CreateAppProject(Self, MapXObject1);
  with MyGIS do
  begin
    OnTurnTool:=DoOnTurnTool;
    GMapTools.m_Map.SysTools.AfterSetCurrentTool:=DoAfterSetCurrentTool;
    GMapTools.m_Map.UserTools.AfterSetCurrentTool:=DoAfterSetCurrentTool;
  end;
  //-------------------------------------------------------------------------//
  //加载应用程序命令框架设置//
  CmdToolGroups:=TCmdCtrlGroupList.Create;
  RegisterCmdCtrlItems;
  CmdToolGroups.Items[0].SetRadioIndex(NPan);
  //-------------------------------------------------------------------------//
  if Frame_Search1<>nil then
    Frame_Search1.MapX:=MyGIS.GMapTools.MapX;
  if Frame_DrawShape1<>nil then
    Frame_DrawShape1.SelectionChanged;
  //-------------------------------------------------------------------------//
end;

procedure TForm_Main.FormDestroy(Sender: TObject);
begin
  CmdToolGroups.Free; CmdToolGroups:=nil;
  MyGIS.Free; MyGIS:=nil;
  ClearLayerTreeInfo(tvLayers);
end;

procedure TForm_Main.MapXObject1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  MyGIS.GMapTools.m_Map.DoMouseDown(Sender, Button, Shift, X, Y);
end;

procedure TForm_Main.MapXObject1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  MyGIS.GMapTools.m_Map.DoMouseUp(Sender, Button, Shift, X, Y);
end;

procedure TForm_Main.MapXObject1MouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
var
  m_x, m_y:Double;

⌨️ 快捷键说明

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