📄 main.~pas
字号:
SbZoomOut.Down:=true ;
end;
3:
begin
SbPan.Click;
SbPan.Down:=true;
end;
4:
begin
SbMeasure.Click;
SbMeasure.Down:=true;
end;
5:
begin
SbReady.Click;
SbReady.Down:=True;
end;
6:
begin
SbFullExtent.Click;
end;
end;
end;
end;
{*****************************************************************************}
procedure TMainFrm.PmFulExtenClick(Sender: TObject);
begin
//地图1:1显示
MainMap.Extent:=MainMap.FullExtent;
end;
procedure TMainFrm.MnVLocalMapClick(Sender: TObject);
begin
if sender is TMenuItem then
begin
case(sender as TMenuItem).Tag of
1:
begin
if MnVLocalMap.Checked=false then
MnVLocalMap.Checked:=true
else
MnVLocalMap.Checked:=false;
Localmap.Visible:=MnVLocalMap.Checked;
end;
2:
begin
if MnVTool.Checked=false then
MnVTool.Checked:=true
else
MnVTool.Checked:=false;
ToolBar1.Visible:=MnVTool.Checked ;
end;
3:
begin
if MnVPose.Checked=false then
MnVPose.Checked:=true
else
MnVPose.Checked:=false;
StatusBar1.Visible:=MnVPose.Checked;
end;
4:
begin
if MnSTool.Checked=false then
MnSTool.Checked:=true
else
MnSTool.Checked:=false;
panel2.Visible:=MnSTool.Checked;
kaiguang:=false;
end;
5:
begin
if MnVAttrabute.Checked=false then
begin
MnVAttrabute.Checked:=true;
if MainMap.Layers.Count > 0 then
mainFrm.AttrShow
else
Application.MessageBox('请添加图层', '提示', MB_OK);
end
else
begin
MnVAttrabute.Checked:=false;
ViewAttrFrm.Close;
end;
end;
6:
begin
if Mnzl.Checked=false then
begin
Mnzl.Checked:=true ;
//ShowZl();
end
else
begin
Mnzl.Checked:=false;
ZLFrm.Close;
MediaFrm.MediaPlayer1.Close;
MediaFrm.Close;
PictureFrm.Close;
end;
end;
end;
end;
end;
{*****************************************************************************}
procedure TMainFrm.MnSbyExpreeClick(Sender: TObject);
begin
if MainMap.Layers.Count > 0 then
QueryFrm.Show
else
Application.MessageBox('请添加图层', '提示', MB_OK);
end;
{*****************************************************************************}
procedure TMainFrm.Timer1Timer(Sender: TObject);
begin
if SbFlashGet.Down=true then
MapTps2.Timer
else
MapTps2.Free;
end;
{*****************************************************************************}
procedure TMainFrm.MnSbyShapeClick(Sender: TObject);
var
Clayer:imoMaplayer;
i:integer;
begin
panel2.Visible:=true;
panel2.Enabled:=true;
MnSTool.Enabled:=true;
Clayer:=coMaplayer.Create;
Cbblayers.clear;
Cbbuse.Clear;
For i:=0 to Mainmap.Layers.count -1 do
begin
Clayer:=Imomaplayer(MainFrm.Mainmap.Layers.Item(i));
Cbblayers.Items.Add(Clayer.Name);
Cbbuse.Items.Add(Clayer.Name);
end;
Cbbrelation.Items.Add('shape and feature boundaries overlap');
Cbbrelation.items.Add('shape and feature share a common point');
Cbbrelation.items.Add('shape and feature cross edges');
Cbbrelation.items.Add('shape and feature share a common line');
Cbbrelation.items.Add('shape and feature share common point or cross edges');
Cbbrelation.items.Add('shape and feature intersect');
Cbbrelation.items.Add('shape and feature intersect on interior');
Cbbrelation.items.Add('shape and feature intersect without touching edges');
Cbbrelation.items.Add('feature contains shape');
Cbbrelation.items.Add('shape contains feature');
Cbbrelation.items.Add('feature completely contains shape');
Cbbrelation.items.Add('shape completely contains feature');
Cbbrelation.items.Add('feature contains first point of shape');
Cbbrelation.items.Add('shape contains feature centroid');
Cbbrelation.items.Add('feature is identical to shape');
Cbbuse.Items.Add('TOOLS');
Cbblayers.ItemIndex:=0;
Cbbuse.ItemIndex:=0;
Cbbrelation.ItemIndex:=0;
Kaiguang:=true;
MnSTool.Checked:=true;
end;
procedure TMainFrm.MainmapAfterTrackingLayerDraw(Sender: TObject;
hDC: Cardinal);
var
sym:imoSymbol;
begin
if g_line<>nil then
begin
sym:=CoSymbol.Create;
sym.Color:=MoBlack;
MainMap.DrawShape(pts,sym);
if Pts.Count>1 then
begin
sym.Color:=MoRed;
MainMap.DrawShape(g_line,sym);
end;
end;
MainMap.Refresh;
end;
procedure TMainFrm.MnEXITClick(Sender: TObject);
begin
if MessageDlg('真的要退出程序吗',mtConfirmation,[mbYes,mbNo],0)=mrYes then
begin
SInfoFrm.ADOConnection1.Close;
Application.Terminate;
end
else
exit;
end;
procedure TMainFrm.MnSbyDistanceClick(Sender: TObject);
var
okChecked:Boolean;
begin
if MainMap.Layers.Count > 0 then
begin
n:=floatToStr(0.5);
okChecked:=(InputQuery ('校园地理信息系统','请输入查找范围:',n));
if okChecked then
if n<>''then
begin
StatusBar1.Panels[0].Text:='当前状态: '+ '按距离查询';
SbIdentify.Down:=true;
MainMap.MousePointer:=MoIdentify;
end
else
begin
showmessage('请输入查询范围!');
exit;
end;
end
else
Application.MessageBox('请添加图层', '提示', MB_OK);
end;
procedure TMainFrm.MnFlashGetClick(Sender: TObject);
begin
if MainMap.Layers.Count > 0 then
begin
Application.CreateForm(TSelectFrm, SelectFrm);
SelectFrm.Show
end
else
Application.MessageBox('请添加图层', '提示', MB_OK);
end;
procedure TMainFrm.MainmapMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if SbPan.Down then
MainMap.MousePointer:=MoPan;
end;
procedure TMainFrm.MnEasySClick(Sender: TObject);
var
i:integer;
MapLayers:imoMaplayer;
y:boolean;
begin
if MainMap.Layers.Count > 0 then
begin
y:=false;
for i:=0 to MainMap.Layers.Count-1 do
begin
MapLayers := ImoMapLayer(MainMap.Layers.Item(i));
if MapLayers.Name ='白龙校区建筑1:500'then
y:=true;
end;
if y=true then
begin
EasyFrm:=TEasyFrm.Create(Application);
EasyFrm.Show;
end;
end
else
Application.MessageBox('请添加图层', '提示', MB_OK);
end;
procedure TMainFrm.MnAboutClick(Sender: TObject);
begin
Application.CreateForm(TaboutFrm, aboutFrm);
aboutFrm.ShowModal;
end;
procedure TMainFrm.FormCreate(Sender: TObject);
begin
MnVAttrabute.Enabled:=false;
MnLayerMana.Enabled:=false;
MnRenderer.Enabled:=false;
MnLayerSet.Enabled:=false;
MnLabel.Enabled:=false;
MnSbyExpree.Enabled:=false;
MnSbyDistance.Enabled:=false;
MnSbyShape.Enabled:=false;
MnFlashGet.Enabled:=false;
MnEasyS.Enabled:=false;
MnSTool.Enabled:=false;
MnSMen .Enabled:=false;
end;
procedure TMainFrm.MnHelpClick(Sender: TObject);
begin
Application.HelpFile := ExtractFileDir(application.ExeName)+'\WINHELP4\SOURCE\GIShelp.hlp';
Application.HelpContext(1);
end;
procedure TMainFrm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
if MessageDlg('真的要退出程序吗',mtConfirmation,[mbYes,mbNo],0)=mrNo then
CanClose:=false
else
SInfoFrm.ADOConnection1.Close;
end;
procedure TMainFrm.FormActivate(Sender: TObject);
begin
MnSTool.Checked:=kaiguang;
end;
procedure TMainFrm.MnSMenClick(Sender: TObject);
var
i:integer;
MapLayers:imoMaplayer;
y:boolean;
begin
if MainMap.Layers.Count > 0 then
begin
y:=false;
for i:=0 to MainMap.Layers.Count-1 do
begin
MapLayers := ImoMapLayer(MainMap.Layers.Item(i));
if MapLayers.Name ='白龙校区建筑1:500'then
y:=true;
end;
if y=true then sInfoFrm.Show;
end
else
Application.MessageBox('请添加图层', '提示', MB_OK);
end;
procedure TMainFrm.MnOpointClick(Sender: TObject);
var
sFtype:string;
i:integer;
begin
if sender is TMenuItem then
begin
Opendialog1.Filter:='CAD(*.dwg)|*.dwg|CAD(*.dxf)|*.dxf';
Opendialog1.Title:='打开CAD文件 ';
if Opendialog1.Execute then
if Opendialog1.FileName<>''then
begin
case (sender as TMenuItem).tag of
1: //调用添加CAD文件的函数
sFtype:='Point';
2:
sFtype:='Line';
3:
sFtype:='Area';
end;
for i:=0 to Opendialog1.Files.Count-1 do
try
AddCADFile(Opendialog1.Files.Strings[i],sFtype);
except
exit;
end;
end;
tfcMaptreeview1.DrawLegend;
MnLayerMana.Enabled:=true;
MainMap.Refresh;
end;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -