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

📄 unitmain.pas

📁 在delphi下基于MapX5.0的GIS程序
💻 PAS
📖 第 1 页 / 共 2 页
字号:
unit UnitMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, OleCtrls, MapXLib_TLB, StdCtrls, ExtCtrls, ComCtrls, ComObj,
  ToolWin, ImgList, Buttons, Registry, DB, Mask, IdGlobal, ShellAPI;

const
  IDI_TRAYICON=WM_USER + 10;
  TRAY_CALLBACK=WM_USER + 20;

type
  TFrmMain = class(TForm)
    MainMenu1: TMainMenu;
    NSystemManage: TMenuItem;
    NMapControl: TMenuItem;
    NmiPanTool: TMenuItem;
    NCUSTOM_ZOOMIN_TOOL: TMenuItem;
    NCUSTOM_ZOOMOUT_TOOL: TMenuItem;
    NCUSTOM_SYMBOL_TOOL: TMenuItem;
    NCUSTOM_TEXT_TOOL: TMenuItem;
    NmiSelectTool: TMenuItem;
    NmiRadiusSelectTool: TMenuItem;
    NmiRectSelectTool: TMenuItem;
    NmiPolygonSelectTool: TMenuItem;
    NCUSTOM_LINE_TOOL: TMenuItem;
    NCUSTOM_POLYLINE_TOOL: TMenuItem;
    NCUSTOM_REGION_TOOL: TMenuItem;
    SBar: TStatusBar;
    PanelBack: TPanel;
    NUserManage: TMenuItem;
    NDataBaseManage: TMenuItem;
    NClientManage: TMenuItem;
    NRecordManage: TMenuItem;
    NReEnter: TMenuItem;
    NExit: TMenuItem;
    NModifyWindows: TMenuItem;
    NCSCommunicate: TMenuItem;
    NView: TMenuItem;
    NToolBar: TMenuItem;
    NSearchWindows: TMenuItem;
    NStatusBar: TMenuItem;
    NHelp: TMenuItem;
    NMainHelp: TMenuItem;
    NAboutSystem: TMenuItem;
    NAboutAuthor: TMenuItem;
    PanelClient: TPanel;
    Map1: TMap;
    ImageList1: TImageList;
    NMapViewTool: TMenuItem;
    NIniMap: TMenuItem;
    NDrawMapTool: TMenuItem;
    NLayerManage: TMenuItem;
    NLoadGST: TMenuItem;
    NSelectMapTool: TMenuItem;
    NRemoveFeature: TMenuItem;
    NViewBeforeMap: TMenuItem;
    N2: TMenuItem;
    NEagleEye: TMenuItem;
    NUpLoadGST: TMenuItem;
    NCUSTOM_CIRCULARREGION_TOOL: TMenuItem;
    NmiCenterTool: TMenuItem;
    NNavigation: TMenuItem;
    N3: TMenuItem;
    NCombineFeature: TMenuItem;
    NCUSTOM_RECTANGLE_TOOL: TMenuItem;
    CoolBar1: TCoolBar;
    ToolBarMapViewTool: TToolBar;
    TBtnmiPanTool: TToolButton;
    TBtnCUSTOM_ZOOMIN_TOOL: TToolButton;
    TBtnCUSTOM_ZOOMOUT_TOOL: TToolButton;
    TBtnmiCenterTool: TToolButton;
    ToolButton1: TToolButton;
    TBtnEagleEye: TToolButton;
    TBtnNavigation: TToolButton;
    TBtnViewBeforeMap: TToolButton;
    TBtnIniMap: TToolButton;
    ToolBarDrawMapTool: TToolBar;
    TBtnCUSTOM_SYMBOL_TOOL: TToolButton;
    TBtnCUSTOM_TEXT_TOOL: TToolButton;
    TBtnCUSTOM_LINE_TOOL: TToolButton;
    TBtnCUSTOM_POLYLINE_TOOL: TToolButton;
    TBtnCUSTOM_RECTANGLE_TOOL: TToolButton;
    TBtnCUSTOM_CIRCULARREGION_TOOL: TToolButton;
    TBtnCUSTOM_REGION_TOOL: TToolButton;
    TBtnRemoveFeature: TToolButton;
    TBtnCombineFeature: TToolButton;
    ToolButton12: TToolButton;
    NmiClearSelTool: TMenuItem;
    NDrawStyleModify: TMenuItem;
    TBtnmiSelectTool: TToolButton;
    TBtnmiRadiusSelectTool: TToolButton;
    TBtnmiRectSelectTool: TToolButton;
    TBtnmiPolygonSelectTool: TToolButton;
    BtnClearSelTool: TToolButton;
    ToolButton4: TToolButton;
    TBtnLayerManage: TToolButton;
    ToolButton2: TToolButton;
    TimerModifyMoveText: TTimer;
    TBtnCUSTOM_LABEL_TOOL: TToolButton;
    NCUSTOM_LABEL_TOOL: TMenuItem;
    NPackMap: TMenuItem;
    NInfoManage: TMenuItem;
    PMenuRight: TPopupMenu;
    PNmiPanTool: TMenuItem;
    PNCUSTOM_ZOOMIN_TOOL: TMenuItem;
    PNCUSTOM_ZOOMOUT_TOOL: TMenuItem;
    PNmiCenterTool: TMenuItem;
    N8: TMenuItem;
    PNEagleEye: TMenuItem;
    PNNavigation: TMenuItem;
    PNViewBeforeMap: TMenuItem;
    PNAllMap: TMenuItem;
    PNIniMap: TMenuItem;
    N14: TMenuItem;
    N15: TMenuItem;
    NAllMap: TMenuItem;
    TBtnAllMap: TToolButton;
    PMenuIcon: TPopupMenu;
    PNExit: TMenuItem;
    Timer: TTimer;
    N11: TMenuItem;
    NMapTool: TMenuItem;
    N21: TMenuItem;
    TBtnLoadGS: TToolButton;
    TBtnUpLoadGST: TToolButton;
    TBtnPackMap: TToolButton;
    ToolButton5: TToolButton;
    TBtnDrawStyleModify: TToolButton;
    procedure NLayerManageClick(Sender: TObject);
    procedure NLoadGSTClick(Sender: TObject);
    procedure Map1PolyToolUsed(Sender: TObject; ToolNum: Smallint;
      Flags: Integer; const Points: IDispatch; bShift, bCtrl: WordBool;
      var EnableDefault: WordBool);
    procedure Map1ToolUsed(Sender: TObject; ToolNum: Smallint; X1, Y1, X2,
      Y2, Distance: Double; Shift, Ctrl: WordBool;
      var EnableDefault: WordBool);
    procedure NRemoveFeatureClick(Sender: TObject);
    procedure Map1MapViewChanged(Sender: TObject);
    procedure NViewBeforeMapClick(Sender: TObject);
    procedure NIniMapClick(Sender: TObject);
    procedure NUpLoadGSTClick(Sender: TObject);
    procedure NSearchWindowsClick(Sender: TObject);
    procedure NmiPanToolClick(Sender: TObject);
    procedure NCUSTOM_ZOOMIN_TOOLClick(Sender: TObject);
    procedure NCUSTOM_ZOOMOUT_TOOLClick(Sender: TObject);
    procedure NmiCenterToolClick(Sender: TObject);
    procedure NEagleEyeClick(Sender: TObject);
    procedure NNavigationClick(Sender: TObject);
    procedure NCombineFeatureClick(Sender: TObject);
    procedure NCUSTOM_SYMBOL_TOOLClick(Sender: TObject);
    procedure NCUSTOM_TEXT_TOOLClick(Sender: TObject);
    procedure NCUSTOM_LINE_TOOLClick(Sender: TObject);
    procedure NCUSTOM_POLYLINE_TOOLClick(Sender: TObject);
    procedure NCUSTOM_RECTANGLE_TOOLClick(Sender: TObject);
    procedure NCUSTOM_CIRCULARREGION_TOOLClick(Sender: TObject);
    procedure NCUSTOM_REGION_TOOLClick(Sender: TObject);
    procedure NmiSelectToolClick(Sender: TObject);
    procedure NmiRadiusSelectToolClick(Sender: TObject);
    procedure NmiRectSelectToolClick(Sender: TObject);
    procedure NmiPolygonSelectToolClick(Sender: TObject);
    procedure NmiClearSelToolClick(Sender: TObject);
    procedure NDrawStyleModifyClick(Sender: TObject);
    procedure Map1DblClick(Sender: TObject);
    procedure NModifyWindowsClick(Sender: TObject);
    procedure Map1Click(Sender: TObject);
    procedure TimerModifyMoveTextTimer(Sender: TObject);
    procedure Map1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Map1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure NCUSTOM_LABEL_TOOLClick(Sender: TObject);
    procedure Map1SelectionChanged(Sender: TObject);
    procedure NPackMapClick(Sender: TObject);
    procedure Map1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Map1KeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure NAboutSystemClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure NAllMapClick(Sender: TObject);
    procedure PNExitClick(Sender: TObject);
    procedure AppException(Sender: TObject; E: Exception);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure TrayCallBack(var Msg:TMessage); message TRAY_CALLBACK;
    procedure NReEnterClick(Sender: TObject);
    procedure TimerTimer(Sender: TObject);
    procedure NClientManageClick(Sender: TObject);
    procedure NRecordManageClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure NExitClick(Sender: TObject);
    procedure NToolBarClick(Sender: TObject);
    procedure NStatusBarClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FrmMain: TFrmMain;

