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

📄 main.~pas

📁 校园GIS系统——介绍校园个部门
💻 ~PAS
📖 第 1 页 / 共 3 页
字号:
unit Main;

interface

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

type
  TMainFrm = class(TForm)
    MainMenu1: TMainMenu;
    F1: TMenuItem;
    V1: TMenuItem;
    L1: TMenuItem;
    Q1: TMenuItem;
    H1: TMenuItem;
    MnOpenShapeFile: TMenuItem;
    MnOpenCADFile: TMenuItem;
    MnOpenEmageFile: TMenuItem;
    MnVLocalMap: TMenuItem;
    MnVTool: TMenuItem;
    MnVPose: TMenuItem;
    MnVAttrabute: TMenuItem;
    ToolBar1: TToolBar;
    StatusBar1: TStatusBar;
    Mainmap: TMap;
    Panel1: TPanel;
    Splitter1: TSplitter;
    SbZoomIn: TSpeedButton;
    SbZoomOut: TSpeedButton;
    SbPan: TSpeedButton;
    SbMeasure: TSpeedButton;
    SbReady: TSpeedButton;
    SbFullExtent: TSpeedButton;
    Localmap: TMap;
    OpenDialog1: TOpenDialog;
    MnLayerMana: TMenuItem;
    MnRenderer: TMenuItem;
    MnLayerSet: TMenuItem;
    MnLabel: TMenuItem;
    PopupMenu1: TPopupMenu;
    PmZoomIn: TMenuItem;
    PmZoomOut: TMenuItem;
    PmPan: TMenuItem;
    N7: TMenuItem;
    PmMeasure: TMenuItem;
    PmReady: TMenuItem;
    N10: TMenuItem;
    PmFulExten: TMenuItem;
    MnSbyExpree: TMenuItem;
    MnSbyDistance: TMenuItem;
    MnSbyShape: TMenuItem;
    SbIdentify: TSpeedButton;
    MnFlashGet: TMenuItem;
    Edit1: TEdit;
    Timer1: TTimer;
    SbFlashGet: TSpeedButton;
    MnEXIT: TMenuItem;
    MnEasyS: TMenuItem;
    MnExportMap: TMenuItem;
    MnHelp: TMenuItem;
    MnAbout: TMenuItem;
    Mnzl: TMenuItem;
    N1: TMenuItem;
    Panel2: TPanel;
    Cbbrelation: TComboBox;
    Cbblayers: TComboBox;
    Label1: TLabel;
    Cbbuse: TComboBox;
    Label2: TLabel;
    SbRec: TSpeedButton;
    Sbpolygon: TSpeedButton;
    SbPoint: TSpeedButton;
    MnSTool: TMenuItem;
    Label3: TLabel;
    tfcMaptreeview1: tfcMaptreeview;
    Splitter2: TSplitter;
    MnSMen: TMenuItem;
    MnOpoint: TMenuItem;
    MnOline: TMenuItem;
    MnOpoygen: TMenuItem;
    procedure Addshape(SshapeFileName:string);
    procedure AddCADFile(sCADFile:string;sFileType:string);
    procedure ShowZl();
    procedure AttrShow();
    procedure DoMaptip();
    procedure MnOpenShapeFileClick(Sender: TObject);
    procedure MnOpenCADFileClick(Sender: TObject);
    procedure MnOpenEmageFileClick(Sender: TObject);
    procedure SbZoomInClick(Sender: TObject);
    procedure MainmapMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure MainmapMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure LocalmapAfterTrackingLayerDraw(Sender: TObject;
      hDC: Cardinal);
    procedure LocalmapMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure LocalmapMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure MainmapAfterLayerDraw(Sender: TObject; index: Smallint;
      canceled: WordBool; hDC: Cardinal);
    procedure LocalmapMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure MnLayerManaClick(Sender: TObject);
    procedure MnRendererClick(Sender: TObject);
    procedure MnLayerSetClick(Sender: TObject);
    procedure MnLabelClick(Sender: TObject);
    procedure PmZoomInClick(Sender: TObject);
    procedure PmFulExtenClick(Sender: TObject);
    procedure MnVLocalMapClick(Sender: TObject);
    procedure MnSbyExpreeClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure MnSbyShapeClick(Sender: TObject);
    procedure MainmapAfterTrackingLayerDraw(Sender: TObject;
      hDC: Cardinal);
    procedure MnEXITClick(Sender: TObject);
    procedure MnSbyDistanceClick(Sender: TObject);
    procedure MnFlashGetClick(Sender: TObject);
    procedure MainmapMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure MnEasySClick(Sender: TObject);
    procedure MnAboutClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure MnHelpClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormActivate(Sender: TObject);
    procedure MnSMenClick(Sender: TObject);
    procedure MnOpointClick(Sender: TObject);
  private
     g_line:ImoLine;
     Pts:imoPoints;{ Private declarations }
     MyRecordSet:ImoRecordSet;
     BaseRecordSet:ImoRecordSet;
     n:string;
  public
    Kaiguang:boolean;

    FindRecord:ImoRecordSet;
    i:integer;
    S,X1,X2,Y1,Y2:double;
  end;

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

