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

📄 main.~pas

📁 校园GIS系统——介绍校园个部门
💻 ~PAS
📖 第 1 页 / 共 3 页
字号:
            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 + -