一个非常简单的地图控件的实现（Delphi/Pascal）

leeky 2006-01-18 11:04:58
加精
//******************************************************************
这是我差不多两年前为一个小项目写的地图控件，因为考虑到成本与实际需要，我们没有采用其它如MapX等工具，而是自己画图。
此地图控件的最初实现花了我一周的时间，后来随着用户的其它需求，又加入了新的功能，前后共花时间半个月左右，并把它用于项目中。
控件实现了缩放、漫游、选取（框选、点选）、增加（点、边）、删除（点、边）、测距等基本操作。
在实际的程序中，还利用它实现了鹰眼、智能判断路线、自动区分多次巡查等功能。
本控件功能相对简单，对于新手具有一定的参考作用，但也得花功夫；对于高手，完全可以不必分析此代码（以免耽误您的时间），可以做出远胜于我的功能。
读懂此控件所需要的知识准备：对初等数学有较深入的了解、对消息、事件比较熟悉。
我现在的工作很忙，早已不对此控制进行维护等工作，所以对于控件的使用，我恐怕没有时间作任何回答，请原谅。但如果您读懂了代码，自然就知如何使用了。
//******************************************************************
}
...全文
1399 19 打赏 收藏 转发到动态 举报
写回复
用AI写文章
19 条回复
切换为时间正序
请发表友善的回复…
发表回复
letheanwater 2006-02-14
  • 打赏
  • 举报
 回复
好东西,绝对鼓励.!~
:)
楼主,如果介一期发完了,麻烦结贴通知俺一声.
俺做到精华区里面去.
shansheng 2006-02-14
  • 打赏
  • 举报
 回复
鼓励，顶一把



leeky 2006-02-14
  • 打赏
  • 举报
 回复
procedure TMapX.DeleteEmptySubRoads;
var
RoadIDX:integer;
begin
for RoadIDX:=High(SubRoads) downto 0 do
ValidSubRoad(RoadIDX);
end;

function TMapX.AddSubRoadPos(SubRoadID,PosNo:integer):Boolean;
var //0423 更新：如果子路序号大于最大号，则不退出，而是扩充子路个数。
HiPos:integer;
begin
Result:=False;
if (SubRoadID<0) // or (SubRoadID>High(SubRoads))
then exit;

if PosNo>High(RoadPos) then Exit;

if (SubRoadID>High(SubRoads))
then SetLength(SubRoads,SubRoadID+1); //重新分配子路的个数。

HiPos:=High(SubRoads[SubRoadID]);
inc(HiPos);
SetLength(SubRoads[SubRoadID],HiPos+1);
SubRoads[SubRoadID][HiPos]:=PosNo;

Result:=True;
end;

procedure TMapX.InsertRoadPos(idx:integer;Longitude,Latitude:real;LocName:string;LabelPos:integer);
var
posCNT:integer;
cnt:integer;
begin
posCNT:=High(RoadPos); //现有点数
if (idx<0) or (idx>PosCNT) //不在当前数组的范围内
then Exit;

inc(PosCNT);

SetLength(RoadPos,PosCNT+1);
for cnt:=PosCNT-1 downto idx do
RoadPos[cnt+1]:=RoadPos[cnt]; //后移一个数据；

RoadPos[idx].Name:=LocName;
RoadPos[idx].Coord.longitude:=longitude;
RoadPos[idx].Coord.latitude :=Latitude;
RoadPos[idx].Passed:=false; //可不写
RoadPos[idx].LabelPos:=LabelPos;

InSertIsolatedPos(idx); //更改SubRoads中的点序号。
end;

procedure TMapX.InsertRoadPos(idx:integer;Coord:TCoordinate;LocName:string;LabelPos:integer);
begin
InsertRoadPos(Idx,Coord.Longitude,Coord.Latitude,LocName,LabelPos);
end;

procedure TMapX.DeleteRoadPos(idx:integer);
var
posCNT:integer;
cnt:integer;
begin
posCNT:=High(RoadPos)+1; //现有点数
if (idx<0) or (idx>PosCNT-1) //不在当前数组的范围内
then Exit;

for cnt:=idx to PosCnt-2 do
RoadPos[cnt]:=RoadPos[cnt+1];
Dec(PosCNT);
SetLength(RoadPos,PosCNT);

end;

procedure TMapX.ModifyRoadPos(PosNo:integer;APos:TRoadPosition);
var
posCNT:integer;
begin
posCNT:=High(RoadPos)+1; //现有点数
if (PosNo<0) or (PosNo>PosCNT-1) //不在当前数组的范围内
then Exit;

RoadPos[PosNo]:=APos;

end;

{procedure TMapX.ModifyRoadPos(idx:integer;Coord:TCoordinate;LocName:string;LabelPos:integer);
begin
ModifyRoadPos(Idx,Coord.Longitude,Coord.Latitude,LocName,LabelPos);
end; }

function TMapX.GetRoadPos(PosName:String;ExceptNo:integer):integer;
var
idx:integer;
Loc:integer;
begin
result:=-100; //负数表示没找到；

for idx:=Low(RoadPos) to High(RoadPos) do
if (RoadPos[idx].Name=PosName) //找到同名
then begin
Loc:=idx+1;
if (Loc<>ExceptNo) //排除特殊值。如修改时可与自己相同。
then begin
result:=idx+1;
break;
end;
end;
end;

//设置此检测点是否被通过.
procedure TMapX.SetRoadPosPassed(idx:integer;passed:Boolean);
begin
if ( (idx<=High(RoadPos))
and (idx>=Low(RoadPos)) )
then RoadPos[idx].Passed:=passed;
end;

procedure TMapX.AddPatrolPos(X,Y:real;Time:TDateTime;Status:Byte);
var
PosCnt:integer;
hicnt:integer;
begin
hicnt:=High(PatrolPos); //如果为空则取到-1
PosCnt:=hicnt+1;
SetLength(PatrolPos,PosCnt+1);
with PatrolPos[PosCnt] do
begin
PatrolTime:=Time;
Coord.longitude:=X;
Coord.Latitude:=Y;
State:=Status;
// Shape:=TShape.Create(self);
end;

end;

//清空所有设备图标
procedure TMapX.ClearSymbols;
var
IDX:integer;
begin
for IDX:=0 to High(EquipSymbols) do
if Assigned(EquipSymbols[IDX])
then begin
EquipSymbols[IDX].Free;
EquipSymbols[IDX]:=nil;
end;

// setLength(Equipsymbols,0);
end;

procedure TMapX.ResetZoom(zoom:real);
begin
//
end;

procedure TMapX.FirstInit();
begin
BmpFile:='';
ZoomRatio:=1;