implementation

uses UnitLayerControl, UnitCompanys, UnitLabelInfo, UnitCommonModule,
  UnitSearch, UnitNavigation, UnitDrawStyleModify, UnitModify,
  UnitDataModule, UnitComInfo, UnitComWay, UnitAbout, UnitSplash, UnitEagleEye, UnitLogin,
  UnitClientManage, UnitRecordManage;

{$R *.dfm}

procedure TFrmMain.NLayerManageClick(Sender: TObject);
begin
  if FrmLayerControl = Nil then
    Application.CreateForm(TFrmLayerControl, FrmLayerControl);
  FrmLayerControl.ShowModal;
end;

procedure TFrmMain.NLoadGSTClick(Sender: TObject);
begin
// Load Map1 GeoSet
  LoadMapSetIniMap();
end;

procedure TFrmMain.Map1PolyToolUsed(Sender: TObject; ToolNum: Smallint;
  Flags: Integer; const Points: IDispatch; bShift, bCtrl: WordBool;
  var EnableDefault: WordBool);
begin
  If  Not (EditLayer.Type_ = miLayerTypeUserDraw) Then
  If Flags = miPolyToolBegin Then
  //Someone's beginning the use of a PolyTool...
  Else           
  If Flags = miPolyToolEnd Then
  begin
    // 添加随机的数据信息
    AddRandomData();
    Case ToolNum of
      CUSTOM_REGION_TOOL :
      begin
        newObj := Map1.FeatureFactory.CreateRegion(Points, Map1.DefaultStyle);
      end;
      CUSTOM_POLYLINE_TOOL :
      begin
        newObj := Map1.FeatureFactory.CreateLine(Points, Map1.DefaultStyle);
      end;
    end;
    EditLayer.AddFeature(newobj, RowVals);
  end
  Else If Flags = miPolyToolEndEscaped then
  begin
  // The users hit 'Esc' or backspaced all the nodes
  // away... don't add anything in.
  end;
