📄 code1.txt
字号:
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 + -