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

📄 main.~pas

📁 校园GIS系统——介绍校园个部门
💻 ~PAS
📖 第 1 页 / 共 3 页
字号:
procedure TMainFrm.MnOpenEmageFileClick(Sender: TObject);
var
ThisLayer:imoImageLayer;
begin
   ThisLayer:=coImagelayer.Create;
   Opendialog1.Title:=' 打开影像文件 ';
   Opendialog1.Filter:='影像文件(*.jpg)|*.jpg|tif|*.tif';
   if Opendialog1.execute then
     if Opendialog1.FileName<>''then
     begin
       ThisLayer.File_:=Opendialog1.FileName;
       MainMap.Layers.Add(ThisLayer);
     end;
   MainMap.Refresh;

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:
        if MainMap.Layers.Count  > 0 then
        begin
          MainMap.MousePointer:=MoCross;
          StatusBar1.Panels[0].Text:='当前状态:  '+ '测距';
        end

        else
        begin
          Sbmeasure.Down:=false;
          Application.MessageBox('请添加图层', '提示', MB_OK);

        end;
     5:
        begin
          MainMap.MousePointer:=MoCross;
          StatusBar1.Panels[0].Text:='当前状态:  '+ '准备';
        end;

     6:
        begin
        //地图1:1显示
          MainMap.Extent:=MainMap.FullExtent;

         end;
     7:

        begin
          MnSbyDistance.OnClick(sender);
        end;


     8:
       MnFlashGet.Click;
   end;
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:=ThisPoint.X;
   CurrentY:=ThisPoint.Y;
   StatusBar1.Panels[1].Text:='坐标'+ floattostr(Round(CurrentX*100)/100)
                                +' , '+floattostr(Round(CurrentY*100)/100);
   //获取地图坐标,并在状态栏显示
   if SbFlashGet.Down then
     MapTps2.MouseMove(x,y);
end;
{*****************************************************************************}
procedure TMainFrm.MainmapMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
 var
  rectangle:    imorectangle;
  ThisPoint:    imoPoint;
  Sdrawshape:   variant;
  Selectedlayer:ImoMaplayer;
  BaseLayer:    ImoMaplayer;
   v :          Variant;
begin
  if MainMap.Layers.Count>0 then

   begin
     if Button=MbLeft 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;
      
      if SbPan.Down then
       //地图平移
         begin
           MainMap.Pan;
           MainMap.MousePointer:=MoPanning;
           exit;
         end;
       //空间查询
      if KaiGuang=true then
       begin
         Selectedlayer:=CoMaplayer.Create;
         BaseLayer:=CoMaplayer.Create;
         Selectedlayer:=ImoMaplayer(MainMap.Layers.Item(CbbLayers.text));
         Baselayer:=ImoMaplayer(MainMap.Layers.Item(Cbbuse.text));

       if SbPoint.Down then Sdrawshape:=MainMap.ToMapPoint(X,Y);
       if SbRec.Down then Sdrawshape:=MainMap.TrackRectangle;
       if Sbpolygon.Down then Sdrawshape:=MainMap.TrackPolygon;
       if Cbbuse.Text='TOOLS'then
        begin
         MyRecordSet:= Selectedlayer.SearchShape(Sdrawshape,CbbRelation.ItemIndex,'');
        end

       else begin
         if Sbpoint.Down then
            BaseRecordSet:=BaseLayer.SearchByDistance(Sdrawshape,0.05,'')
         else
         begin
           BaseRecordSet:=Baselayer.SearchShape(Sdrawshape,moContaining,'');
           MyRecordSet:=SelectedLayer.SearchShape(BaseRecordSet,CbbRelation.ItemIndex,'');
         end;
       MainMap.Refresh;
       end;
    end;

    //提取属性
    if SbIdentify.Down then
    begin
      Currentlayer:=ImoMaplayer(MainFrm.MainMap.Layers.Item(0));
      ThisPoint:=CoPoint.Create;
      ThisPoint:=MainFrm.MainMap.ToMapPoint(X,Y);
      FindRecord:=CurrentLayer.SearchByDistance(ThisPoint,strTofloat(n),'');
      //Showmessage(intToStr(MainFrm.FindRecord.Count));
      if not FindRecord.EOF then
      begin
        MainMap.Refresh;
        ShowZl();
        AttrShow();
        FindRecord:=nil;
      end//IdentifyFrm.ShowModal;
      else
      begin
        showmessage('没有记录,请重试');
        exit;
      end;

    end;

  end;
    {**********测距*****************}
    if SbMeasure.Down then


    begin
      if Button= mbleft then

      begin
       if g_line=nil then g_line:=CoLine.Create;
       if Pts=nil then Pts:=CoPoints.Create;

         Thispoint := coPoint.Create;
         Thispoint := MainMap.ToMapPoint(x, y);
          //画线
         pts.Add(ThisPoint);
         g_line.Parts.Add(Pts);
         MainMap.TrackingLayer.Refresh(true,v);

         i:=i+1;  //计下点数
      if i=1 then
        begin
          //showmessage('1');
          X1:=round(Thispoint.X);
          Y1:=round(Thispoint.Y);
          //showmessage(floatTostr(X1)+'  '+floatTostr(Y1));
        end;
      if i >1 then

       begin
        //showmessage('>1');
         if i mod 2 = 0 then
           begin
             X2:=round(Thispoint.X);
             Y2:=round(Thispoint.Y);
             //showmessage(intToStr(i)+':'+floatTostr(X2)+'  '+floatTostr(Y2));
           end
         else
            begin

              X1:=round(Thispoint.X);
              Y1:=round(Thispoint.Y);
              // showmessage(intToStr(i)+':'+ floatTostr(X1)+'  '+floatTostr(Y1));
            end ;
         s:= s + sqrt((X2-X1)*(X2-X1)+(Y2-Y1)*(Y2-Y1));
         s:=round(s*100)/100;
        //showmessage('距离为:'+floatToStr(s));
       end;

  end

  else
    begin
      showmessage('距离为:'+floatToStr(s)+'米!');
      i:=0;
      s:=0;
      X1:=0;
      X2:=0;
      Y1:=0;
      Y2:=0;

      g_line:=nil;
      pts:=nil;
      MainMap.Refresh;
      exit;
    end;


   end;



   {***********以上为测距***********************}
 end;

end;

{*****************************************************************************}
procedure TMainFrm.LocalmapAfterTrackingLayerDraw(Sender: TObject;
  hDC: Cardinal);
var
 sym : IMoSymbol;
begin
  sym := CoSymbol.Create;
  sym.OutlineColor := moRed;
  sym.Style := moTransparentFill;
  LocalMap.DrawShape(MainMap.Extent,sym);
end;
{*****************************************************************************}
procedure TMainFrm.LocalmapMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
MyPoint:ImoPoint;

begin
   MyPoint:=CoPoint.Create;
   MyPoint:=LocalMap.ToMapPoint(X,Y);
   MainMap.CenterAt(MyPoint.X,MyPoint.Y);
   if MainMap.Extent.IsPointIn(MyPoint) then
   begin
     MyDragFeedback.DragStart(MainMap.Extent,LocalMap,X,Y);
   end;
end;
{*****************************************************************************}
procedure TMainFrm.LocalmapMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin
   if not (MyDragFeedback =NIL)   then
     MyDragfeedback.DragMove(x,y);
end;
{*****************************************************************************}
procedure TMainFrm.MainmapAfterLayerDraw(Sender: TObject; index: Smallint;
  canceled: WordBool; hDC: Cardinal);
var
 MySymbol:imoSymbol;
 v :      Variant;
begin
  MySymbol:=CoSymbol.Create;
  MySymbol.Color:=ClYellow;
  if Assigned(FindRecord)then

     MainMap.DrawShape(FindRecord,MySymbol);
  MainMap.Refresh;

   {////////////////////////////////////////}
     if index =0 then
   // after drawing the first layer, refresh the locater map
   LocalMap.TrackingLayer.Refresh(True,v);
      if KaiGuang=true then
       begin
         MySymbol.Color:=clRed;
         if assigned(Baserecordset)then
           MainMap.DrawShape(Baserecordset,MySymbol);
           MySymbol.Color:=clyellow;
         if assigned(Myrecordset)then
           MainMap.DrawShape(Myrecordset,MySymbol);
          
           MainMap.Refresh;
           Baserecordset:=nil;
           Myrecordset:=nil;
       end;
    //end;
end;
{*****************************************************************************}
procedure TMainFrm.LocalmapMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if not (Mydragfeedback = NIL)  then
  begin
    LocalMap.Refresh;
    MainMap.extent := IMoRectangle(MyDragFeedback.DragFinish(x,y));
  end;
end;
{*****************************************************************************}
procedure TMainFrm.MnLayerManaClick(Sender: TObject);
begin
   LayerManaFrm.ShowModal;
end;
{*****************************************************************************}
procedure TMainFrm.MnRendererClick(Sender: TObject);
begin
   if MainMap.Layers.Count  > 0 then
      RendererFrm.Show
   else
      Application.MessageBox('请添加图层', '提示', MB_OK);
end;
{*****************************************************************************}
procedure TMainFrm.MnLayerSetClick(Sender: TObject);
begin
   if MainMap.Layers.Count  > 0 then
      LayerSetFrm.ShowModal
   else
      Application.MessageBox('请添加图层', '提示', MB_OK);
end;
{*****************************************************************************}
procedure TMainFrm.MnLabelClick(Sender: TObject);
begin
  if MainMap.Layers.Count  > 0 then
    LabelFrm.ShowModal
  else
    Application.MessageBox('请添加图层', '提示', MB_OK);
end;
{*****************************************************************************}
procedure TMainFrm.PmZoomInClick(Sender: TObject);
begin
  if sender is TMenuItem then
   begin


      case(sender as TMenuItem).Tag of
      1:
         begin
           SbZoomIn.Click;
            SbZoomIn.Down:=true ;
         end;
      2:
        begin
           SbZoomOut.Click;

⌨️ 快捷键说明

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