end;

procedure TFrmMain.Map1ToolUsed(Sender: TObject; ToolNum: Smallint; X1, Y1,
  X2, Y2, Distance: Double; Shift, Ctrl: WordBool;
  var EnableDefault: WordBool);
var
  pts: Variant;    // Used for storing collection of points
  temZoom: Double;
begin
  infFormViewType := NEW_FEATURE;
  Pt := CreateOleObject('MapX.Point.5');
  Pt.Set(X1, Y1);
  Case ToolNum of
    CUSTOM_ZOOMIN_TOOL :
    begin
      if (X1 = X2) or (Y1 = Y2) then
      begin
        if (Map1.Zoom/1.8 > MINZOOM) then Map1.ZoomTo(Map1.Zoom/1.8, X1, Y1)
          else Map1.ZoomTo(MINZOOM, X1, Y1)
      end else
      begin
        if Map1.Width/Abs(X2 - X1) > Map1.Height/Abs(Y2 - Y1)
          then temZoom := Map1.Bounds.Height/Abs(Y2 - Y1)
          else temZoom := Map1.Bounds.Width/Abs(X2 - X1);
        if (Map1.Zoom/temZoom > MINZOOM)
          then Map1.ZoomTo(Map1.Zoom/temZoom, (X1+X2)/2, (Y1+Y2)/2)
          else Map1.ZoomTo(MINZOOM, (X1+X2)/2, (Y1+Y2)/2)
      end;
      SetViewLayer();
    end;
    CUSTOM_ZOOMOUT_TOOL :
    begin
      if (X1 = X2) or (Y1 = Y2) then
      begin
        if (Map1.Zoom*1.8 < MAXZOOM) then Map1.ZoomTo(Map1.Zoom*1.8, X1, Y1)
          else Map1.ZoomTo(MAXZOOM, X1, Y1)
      end else
      begin
        if Map1.Width/Abs(X2 - X1) > Map1.Height/Abs(Y2 - Y1)
          then temZoom := Map1.Bounds.Height/Abs(Y2 - Y1)
          else temZoom := Map1.Bounds.Width/Abs(X2 - X1);
        if (Map1.Zoom*temZoom < MAXZOOM)
          then Map1.ZoomTo(Map1.Zoom*temZoom, (X1+X2)/2, (Y1+Y2)/2)
          else Map1.ZoomTo(MAXZOOM, (X1+X2)/2, (Y1+Y2)/2)
      end;
      SetViewLayer();
    end;
    CUSTOM_SYMBOL_TOOL :
    begin
      newObj := Map1.FeatureFactory.CreateSymbol(Pt, Map1.DefaultStyle);
      EditLayer.AddFeature(newObj, Empty);
      Ftrs := EditLayer.SearchAtPoint(Pt, 0);
      if Ftrs.Count = 1 Then
      begin
        infoFeature := Ftrs.Item[1];
        if FrmModify.CBoxEditLayerName.Text = '企事业' then FrmCompanysInfo.ShowModal;
        if FrmModify.CBoxEditLayerName.Text = '公交站点' then FrmComInfo.ShowModal;
      end;
    end;
    CUSTOM_LINE_TOOL :
    begin
      if Not((X1 = X2) and (Y1 = Y2)) then
      begin
        pts := CreateOleObject('MapX.Points.5');
        pts.AddXY(X1, Y1);
        pts.AddXY(X2, Y2);
        // 添加随机的数据信息
        AddRandomData();
        // 添加图元
        newObj := Map1.FeatureFactory.CreateLine(pts, Map1.DefaultStyle);
        EditLayer.AddFeature(newObj, RowVals);
        VarClear(pts);
      end;
    end;
    CUSTOM_CIRCULARREGION_TOOL :
    begin
      // 添加随机的数据信息
      AddRandomData();
      newObj := Map1.FeatureFactory.CreateCircularRegion(miCircleTypeMap, Pt, Distance, miUnitMile, Empty, Map1.DefaultStyle);
      EditLayer.AddFeature(newObj, RowVals);
    end;
    CUSTOM_RECTANGLE_TOOL :
    begin
      pts := CreateOleObject('MapX.Points.5');
      pts.AddXy(X1, Y1);      pts.AddXy(X2, Y1);
      pts.AddXy(X2, Y2);      pts.AddXy(X1, Y2);
      // 添加随机的数据信息
      AddRandomData();
      newObj := Map1.FeatureFactory.CreateRegion(Pts, Map1.DefaultStyle);
      EditLayer.AddFeature(newobj, RowVals);
      VarClear(pts);
    end;
    CUSTOM_TEXT_TOOL :
    begin
      FrmLabelInfo.ShowModal;
    end;
    CUSTOM_LABEL_TOOL :
    begin
      LabelToolUsed();
    end;
    miSelectTool, miRadiusSelectTool,
    miRectSelectTool, miPolygonSelectTool :
    begin
      if (Ctrl) then
        EditLayer.Selection.SelectByPoint(X1, Y1, miSelectionAppend, Empty)
      else if (Shift) then
        EditLayer.Selection.SelectByPoint(X1, Y1, miSelectionRemove, Empty)
      else
        EditLayer.Selection.SelectByPoint(X1, Y1, miSelectionNew, Empty);
    end;
    CUSTOM_INFO_TOOL :
    begin
      Ftrs := EditLayer.SearchAtPoint(Pt, 0);
      if Ftrs.Count = 1 Then
      begin
        infFormViewType := SEARCH_FEATURE;
        infoFeature := Ftrs.Item[1];
        // 根据类型选择窗体了
      end;
    end;
  end;
  // 释放Pt
  Varclear(Pt);
