📄 umap.pas
字号:
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 + -