Top:=0;
Left:=0;
//Width :=parent.Width;
//Height :=parent.Height;
MapTop:=Top;
MapLeft:=Left;
MapWidth :=Width;
MapHeight:=Height;
ReCalcuCenter();
OnMouseDown :=LeeMouseDown;
OnMouseMove :=LeeMouseMove;
OnMouseUp :=LeeMouseUp;

//以下测试用
Canvas.Pen.Color:=clBlue;
Canvas.Pen.Mode :=pmCopy;
Canvas.Pen.Width:=2;
Canvas.MoveTo(0,0);
Canvas.LineTo(0,300);
Canvas.LineTo(300,0);
Canvas.LineTo(0,0);
end;
leeky 2006-02-14
  • 打赏
  • 举报
 回复

procedure TMapX.MergeTwoSubRoad(Road1:integer;mType1:TMergeType; Road2:integer;mType2:TMergeType );
var
HighRoad,PosCnt1,PosCnt2:integer;
PosIdx:integer;
begin
HighRoad:=High(SubRoads);

if (Road1<0) or (Road1>HighRoad )
or (Road2<0) or (Road2>HighRoad)
then Exit;

PosCnt1:=High(SubRoads[Road1]);
PosCnt2:=High(SubRoads[Road2]);
SetLength(SubRoads[Road1],PosCnt1+PosCnt2+2);

if (mType1=MHead) then
begin
for PosIdx:=PosCnt1 downto 0 do //顺序 移到　最后。
SubRoads[Road1][PosIDx+PosCnt2+1]:=SubRoads[Road1][PosIDx];

if (mType2=MHead)
then
for PosIDX:=0 to PosCnt2 do //第二条路倒序并放在前面。
SubRoads[Road1][PosIDx]:=SubRoads[Road2][PosCnt2-PosIDx]
else
for PosIDX:=0 to PosCnt2 do //第二条路顺序序并放在前面。
SubRoads[Road1][PosIDx]:=SubRoads[Road2][PosIDx];

end
else begin
//路一不变。
if (mType2=MHead)
then
for PosIDX:=0 to PosCnt2 do //第二条路 顺序放在后面。
SubRoads[Road1][PosIDx+PosCnt1+1]:=SubRoads[Road2][PosIDx]
else
for PosIDX:=0 to PosCnt2 do //第二条路倒序并放在后面。
SubRoads[Road1][PosIDx+PosCnt1+1]:=SubRoads[Road2][PosCnt2-PosIDx];
end;

DelSubRoad(Road2);

end;

procedure TMapX.MergeTwoSubRoad(MergePos1,MergePos2:TMergePos);
begin
MergeTwoSubRoad(MergePos1.RoadID,MergePos1.MergeType,MergePos2.RoadID,MergePos2.MergeType);
end;

procedure TMapX.CreateSubRoadWith(PosNo1,PosNo2:integer);
var
HiRoad:integer;
begin
HiRoad:=High(SubRoads);
Inc(HiRoad);
SetLength(SubRoads,HiRoad+1);
SetLength(SubRoads[HiRoad],2);

SubRoads[HiRoad][0]:=PosNo1;
SubRoads[HiRoad][1]:=PosNo2;
end;

function TMapX.InSameSubRoad(MPos1,MPos2:TMergePos):Boolean;
begin
Result:=( (MPos1.RoadID=MPos2.RoadID)
and (MPos1.RoadID>=0) );
end;

procedure TMapX.ConnectPos(Pos1,Pos2:integer);
var
MPos1,MPos2:TMergePos;
begin
if (Pos1<0) or (Pos2<0) then Exit;

MPos1.PosNo:=Pos1;
MPos2.PosNo:=Pos2;
CheckPosMergeType(MPos1);
CheckPosMergeType(MPos2);

if InSameSubRoad(MPos1,MPos2)
then Exit; //同在一条子路中。

if (MPos1.MergeType=MNone) and (MPos2.MergeType=MNone)
then begin //直接由此两点生成一条新的子路。
self.CreateSubRoadWith(Pos1,Pos2);
Exit;
end;

if (MPos1.MergeType=MNone) then
begin
if (MPos2.MergeType=MHead)
then self.Add2SubRoadHead(MPos2.RoadID,MPos1.PosNo) //头
else self.Add2SubRoadEnd (MPos2.RoadID,MPos1.PosNo); //尾
exit;
end;

if (MPos2.MergeType=MNone) then
begin
if (MPos1.MergeType=MHead)
then self.Add2SubRoadHead(MPos1.RoadID,MPos2.PosNo) //头
else self.Add2SubRoadEnd (MPos1.RoadID,MPos2.PosNo); //尾
exit;
end;

//两点都在端点
self.MergeTwoSubRoad(MPos1,MPos2);

end;

procedure TMapX.AddRoadPos(Coord:TCoordinate;PosName:string;LabelPos:integer; EquipType, Status:Byte);
begin
AddRoadPos(Coord.longitude,Coord.latitude,PosName,LabelPos,EquipType, Status);
end;

procedure TMapX.AddRoadPos(APos:TRoadPosition);
begin
AddRoadPos(APos.Coord,APos.Name,APos.LabelPos,APos.EquipType,APos.Status);
end;

procedure TMapX.AllPosAs1SubRoad;
var
idx:integer;
HiPos:integer;
begin
SetLength(SubRoads,1); //所有点是一条子路。
HiPos:= High(RoadPos);
SetLength(SubRoads[0],HiPos+1);
for idx:=0 to HiPos do
SubRoads[0][idx]:=idx;
end;

procedure TMapX.ValidSubRoad(SubRoadID :integer);
begin
if (SubRoadID<0) or (SubRoadID>High(SubRoads))
then exit;

if High(SubRoads[SubRoadID])<1 //删除无点或一个点的子路。
then DelSubRoad(SubRoadID);
end;
leeky 2006-02-14
  • 打赏
  • 举报
 回复
//才发了一小半，呵呵，希望朋友们在三帖之后继续顶
function TMapX.ISIsolatedPos(PosNo:integer) :Boolean;
var
RoadIDX,PosIDX:integer;
begin
Result:=false;
if (PosNo<0) or (PosNo>High(RoadPos)) then Exit;
//无效点肯定不是孤立点

for RoadIDX:=0 to High(SubRoads) do
for PosIDX:=0 to High(SubRoads[RoadIDX]) do
if (SubRoads[RoadIDX][PosIDX]=PosNo)
then Exit;

Result:=True; //不在所有子路上。
end;

function TMapX.DelIsolatedPos(PosNo:integer):Boolean;
var
RoadIDX,PosIDX:integer;
begin
Result:=false;
if (PosNo<0) or (PosNo>High(RoadPos)) then Exit;

self.DeleteRoadPos(PosNo);
Result:=True;
for RoadIDX:=0 to High(SubRoads) do
for PosIDX:=0 to High(SubRoads[RoadIDX]) do
if (SubRoads[RoadIDX][PosIDX]>PosNo) //往前移一。
then SubRoads[RoadIDX][PosIDX]:=SubRoads[RoadIDX][PosIDX]-1;
end;

