📄 unit1.pas
字号:
end;
// 删除 所有 图层
procedure TForm1.Button11Click(Sender: TObject);
begin
ptsAll.RemoveAll;
ptsLine.RemoveAll;
ptsCircular.RemoveAll;
Map1.BackColor :=clSkyBlue;
Map1.Layers.RemoveAll;
end;
// 重新 创建 应用图层
procedure TForm1.Button12Click(Sender: TObject);
begin
// 创建 应用图层，进行相应设置
if not loadGeoFlag then
begin
layerName := 'Cover_layer';
lyrCover := Map1.Layers.CreateLayer(layerName,EmptyParam,1,
EmptyParam,EmptyParam);
lyrCover.Visible := True;
lyrCover.Selectable := False;
lyrCover.Editable := True;
// Map1.Layers.AnimationLayer := lyrCover;
layerName := 'Track_layer';
lyrTrack := Map1.Layers.CreateLayer(layerName,EmptyParam,1,
EmptyParam,EmptyParam);
lyrTrack.Visible := True;
lyrTrack.Selectable := True;
lyrTrack.Editable := True;
loadGeoFlag:= false;
end;
end;
// 汽车行进轨迹 实现
procedure TForm1.carTrack(Longitude: double;Latitude: double);
var
i: integer;
screenX: single;
screenY: single;
x: double;
y: double;
ptTemp: Point;
ptNew : Point;
ptLast: Point;
ptSymbol: Point;
fLine: Feature;
fSymbol: Feature;
fCircular: Feature;
fFtrs: Features;
begin
ptTemp:= CoPoint.Create();
ptNew:= CoPoint.Create();
ptLast:= CoPoint.Create();
PtSymbol:= CoPoint.Create();
ptNew.Set_(Longitude,Latitude);
// 察看当前车辆行驶轨迹，防止车辆移出地图
Map1.ConvertCoord(screenX,screenY,Longitude,Latitude,miMapToScreen);
Memo1.Lines.Append(' screenX :'+FloatToStr(screenX));
Memo1.Lines.Append(' screenY :'+FloatToStr(screenY));
if ((screenX > Map1.MapScreenWidth-20)or(screenX < 20)
or(screenY > Map1.MapScreenHeight-20)or(screenY < 20)) then
begin
Map1.CenterX := Longitude;
Map1.CenterY := Latitude;
end;
// 如果位移量较大则重新开始 一个区域的绘制
if (ptsAll.Count>0) then
begin
ptLast:= ptsAll.Item(ptsAll.Count);
x:= Abs(ptLast.X-Longitude);
y:= Abs(ptLast.Y-Latitude);
if (x>=0.001) or (y>=0.001) then // 删除 符号图元 车辆
begin
Map1.Layers.AnimationLayer := lyrTrack;
ptTemp.Set_(ptLast.X,ptLast.Y);
fFtrs := lyrTrack.SearchWithinDistance(ptTemp,20,miUnitMeter,
miSearchTypeCentroidWithin);
if (fFtrs.Count>=1) then
begin
for i:=1 to fFtrs.Count do
begin
if (fFtrs.Item(i).KeyValue = 'car') then
begin
lyrTrack.DeleteFeature(fFtrs.Item(i));
end;
end;
end;
ptsAll.RemoveAll;
ptsLine.RemoveAll;
end;
end;
if (ptsAll.Count=0)then // 判断是否 重新开始一个区域的绘制
begin
ptsAll.Add(ptNew,EmptyParam); // 把新的坐标点 加入点集
ptsLine.Add(ptNew,EmptyParam); // 添加新坐标点
ptsCircular.Add(ptNew,EmptyParam); // 添加新坐标点
// 绘制 覆盖区域
Map1.Layers.AnimationLayer := lyrCover;
fCircular := Map1.FeatureFactory.CreateCircularRegion(1,
ptNew,coverScale,7,30,Map1.DefaultStyle);
fCircular.KeyValue := 'cover_0';
fCircular.Style.RegionPattern := 9;
fCircular.Style.RegionBorderStyle := 0;
fCircular.Style.RegionColor := regionColor;
fCircular.Style.RegionTransparent := True;
fCir := fCircular;
lyrCover.AddFeature(fCir, EmptyParam);
// 绘制车辆
Map1.Layers.AnimationLayer := lyrTrack;
ptSymbol.Set_(ptNew.X,ptNew.Y);
fSymbol := Map1.FeatureFactory.CreateSymbol(ptSymbol,Map1.DefaultStyle);
fSymbol.KeyValue := 'car';
fSymbol.Style.SymbolType :=1;
fSymbol.Style.SymbolBitmapName := carPicName;
fSymbol.Style.SymbolBitmapSize := 24;
fSymbol.Style.SymbolBitmapTransparent :=True;
lyrTrack.AddFeature(fSymbol, EmptyParam);
Map1.Refresh; // 刷新、重绘地图
end
else begin
// 后续的绘制
ptLast:= ptsAll.Item(ptsAll.Count);
// x:= Abs(ptLast.X-Longitude);
// y:= Abs(ptLast.Y-Latitude);
// 如果位移量不是太小则进行后续 绘制
// if (x>=0.0001) and (y>=0.0001)then
// begin
ptsLine.Add(ptNew,EmptyParam); // 添加新坐标点
ptsCircular.Add(ptNew,EmptyParam); // 添加新坐标点
Memo1.Lines.Append('ptsAll :'+IntToStr(ptsAll.Count)); // 临时
Memo1.Lines.Append('ptsLine :'+IntToStr(ptsLine.Count)); // 临时
Memo1.Lines.Append('ptsCircular :'+IntToStr(ptsCircular.Count)); // 临时
Memo1.Lines.Append('*************'); // 临时
// 删除 符号图元 车辆
Map1.Layers.AnimationLayer := lyrTrack;
ptTemp.Set_(ptLast.X,ptLast.Y);
fFtrs := lyrTrack.SearchWithinDistance(ptTemp,20,miUnitMeter,
miSearchTypeCentroidWithin);
if (fFtrs.Count>=1) then
begin
for i:=1 to fFtrs.Count do
begin
if (fFtrs.Item(i).KeyValue = 'car') then
begin
lyrTrack.DeleteFeature(fFtrs.Item(i));
end;
end;
end;
// 绘制 覆盖区域
Map1.Layers.AnimationLayer := lyrCover;
{ for i:=1 to ptsCircular.Count do // 如有必要在此插入坐标点
begin
fCircular := Map1.FeatureFactory.CreateCircularRegion(1,
ptsCircular.Item(1),200,7,30,Map1.DefaultStyle); }
fCircular := Map1.FeatureFactory.CreateCircularRegion(1,
ptNew,coverScale,7,30,Map1.DefaultStyle);
fCircular.KeyValue := 'cover_i';
fCir := Map1.FeatureFactory.CombineFeatures(fCir,fCircular);
fCir.Style.RegionPattern := 9;
fCir.Style.RegionBorderStyle := 0;
fCir.Style.RegionColor := regionColor;
fCir.Style.RegionTransparent := True;
fCirs := lyrCover.AllFeatures;
if (fCirs.Count>0) then
begin
for i:=1 to fCirs.Count do
begin
if not(fCirs.Item(i).KeyValue = 'track') then
begin
lyrCover.DeleteFeature(fCirs.Item(i));
end;
end;
end;
lyrCover.AddFeature(fCir, EmptyParam);
// end;
// 分段 绘制 车辆行进轨迹
Map1.Layers.AnimationLayer := lyrTrack;
if (ptsLine.Count>=2) then
begin
fLine := Map1.FeatureFactory.CreateLine(ptsLine,EmptyParam);
fline.KeyValue := 'track';
fLine.Style.LineStyle := 65;
fLine.Style.LineColor := lineColor;
fLine.Style.LineWidthUnit := 0;
fLine.Style.LineWidth := 1;
lyrTrack.AddFeature(fLine,EmptyParam);
ptsLine.Remove(1); // 把轨迹分段
end;
// 绘制车辆
ptSymbol.Set_(ptNew.X,ptNew.Y);
fSymbol := Map1.FeatureFactory.CreateSymbol(ptSymbol,Map1.DefaultStyle);
fSymbol.KeyValue := 'car';
fSymbol.Style.SymbolType :=1;
fSymbol.Style.SymbolBitmapName := carPicName;
fSymbol.Style.SymbolBitmapSize := 24;
fSymbol.Style.SymbolBitmapTransparent :=True;
lyrTrack.AddFeature(fSymbol, EmptyParam);
// 把新的坐标点 加入点集
ptsAll.Add(ptNew,EmptyParam);
// 刷新、重绘地图
Map1.Refresh;
// end; // if then end
end; // if then else end
end;
procedure TForm1.Button7Click(Sender: TObject);
var
i: Integer;
k: Double;
x: double;
y: double;
begin
k:= 0.0008; // 误差 7m
x:= Map1.CenterX;
y:= Map1.CenterY;
for i:=1 to 100 do begin
carTrack(x+i*k,y);
end;
end;
// 更改车辆属性
procedure TForm1.Button15Click(Sender: TObject);
var
RegIniFile : TRegIniFile;
path : string;
picName : string;
begin
RegIniFile := TRegIniFile.Create;
RegIniFile.RootKey := HKEY_LOCAL_MACHINE;
// 打开 BMP 文件
if OpenDialog1.Execute then
begin
OpenDialog1.DefaultExt := 'bmp';
path := 'C:\\Program Files\\Common Files\\MapInfo Shared\\MapX Common\\CUSTSYMB';
OpenDialog1.InitialDir := path;
picName := OpenDialog1.FileName;
carPicName := ExtractFileName(picName);
end;
try // 修改注册表 ，更改下一次默认 车辆属性
if RegIniFile.OpenKey('\SOFTWARE\',FALSE) then
if RegIniFile.KeyExists('PHS ID') then begin
RegIniFile.WriteString('PHS ID','CarPicName',carPicName);
RegIniFile.CloseKey;
end
else begin
if RegIniFile.CreateKey('PHS ID') then
RegIniFile.WriteString('PHS ID','CarPicName',carPicName);
RegIniFile.CloseKey;
end
finally
RegIniFile.Free
end;
end;
procedure TForm1.Button14Click(Sender: TObject);
var
RegIniFile : TRegIniFile;
begin
RegIniFile := TRegIniFile.Create;
RegIniFile.RootKey := HKEY_LOCAL_MACHINE;
// 打开 BMP 文件
if ColorDialog1.Execute then
begin
lineColor := ColorDialog1.Color;
end;
try // 修改注册表 ，更改下一次默认 车辆属性
if RegIniFile.OpenKey('\SOFTWARE\',FALSE) then
if RegIniFile.KeyExists('PHS ID') then begin
RegIniFile.WriteString('PHS ID','LineColor',IntToStr(lineColor));
RegIniFile.CloseKey;
end
else begin
if RegIniFile.CreateKey('PHS ID') then
RegIniFile.WriteString('PHS ID','LineColor',IntToStr(lineColor));
RegIniFile.CloseKey;
end
finally
RegIniFile.Free
end;
end;
procedure TForm1.Button19Click(Sender: TObject);
var
RegIniFile : TRegIniFile;
begin
RegIniFile := TRegIniFile.Create;
RegIniFile.RootKey := HKEY_LOCAL_MACHINE;
if ColorDialog1.Execute then
begin
regionColor := ColorDialog1.Color;
end;
try // 修改注册表 ，更改下一次默认 车辆属性
if RegIniFile.OpenKey('\SOFTWARE\',FALSE) then
if RegIniFile.KeyExists('PHS ID') then begin
RegIniFile.WriteString('PHS ID','RegionColor',IntToStr(regionColor));
RegIniFile.CloseKey;
end
else begin
if RegIniFile.CreateKey('PHS ID') then
RegIniFile.WriteString('PHS ID','RegionColor',IntToStr(regionColor));
RegIniFile.CloseKey;
end
finally
RegIniFile.Free
end;
end;
procedure TForm1.TrackBar1Change(Sender: TObject);
var
RegIniFile : TRegIniFile;
begin
RegIniFile := TRegIniFile.Create;
RegIniFile.RootKey := HKEY_LOCAL_MACHINE;
TrackBar1.Max := 1000;
TrackBar1.Min := 100;
coverScale := TrackBar1.Position;
try // 修改注册表 ，更改下一次默认 覆盖范围
if RegIniFile.OpenKey('\SOFTWARE\',FALSE) then
if RegIniFile.KeyExists('PHS ID') then begin
RegIniFile.WriteString('PHS ID','CoverScale',IntToStr(coverScale));
RegIniFile.CloseKey;
end
else begin
if RegIniFile.CreateKey('PHS ID') then
RegIniFile.WriteString('PHS ID','CoverScale',IntToStr(coverScale));
RegIniFile.CloseKey;
end
finally
RegIniFile.Free
end;
end;
procedure TForm1.Button20Click(Sender: TObject);
var
ptSym : Point;
fSym : Feature;
begin
Map1.Layers.AnimationLayer := lyrCover;
ptSym := CoPoint.Create;
ptSym.Set_(Map1.CenterX,Map1.CenterY);
fSym := Map1.FeatureFactory.CreateSymbol(ptSym,Map1.DefaultStyle);
fSym.KeyValue := 'car';
fSym.Style.SymbolType :=1;
fSym.Style.SymbolBitmapName := 'TOWE1-32.BMP';
fSym.Style.SymbolBitmapSize := 24;
fSym.Style.SymbolBitmapTransparent :=True;
lyrCover.AddFeature(fSym, EmptyParam);
end;
procedure TForm1.Map1PolyToolUsed(ASender: TObject; ToolNum: Smallint;
Flags: Integer; const Points: IDispatch; bShift, bCtrl: WordBool;
var EnableDefault: WordBool);
var
dist : double;
pt1,pt2 : Point;
begin
pt1 := CoPoint.Create;
pt2 := CoPoint.Create;
case Flags of
miPolyToolBegin: dist :=0;
// miPolyToolInProgress : showmessage('good luck');
miPolyToolEnd:
begin
if ToolNum = 4 then
begin
showmessage('good '+ FloatToStr(dist));
end;
end;
miPolyToolEndEscaped: ;
else
begin
// dist := Map1.Distance()；
end;
end;
end;
procedure TForm1.Button21Click(Sender: TObject);
begin
//Map1.Layers.Add()
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -