pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

lazmapviewer: Cosmetic changes

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6809 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2019-01-27 18:44:08 +00:00
parent f962f9a439
commit 70aa57d3bb
9 changed files with 634 additions and 682 deletions
Download Patch File Download Diff File Expand all files Collapse all files

3
components/lazmapviewer/source/mvcache.pas
View File

@ -22,7 +22,8 @@ unit mvCache;
interface
uses
Classes, SysUtils,mvmapprovider,IntfGraphics,syncObjs,mvtypes;
Classes, SysUtils, IntfGraphics, syncObjs,
mvMapProvider, mvTypes;
Type

19
components/lazmapviewer/source/mvdragobj.pas
View File

@ -31,7 +31,7 @@ Type
{ TDragObj }
TDragObj = Class
TDragObj = class
private
FMouseDown : boolean;
FLnkObj: TObject;
@ -64,8 +64,6 @@ Type
property OnDrag: TDragEvent read FOnDrag write SetOnDrag;
property OnEndDrag: TDragEvent read FOnEndDrag write SetOnEndDrag;
property OfsX: integer read FOfsX;
property OfsY: integer read FOfsY;
property StartX: integer read FStartX;
@ -78,6 +76,7 @@ Type
property DragSrc: TObject Read FStartSrc;
end;
implementation
{ TDragObj }
@ -119,7 +118,7 @@ end;
procedure TDragObj.DoDrag(X, Y: integer);
begin
if (X<>FEndX) or (Y<>FEndY) then
Begin
begin
SetDest(X,Y);
if Assigned(FOnDrag) then
FOnDrag(Self);
@ -157,15 +156,15 @@ end;
procedure TDragObj.MouseDown(aDragSrc : TObject;X, Y: integer);
begin
if not(FMouseDown) then
Begin
begin
FDragSrc := aDragSrc;
FMouseDown := True;
FStartX := X;
FStartY := Y;
FEndX := X;
FEndY := Y;
End
Else
end
else
AbortDrag;
end;
@ -175,11 +174,11 @@ begin
FMouseX := X;
FMouseY := Y;
if FMouseDown then
Begin
begin
if InDrag then
DoDrag(X,Y)
else
Begin
begin
if HasMoved(X,Y) then
DoStartDrag(X,Y);
end;
@ -190,7 +189,7 @@ end;
procedure TDragObj.MouseUp(X, Y: integer);
begin
if FMouseDown then
Begin
begin
FMouseDown := False;
if InDrag then
DoEndDrag(X,Y);

30
components/lazmapviewer/source/mvengine.pas
View File

@ -39,7 +39,8 @@ const
Type
TDrawTileEvent = Procedure (const TileId : TTileId;X,Y : integer;TileImg : TLazIntfImage) of object;
TDrawTileEvent = Procedure (const TileId: TTileId; X,Y: integer;
TileImg: TLazIntfImage) of object;
TTileIdArray = Array of TTileId;
@ -133,11 +134,12 @@ Type
procedure DblClick(Sender: TObject);
procedure MouseDown(Sender: TObject; Button: TMouseButton;
{%H-}Shift: TShiftState; X, Y: Integer);
procedure MouseMove(Sender: TObject; {%H-}Shift: TShiftState; X, Y: Integer);
procedure MouseMove(Sender: TObject; {%H-}Shift: TShiftState;
X, Y: Integer);
procedure MouseUp(Sender: TObject; Button: TMouseButton;
{%H-}Shift: TShiftState; X, Y: Integer);
procedure MouseWheel(Sender: TObject; {%H-}Shift: TShiftState; WheelDelta: Integer;
{%H-}MousePos: TPoint; var Handled: Boolean);
procedure MouseWheel(Sender: TObject; {%H-}Shift: TShiftState;
WheelDelta: Integer; {%H-}MousePos: TPoint; var Handled: Boolean);
procedure ZoomOnArea(const aArea: TRealArea);
property Center: TRealPoint read GetCenter write SetCenter;
@ -146,8 +148,10 @@ Type
property Active: Boolean read FActive write SetActive default false;
property CacheOnDisk: Boolean read GetCacheOnDisk write SetCacheOnDisk;
property CachePath: String read GetCachePath write SetCachePath;
property DownloadEngine: TMvCustomDownloadEngine read FDownloadEngine write SetDownloadEngine;
property DrawTitleInGuiThread: boolean read FDrawTitleInGuiThread write FDrawTitleInGuiThread;
property DownloadEngine: TMvCustomDownloadEngine
read FDownloadEngine write SetDownloadEngine;
property DrawTitleInGuiThread: boolean
read FDrawTitleInGuiThread write FDrawTitleInGuiThread;
property Height: integer read GetHeight write SetHeight;
property JobQueue: TJobQueue read Queue;
property MapProvider: String read GetMapProvider write SetMapProvider;
@ -161,6 +165,7 @@ Type
property OnZoomChange: TNotifyEvent read FOnZoomChange write FOnZoomChange;
end;
implementation
uses
@ -171,7 +176,7 @@ type
{ TLaunchDownloadJob }
TLaunchDownloadJob = Class(TJob)
TLaunchDownloadJob = class(TJob)
private
AllRun: boolean;
Win: TMapWindow;
@ -187,7 +192,8 @@ type
procedure ExecuteTask(aTask: integer; FromWaiting: boolean); override;
function Running: boolean; override;
public
Constructor Create(Eng: TMapViewerEngine; const Tiles: TTileIdArray; const aWin: TMapWindow);
constructor Create(Eng: TMapViewerEngine; const Tiles: TTileIdArray;
const aWin: TMapWindow);
end;
@ -295,7 +301,7 @@ end;
{ TEnvTile }
constructor TEnvTile.Create(const aTile : TTileId;Const aWin : TMapWindow);
constructor TEnvTile.Create(const aTile: TTileId; const aWin: TMapWindow);
begin
Tile := aTile;
Win := aWin;
@ -357,8 +363,8 @@ var
begin
MaxX := (Int64(aWin.Width) div TILE_SIZE) + 1;
MaxY := (Int64(aWin.Height) div TILE_SIZE) + 1;
startX := (-(aWin.X)) div TILE_SIZE;
startY := (-(aWin.Y)) div TILE_SIZE;
startX := -aWin.X div TILE_SIZE;
startY := -aWin.Y div TILE_SIZE;
Result.Left := startX;
Result.Right := startX + MaxX;
Result.Top := startY;
@ -713,9 +719,7 @@ var
aPt: TPoint;
Begin
if Sender.LnkObj = nil then
begin
Sender.LnkObj := TMemObj.Create(MapWin);
end;
old := TMemObj(Sender.LnkObj);
aPt.X := old.FWin.Width DIV 2-Sender.OfsX;
aPt.Y := old.FWin.Height DIV 2-Sender.OfsY;

2
components/lazmapviewer/source/mvextradata.pas
View File

@ -22,11 +22,11 @@ type
property Id: integer read FId;
End;
implementation
{ TDrawingExtraData }
procedure TDrawingExtraData.SetColor(AValue: TColor);
begin
if FColor = AValue then Exit;

84
components/lazmapviewer/source/mvgeonames.pas
View File

@ -195,47 +195,9 @@ begin
parser.Free;
end;
end;
(*
function TMVGeoNames.RemoveTag(Const str : String) : TStringArray;
var iStart,iEnd,i : Integer;
tmp : String;
lst : TStringList;
Begin
SetLength(Result,0);
tmp := StringReplace(str,'<br>',#13,[rfReplaceall]);
tmp := StringReplace(tmp,'&nbsp;',' ',[rfReplaceall]);
tmp := StringReplace(tmp,' ',' ',[rfReplaceall]);
repeat
iEnd:=-1;
iStart:=pos('<',tmp);
if iStart>0 then
Begin
iEnd:=posEx('>',tmp,iStart);
if iEnd>0 then
Begin
tmp:=copy(tmp,1,iStart-1)+copy(tmp,iEnd+1,length(tmp));
end;
end;
until iEnd<=0;
lst:=TStringList.Create;
try
lst.Text:=tmp;
SetLEngth(Result,lst.Count);
For i:=0 to pred(lst.Count) do
Result[i]:=trim(lst[i]);
finally
freeAndNil(lst);
end;
end;
*)
function TMVGeoNames.Search(ALocationName: String;
ADownloadEngine: TMvCustomDownloadEngine): TRealPoint;
{
const
LAT_ID = '<span class="latitude">';
LONG_ID = '<span class="longitude">';
}
var
s: string;
@ -260,12 +222,6 @@ var
var
ms: TMemoryStream;
url: String;
{
iRes,i : integer;
lstRes : Array of TResRec;
iStartDescr : integer;
lst : TStringArray;
}
begin
FLocationName := ALocationName;
ms := TMemoryStream.Create;
@ -280,46 +236,6 @@ begin
end;
Result := Parse(PChar(s));
{
Result.Lon := 0;
Result.Lat := 0;
SetLength(lstRes, 0);
iRes := Pos('<span class="geo"',s);
while (iRes>0) do
begin
SetLength(lstRes,length(lstRes)+1);
lstRes[high(lstRes)].Loc.Lon := StrToFloat(gs(LONG_ID,iRes));
lstRes[high(lstRes)].Loc.Lat := StrToFloat(gs(LAT_ID,iRes));
iStartDescr := RPosex('<td>',s,iRes);
if iStartDescr>0 then
begin
lst:=RemoveTag(Copy(s,iStartDescr,iRes-iStartDescr));
if length(lst)>0 then
lstRes[high(lstRes)].Name:=lst[0];
lstRes[high(lstRes)].Descr:='';
for i:=1 to high(lst) do
lstRes[high(lstRes)].Descr+=lst[i];
end;
Result.Lon += lstRes[high(lstRes)].Loc.Lon;
Result.Lat += lstRes[high(lstRes)].Loc.Lat;
iRes := PosEx('<span class="geo"',s,iRes+17);
end;
if Length(lstRes) > 0 then
begin
if Length(lstRes) > 1 then
begin
Result.Lon := Result.Lon/length(lstRes);
Result.Lat := Result.Lat/length(lstRes);
end;
if Assigned(FOnNameFound) then
for iRes:=low(lstRes) to high(lstRes) do
begin
FOnNameFound(lstRes[iRes].Name, lstRes[iRes].Descr, lstRes[iRes].Loc);
end;
end;
}
end;
end.

216
components/lazmapviewer/source/mvgpsobj.pas
View File

@ -23,15 +23,17 @@ interface
uses
Classes, SysUtils,fgl,mvtypes,contnrs,syncobjs;
const
NO_ELE = -10000000;
NO_DATE = 0;
type
TIdArray = Array of integer;
{ TGPSObj }
TGPSObj = Class
TGPSObj = class
private
BBoxSet: Boolean;
FBoundingBox: TRealArea;
@ -43,18 +45,17 @@ type
procedure SetExtraData(AValue: TObject);
public
destructor Destroy; override;
Procedure GetArea(out Area : TRealArea);virtual;abstract;
procedure GetArea(out Area: TRealArea); virtual; abstract;
property Name: String read FName write FName;
property ExtraData: TObject read FExtraData write SetExtraData;
property BoundingBox: TRealArea read GetBoundingBox write SetBoundingBox;
end;
TGPSObjarray = Array of TGPSObj;
{ TGPSPoint }
TGPSPoint = Class(TGPSObj)
TGPSPoint = class(TGPSObj)
private
FRealPt: TRealPoint;
FEle: Double;
@ -62,12 +63,13 @@ type
function GetLat: Double;
function GetLon: Double;
public
Procedure GetArea(out Area : TRealArea);override;
Function HasEle : boolean;
Function HasDateTime : Boolean;
Function DistanceInKmFrom(OtherPt : TGPSPoint;UseEle : boolean=true) : double;
constructor Create(ALon,ALat : double;AEle : double=NO_ELE;ADateTime : TDateTime=NO_DATE);
Class function CreateFrom(aPt : TRealPoint) : TGPSPoint;
class function CreateFrom(aPt: TRealPoint): TGPSPoint;
procedure GetArea(out Area: TRealArea);override;
function HasEle: boolean;
function HasDateTime: Boolean;
function DistanceInKmFrom(OtherPt: TGPSPoint; UseEle: boolean=true): double;
property Lon: Double read GetLon;
property Lat: Double read GetLat;
@ -80,7 +82,7 @@ type
{ TGPSTrack }
TGPSTrack = Class(TGPSObj)
TGPSTrack = class(TGPSObj)
private
FDateTime: TDateTime;
FPoints: TGPSPointList;
@ -89,8 +91,8 @@ type
constructor Create;
destructor Destroy; override;
Procedure GetArea(out Area : TRealArea);override;
Function TrackLengthInKm(UseEle : Boolean=true) : double;
procedure GetArea(out Area: TRealArea); override;
function TrackLengthInKm(UseEle: Boolean=true): double;
property Points: TGPSPointList read FPoints;
property DateTime: TDateTime read GetDateTime write FDateTime;
@ -104,13 +106,15 @@ type
private
FRef: TObject;
public
Destructor Destroy;override;
destructor Destroy; override;
end;
{ TGPSObjectList }
TModifiedEvent = procedure (Sender : TObject;objs : TGPSObjList;Adding : boolean) of object;
TGPSObjectList = Class(TGPSObj)
TModifiedEvent = procedure (Sender: TObject; objs: TGPSObjList;
Adding: boolean) of object;
TGPSObjectList = class(TGPSObj)
private
Crit: TCriticalSection;
FPending: TObjectList;
@ -118,54 +122,58 @@ type
FOnModified: TModifiedEvent;
FUpdating: integer;
FItems: TGPSObjList;
function Getcount: integer;
function GetCount: integer;
protected
Procedure _Delete(Idx: Integer; var DelLst: TGPSObjList);
Procedure FreePending;
Procedure DecRef;
procedure _Delete(Idx: Integer; var DelLst: TGPSObjList);
procedure FreePending;
procedure DecRef;
procedure Lock;
procedure UnLock;
procedure CallModified(lst: TGPSObjList; Adding: boolean);
property Items: TGPSObjList read FItems;
procedure IdsToObj(const Ids: TIdArray; out objs: TGPSObjArray; IdOwner: integer);
public
Procedure GetArea(out Area : TRealArea);override;
function GetObjectsInArea(const Area: TRealArea): TGPSObjList;
constructor Create;
destructor Destroy; override;
Procedure Clear(OwnedBy: integer);
procedure ClearExcept(OwnedBy : integer;const ExceptLst : TIdArray;out Notfound : TIdArray);
procedure ClearExcept(OwnedBy: integer; const ExceptLst: TIdArray;
out Notfound: TIdArray);
procedure GetArea(out Area: TRealArea); override;
function GetObjectsInArea(const Area: TRealArea): TGPSObjList;
function GetIdsArea(const Ids: TIdArray; IdOwner: integer): TRealArea;
function Add(aItem: TGpsObj; IdOwner: integer): integer;
Procedure DeleteById(const Ids : Array of integer);
procedure DeleteById(const Ids: Array of integer);
Procedure BeginUpdate;
Procedure EndUpdate;
procedure BeginUpdate;
procedure EndUpdate;
property Count : integer read Getcount;
property Count: integer read GetCount;
property OnModified: TModifiedEvent read FOnModified write FOnModified;
end;
function hasIntersectArea(const Area1 : TRealArea;const Area2 : TRealArea) : boolean;
function HasIntersectArea(const Area1: TRealArea; const Area2: TRealArea): boolean;
function IntersectArea(const Area1: TRealArea; const Area2: TRealArea): TRealArea;
function PtInsideArea(const aPoint: TRealPoint; const Area: TRealArea): boolean;
Function AreaInsideArea(const AreaIn : TRealArea;const AreaOut : TRealArea) : boolean;
Procedure ExtendArea(var AreaToExtend : TRealArea;Const Area : TRealArea);
Function GetAreaOf(objs : TGPSObjList) : TRealArea;
function AreaInsideArea(const AreaIn: TRealArea; const AreaOut: TRealArea): boolean;
procedure ExtendArea(var AreaToExtend: TRealArea; const Area: TRealArea);
function GetAreaOf(objs: TGPSObjList): TRealArea;
implementation
uses mvextradata;
uses
mvExtraData;
function hasIntersectArea(const Area1: TRealArea; const Area2: TRealArea): boolean;
begin
Result:=(Area1.TopLeft.Lon<=Area2.BottomRight.Lon) and (Area1.BottomRight.Lon>=Area2.TopLeft.Lon) and
(Area1.TopLeft.Lat>=Area2.BottomRight.Lat) and (Area1.BottomRight.Lat<=Area2.TopLeft.Lat);
Result := (Area1.TopLeft.Lon <= Area2.BottomRight.Lon) and
(Area1.BottomRight.Lon >= Area2.TopLeft.Lon) and
(Area1.TopLeft.Lat >= Area2.BottomRight.Lat) and
(Area1.BottomRight.Lat <= Area2.TopLeft.Lat);
end;
function IntersectArea(const Area1: TRealArea; const Area2: TRealArea
): TRealArea;
function IntersectArea(const Area1: TRealArea; const Area2: TRealArea): TRealArea;
begin
Result := Area1;
if Result.TopLeft.Lon<Area2.topLeft.Lon then
@ -180,15 +188,18 @@ end;
function PtInsideArea(const aPoint: TRealPoint; const Area: TRealArea): boolean;
begin
Result:=(Area.TopLeft.Lon<=aPoint.Lon) and (Area.BottomRight.Lon>=aPoint.Lon) and
(Area.TopLeft.Lat>=aPoint.Lat) and (Area.BottomRight.Lat<=aPoint.Lat);
Result := (Area.TopLeft.Lon <= aPoint.Lon) and
(Area.BottomRight.Lon >= aPoint.Lon) and
(Area.TopLeft.Lat >= aPoint.Lat) and
(Area.BottomRight.Lat <= aPoint.Lat);
end;
function AreaInsideArea(const AreaIn: TRealArea; const AreaOut: TRealArea
): boolean;
function AreaInsideArea(const AreaIn: TRealArea; const AreaOut: TRealArea): boolean;
begin
Result:=(AreaIn.TopLeft.Lon>=AreaOut.TopLeft.Lon) and (AreaIn.BottomRight.Lon<=AreaOut.BottomRight.Lon) and
(AreaOut.TopLeft.Lat>=AreaIn.TopLeft.Lat) and (AreaOut.BottomRight.Lat<=AreaIn.BottomRight.Lat);
Result := (AreaIn.TopLeft.Lon >= AreaOut.TopLeft.Lon) and
(AreaIn.BottomRight.Lon <= AreaOut.BottomRight.Lon) and
(AreaOut.TopLeft.Lat >= AreaIn.TopLeft.Lat) and
(AreaOut.BottomRight.Lat <= AreaIn.BottomRight.Lat);
end;
procedure ExtendArea(var AreaToExtend: TRealArea; const Area: TRealArea);
@ -205,16 +216,17 @@ begin
end;
function GetAreaOf(objs: TGPSObjList): TRealArea;
var i : integer;
var
i: integer;
begin
Result.TopLeft.Lon := 0;
Result.TopLeft.Lat := 0;
Result.BottomRight.Lon := 0;
Result.BottomRight.Lat := 0;
if Objs.Count>0 then
Begin
begin
Result := Objs[0].BoundingBox;
For i:=1 to pred(Objs.Count) do
for i:=1 to pred(Objs.Count) do
ExtendArea(Result, Objs[i].BoundingBox);
end;
end;
@ -241,7 +253,7 @@ end;
function TGPSObj.GetBoundingBox: TRealArea;
begin
if not(BBoxSet) then
Begin
begin
GetArea(FBoundingBox);
BBoxSet := true;
end;
@ -262,7 +274,7 @@ end;
{ TGPSObjectList }
function TGPSObjectList.Getcount: integer;
function TGPSObjectList.GetCount: integer;
begin
Result := FItems.Count
end;
@ -272,9 +284,9 @@ var
Item: TGpsObj;
begin
Lock;
Try
try
if not(Assigned(DelLst)) then
Begin
begin
DelLst := TGpsObjList.Create(False);
DelLst.FRef := Self;
inc(FRefCount);
@ -292,9 +304,9 @@ end;
procedure TGPSObjectList.FreePending;
begin
if Assigned(FPending) then
Begin
begin
Lock;
Try
try
FreeAndNil(FPending);
finally
UnLock;
@ -329,7 +341,8 @@ begin
lst.Free;
end;
procedure TGPSObjectList.IdsToObj(const Ids: TIdArray; out objs: TGPSObjArray;IdOwner : integer);
procedure TGPSObjectList.IdsToObj(const Ids: TIdArray; out objs: TGPSObjArray;
IdOwner: integer);
function ToSelect(aId: integer): boolean;
var
@ -347,17 +360,17 @@ procedure TGPSObjectList.IdsToObj(const Ids: TIdArray; out objs: TGPSObjArray;Id
var
i,nb : integer;
begin
SetLength(objs,length(Ids));
SetLength(objs, Length(Ids));
nb := 0;
Lock;
Try
try
for i:=0 to pred(FItems.Count) do
begin
if (IdOwner = 0) or (IdOwner = FItems[i].FIdOwner) then
if Assigned(FItems[i].ExtraData) and FItems[i].ExtraData.InheritsFrom(TDrawingExtraData) then
Begin
begin
if ToSelect(TDrawingExtraData(FItems[i].ExtraData).Id) then
Begin
begin
objs[nb] := FItems[i];
nb+=1;
end;
@ -370,7 +383,8 @@ begin
end;
procedure TGPSObjectList.GetArea(out Area: TRealArea);
var i : integer;
var
i: integer;
ptArea: TRealArea;
begin
Area.BottomRight.lon := 0;
@ -378,7 +392,7 @@ begin
Area.TopLeft.lon := 0;
Area.TopLeft.lat := 0;
Lock;
Try
try
if Items.Count > 0 then
begin
Area := Items[0].BoundingBox;
@ -394,17 +408,18 @@ begin
end;
function TGPSObjectList.GetObjectsInArea(const Area: TRealArea): TGPSObjList;
var i : integer;
var
i: integer;
ItemArea: TRealArea;
begin
Result := TGPSObjList.Create(false);
Lock;
Try
try
Inc(FRefCount);
For i:=0 to pred(Items.Count) do
Begin
for i:=0 to pred(Items.Count) do
begin
ItemArea := Items[i].BoundingBox;
If hasIntersectArea(Area,ItemArea) then
if hasIntersectArea(Area,ItemArea) then
Result.Add(Items[i]);
end;
if Result.Count > 0 then
@ -431,13 +446,14 @@ begin
end;
procedure TGPSObjectList.Clear(OwnedBy: integer);
var i : integer;
var
i: integer;
DelObj: TGPSObjList;
begin
DelObj := nil;
Lock;
try
For i:=pred(FItems.Count) downto 0 do
for i:=pred(FItems.Count) downto 0 do
if (OwnedBy = 0) or (FItems[i].FIdOwner = OwnedBy) then
_Delete(i,DelObj);
finally
@ -450,21 +466,23 @@ end;
procedure TGPSObjectList.ClearExcept(OwnedBy: integer;
const ExceptLst: TIdArray; out Notfound: TIdArray);
var Found : TIdArray;
var
Found: TIdArray;
function ToDel(aIt: TGPsObj): boolean;
var i,Id : integer;
Begin
var
i,Id: integer;
begin
if (aIt.ExtraData=nil) or not(aIt.ExtraData.InheritsFrom(TDrawingExtraData)) then
result:=true
Result := true
else
Begin
Result := true;
Id := TDrawingExtraData(aIt.ExtraData).Id;
for i:=low(ExceptLst) to high(ExceptLst) do
for i := Low(ExceptLst) to High(ExceptLst) do
if Id = ExceptLst[i] then
begin
result:=false;
Result := false;
SetLength(Found, Length(Found)+1);
Found[high(Found)] := Id;
exit;
@ -472,7 +490,8 @@ Begin
end;
end;
var i,j : integer;
var
i,j: integer;
IsFound: boolean;
DelLst: TGPSObjList;
begin
@ -481,7 +500,7 @@ begin
SetLength(Found, 0);
Lock;
try
For i:=pred(FItems.Count) downto 0 do
for i := pred(FItems.Count) downto 0 do
begin
if (FItems[i].FIdOwner = OwnedBy) or (OwnedBy = 0) then
Begin
@ -492,18 +511,18 @@ begin
finally
Unlock;
end;
For i:=low(ExceptLst) to high(ExceptLst) do
Begin
for i:=low(ExceptLst) to high(ExceptLst) do
begin
IsFound := false;
for j:=low(Found) to high(Found) do
for j:=Low(Found) to High(Found) do
if Found[j] = ExceptLst[i] then
begin
IsFound := true;
break;
end;
if not(IsFound) then
Begin
SetLength(NotFound,length(NotFound)+1);
if not IsFound then
begin
SetLength(NotFound, Length(NotFound)+1);
NotFound[high(NotFound)] := ExceptLst[i];
end;
end;
@ -512,7 +531,8 @@ begin
end;
function TGPSObjectList.GetIdsArea(const Ids: TIdArray; IdOwner: integer): TRealArea;
var Objs : TGPSObjarray;
var
Objs: TGPSObjarray;
i: integer;
begin
Result.BottomRight.Lat := 0;
@ -520,23 +540,22 @@ begin
Result.TopLeft.Lat := 0;
Result.TopLeft.Lon := 0;
Lock;
Try
try
IdsToObj(Ids, Objs, IdOwner);
if length(Objs)>0 then
Begin
Result:=Objs[0].BoundingBox;
for i:=succ(low(Objs)) to high(Objs) do
if Length(Objs) > 0 then
begin
Result := Objs[0].BoundingBox;
for i:=succ(Low(Objs)) to High(Objs) do
ExtendArea(Result, Objs[i].BoundingBox);
end;
end;
finally
Unlock;
end;
end;
function TGPSObjectList.Add(aItem: TGpsObj; IdOwner: integer): integer;
var mList : TGPSObjList;
var
mList: TGPSObjList;
begin
aItem.FIdOwner := IdOwner;
Lock;
@ -559,9 +578,9 @@ procedure TGPSObjectList.DeleteById(const Ids: array of integer);
i: integer;
begin
result := false;
For i:=low(Ids) to high(Ids) do
For i:=Low(Ids) to High(Ids) do
if Ids[i] = AId then
Begin
begin
result := true;
exit;
end;
@ -585,7 +604,8 @@ begin
// !!! wp: There is a warning that TGPSObj and TDrawingExtraData are not related !!!
if ToDelete(Extr.Id) then
_Delete(i, DelLst);
// !!! wp: DelLst is a local var and created by _Delete but not destroyed anywhere here !!!
// !!! wp: DelLst is a local var and was created by _Delete but is
// not destroyed anywhere here !!!
end;
end;
end;
@ -593,7 +613,7 @@ begin
Unlock;
end;
if Assigned(DelLst) then
// wp: is this missing here: DelLst.Free;
end;
procedure TGPSObjectList.BeginUpdate;
@ -636,7 +656,8 @@ begin
end;
procedure TGPSTrack.GetArea(out Area: TRealArea);
var i : integer;
var
i: integer;
ptArea: TRealArea;
begin
Area.BottomRight.lon := 0;
@ -655,14 +676,14 @@ begin
end;
function TGPSTrack.TrackLengthInKm(UseEle: Boolean): double;
var i : integer;
var
i: integer;
begin
Result := 0;
For i:=1 to pred(FPoints.Count) do
begin
for i:=1 to pred(FPoints.Count) do
result += FPoints[i].DistanceInKmFrom(FPoints[pred(i)], UseEle);
end;
end;
{ TGPSPoint }
@ -693,7 +714,8 @@ begin
end;
function TGPSPoint.DistanceInKmFrom(OtherPt: TGPSPoint; UseEle: boolean): double;
var a : double;
var
a: double;
lat1, lat2, lon1, lon2, t1, t2, t3, t4, t5, rad_dist: double;
DiffEle: Double;
begin
@ -712,7 +734,7 @@ begin
result := (rad_dist * 3437.74677 * 1.1508) * 1.6093470878864446;
if UseEle and (FEle<>OtherPt.FEle) then
if (HasEle) and (OtherPt.HasEle) then
Begin
begin
//FEle is assumed in Metter
DiffEle := (FEle-OtherPt.Ele)/1000;
Result := sqrt(DiffEle*DiffEle+result*result);

2
components/lazmapviewer/source/mvjobs.pas
View File

@ -105,11 +105,13 @@ begin
Result := NO_MORE_TASK
end
else
begin
if FEnded then
Result := ALL_TASK_COMPLETED
else
Result := 1;
end;
end;
procedure TSimpleJob.pTaskStarted(aTask: integer);
begin

18
components/lazmapviewer/source/mvmapprovider.pas
View File

@ -79,9 +79,9 @@ end;
procedure TMapProvider.SetLayer(AValue: integer);
begin
if FLayer = AValue then Exit;
if (aValue<low(FUrl)) and (aValue>high(FUrl)) then
if (aValue < Low(FUrl)) and (aValue > High(FUrl)) then
Begin
Raise Exception.create('bad Layer');
Raise Exception.Create('bad Layer');
end;
FLayer:=AValue;
end;
@ -107,12 +107,12 @@ begin
end;
procedure TMapProvider.AddURL(Url: String; NbSvr: integer;
aMinZoom : integer;aMaxZoom : integer;
GetSvrStr: TGetSvrStr; GetXStr: TGetValStr; GetYStr: TGetValStr;
GetZStr: TGetValStr);
var nb : integer;
aMinZoom: integer; aMaxZoom: integer; GetSvrStr: TGetSvrStr;
GetXStr: TGetValStr; GetYStr: TGetValStr; GetZStr: TGetValStr);
var
nb: integer;
begin
nb:=length(FUrl)+1;
nb := Length(FUrl)+1;
SetLength(IdServer, nb);
SetLength(FUrl, nb);
SetLength(FNbSvr, nb);
@ -122,7 +122,7 @@ begin
SetLength(FGetZStr, nb);
SetLength(FMinZoom, nb);
SetLength(FMaxZoom, nb);
nb:=high(FUrl);
nb := High(FUrl);
FUrl[nb] := Url;
FNbSvr[nb] := NbSvr;
FMinZoom[nb] := aMinZoom;
@ -131,7 +131,7 @@ begin
FGetXStr[nb] := GetXStr;
FGetYStr[nb] := GetYStr;
FGetZStr[nb] := GetZStr;
FLayer:=low(FUrl);
FLayer := Low(FUrl);
end;
procedure TMapProvider.GetZoomInfos(out AZoomMin, AZoomMax: integer);

92
components/lazmapviewer/source/mvmapviewer.pas
View File

@ -97,14 +97,18 @@ Type
{$ENDIF}
procedure DblClick; override;
Procedure DoDrawTile(const TileId: TTileId; X,Y: integer; TileImg: TLazIntfImage);
function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean; override;
function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
MousePos: TPoint): Boolean; override;
procedure DoOnResize; override;
Function IsActive : Boolean;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y:Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
function IsActive: Boolean;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X,Y: Integer); override;
procedure Paint; override;
procedure OnGPSItemsModified(Sender: TObject; objs: TGPSObjList;Adding : boolean);
procedure OnGPSItemsModified(Sender: TObject; objs: TGPSObjList;
Adding: boolean);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
@ -136,7 +140,7 @@ Type
property Zoom: integer read GetZoom write SetZoom;
property OnCenterMove: TNotifyEvent read GetOnCenterMove write SetOnCenterMove;
property OnZoomChange: TNotifyEvent read GetOnZoomChange write SetOnZoomChange;
property OnChange: TNotifyEvent Read GetOnChange write SetOnChange;
property OnChange: TNotifyEvent read GetOnChange write SetOnChange;
property OnDrawGpsPoint: TDrawGpsPointEvent read FOnDrawGpsPoint write FOnDrawGpsPoint;
property OnMouseDown;
property OnMouseEnter;
@ -145,6 +149,7 @@ Type
property OnMouseUp;
end;
implementation
uses
@ -212,7 +217,7 @@ Type
{ TDrawObjJob }
TDrawObjJob = Class(TJob)
TDrawObjJob = class(TJob)
private
AllRun: boolean;
Viewer: TMapView;
@ -228,7 +233,7 @@ Type
procedure ExecuteTask(aTask: integer; FromWaiting: boolean); override;
function Running: boolean;override;
public
Constructor Create(aViewer: TMapView; aLst: TGPSObjList; const aArea: TRealArea);
constructor Create(aViewer: TMapView; aLst: TGPSObjList; const aArea: TRealArea);
destructor Destroy; override;
end;
@ -240,16 +245,17 @@ var
begin
if not(AllRun) and not(Cancelled) then
begin
For i:=low(FStates) to high(FStates) do
for i := Low(FStates) to High(FStates) do
if FStates[i]=0 then
Begin
begin
result := i+1;
Exit;
end;
AllRun:=True;
end;
Result := ALL_TASK_COMPLETED;
for i:=low(FStates) to high(FStates) do
for i := Low(FStates) to High(FStates) do
if FStates[i]=1 then
begin
Result := NO_MORE_TASK;
@ -272,20 +278,17 @@ begin
end;
procedure TDrawObjJob.ExecuteTask(aTask: integer; FromWaiting: boolean);
var iObj : integer;
var
iObj: integer;
Obj: TGpsObj;
begin
iObj := aTask-1;
Obj := FLst[iObj];
if Obj.InheritsFrom(TGPSTrack) then
begin
Viewer.DrawTrack(FArea, TGPSTrack(Obj));
end;
if Obj.InheritsFrom(TGPSPoint) then
begin
Viewer.DrawPt(FArea, TGPSPoint(Obj));
end;
end;
function TDrawObjJob.Running: boolean;
begin
@ -451,8 +454,8 @@ begin
Engine.MouseWheel(self,Shift,WheelDelta,MousePos,Result);
end;
procedure TMapView.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
procedure TMapView.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
inherited MouseDown(Button, Shift, X, Y);
if IsActive then
@ -532,7 +535,7 @@ procedure TMapView.OnGPSItemsModified(Sender: TObject; objs: TGPSObjList;
var
Area,ObjArea,vArea: TRealArea;
begin
if Adding and assigned(Objs) then
if Adding and Assigned(Objs) then
begin
ObjArea := GetAreaOf(Objs);
vArea := GetVisibleArea;
@ -552,31 +555,32 @@ begin
end;
procedure TMapView.DrawTrack(const Area: TRealArea; trk: TGPSTrack);
var Old,New : TPoint;
var
Old,New: TPoint;
i: integer;
aPt: TRealPoint;
LastInside, IsInside: boolean;
trkColor: TColor;
Begin
begin
if trk.Points.Count>0 then
Begin
begin
trkColor := clRed;
if trk.ExtraData <> nil then
Begin
if trk.ExtraData.inheritsFrom(TDrawingExtraData) then
begin
if trk.ExtraData.InheritsFrom(TDrawingExtraData) then
trkColor := TDrawingExtraData(trk.ExtraData).Color;
end;
LastInside := false;
For i:=0 to pred(trk.Points.Count) do
Begin
for i:=0 to pred(trk.Points.Count) do
begin
aPt := trk.Points[i].RealPoint;
IsInside := PtInsideArea(aPt,Area);
if IsInside or LastInside then
Begin
begin
New := Engine.LonLatToScreen(aPt);
if i > 0 then
Begin
if not(LastInside) then
begin
if not LastInside then
Old := Engine.LonLatToScreen(trk.Points[pred(i)].RealPoint);
{$IFDEF USE_RGBGRAPHICS}
Buffer.Canvas.OutlineColor := trkColor;
@ -612,14 +616,14 @@ begin
Pt := Engine.LonLatToScreen(aPOI.RealPoint);
PtColor := clRed;
if aPOI.ExtraData <> nil then
Begin
begin
if aPOI.ExtraData.inheritsFrom(TDrawingExtraData) then
PtColor := TDrawingExtraData(aPOI.ExtraData).Color;
end;
{$IFDEF USE_RGBGRAPHICS}
Buffer.canvas.OutlineColor:=ptColor;
Buffer.canvas.Line(Pt.X,Pt.y-5,Pt.X,Pt.Y+5);
Buffer.canvas.Line(Pt.X-5,Pt.y,Pt.X+5,Pt.Y);
Buffer.Canvas.OutlineColor := ptColor;
Buffer.Canvas.Line(Pt.X, Pt.y-5, Pt.X, Pt.Y+5);
Buffer.Canvas.Line(Pt.X-5, Pt.y, Pt.X+5, Pt.Y);
{$ENDIF}
{$IFDEF USE_LAZINTFIMAGE}
BufferCanvas.Pen.FPColor := TColorToFPColor(ptColor);
@ -633,13 +637,14 @@ end;
procedure TMapView.CallAsyncInvalidate;
Begin
if not(AsyncInvalidate) then
Begin
begin
AsyncInvalidate := true;
Engine.Jobqueue.QueueAsyncCall(@DoAsyncInvalidate, 0);
end;
end;
procedure TMapView.DrawObjects(const TileId: TTileId; aLeft, aTop,aRight,aBottom: integer);
procedure TMapView.DrawObjects(const TileId: TTileId;
aLeft, aTop,aRight,aBottom: integer);
var
aPt: TPoint;
Area: TRealArea;
@ -651,7 +656,7 @@ begin
aPt.X := aRight;
aPt.Y := aBottom;
Area.BottomRight := Engine.ScreenToLonLat(aPt);
if GPSItems.count>0 then
if GPSItems.Count > 0 then
begin
lst := GPSItems.GetObjectsInArea(Area);
if lst.Count > 0 then
@ -684,7 +689,7 @@ begin
if Assigned(Buffer) then
begin
if Assigned(TileImg) then
Begin
begin
{$IFDEF USE_RGBGRAPHICS}
if (X >= 0) and (Y >= 0) then //http://mantis.freepascal.org/view.php?id=27144
begin
@ -693,7 +698,7 @@ begin
ri.Data := Buffer.Pixels;
BuffLaz := TLazIntfImage.Create(ri, false);
try
BuffLaz.CopyPixels(TileImg,X,y);
BuffLaz.CopyPixels(TileImg, X, Y);
ri.Init;
finally
FreeandNil(BuffLaz);
@ -706,7 +711,7 @@ begin
try
Buffer.Draw(X, Y, temp);
finally
FreeAndNil(Temp);
FreeAndNil(temp);
end;
end;
{$ENDIF}
@ -812,7 +817,8 @@ begin
end;
procedure TMapView.CenterOnObj(obj: TGPSObj);
var Area : TRealArea;
var
Area: TRealArea;
Pt: TRealPoint;
begin
obj.GetArea(Area);
@ -822,7 +828,8 @@ begin
end;
procedure TMapView.ZoomOnObj(obj: TGPSObj);
var Area : TRealArea;
var
Area: TRealArea;
begin
obj.GetArea(Area);
Engine.ZoomOnArea(Area);
@ -834,7 +841,8 @@ begin
end;
function TMapView.GetVisibleArea: TRealArea;
var aPt : TPoint;
var
aPt: TPoint;
begin
aPt.X := 0;
aPt.Y := 0;