uses ViewAttra, layermanage, renderer, LayerSet, Labels, query, Identify,
   Ziliao, EasyQuery, about, Zpicture, Zmedia, SelectFiled, sInfo;

{$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
      begin
        Mainmap.Layers.Add(ThisLayer);
        Localmap.Layers.Add(ThisLayer);
        MainMap.FullExtent;
      end;  
   end;

end;
{*****************************************************************************}

procedure TMainFrm.MnOpenShapeFileClick(Sender: TObject);
var
i:integer;
begin
  Opendialog1.Filter:='ArcGIS File(*.shp)|*.shp';
  Opendialog1.Title:='打开.shp文件 ';
  if Opendialog1.Execute then
    if length(Opendialog1.FileName)>0then
    begin
     for i:=0 to Opendialog1.Files.Count-1 do
     //调用添加SHAPE文件的函数
        Addshape(Opendialog1.files.Strings[i]);
     StatusBar1.Panels[2].Text:='当前图层:  '+IMoMapLayer(mainfrm.mainmap.Layers.Item(0)).Name;
     MnVAttrabute.Enabled:=true;
     L1.Enabled:=true;
     Q1.Enabled:=true;
     tfcMaptreeview1.DrawLegend;
    end;
  MainMap.Refresh;
  if MainMap.Layers.Count>0 then
  begin
    MnVAttrabute.Enabled:=true;
    MnLayerMana.Enabled:=true;
    MnRenderer.Enabled:=true;
    MnLayerSet.Enabled:=true;
    MnLabel.Enabled:=true;
    MnSbyExpree.Enabled:=true;
    MnSbyDistance.Enabled:=true;
    MnSbyShape.Enabled:=true;
    MnFlashGet.Enabled:=true;
    MnEasyS.Enabled:=true;
    MnSMen.Enabled:=true;
  end;

end;
{******************************************************************************}
procedure TMainFrm.ShowZl();
var
i:integer;
ThisTable:ImoTableDesc;
Cpath,TxtPath,PicPath,MediaPath:string;
begin
  TxtPath:='';
  PicPath:='';
  MediaPath:='';
  ZLFrm.Memo1.Clear;
  //ZLFrm.Image1.Picture.CleanupInstance;
  MediaFrm.MediaPlayer1.Close;
  if FindRecord=nil then exit;
    ThisTable:=CoTableDESC.Create;
    ThisTable:=FindRecord.TableDesc;
    Cpath:=ExtractFileDir(application.ExeName);
   for i:=0 to ThisTable.FieldCount-1 do
   begin
     if FindRecord.fields.Item(ThisTable.FieldName[i]).Name ='TEXT' then
       begin
         TxtPath :=FindRecord.fields.Item(ThisTable.FieldName[i]).ValueAsString;
          //showmessage(TxtPath);
       end;
     if FindRecord.fields.Item(ThisTable.FieldName[i]).Name ='PICTURE' then
       begin
         PicPath :=FindRecord.fields.Item(ThisTable.FieldName[i]).ValueAsString;
            //showmessage(PicPath);
         end;
     if FindRecord.fields.Item(ThisTable.FieldName[i]).Name ='MEDIA' then
        begin
          MediaPath :=FindRecord.fields.Item(ThisTable.FieldName[i]).ValueAsString;
            //showmessage(MediaPath);
        end;
     end;

     if TxtPath<>''then
       begin
         ZLFrm.Memo1.Lines.LoadFromFile(Cpath+TxtPath);
         ZLFrm.Show;
         Mnzl.Enabled:=true;
       end
     else
       ZLFrm.Hide;

     if PicPath<>''then
     begin
       PictureFrm.Image1.Picture.LoadFromFile(Cpath+PicPath);
       PictureFrm.show;
     end
     else
       PictureFrm.Hide;
     if MediaPath<>''then
     
       begin
         MediaFrm.MediaPlayer1.FileName:=Cpath+MediaPath;
         // showmessage(Cpath+MediaPath);
         MediaFrm.MediaPlayer1.Open;
         try
           mediaFrm.MediaPlayer1.Play;
           MediaFrm.Show;
         except
          exit;
         end;

      end  
     else
        MediaFrm.Hide;
     //if TxtPath='' and TxtPath='' then exit;
     
     
     


end;

{*****************************************************************************}

procedure TMainFrm.AttrShow();
Var
i,j,k:     integer;
ThisRecord:ImoRecordSet;
begin

  k:=0;
  if MainFrm.FindRecord=nil then
  begin
    Currentlayer:=ImoMaplayer(MainFrm.MainMap.Layers.Item(0));
    ThisRecord:=CurrentLayer.Records;
  end
  else
    ThisRecord := MainFrm.FindRecord;
    ThisRecord.MoveFirst;
    while not ThisRecord.EOF do
    begin
      k:=k+1;
      ThisRecord.MoveNext;
    end;
    ViewAttrFrm.StringGrid1.ColCount:=ThisRecord.TableDesc.FieldCount;
    ViewAttrFrm.StringGrid1.rowCount:=k+1;
    for i:=0 to ThisRecord.TableDesc.FieldCount-1 do
     begin
       ViewAttrFrm.StringGrid1.Cells[i,0] := ThisRecord.fields.Item(ThisRecord.TableDesc.FieldName[i]).Name ;
        j:=1;
        //Showmessage(intTostr(i));
        //添加字段
        // for j:=0 to ThisRecord.Count-1 do
        //StringGrid1.Cells[j,i+1] := ThisRecord.fields.Item(ThisRecord.TableDesc.FieldName[2]).ValueAsString;
        Thisrecord.MoveFirst;
        While not ThisRecord.EOF do
        begin
          ViewAttrFrm.StringGrid1.Cells[i,j] := ThisRecord.fields.Item(ViewAttrFrm.StringGrid1.Cells[i,0]).ValueAsString;
          j:=j+1;

          ThisRecord.MoveNext;
        end;

      
     end;
     ViewAttrFrm.show;;
     //StatusBar2.Panels[0].Text:='共'+ intTostr(StringGrid1.rowCount) +'条记录' ;

end;

{*****************************************************************************}
procedure TMainFrm.DoMaptip();
begin
  MapTps2 := TMapTips2.create;
  MapTps2.Initialize(MainMap,timer1,edit1);
  MapTps2.SetLayer(CurrentLayer,SelectFrm.CbbFields.Text);
end;
{*****************************************************************************}
procedure TMainFrm.MnOpenCADFileClick(Sender: TObject);


begin

end;
{*****************************************************************************}

⌨️ 快捷键说明

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