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

📄 umap.pas

📁 用DELPHI 和MAPX的基础练习.是学习的好资料
💻 PAS
📖 第 1 页 / 共 2 页
字号:
  Features:=Map1.Layers[1].AllFeatures;
  for i:=1 to Features.Count do
  begin
    Feature:=Features.Item[i];
    Feature.Style.SymbolFontRotation:=ds.Value[i,29];
    if ds.Value[i,29]>150 then
       begin
       Feature.Style.SymbolFontColor:=miColorRed;
       Feature.Update(EmptyParam,EmptyParam);
       end;
  end;
end;

procedure TFMap.Button3Click(Sender: TObject);
var
Features: CMapXFeatures;
i: integer;
Feature:  CMapXFeature;
begin
  Features:=Map1.Layers[1].AllFeatures;
  for i:=1 to Features.Count do
  begin
    Feature:=Features.Item[i];
    Feature.Style.SymbolFontcolor:=miColorBlack;
    Feature.Update(EmptyParam,EmptyParam);
  end;
end;

procedure TFMap.Map1MapViewChanged(Sender: TObject);
var
j:integer;
begin
    //showmessage(inttostr(Map1.Layers[1].Labels.count));
end;

procedure TFMap.Button4Click(Sender: TObject);
var
Selected: CMapXSelection;
i:integer;
begin
  Selected := Map1.Layers.Item[1].Selection;
  for i:=1 to Selected.Count do
      begin
        showmessage(inttostr(i));
      end;
end;

procedure TFMap.FormActivate(Sender: TObject);
var
ds:      CMapXDataSet;
j:integer;
begin
  {ds := Map1.Datasets.Add(miDataSetLayer, Map1.Layers.Item[1], EmptyParam, EmptyParam, EmptyParam, EmptyParam,
                             EmptyParam, EmptyParam);
  //showmessage(inttostr(Map1.Layers[1].Labels.count));
 // showmessage(inttostr(Map1.Layers[1].Labels.count));

  for j:=1 to  Map1.Layers[1].Labels.count  do
      begin
       Map1.Layers[1].Labels.item[j].LineType:= miLineTypeSimple ;
       Map1.Layers[1].Labels.item[j].Offset:=20;
       Map1.Layers[1].Labels.item[j].Position:=miPositionTL+(j mod 3)+2;
      end;  }
end;

procedure TFMap.OpenGeoSet1Click(Sender: TObject);
var
FileName:String;
begin
OpenDialog1.Title:='打开GST文件' ;
if OpenDialog1.Execute then
   FileName:=OpenDialog1.FileName;

if FileName<>'' then
   begin
   try
   Map1.GeoSet:=  FileName;
   FMap.Caption:=Map1.TitleText;
   except
   showmessage('打开GST文件出错');
   end;
   end;
end;

procedure TFMap.OpenLayer1Click(Sender: TObject);
var
FileName:String;

begin

OpenDialog2.Title:='增加图层';
if OpenDialog2.Execute then
   FileName:=OpenDialog2.FileName;
   if FileName<>'' then
   begin
   try
   map1.Layers.Add(FileName,2);
   except
   showmessage('打开TAB文件出错');
   end;
   end;
end;

procedure TFMap.SaveGeoSet1Click(Sender: TObject);
begin
if Map1.GeoSet<>'' then
   begin
     if MessageDlg('保存GeoSet将覆盖当前的GeoSet的数据和设置,是否继续?',mtConfirmation,mbOKCancel,0)=mrYes then
     map1.SaveMapAsGeoset( Map1.TitleText, Map1.GeoSet);
   end
else
   MessageDlg('当前没有打开的GST文件',mtConfirmation,[mbOK],0);
end;

procedure TFMap.Save1Click(Sender: TObject);
var
FileName:String;
begin
  if savedialog1.Execute then
  begin
   FileName:=savedialog1.FileName;
   if FileName<>'' then
      begin
        Map1.SaveMapAsGeoset('',FileName);
      end
   else
   MessageDlg('请选择要保存的文件',mtConfirmation,[mbOK],0);
  end;
end;

procedure TFMap.Export1Click(Sender: TObject);
var
FileName:String;
begin
   if (ExportFormatString='') and  (ExportFormatExt='') then
   begin
   ExportFormatString:= 'Windows Bitmap';
   ExportFormatExt:=    '*.bmp';
   end;
   savedialog2.Filter:=ExportFormatString+'|'+ExportFormatExt;
   if savedialog2.Execute then
    begin
      FileName:=savedialog1.FileName;
    end;

    //ExportHeight:=Map1.MapPaperHeight;
    //ExportWidth:=Map1.MapPaperWidth;
    //showmessage(Floattostr(ExportHeight));
  if (ExportHeight=0) or (ExportWidth=0)  then
    begin
      Map1.ExportMap(FileName,ExportFormat);
    end
  else
      Map1.ExportMap(FileName,ExportFormat,ExportWidth,ExportHeight);

end;

procedure TFMap.N4Click(Sender: TObject);
begin
FOption.ShowModal;
end;