//被 self.InsertRoadPos(); 调用。
function TMapX.InSertIsolatedPos(PosNo:integer):Boolean;
var
RoadIDX,PosIDX:integer;
begin
Result:=false;
if (PosNo<0) or (PosNo>High(RoadPos)) then Exit;

Result:=True;
for RoadIDX:=0 to High(SubRoads) do
for PosIDX:=0 to High(SubRoads[RoadIDX]) do
if (SubRoads[RoadIDX][PosIDX]>=PosNo) //往后移一。
then SubRoads[RoadIDX][PosIDX]:=SubRoads[RoadIDX][PosIDX]+1;

end;

function TMapX.DelSubRoad(RoadID:integer):Boolean;
var
idx:integer;
PosNo:integer;
RoadCnt,PosCnt:integer;

begin
result:=false;
RoadCnt:= High(SubRoads);
if (RoadID<0) or (RoadID> RoadCnt) then exit; //不能用等于。

for idx:=RoadID to High(SubRoads)-1 do
begin
PosCnt:=High(SubRoads[idx+1])+1;
SetLength(SubRoads[idx],PosCnt);
for PosNo:=0 to PosCnt-1 do
SubRoads[idx][PosNo]:= SubRoads[idx+1][PosNo];
end;
SetLength(SubRoads[High(SubRoads)],0);
// Dec(RoadCnt);
SetLength(SubRoads,RoadCnt);
end;

procedure TMapX.CheckPosMergeType(var MPos:TMergePos);
var
RoadIDX:integer;
PosIDX:integer;
begin
MPos.RoadID:=-100;
Mpos.MergeType:=MNone;

for RoadIDX:=0 to High(SubRoads) do
begin
// for PosIDX:=0 to High(SubRoads[RoadIDX]) do
if MPos.PosNo=SubRoads[RoadIDX][0] then
begin
MPos.RoadID:=RoadIDX;
MPos.MergeType:=MHead;
Exit;
end;

PosIDX:= High(SubRoads[RoadIDX]);
if MPos.PosNo=SubRoads[RoadIDX][PosIDX] then
begin
MPos.RoadID:=RoadIDX;
MPos.MergeType:=MEnd;
Exit;
end;
end;
end;


procedure TMapX.Add2SubRoadHead(RoadID,PosNo:integer);
var
PosIDX,PosCnt:integer;
begin
if (RoadID<0) or (RoadID>High(SubRoads))
then exit;

PosCnt:=High(SubRoads[RoadID])+2;
SetLength(SubRoads[RoadID],PosCnt);

for PosIDX:=PosCnt-2 downto 0 do //后移，
SubRoads[RoadID][PosIDX+1]:=SubRoads[RoadID][PosIDX]; //后移一位。

SubRoads[RoadID][0]:=PosNo;
end;

procedure TMapX.Add2SubRoadEnd(RoadID,PosNo:integer);
begin
AddSubRoadPos(RoadID,PosNo);
end;

procedure TMapX.AddRoadPos(X,Y:real;PosName:string;LabelPos:integer;EquipType, Status:Byte);
var
PosCnt:integer;
hicnt:integer;
begin
HiCnt:=High(RoadPos); //如果为空则取到-1
PosCnt:=HiCnt+1;

SetLength(RoadPos,PosCnt+1);
RoadPos[PosCnt].Name:=PosName;
RoadPos[PosCnt].Coord.longitude:=X;
RoadPos[PosCnt].Coord.Latitude:=Y;
RoadPos[PosCnt].LabelPos:=LabelPos;
RoadPos[PosCnt].EquipType := EquipType;
RoadPos[PosCnt].Status := Status;
// RoadPos[PosCnt].Passed:= ((Random(13)mod 2)=0 ) ; //测试用。
end;
cocu_chen 2006-02-09
  • 打赏
  • 举报
 回复
顶，楼主继续
leeky 2006-02-09
  • 打赏
  • 举报
 回复
procedure TMapX.DrawNewMap;
begin
InitLocation();
GetMapScope;
Refresh;
end;

procedure TMapX.ReCalcuCenter();
begin
CenterX:=MapLeft+(MapWidth div 2);
CenterY:=MapTop+(MapHeight div 2);
end;

function TMapX.Distance(X1,Y1,X2,Y2:real;Z1:real=0;Z2:real=0) : real;
var
LongiRate:real;
DeltaLongitude,DeltaLatitude:real;
begin
LongiRate:=Cos((Y1+Y2)/(2*Arc2Degree)); //化成弧度求平均值。
DeltaLongitude:=(X1-X2)* LongiDegree2Length *LongiRate;
//=111320.590351; //经度差一度（在赤道上）的长度，米
DeltaLatitude :=(Y1-Y2)* LatiDegree2Length ;
//=110947.089891;
Result:=Sqrt(Sqr(DeltaLongitude)+Sqr(DeltaLatitude));
end;

function TMapX.Distance(Coord1,Coord2:TCoordinate) :real;
begin
Result:=Distance(Coord1.longitude,Coord1.latitude,Coord2.longitude,Coord2.latitude);
end;

function TMapX.ConvXYToCoord(X,Y:integer):TCoordinate;
var
tmpCoord:TCoordinate;
DeltaLongi,DeltaLati:real;
XOff,YOff:integer;
begin
XOff:=X+Left-MapLeft; //与左上角相对而言。
YOff:=Y+Top-MapTop;

DeltaLongi:=BottomRight.longitude-TopLeft.longitude;
DeltaLati :=BottomRight.latitude-TopLeft.latitude; //此时不反向
if (DeltaLongi>0.000001) and (DeltaLati<-0.000001) //只要是正确设置，应当满足此式
then begin
tmpCoord.longitude := (XOff/MapWidth)*DeltaLongi+TopLeft.longitude;
tmpCoord.latitude := (YOff/MapHeight)*DeltaLati+TopLeft.latitude;
end;

result:=tmpCoord;
end;

procedure TMapX.ConvCoordToXY(coord:TCoordinate;var X,Y:integer);
var
//PosCnt,idx:integer;
DeltaLongi,DeltaLati:real;
//X,Y:array of integer;
Xoff,YOff:integer;
StrHeight,StrWidth:integer;
begin
// PosCnt:= High(RoadPos)+1;
// if (PosCnt<2) then exit; //少于两个点

DeltaLongi:= Abs(TopLeft.longitude-BottomRight.longitude);
DeltaLati:= Abs(TopLeft.latitude-BottomRight.latitude);
if (DeltaLongi<0.000001)
or (DeltaLati<0.000001)
then exit; //范围太小，或者相等。