end;

procedure TFrmMain.NRemoveFeatureClick(Sender: TObject);
var
  i: Integer;
begin
  if EditLayer.Selection.Count > 0 then
  if Application.MessageBox('确实要删除吗?', '提示', MB_YESNO) = IDYES	then
  begin
    try
      // 删除图元及对应的数据  标记图元及数据
      for i := 1 to EditLayer.Selection.Count do
      begin
        DeleteNumI := i;
        EditLayer.KeyField := 'ID';
        DeleteFeatureLabelData(EditLayer.Selection.Item[i].KeyValue);
      end;
      EditLayer.Selection.ClearSelection;
    Except on E:Exception do ShowMessage(E.message);
    end;
  end else EditLayer.Selection.ClearSelection;
end;

procedure TFrmMain.Map1MapViewChanged(Sender: TObject);
begin
  SetMapViewChanged();
end;

procedure TFrmMain.NViewBeforeMapClick(Sender: TObject);
begin
  Map1.ZoomTo(PrevMapZoom, PrevMapZoomPosX, PrevMapZoomPosY);
  SetViewLayer();
end;

procedure TFrmMain.NIniMapClick(Sender: TObject);
begin
  Map1.ZoomTo(IniMapZoom, IniMapZoomPosX, IniMapZoomPosY);
  SetViewLayer();
end;

procedure TFrmMain.NUpLoadGSTClick(Sender: TObject);
begin
  if Map1.Layers.Count=0 then ShowMessage('地图至少需要一个图层,请添加图层!')
  else Map1.SaveMapAsGeoset('JLU-MAP', ExeFilePath+'Maps\JLU-MAP.GST');
  UpLoadMap();
end;

procedure TFrmMain.NSearchWindowsClick(Sender: TObject);
begin
  FrmSearch.Show;
end;   

procedure TFrmMain.NmiPanToolClick(Sender: TObject);
begin
  Map1.CurrentTool := miPanTool;
  Set_MenuCheck_BtnDown(NmiPanTool, TBtnmiPanTool);
end;

procedure TFrmMain.NCUSTOM_ZOOMIN_TOOLClick(Sender: TObject);
begin
  Map1.CurrentTool := CUSTOM_ZOOMIN_TOOL;
  Set_MenuCheck_BtnDown(NCUSTOM_ZOOMIN_TOOL, TBtnCUSTOM_ZOOMIN_TOOL);
end;

procedure TFrmMain.NCUSTOM_ZOOMOUT_TOOLClick(Sender: TObject);
begin
  Map1.CurrentTool := CUSTOM_ZOOMOUT_TOOL;
  Set_MenuCheck_BtnDown(NCUSTOM_ZOOMOUT_TOOL, TBtnCUSTOM_ZOOMOUT_TOOL);
end;

procedure TFrmMain.NmiCenterToolClick(Sender: TObject);
begin
  Map1.CurrentTool := miCenterTool;
  Set_MenuCheck_BtnDown(NmiCenterTool, TBtnmiCenterTool);
end;

procedure TFrmMain.NEagleEyeClick(Sender: TObject);
begin
  NEagleEye.Checked := Not NEagleEye.Checked;
  PNEagleEye.Checked := NEagleEye.Checked;
  TBtnEagleEye.Down := NEagleEye.Checked;
  FrmEagleEye.Visible := NEagleEye.Checked;
end;

procedure TFrmMain.NNavigationClick(Sender: TObject);
begin
  NNavigation.Checked := Not NNavigation.Checked;
  PNNavigation.Checked := NNavigation.Checked;
  TBtnNavigation.Down := NNavigation.Checked;
  FrmNavigation.Visible := NNavigation.Checked;
end;

procedure TFrmMain.NCombineFeatureClick(Sender: TObject);
Var
   selItems : Variant;
   newFeature, Style: Variant;
   i: Integer;

⌨️ 快捷键说明

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