procedure TFMap.Map1ToolUsed(Sender: TObject; ToolNum: Smallint; X1, Y1,
  X2, Y2, Distance: Double; Shift, Ctrl: WordBool;
  var EnableDefault: WordBool);
var
distStr:string;
begin
  case toolnum of
       RulerToolID:
          begin

            Map1.MapUnit := RulerUnit;
            if Distance > 1 then
                 distStr := FloatToStrF(Distance, ffFixed, 12, 1)
            else
                 distStr := FloatToStrF(Distance, ffFixed, 12, 4);
            showmessage(distStr + RulerUnitString);
          end;
  end;
end;

procedure TFMap.N10Click(Sender: TObject);
begin
    If Fmap.UsePolyRuler = True Then
        Map1.CurrentTool := PolyRulerToolID
    Else
        Map1.CurrentTool := RulerToolID;
end;

procedure TFMap.N8Click(Sender: TObject);
begin
close;
end;

procedure TFMap.Map1PolyToolUsed(Sender: TObject; ToolNum: Smallint;
  Flags: Integer; const Points: IDispatch; bShift, bCtrl: WordBool;
  var EnableDefault: WordBool);
var
dist      :double;
distStr   :string;
i      :integer;
Points1:CMapXpoints;
begin
  Points1 := CMapXpoints(Points);
  if ToolNum = PolyRulerToolID then
     begin
      if Points1.count>0 then
         begin
           for i:=2 to Points1.count do
               begin
                 //showmessage(FloatToStr(Points1.Item[i-1].x));
                 dist:=dist+ Map1.Distance(Points1.item[i].x,Points1.item[i].y,Points1.item[i-1].x,Points1.item[i-1].y);
               end;
         end;
       distStr := FloatToStrF(dist, ffFixed, 12, 1);

       if Flags = 1 then
          showmessage(distStr + RulerUnitString)
       else statusbar1.SimpleText:=distStr ;
    end;
end;

procedure TFMap.N6Click(Sender: TObject);
begin
 //PrintDialog1.Execute;
end;

procedure TFMap.N12Click(Sender: TObject);
begin
FMap.Map1.Layers.LayersDlg(EmptyParam,EmptyParam) ;
end;

procedure TFMap.N14Click(Sender: TObject);
begin
FDataSets.show;
end;

procedure TFMap.N15Click(Sender: TObject);
begin
FCreateTheme.Show;
end;

procedure TFMap.N16Click(Sender: TObject);
begin
FModifyTheme.Show;
end;

procedure TFMap.N17Click(Sender: TObject);
begin
FModifyLegend.Show;
end;

procedure TFMap.N19Click(Sender: TObject);
begin
FFind.Show;
end;

procedure TFMap.N22Click(Sender: TObject);
begin
FZoom.show;
end;

procedure TFMap.N23Click(Sender: TObject);
begin
FViewLayer.Show;
end;

procedure TFMap.N24Click(Sender: TObject);
begin
Map1.DisplayCoordSys.PickCoordSys(EmptyParam,EmptyParam) ;
Map1.NumericCoordSys:= Map1.DisplayCoordSys;
end;

procedure TFMap.N26Click(Sender: TObject);
begin
Map1.PropertyPage;
end;

procedure TFMap.N27Click(Sender: TObject);
begin
  N27.Checked:=true;
  Map1.CurrentTool := miArrowTool;
end;

procedure TFMap.N28Click(Sender: TObject);
begin
  N28.Checked:=true;
  Map1.CurrentTool := miZoomInTool;
end;

procedure TFMap.N29Click(Sender: TObject);
begin
  N29.Checked:=true;
  Map1.CurrentTool := miZoomInTool;
end;

procedure TFMap.N30Click(Sender: TObject);
begin
  N30.Checked:=true;
  Map1.CurrentTool := miPanTool;
end;

procedure TFMap.N32Click(Sender: TObject);
begin
  N32.Checked:=true;
  Map1.CurrentTool := miSelectTool;
end;

procedure TFMap.N33Click(Sender: TObject);
begin
  N33.Checked:=true;
  Map1.CurrentTool := miRectSelectTool ;
end;

procedure TFMap.N34Click(Sender: TObject);
begin
  N34.Checked:=true;
  Map1.CurrentTool := miRadiusSelectTool;
end;

procedure TFMap.N35Click(Sender: TObject);
begin
  N35.Checked:=true;
  Map1.CurrentTool := miPolygonSelectTool;
end;

procedure TFMap.N36Click(Sender: TObject);
begin
  N36.Checked:=true;
  Map1.CurrentTool := miLabelTool;
end;

procedure TFMap.N38Click(Sender: TObject);
begin
  N38.Checked:=true;
  Map1.CurrentTool := miSymbolTool;
end;

procedure TFMap.N39Click(Sender: TObject);
begin
  N39.Checked:=true;
  Map1.CurrentTool := miTextTool
end;

procedure TFMap.N40Click(Sender: TObject);
begin
  Map1.Annotations.RemoveAll;
end;

procedure TFMap.N41Click(Sender: TObject);
begin
FStyle.Show;
end;

end.

⌨️ 快捷键说明

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