XOff:=MapLeft-Left;
YOff:=MapTop -Top;
//SetLength(X,PosCnt);
//SetLength(Y,PosCnt);

X:=Round(MapWidth * (coord.longitude-TopLeft.longitude) / DeltaLongi);
Y:=Round(MapHeight* (TopLeft.latitude - coord.latitude) / DeltaLati);

end;

procedure TMapX.CreateSelPosWith2Pos(Pos1,Pos2:integer);
begin
SetLength(SelPosNos,2);
SelPosNos[0]:=Pos1;
SelPosNos[1]:=Pos2;
end;

procedure TMapX.SortSelPos2Road; //从被选点在 RoadPos中的序号 得到在子路中的序号
var //这里只作序号的对比，而不必用InArea判断距离。
RoadIDX,PosIDX:integer;
SelPosIDX: integer;
SelCnt:integer;
begin
SelCnt:=0;
SetLength(SelPosInRoads,0);

for RoadIDX:=0 to High(SubRoads) do //子路条数
for PosIDx:=0 to High(SubRoads[RoadIDX]) do //子路中的序号 保证在子路中增序
for SelPosIDX :=0 to High(SelPosNos) do
begin
if (SubRoads[RoadIDX][PosIDX]=SelPosNos[SelPosIDX]) then
begin
Inc(SelCnt);
SetLength(SelPosInRoads,SelCnt);
SelPosInRoads[SelCnt-1].SubRoadID:=RoadIDX;
SelPosInRoads[SelCnt-1].PosID:=PosIDX;
end;
end;
end;

function TMapX.GetNeighborSelPos (fromID:integer;var RoadID,PosID:integer):Boolean;
var
idx:integer;
begin
Result:=False;

for idx:=fromID to High(SelPosInRoads)-1 do
begin
if (SelPosInRoads[idx].SubRoadID=SelPosInRoads[idx+1].SubRoadID)
and (SelPosInRoads[idx].PosID= (SelPosInRoads[idx+1].PosID-1))
then begin
Result:=True;
RoadID:=SelPosInRoads[idx].SubRoadID;
PosID :=SelPosInRoads[idx+1].PosID;

Break; //已经找到。
end;
end;
end;

function TMapX.CheckSinglePosRoad(RoadID:integer):Boolean;
var
RoadIDX,PosIDX:integer;
HiRoad:integer;
PosNo:integer;
begin
Result:=false;

HiRoad:= High(SubRoads);

if (RoadID<0) or (RoadID>High(SubRoads))
then Exit;

if not (High(SubRoads[RoadID])=0) then Exit; //不是单点
DelSubRoad(RoadID);

// PosNo:= SubRoads[RoadID][0]; //路中只有一个点


{ for RoadIDX:=0 to HiRoad do
begin
if (RoadIDX<>RoadID) then //除去本路。
for PosIDX:=0 to High(SubRoads[RoadIDX]) do
if (PosNo=SubRoads[RoadIDX][PosIDX]) then
begin // 其它路中包含此点
Result:=True;
Exit;
end;
end;
}
end;

function TMapX.DivideSubRoad(RoadID,PosID:integer):Boolean;
var
SubRoadCnt:integer;
HiPos:integer;
PosIDX:integer;
begin
result:=False;
SubRoadCnt:=High(SubRoads);
HiPos:=High(SubRoads[RoadID]);

if RoadID>SubRoadCnt then exit;
if (PosID>HiPos) then Exit;

Inc(SubRoadCnt); //序号增加。
SetLength(SubRoads,SubRoadCnt+1); //新增一条路；
SetLength(SubRoads[SubRoadCnt],HiPos-PosID+1); // 新增路的点数

for PosIDX:=PosID to HiPos do
SubRoads[SubRoadCnt][PosIDX-PosID]:=SubRoads[RoadID][PosIDX];

SetLength(SubRoads[RoadID],PosID); //原来的路少去后来的点。 序号从０开始

//此两　路是否单点路且点已经包含在其它路中。
{ if CheckSinglePosRoad(SubRoadCnt) then self.DelSubRoad(SubRoadCnt);
if CheckSinglePosRoad(RoadID) then self.DelSubRoad(RoadID);}

ValidSubRoad(SubRoadCnt);
ValidSubRoad(RoadID);
//CheckSinglePosRoad(SubRoadCnt);
//CheckSinglePosRoad(RoadID);

result:=True;
end;
leeky 2006-02-09
  • 打赏
  • 举报
 回复
procedure TMapX.DrawRoadPos;
var {奇怪：画线必须在前才能显示点的名称。}
//RoadCnt,
RoadIDX:integer; //200404
PosCnt,idx:integer;
PosInSubRoad:integer;
DeltaLongi,DeltaLati:real;
X,Y:array of integer;
Xoff,YOff:integer;
StrHeight,StrWidth:integer;

dist:real; //20040324
tmpStr:string; //20040324
cirSz:integer;

PosNo1,PosNo2:integer;
begin
PosCnt:= High(RoadPos);
if PosCnt<0 then Exit; //居然写成RoadCnt

DeltaLongi:= Abs(TopLeft.longitude-BottomRight.longitude);
DeltaLati:= Abs(TopLeft.latitude-BottomRight.latitude);
if (DeltaLongi<0.000001)
or (DeltaLati<0.000001)
then exit; //范围太小，或者相等。

XOff:=MapLeft-Left;
YOff:=MapTop -Top;
SetLength(X,PosCnt+1);
SetLength(Y,PosCnt+1);
for idx :=0 to (PosCnt) do //把所有的对象点　坐标化为 X,Y
begin //得到坐标
X[idx]:=Round(MapWidth * (RoadPos[idx].Coord.longitude-TopLeft.longitude)/DeltaLongi);
Y[idx]:=Round(MapHeight* (TopLeft.latitude - RoadPos[idx].Coord.latitude) /DeltaLati);
end;


//画各子线
if UseBnW then
begin //Lee 20040324
Canvas.Brush.Color:=clWhite;
Canvas.Pen.Color:=clBlack;
Canvas.Pen.Width:=2;
end
else begin
Canvas.Pen.Color:=clBlack; //clBlue; //clSilver;
Canvas.Pen.Width:=2;
end;

StrHeight:=Canvas.TextHeight('测试');

for RoadIDX:=0 to High(SubRoads) do
begin
PosInSubRoad:=High(SubRoads[RoadIDX]); //子路中点数,从0起
if PosInSubRoad<0 then Continue; //没有点，则下一条子路。

for idx :=0 to (PosInSubRoad-1) do
begin
PosNo1:= SubRoads[RoadIDX][idx];
PosNo2:= SubRoads[RoadIDX][idx+1];

LinePixelOff(X[PosNo1],Y[PosNo1],X[PosNo2],Y[PosNo2],Xoff,YOff);
dist:= Distance(RoadPos[PosNo1].Coord.longitude,RoadPos[PosNo1].Coord.latitude,
RoadPos[PosNo2].Coord.longitude,RoadPos[PosNo2].Coord.latitude);
tmpStr:=Format('%2.1f',[dist]);
{ Format('%*.*f', [8, 2, 123.456]) 　is the same as Format('%8.2f', [123.456]).}
if (X[PosNo1]-X[PosNo2])* (Y[PosNo1]-Y[PosNo2])>0 //线段倾斜方向
then Canvas.TextOut( (X[PosNo1]+X[PosNo2])div 2+XOff+5,(Y[PosNo1]+Y[PosNo2])div 2+YOff-StrHeight,tmpStr ) //右上
else Canvas.TextOut( (X[PosNo1]+X[PosNo2])div 2+XOff+5,(Y[PosNo1]+Y[PosNo2])div 2+YOff+5,tmpStr ); //右下
end;
end;


//然后画点。
if UseBnW then
begin //打印地图时使用。
// Canvas.Brush.Color:=clBlack; 20040430
// Canvas.Pen.Color:=clBlack;
Canvas.Pen.Width:=2;
cirSz:=5;
end
else begin
Canvas.Pen.Width:=1;
cirSz:=7;
end;


for idx :=0 to PosCnt do
begin
if UseBnW then begin //打印地图时使用。
Canvas.Brush.Color:=clWhite;
Canvas.Pen.Color:=clBlack;
end
else if RoadPos[idx].Passed
then begin
Canvas.Brush.Color:=clLime;
Canvas.Pen.Color:=clBlack; //以使能看到边框。
end
else begin
Canvas.Brush.Color:=clSilver;
Canvas.Pen.Color:=clSilver;
end;

begin //画Symbol
DrawSymbol(idx,X[idx]+XOff,Y[idx]+YOff);
end;

if UseBnW then Canvas.Brush.Color:=clWhite else //2004 0324 0:44
Canvas.Brush.Color:=$0052DD4F; //与底色相近。

StrWidth:=Canvas.TextWidth(RoadPos[idx].Name);
//StrHeight:=Canvas.TextHeight(RoadPos[RoadIDX][idx].Name); 高度不必每次都算。
Case RoadPos[idx].LabelPos of
0: self.Canvas.TextOut(X[idx]+XOff-StrWidth div 2,Y[idx]+YOff-StrHeight-8,RoadPos[idx].Name); //上
1: self.Canvas.TextOut(X[idx]+XOff-StrWidth div 2,Y[idx]+YOff+8,RoadPos[idx].Name); //下
2: self.Canvas.TextOut(X[idx]+XOff-StrWidth-8 ,Y[idx]+YOff-StrHeight div 2,RoadPos[idx].Name); //左
else
self.Canvas.TextOut(X[idx]+XOff+8 ,Y[idx]+YOff-StrHeight div 2,RoadPos[idx].Name); //右
end;
end; //以上０４１５改为画点提前。



SetLength(X,0);
SetLength(Y,0);

end;

procedure TMapX.DrawPatrolPos;
var
PosCnt,idx:integer;
DeltaLongi,DeltaLati:real;
X,Y:array of integer;
Xoff,YOff:integer;


begin
if (maxDispPPosNo>High(PatrolPos))
then maxDispPPosNo:=High(PatrolPos);
if (maxDispPPosNo<0)
then begin
maxDispPPosNo:=-1;
Exit;
end;

PosCnt:= maxDispPPosNo+1;
//if (PosCnt<1) then exit; //少于两个点
//GetMapScope;
Canvas.Pen.Color:=clBlue;
Canvas.Pen.Width:=2;
Canvas.Brush.Color:=clBlue;

DeltaLongi:= Abs(TopLeft.longitude-BottomRight.longitude);
DeltaLati:= Abs(TopLeft.latitude-BottomRight.latitude);
if (DeltaLongi<0.000001)
or (DeltaLati<0.000001)
then exit; //范围太小，或者相等。

XOff:=MapLeft-Left;
YOff:=MapTop -Top;
SetLength(X,PosCnt);
SetLength(Y,PosCnt);
for idx :=0 to (PosCnt-1) do
begin
X[idx]:=Round(MapWidth * (PatrolPos[idx].Coord.longitude-TopLeft.longitude)/DeltaLongi);
Y[idx]:=Round(MapHeight* (TopLeft.latitude -PatrolPos[idx].Coord.latitude) /DeltaLati);

Canvas.Ellipse(X[idx]-4+XOff,Y[idx]-4+YOff,X[idx]+4+XOff,Y[idx]+4+YOff);
end;

for idx :=0 to (PosCnt-2) do
begin
LinePixelOff(X[idx],Y[idx],X[idx+1],Y[idx+1],Xoff,YOff);
end;

SetLength(X,0);
SetLength(Y,0);
end;

procedure TMapX.Refresh;
begin
ReloadBmp(FBmpFile);
//GetMapScope; //217提出来,因为每次重画都计算就是重复了.
DrawRoadPos;
DrawPatrolPos;
end;
leeky 2006-02-09
  • 打赏
  • 举报
 回复
implementation

procedure Register;
begin
RegisterComponents('故乡云', [TMapX]);
end;

Constructor TMapX.Create(AOwner:TComponent);
begin
inherited Create(AOwner);
{FOutLine:=TBevel.Create(self.Parent);
FoutLine.Parent:=self.Parent;
FOutLine.Shape:=bsFrame;
FoutLine.Visible:=false;
由于自动生成看不到东西，现改成赋值。
}
FBmpFile:='';
FZoomRatio:=1;

InitTraceData;

LongiToLati:=0.866;
Top:=0;
Left:=0;
MapTop:=Top;
MapLeft:=Left;
MapWidth :=Width;
MapHeight:=Height;
ReCalcuCenter; //确定中心位置
OnMouseDown :=LeeMouseDown;
OnMouseMove :=LeeMouseMove;
OnMouseUp :=LeeMouseUp;
// ResetViewSize; //设置可视大小
DrawViewBox(2,clRed); //用宽度为2的笔画红框
Stretch:=true; //设为true就不闪烁。
//以下设为成都的范围
TopLeft.longitude:=104.0677;
TopLeft.latitude :=30.6843;
BottomRight.longitude:=104.2547;
BottomRight.latitude :=30.5513;
FPrecision:= 50; //精度(误差)50米。
end;

Destructor TMapX.Destroy;

begin
// FOutLine.Free; 现改为非自动生成。
InitTraceData;
{ FreeRoadPos; //释放检查站点
FreePatrolPos; //释放检查路线
}
ClearSymbols;

inherited Destroy;
end;

