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

📄 code1.txt

📁 校园GIS系统——介绍校园个部门
💻 TXT
📖 第 1 页 / 共 2 页
字号:
      if SbPan.Down then
       //地图平移
        begin
           MainMap.Pan;
           MainMap.MousePointer:=MoPanning;
           exit;
        end;
    

    {***************************************************************************}

   end;

end;

procedure TMainFrm.BadvanceQueryClick(Sender: TObject);
begin
   if MainMap.Layers.Count  > 0 then
      QueryFrm.ShowModal
   else
      Application.MessageBox('请添加图层', '提示', MB_OK);
end;

procedure TMainFrm.FormActivate(Sender: TObject);
begin
   CurrentLayer:=comaplayer.Create;
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);

    //end;
end;

procedure TMainFrm.RbAtrCheckClick(Sender: TObject);
begin
    if RbAtrCheck.Checked then
     begin
       EdtName.Enabled:=true;
       BbChaxun.Enabled :=true;
       BadvanceQuery.Enabled:=true;
       EdtName.SetFocus;
     end;
end;

procedure TMainFrm.RbSrCheckClick(Sender: TObject);
begin
   if RbSrCheck.Checked then
     begin
       EdtName.Enabled:=false;
       BbChaxun.Enabled :=false;
       BadvanceQuery.Enabled:=false;
     end;
end;

procedure TMainFrm.BbChaxunClick(Sender: TObject);
var
i:integer;
  ThisRecord:ImoRecordSet;
  ThisTable:ImoTableDesc;
  ThisPoint:imoPoint;
begin
   if MainMap.Layers.Count  > 0 then
      begin
         CurrentLayer:=ImoMaplayer(MainFrm.MainMap.Layers.Item(0));
         //按地名模糊查询
         FindRecord:= CurrentLayer.SearchExpression('Name like'+' '+chr(39)+EdtName.Text+'%'+chr(39));

         //MainFrm.MainMap.Refresh;
         //提取属性值

      ThisTable:=coTableDesc.Create;
      
      Currentlayer:=ImoMaplayer(MainMap.Layers.Item(0));
       //ThisPoint:=CoPoint.Create;
      //ThisPoint:=MainMap.ToMapPoint(X,Y);
      //ThisRecord:=CurrentLayer.SearchShape(ThisPoint,12,'');
      ThisTable:=MainFrm.FindRecord.TableDesc;
      //MainFrm.FindRecord.MoveFirst ;
     //if not FindRecord.EOF then
        //begin
         StringGrid1.Cells[0,0] :=' 字段 ';
         StringGrid1.Cells[1,0] :=' 值 ';
         StringGrid1.RowCount:=ThisTable.FieldCount-1;
        for i := 0 to ThisTable.FieldCount-1 do
          begin
            StringGrid1.Cells[0,i+1] := FindRecord.fields.Item(ThisTable.FieldName[i]).Name ;
            StringGrid1.Cells[1,i+1] := FindRecord.fields.Item(ThisTable.FieldName[i]).ValueAsString;
          end;
      // MainFrm.FindRecord.MoveNext;
        //end;

        StringGrid1.Visible:= True;
        MenuVLMap.Checked:=False;
        MainFrm.MainMap.FlashShape(FindRecord.Fields.Item('Shape').Value,10);
      end
   else
      Application.MessageBox('请添加图层', '提示', MB_OK);
end;

procedure TMainFrm.PageControl1Change(Sender: TObject);
var
i:integer;

begin
   CbbLayers.clear;
   CbbFields.Clear;

   for i:=0 to MainFrm.MainMap.Layers.Count-1 do
     begin
        Currentlayer:=ImoMaplayer(MainFrm.MainMap.Layers.Item(i));
        CbbLayers.Items.Add(Currentlayer.Name);
     end;
        CbbLayers.Itemindex:=0;
        CbbLayers.OnChange(sender);
end;

procedure TMainFrm.CbbLayersChange(Sender: TObject);
var
MyTableDesc:imoTableDesc;
i:integer;
begin
  if MainFrm.MainMap.Layers.Count>0 then
     begin
       MyTableDesc:=CoTableDesc.Create;
       Currentlayer:=ImoMaplayer(MainFrm.MainMap.Layers.Item(CbbLayers.Text));
       MyTableDesc:=Currentlayer.Records.TableDesc;
       CbbFields.Clear;
       for i:=0 to MyTableDesc.FieldCount-1 do
         begin
           CbbFields.Items.Add(MyTableDesc.FieldName[i]);
       end;
       CbbFields.ItemIndex:=0;
       end
   else
   Application.MessageBox('请添加图层', '提示', MB_OK);
end;


procedure TMainFrm.PanelStaColClick(Sender: TObject);
begin
  if ColorDialog1.Execute then
     PanelStaCol.Color:= ColorDialog1.Color;
end;

procedure TMainFrm.PanelFinColClick(Sender: TObject);
begin
   if ColorDialog1.Execute then
     PanelFinCol.Color:= ColorDialog1.Color;
end;


procedure TMainFrm.BtSureClick(Sender: TObject);
var
MyRecord:imoRecordSet;
MyBreaksCount:integer;
MyRenderer:imoClassBreaksRenderer;
i,j:integer;
begin
  CurrentLayer:=ImoMaplayer(MainMap.Layers.Item(CbbLayers.Text));
  Myrenderer:=coClassBreaksRenderer.Create;
  MyRecord:=CurrentLayer.SearchExpression(CbbFields.Text+ '>-1 Order by '+ CbbFields.Text);
  Myrenderer.Field:=CbbFields.Text;
  MyBreaksCount:=strToInt(EdtBreaksCount.Text);
  Myrenderer.BreakCount:=MyBreaksCount;

  For i:=1 to MyBreaksCount-1 do
   begin
      For j:=0 to Round(MyRecord.Count/MyBreaksCount)do
      Myrecord.moveNext;
      MyRenderer.Break[i]:=MyRecord.fields.item(CbbFields.Text).value;
      //设置分位点并赋值
   end;
   Myrenderer.RampColors(PanelStaCol.Color,PanelFinCol.Color);
   Currentlayer.Renderer:=MyRenderer;
   MainMap.refresh;
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.Exit1Click(Sender: TObject);
begin
Application.Terminate;
end;

procedure TMainFrm.MenuVLMapClick(Sender: TObject);
begin
  if sender is TMenuItem then
  //控制显示 流览,地图工具栏,状态栏
  case (sender as TMenuItem).Tag of
  1:
          begin

          LocalMap.Visible:=MainFrm.MenuVLMap.Checked;
          if not MainFrm.MenuVLMap.Checked then StringGrid1.Visible:= true
          else
          StringGrid1.Visible:=False;
          end;
  2:


          ToolBar1.Visible:=MainFrm.MuneVTool.Checked ;


   3:

          StatusBar1.Visible:=MainFrm.MenuVSBar.Checked ;


  end;
end;

procedure TMainFrm.MnASetClick(Sender: TObject);
begin
  if MainFrm.MainMap.Layers.Count>0 then
    PointSetFrm.ShowModal
  else
    Application.MessageBox('请添加图层', '提示', MB_OK);
end;

procedure TMainFrm.MnAttrbuteClick(Sender: TObject);
begin
    if MainFrm.MainMap.Layers.Count>0 then
      ViewAttrFrm.Show
    else
      Application.MessageBox('请添加图层', '提示', MB_OK);
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.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.MnLableClick(Sender: TObject);
begin
  LabelFrm.ShowModal;
end;

procedure TMainFrm.N2Click(Sender: TObject);
begin
  RendererFrm.ShowModal;
end;

procedure TMainFrm.PMnZoomInClick(Sender: TObject);
begin
   if sender is TPopupMenu then
   begin

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


      end;



   end;
end;

end.

⌨️ 快捷键说明

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