📄 main.~pas
字号:
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 + -