procedure TMapX.SetZoomRatio(ratio:real);
begin
FZoomRatio:=ratio;
ViewWidth:=parent.Width;
ViewHeight:=parent.Height;
MapWidth :=Round(ViewWidth*ZoomRatio);
MapHeight :=Round(ViewHeight*ZoomRatio);
ReCalcuCenter();
end;

procedure TMapX.SetSubRoadCnt(SRCnt:Byte);
begin
SetLength(RoadPos,SRCnt);
end;

procedure TMapX.InitTraceData;
var
idx:integer;
begin
FreeRoadPos();

FreePatrolPos;
end;

procedure TMapX.InitSubRoad(SubRoadCnt:integer=0);
var
idx:integer;
begin
SetLength(SubRoads,SubRoadCnt);
for idx:= 0 to SubRoadCnt-1 do
SetLength(SubRoads[idx],0);
end;

procedure TMapX.FreeRoadPos;
var
// PosCnt:integer;
idx:integer;
begin
// for idx:=0 to High(RoadPos) do //0404
SetLength(RoadPos,0);
for idx:=0 to High(SubRoads) do
SetLength(SubRoads[idx],0);
SetLength(SubRoads,0);

SetLength(RoadPos,0);
end;

procedure TMapX.FreePatrolPos;
//var
// PosCnt:integer;
// idx:integer;
begin

SetLength(PatrolPos,0);
end;

procedure TMapX.DrawSymbol(PosNo,X,Y:integer);
var
HaveSymbol:Boolean;
bmpXOff,bmpYOff:integer;
begin
HaveSymbol:=false;

if ( (RoadPos[PosNo].EquipType>High(EquipSymbols) )
or (RoadPos[PosNo].EquipType<0) )
then HaveSymbol:=false
else HaveSymbol:=(EquipSymbols[RoadPos[PosNo].EquipType]<>nil);

if not HaveSymbol then
Canvas.Ellipse(X-5,Y-5,X+5,Y+5)
else
begin
BmpXOff:=EquipSymbols[RoadPos[PosNo].EquipType].Width div 2;
BmpYOff:=EquipSymbols[RoadPos[PosNo].EquipType].Height div 2;
Canvas.Draw(X-BmpXOff,Y-BmpYOff,EquipSymbols[RoadPos[PosNo].EquipType]);
end;
end;
liuwenke 2006-02-08
  • 打赏
  • 举报
 回复
顶
leeky 2006-02-07
  • 打赏
  • 举报
 回复
To:Zricepig(Ricepig)
你好，我这里实现的是一个非常简单的东西。更深入的我是没能力也没精力去做了。
我这两年在做公路自动化方面的项目。

终于等到了大家的顶贴，我便能继续发帖了，
呵呵，等两天有空我继续贴完余下的代码。
不过每回三帖还得朋友们顶一下，否则我不能继续发下去。
2312 2006-02-06
  • 打赏
  • 举报
 回复
期盼中
romantice 2006-02-02
  • 打赏
  • 举报
 回复
盛赞
小弟对牛人的控件非常感兴趣,小弟同时也在学习这方面的知识,希望能与楼主认识一下,我的联系方式是:
e-mail:swgbq@126.com
qq:470987784
Zricepig 2006-01-29
  • 打赏
  • 举报
 回复
赞
地图符号化是非常繁琐的东西，楼主多加努力：）
dyh0 2006-01-24
  • 打赏
  • 举报
 回复
希望继续出下一期！
dyh0 2006-01-23
  • 打赏
  • 举报
 回复
正在找这方面的资料，顶一下。
leeky 2006-01-18
  • 打赏
  • 举报
 回复
TMapX = class(TImage)
private
{ Private declarations }
// TopLeft,BottomRight:TCoordinate;

CenterX,CenterY:integer; //中心位置；
X1,Y1,X2,Y2:integer;
GetFirstPos:Boolean;
FPrecision:real;

//ViewTop,ViewLeft, //此二者等于UI的左上角坐标，即Top 与 Left 值.
ViewWidth,ViewHeight:integer; //两者等于底图(parent，而非UI)的大小。
//以上成员只在控件源代码中使用，调用控件者不设置；
FOutLine:TBevel; //漫游或缩放时显示范围的边框
//FBoxWidth:integer; //边框宽度

FToolNo:integer;
FBmpFile:String; //背景文件名

FZoomRatio : real; //比例大小。
FLongiToLati:real; //所在纬度上经度变化相当于赤道的比
// FLengthRate:real; //一个点代表的实际距离
// FCurX,FCurY:integer; //这两 个好像没用。

FOnToolsUsed:TToolsUsed; //工具使用事件。
FOnToolsMSMove:TToolsMSMove;

procedure SetToPicSize; //设置到图片大小，使其在stretch=true时没有缩放。
procedure SetBmpFile(FileStr:String);
procedure SetPrecision(precis:real);

procedure DrawViewBox(penWid:integer;color:TColor);
procedure SetToolNo(No:integer);
// procedure SetWidth(wid:integer);
// procedure LeeSetHeight(het:integer);
procedure ReCalcuCenter;
//procedure MoveTo(X,Y:integer);
procedure InitLocation;
procedure ResetZoom(zoom:real);

procedure ValidSubRoad(SubRoadID :integer);
procedure DrawSymbol(PosNo,X,Y:integer);
protected
{ Protected declarations }

public
{ Public declarations }
UseBnW:Boolean; //是白＋黑？ 20040324
RoadName:String; //路线名　 20040324

EquipSymbols : array of TBitmap;

RoadPos : array of TRoadPosition; //道路数据，名称、坐标
SubRoads : array of array of integer; //0415 组成所有子路的点 在 RoadPos 中 序号
PatrolPos : array of TPatrolPosition; //巡查数据
maxDispPPosNo:integer; //已经显示的巡查点最大序号

SelPosNos : array of integer; //被选择的点 在 RoadPos 中的序号
SelPosInRoads: array of TSelPosInRoads; //被选点在子路中的序号

MapTop,MapLeft,MapWidth,MapHeight:integer; //由于要做鹰眼,故放到公用部分.
TopLeft,BottomRight:TCoordinate; //虚地图的上左与下右两点的经纬度坐标

constructor Create(AOwner: TComponent); override;
destructor Destroy; override;

function Distance(X1,Y1,X2,Y2:real;Z1:real=0;Z2:real=0) : real; overload; //近似计算地球上 两点的距离，参数为经、纬度，结果单位为 米。
function Distance(Coord1,Coord2:TCoordinate) :real; overload;
function ConvXYToCoord(X,Y:integer):TCoordinate;
procedure ConvCoordToXY(coord:TCoordinate;var X,Y:integer); // 216 求经纬度对应的屏幕坐标. 以虚地图为基准.

procedure ResetViewSize; //重新设置可视范围大小（初始化与窗体Resize时）
procedure GetMapScope; //得到左上与右下点代表的经纬度。

procedure FirstInit;

function NearPos(Pos1,Pos2:TCoordinate):boolean;
function InArea(APos,PosB,PosE:TCoordinate): Boolean;
procedure ReloadBmp(FileStr:String); //????
procedure MoveUITo(X,Y:integer);
procedure MoveBy(Xoff,YOff:integer);
procedure SetCenter(coord:TCoordinate);

procedure ResetCenter;
procedure ZoomBy(X0,Y0:integer;Zoom:real);
procedure ZoomWith(X1,Y1,X2,Y2:integer;Shift: TShiftState);

procedure LineGeo(Pos1,Pos2:TCoordinate;pColor:TColor;pWidth:integer);
procedure DrawPassRoadPos(PosNo:integer);
procedure DrawPatrolCircle(PatrolPosNo:integer);
procedure DrawCurrCircle;
procedure UILinePixel(X1,Y1,X2,Y2:integer); //最终UI上的画图
procedure LinePixelOff(X1,Y1,X2,Y2,XOff,YOff:integer); //位置为虚地图上的象素，不必计算偏移
procedure LinePixel(X1,Y1,X2,Y2:integer); //位置为虚地图上的象素

procedure LeeMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure LeeMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);

procedure CheckViewArea;
procedure LeeMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);

procedure AddRoadPos(X,Y:real;PosName:string;LabelPos:integer; EquipType, Status:Byte); overload; //1222 加上标签位置
procedure AddRoadPos(Coord:TCoordinate;PosName:string;LabelPos:integer; EquipType, Status:Byte); overload;
procedure AddRoadPos(APos:TRoadPosition); overload;

procedure AllPosAs1SubRoad;
function AddSubRoadPos(SubRoadID,PosNo:integer):Boolean;

procedure DeleteEmptySubRoads;
// procedure AddPosToSubRoad(RoadID,PosID:integer);
//1222新增
// procedure AppendRoadPos(Longitude,Latitude:real;LocName:string;LabelPos:integer);
procedure InsertRoadPos(idx:integer;Longitude,Latitude:real;LocName:string;LabelPos:integer); overload;
procedure InsertRoadPos(idx:integer;Coord:TCoordinate;LocName:string;LabelPos:integer); overload;

procedure DeleteRoadPos(idx:integer);

procedure ModifyRoadPos(PosNo:integer;APos:TRoadPosition); //overload;
//procedure ModifyRoadPos(idx:integer;Coord:TCoordinate;LocName:string;LabelPos:integer); overload;

function GetRoadPos(PosName:String;ExceptNo:integer):integer;
// }
procedure SetRoadPosPassed(idx:integer;passed:Boolean); //1222,检测点是否已经经过
procedure AddPatrolPos(X,Y:real;time:TDateTime;Status:Byte);
procedure FreeRoadPos;
procedure FreePatrolPos;
procedure DrawRoadPos;
procedure DrawPatrolPos;

procedure SetSubRoadCnt(SRCnt:Byte);
procedure InitTraceData;

procedure InitSubRoad(SubRoadCnt:integer=0);

procedure Refresh; // 重画
procedure DrawNewMap; // 第一次画某地图;

procedure SetZoomRatio(ratio:real);

procedure CreateSelPosWith2Pos(Pos1,Pos2:integer); //生成含两个点的选取序列
function GetNeighborSelPos (fromID:integer;var RoadID,PosID:integer):Boolean;
procedure SortSelPos2Road; // 把选取的点序列对应到各子路的点序列中去
function DivideSubRoad(RoadID,PosID:integer):Boolean;
function CheckSinglePosRoad(RoadID:integer) :Boolean;

function ISIsolatedPos(PosNo:integer) :Boolean;
function DelIsolatedPos(PosNo:integer) :Boolean;
function InSertIsolatedPos(PosNo:integer):Boolean;
function DelSubRoad(RoadID:integer):Boolean;

procedure CheckPosMergeType(var MPos:TMergePos); //检测点在哪条路上的哪个端点。

procedure Add2SubRoadHead(RoadID,PosNo:integer);
procedure Add2SubRoadEnd(RoadID,PosNo:integer);
procedure MergeTwoSubRoad(Road1:integer;mType1:TMergeType; Road2:integer;mType2:TMergeType ); overload;
procedure MergeTwoSubRoad(MergePos1,MergePos2:TMergePos); overload;
procedure CreateSubRoadWith(PosNo1,PosNo2:integer);

function InSameSubRoad(MPos1,MPos2:TMergePos):Boolean;
procedure ConnectPos(Pos1,Pos2:integer); //连接两点。

procedure ClearSymbols;
published
{ Published declarations }
property BmpFile :string read FBmpFile write SetBmpFile;

property ZoomRatio :real read FZoomRatio write SetZoomRatio ; //FZoomRatio;
property Precision :real read FPrecision write SetPrecision;
property LongiToLati : real read FLongiToLati write FLongiToLati; //北纬三十度Cos30=0.866025....
property ToolNo :integer read FToolNo write SetToolNo default 0;
property OnToolsUsed :TToolsUsed read FOnToolsUsed write FOnToolsUsed;
property OnToolsMSMove :TToolsMSMove read FOnToolsMSMove write FOnToolsMSMove;
// property GetFirstPos:Boolean read FGetFirstPos write FGetFirstPos;
property OutLine :TBevel read FOutLine write FoutLine;

end;

procedure Register;
leeky 2006-01-18
  • 打赏
  • 举报
 回复
由于代码太长，须分多次发表，请而CSDN似乎会限制连续回帖的数量，所以在必要时请感兴趣的朋友帮顶。
unit LeeMapX;

interface

uses
Windows, Messages, SysUtils, Classes, Controls, ExtCtrls,Dialogs,
Graphics;

const
toolNone=0;
toolPan=1;
toolMeasure=2;
toolZoom=3;
// toolZoomOut=4; 不分ZoomIn 与 ZoomOut
toolBoxSel=5; //框选
toolPosSel=6; //点选

myPi=3.1415926535897932385;
Arc2Degree=57.295779513082321;
LongiDegree2Length=111320.590351; //经度差一度（在赤道上）的长度，米
//Pi* 6,378.2*1000/180
LatiDegree2Length=110947.089891; // 纬度差一度（经线上）的长度，米
//Pi* 6,356.8*1000/180

type
{TVMap=Record

ZoomRatio:real; //后五参数由以上两参数算出。
Top,Left,Width,Height:integer;
end;}
TCoordinate=record
longitude,latitude:real;
end;

TEdage=Record
RoadID :integer; //哪条路
EdageNo:integer; //哪条边。
end;

TRoadPosition=record
Name:string[24];
LabelPos:byte; //标签显示在上\下左右的哪个方位.
Coord :TCoordinate;
// Shape:TShape; //标示其位置的图形 1217晚 不再使用,而直接用圆
Passed:boolean;
EquipType : Byte; { 200404
0:电杆，
1：变压器
}
Status: Byte; {
最新的状态。
状态　完好？损伤？
}
PStatus:Byte; // 巡查时的状态。
end;

TPatrolPosition=record
PatrolTime:TDateTime;
Coord :TCoordinate;
State: Byte; //200404
{ 　完好
　　待修
　　报废
}
end;

TSelPosInRoads=record
SubRoadID: WORD; //子线路
PosID: WORD; //点序号
end;

TMergeType=(MHead,MEnd,MNone); //以头接，以尾接，既不是头也不是尾。

TMergePos=record
PosNo :integer;
RoadID :integer;
MergeType :TMergeType;
end;

TToolsUsed=procedure(Sender:TObject; tools:integer;Distance:real;Coord1,Coord2:TCoordinate ) of Object;
TToolsMSMove=procedure(Sender:TObject; tools:integer;Distance:real;Coord:TCoordinate ) of Object;
leeky 2006-01-18
  • 打赏
  • 举报
 回复
{
　２００４年四月新要求：
１、巡查员与内码不对应。
　　　巡查员可拿任何记录仪巡查；在读时指定人员。
２、读数据时巡查路线不必智能判断；
　　　指定路线，
　　　如果存有多次巡查，则要求读多次，每次指定不同线路。
３、更改后，在读数据后显示判断结果（类回放）。
３、路线可以分岔。
　　编辑，算法是重点。

程序中作如下改动：
增加工具 toolBoxSel=5; //框选
　　　　　toolPosSel=6;
TSelPosInRoads　类型　
SelPosInRoads 变量
　RoadPos 只记点，不管具体子路，
　SubRoads　　二维动态数组 记子路。
　TRoadPosition　增加　EquipType域 记录它是电杆还是变压器等。
TPatrolPosition　增加　State域 记录电杆等设备完好程度
修改原距离计算为Distance(X1,Y1,X2,Y2:real;Z1:real=0;Z2:real=0) 增加高度数据
Distance(Coord1,Coord2:TCoordinate) :real; 函数，重载。
procedure SetSubRoadCnt(SRCnt:integer);
function DivideSubRoad(RoadID,PosID:integer):Boolean;
function GetNeighborSelPos (fromID:integer;var RoadID,PosID:integer):Boolean;

0415在以上基础上把一条路线的所有点改回到一个一维动态数组，但另设一个二维的动态数组
记录子路的点的序号，（数据库当然要改：RoadDetail对应前一个动态数组，不再记录子路号；
另设计一个子路表对应第二个动态数组）：原因===>>>按前面的设计，如果某点在多个子路上，
实际上各子路都有这个点的一个拷贝，当修改某个点时，还得去修改相关所有子路，点不具有唯一性
SubRoads
procedure AddRoadPos(Coord:TCoordinate;PosName:string;LabelPos:integer); overload;
function AddSubRoadPos(SubRoadID,PosNo:integer):Boolean;
procedure InitSubRoad(SubRoadCnt:integer=0);
}


{说明：
1、底图表示要放置地图的容器控件（TImage等）；
2、背景表此地图控件载入的Bmp图像（其它图不能Canvas?）
3、地图控件的大小与其载入的图像一样大小（保证要大于底图，可设到1024X768），但要设置为Stretch=true;
4、引入虚地图的概念：MapLeft,MapTop,MapWidth,MapHeight表示了虚地图的位置、大小
Top,Left,ViewHeight,ViewWidth表示可视区域的位置、大小（大小一般不变，等于底图的大小，并随其变化）。
}

{
现在通用的地球形态大小的数据 (大气圈未计算在内)为：
极半径长度： 6,356.8千米
赤道半径长度： 6,378.2千米
扁率： 1/298 //6378/21.4=298.037
面积：510,000,000平方千米
平均半径长度： 6,371千米
体积：1,083,230,000,000立方千米
赤道长度： 40,076千米
子午线长度： 40,009千米
}
Object Pascal脚本控件
嘿嘿，不要以为Pascal语言就没有脚本了。。。全新的RemObjects Pascal Script for Delphi诞生了，这个控件组支持编译Object Pascal语言脚本，还支持运行，不可多得哦！
SynEdit delphi控件 显示行号 语法高亮
SynEdit delphi控件 显示行号 语法高亮 保证XE7下成功编译安装
YOLOX目标检测：原理与源码解析
【为什么要学习这门课】Linux创始人Linus Torvalds有一句名言：Talk is cheap. Show me the code. 冗谈不够，放码过来！代码阅读是从基础到提高的必由之路。 YOLOX是旷视科技新近推出的高性能实时目标检测网络，性能超越了YOLOv3/YOLOv4 /YOLOv5。YOLOX使用PyTorch实现，含有很多业界前沿和常用的技巧，可以作为很好的代码阅读案例，让我们深入探究其实现原理，其中不少知识点的代码可以作为相关项目的借鉴。【课程内容与收获】本课程将在Ubuntu和Windows系统演示YOLOX对PASCAL VOC数据集和训练和测试，并详细解析YOLOX的实现原理和源码，对关键代码使用PyCharm的debug模式逐行分析解读。 本课程将提供注释后的YOLOX的源码程序文件。【相关课程】除本课程《YOLOX目标检测：原理与源码解析》外，请关注YOLOX系列的其它课程，包括：《YOLOX目标检测实战：训练自己的数据集》https://edu.csdn.net/course/detail/35586《YOLOX目标检测实战：TensorRT加速部署》https://edu.csdn.net/course/detail/35716《YOLOX目标检测实战：OpenVINO部署》https://edu.csdn.net/course/detail/35791《YOLOX目标检测实战：Flask部署》https://edu.csdn.net/course/detail/35815 《YOLOX目标检测实战：Android（安卓）手机部署》https://edu.csdn.net/course/detail/35884
Delphi HCView-Pascal Full Source + Demo
Delphi HCView-Pascal 源码和Demo，一个类似word或wps用于文字排版相关功能的控件，支持Delphi10.x
Pascal 函数集——Delphi 控件属性集
Pascal 函数集——Delphi 控件属性集
地理信息系统

2,142

社区成员

8,289

社区内容

发帖
与我相关
我的任务
社区描述
它是一种特定的十分重要的空间信息系统。它是在计算机硬、软件系统支持下，对整个或部分地球表层（包括大气层）空间中的有关地理分布数据进行采集、储存、管理、运算、分析、显示和描述的技术系统。
社区管理员
  • 地理信息系统
加入社区
  • 近7日
  • 近30日
  • 至今

加载中

查看更多榜单
社区公告
暂无公告

试试用AI创作助手写篇文章吧

+ 用AI写文章