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

📄 code1.txt

📁 校园GIS系统——介绍校园个部门
💻 TXT
📖 第 1 页 / 共 2 页
字号:
unit Unitmain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Buttons, ExtCtrls, ComCtrls, Menus, OleCtrls, MapObjects2_TLB, ToolWin,
  ImgList, StdCtrls,DragFeedback, Grids;

type
  TMainFrm = class(TForm)
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    OpenShapeFile: TMenuItem;
    OpenCADFile: TMenuItem;
    OpenImageFile: TMenuItem;
    N1: TMenuItem;
    Exit1: TMenuItem;
    N3: TMenuItem;
    Edit1: TMenuItem;
    MenuVLMap: TMenuItem;
    MuneVTool: TMenuItem;
    StatusBar1: TStatusBar;
    ToolBar1: TToolBar;
    MainMap: TMap;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    Splitter1: TSplitter;
    OpenDialog1: TOpenDialog;
    Layers: TMenuItem;
    LayersMn: TMenuItem;
    SbZoomIn: TSpeedButton;
    SbZoomOut: TSpeedButton;
    SbFullExten: TSpeedButton;
    SbPan: TSpeedButton;
    SbMeasure: TSpeedButton;
    OpenCADPoint: TMenuItem;
    N8: TMenuItem;
    N9: TMenuItem;
    GroupBox1: TGroupBox;
    RbAtrCheck: TRadioButton;
    RbSrCheck: TRadioButton;
    BadvanceQuery: TButton;
    BbChaxun: TBitBtn;
    EdtName: TEdit;
    Label1: TLabel;
    GroupBox3: TGroupBox;
    EdtBreaksCount: TEdit;
    CbbFields: TComboBox;
    BtSure: TButton;
    Label2: TLabel;
    Label3: TLabel;
    PanelStaCol: TPanel;
    PanelFinCol: TPanel;
    ColorDialog1: TColorDialog;
    Label4: TLabel;
    Label5: TLabel;
    CbbLayers: TComboBox;
    Label6: TLabel;
    UpDown1: TUpDown;
    SbFree: TSpeedButton;
    PopupMenu1: TPopupMenu;
    PMnZoomIn: TMenuItem;
    PMnZoomOut: TMenuItem;
    PMnZoomPan: TMenuItem;
    PMnFulExten: TMenuItem;
    PMnMeasure: TMenuItem;
    PMnStoop: TMenuItem;
    N14: TMenuItem;
    N15: TMenuItem;
    N16: TMenuItem;
    N17: TMenuItem;
    N2: TMenuItem;
    N18: TMenuItem;
    N19: TMenuItem;
    N20: TMenuItem;
    N21: TMenuItem;
    MenuVSBar: TMenuItem;
    MnASet: TMenuItem;
    LocalMap: TMap;
    StringGrid1: TStringGrid;
    MnAttrbute: TMenuItem;
    MnLable: TMenuItem;
    procedure Addshape(SshapeFileName:string);
    procedure AddCADFile(sCADFile:string;sFileType:string);
    procedure OpenShapeFileClick(Sender: TObject);
    procedure LayersMnClick(Sender: TObject);
    procedure MainMapMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure OpenImageFileClick(Sender: TObject);
    procedure OpenCADPointClick(Sender: TObject);
    procedure SbZoomInClick(Sender: TObject);
    procedure MainMapMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure BadvanceQueryClick(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure MainMapAfterLayerDraw(Sender: TObject; index: Smallint;
      canceled: WordBool; hDC: Cardinal);
    procedure RbAtrCheckClick(Sender: TObject);
    procedure RbSrCheckClick(Sender: TObject);
    procedure BbChaxunClick(Sender: TObject);
    procedure BtSureClick(Sender: TObject);
    procedure PanelStaColClick(Sender: TObject);
    procedure PanelFinColClick(Sender: TObject);
    procedure PageControl1Change(Sender: TObject);
    procedure CbbLayersChange(Sender: TObject);
    procedure LocalMapAfterTrackingLayerDraw(Sender: TObject;
      hDC: Cardinal);
    procedure Exit1Click(Sender: TObject);
    procedure MenuVLMapClick(Sender: TObject);
    procedure MnASetClick(Sender: TObject);
    procedure MnAttrbuteClick(Sender: TObject);
    procedure LocalMapMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure LocalMapMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure LocalMapMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure MnLableClick(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure PMnZoomInClick(Sender: TObject);
  private
    { Private declarations }
  public
    FindRecord:ImoRecordSet;
  end;

var
  MainFrm: TMainFrm;
  Currentlayer:imoMaplayer;
  EventNumber:integer;
  MyDragFeedback :TDragfeedback;
implementation

uses layermanage,  query, PointSet, ViewAttrabute, MapLabel, Renderer;

{$R *.DFM}
procedure TMainFrm.Addshape(SshapeFileName:string);
var
ThisDataConnection:imoDataConnection;
Thislayer:imoMaplayer;
Spath:string;
SshapeFile:string;
begin
//添加SHAPE文件的函数
 ThisDataConnection:=coDataConnection.create;
 ThisLayer:=Comaplayer.Create;
 Spath:=ExtractFileDir(SshapeFileName);
 ThisDataConnection.Database:=Spath;
 SshapeFile:=Copy(SShapeFileName,Length(Spath)+2,Length(SShapeFileName)-Length(Spath)-5);
 if ThisDataConnection.Connect then
    begin
      ThisLayer.GeoDataset:=ThisDataconnection.FindGeoDataset(SshapeFile);
      if ThisLayer.Valid then
        Mainmap.Layers.Add(ThisLayer);
        Localmap.Layers.Add(ThisLayer);
    end;
    //ThisLayer.Symbol.Color:=MoKhaki;

end;


procedure TMainFrm.AddCADFile(sCADFile:string;sFileType:string);
var
SpathName:string;
//SFileName:string;
ThisLayer:imoMaplayer;
ThisDataconnection:imoDataconnection;
begin
  //添加CAD文件的函数
  ThisLayer:=coMaplayer.Create;
  ThisDataconnection:=coDataconnection.create;
  SpathName:=ExtractFileDir(sCADFile);
  Delete(sCADFile,1,length(spathName)+1);
  ThisDataconnection.Database:='['+'CAD'+sFileType+']'+ SpathName;
  if not ThisDataConnection.Connect then exit;
   begin
      ThisLayer.GeoDataset:=ThisDataconnection.FindGeoDataset(sCADFile);
      if ThisLayer.Valid then
        Mainmap.Layers.Add(ThisLayer);
        MainMap.FullExtent;
   end;

end;



procedure TMainFrm.OpenShapeFileClick(Sender: TObject);
var
i:integer;
begin
  Opendialog1.Filter:='ArcGIS File(*.shp)|*.shp';
  Opendialog1.Title:='打开.shp文件 ';
  if Opendialog1.Execute then
     for i:=0 to Opendialog1.Files.Count-1 do
     //调用添加SHAPE文件的函数
        Addshape(Opendialog1.files.Strings[i]);
  //StatusBar1.Panels[2].Text:='当前图层:  '+IMoMapLayer(mainfrm.mainmap.Layers.Item(i)).Name;
  {***********************************************************8}
  MainMap.Refresh;

end;

procedure TMainFrm.OpenImageFileClick(Sender: TObject);
var
ThisLayer:imoImageLayer;
begin
   ThisLayer:=coImagelayer.Create;
   Opendialog1.Title:=' 打开影像文件 ';
   Opendialog1.Filter:='影像文件(*.jpg)|*.jpg|tif|*.tif';
   if Opendialog1.execute then
     

     ThisLayer.File_:=Opendialog1.FileName;
     MainMap.Layers.Add(ThisLayer);
     MainMap.Refresh;
end;

procedure TMainFrm.LayersMnClick(Sender: TObject);
begin
LayerManaFrm.ShowModal;
end;

procedure TMainFrm.OpenCADPointClick(Sender: TObject);
var
i,j:integer;

begin
  Opendialog1.Filter:='CAD(*.dwg)|*.dwg|CAD(*.dxf)|*.dxf';
  Opendialog1.Title:='打开CAD文件 ';
  if Opendialog1.Execute then
     for i:=0 to Opendialog1.Files.Count-1 do
        begin
          //调用添加CAD文件的函数
          AddCADFile(Opendialog1.files.Strings[i],'Line');


        end;
  MainMap.Refresh;

end;

procedure TMainFrm.MainMapMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
ThisPoint:imoPoint;
CurrentX,CurrentY:single;
begin
   ThisPoint:=coPoint.Create;
   ThisPoint:=MainMap.ToMapPoint(X,Y);
    //showmessage(floattostr(ThisPoint.X)+floattostr(ThisPoint.Y));
   CurrentX:=Round(ThisPoint.X)*100/100;
   CurrentY:=Round(ThisPoint.Y)*100/100;
   StatusBar1.Panels[1].Text:='坐标'+ floattostr(CurrentX)
                                +' , '+floattostr(CurrentY);
   //获取地图坐标,并在状态栏显示
end;

procedure TMainFrm.SbZoomInClick(Sender: TObject);
begin
  if Sender is TSpeedButton then
  //控制MainMap的鼠标显示
     case (sender as TSpeedButton).Tag of
     1:
        begin
          MainMap.MousePointer:=MoZoomIn;
          StatusBar1.Panels[0].Text:='当前状态:  '+ '图形放大';
        end;
     2:
        begin
          MainMap.MousePointer:=MoZoomOut;
          StatusBar1.Panels[0].Text:='当前状态:  '+ '图形缩小';
        end;
     3:
        begin
          MainMap.MousePointer:=MoPan;
          StatusBar1.Panels[0].Text:='当前状态:  '+ '图形平移';
        end;

     4:
        ;
     5:
        begin
          MainMap.MousePointer:=MoCross;
          StatusBar1.Panels[0].Text:='当前状态:  '+ '准备';
        end;
        
     6:
        begin

        //地图1:1显示
          MainMap.Extent:=MainMap.FullExtent;
         end;
   end;
end;

procedure TMainFrm.MainMapMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
  var
  rectangle:imorectangle;

begin
   if MainMap.Layers.Count>0 then
   begin
     if SbZoomIn.Down then
       //地图放大
       begin
         MainMap.Extent:=MainMap.TrackRectangle;
       //exit;

        end;


      if SbZoomOut.Down then
      //地图缩小
        begin
          rectangle := mainmap.Extent;
          rectangle.ScaleRectangle(variant(1.5));
          mainmap.Extent := rectangle;
          exit;
        end;
      

⌨️ 快捷键说明

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