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

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

@ -22,7 +22,8 @@ unit mvCache;
interface interface
uses uses
Classes, SysUtils,mvmapprovider,IntfGraphics,syncObjs,mvtypes; Classes, SysUtils, IntfGraphics, syncObjs,
mvMapProvider, mvTypes;
Type Type
@ -45,7 +46,7 @@ Type
Function MapProvider2FileName(MapProvider: TMapProvider): String; Function MapProvider2FileName(MapProvider: TMapProvider): String;
Function DiskCached(const aFileName: String): Boolean; Function DiskCached(const aFileName: String): Boolean;
procedure LoadFromDisk(const aFileName: String; out img: TLazIntfImage); procedure LoadFromDisk(const aFileName: String; out img: TLazIntfImage);
Function GetFileName(MapProvider: TMapProvider;const TileId: TTileId): String; Function GetFileName(MapProvider: TMapProvider; const TileId: TTileId): String;
public public
Procedure CheckCacheSize(Sender: TObject); Procedure CheckCacheSize(Sender: TObject);
constructor Create(aOwner: TComponent); override; constructor Create(aOwner: TComponent); override;

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

@ -31,7 +31,7 @@ Type
{ TDragObj } { TDragObj }
TDragObj = Class TDragObj = class
private private
FMouseDown : boolean; FMouseDown : boolean;
FLnkObj: TObject; FLnkObj: TObject;
@ -50,76 +50,75 @@ Type
procedure SetOnDrag(AValue: TDragEvent); procedure SetOnDrag(AValue: TDragEvent);
procedure SetOnEndDrag(AValue: TDragEvent); procedure SetOnEndDrag(AValue: TDragEvent);
Procedure DostartDrag(X,Y : Integer); Procedure DostartDrag(X,Y: Integer);
Procedure DoDrag(X,Y : integer); Procedure DoDrag(X,Y: integer);
Procedure DoEndDrag(X,Y : integer); Procedure DoEndDrag(X,Y: integer);
Function HasMoved(X,Y : integer) : Boolean; Function HasMoved(X,Y: integer) : Boolean;
Procedure AbortDrag; Procedure AbortDrag;
public public
Procedure MouseDown(aDragSrc : TObject;X,Y : integer); Procedure MouseDown(aDragSrc: TObject; X,Y: integer);
Procedure MouseUp(X,Y : integer); Procedure MouseUp(X,Y: integer);
Procedure MouseMove(X,Y : integer); Procedure MouseMove(X,Y: integer);
property OnDrag : TDragEvent read FOnDrag write SetOnDrag; property OnDrag: TDragEvent read FOnDrag write SetOnDrag;
property OnEndDrag : TDragEvent read FOnEndDrag write SetOnEndDrag; property OnEndDrag: TDragEvent read FOnEndDrag write SetOnEndDrag;
property OfsX: integer read FOfsX;
property OfsY: integer read FOfsY;
property OfsX : integer read FOfsX; property StartX: integer read FStartX;
property OfsY : integer read FOfsY; property StartY: integer read FStartY;
property StartX : integer read FStartX; property MouseX: Integer read FMouseX;
property StartY : integer read FStartY; property MouseY: integer read FMouseY;
property MouseX : Integer read FMouseX; property EndX: integer read FEndX;
property MouseY : integer read FMouseY; property EndY: integer read FEndY;
property EndX : integer read FEndX; Property LnkObj: TObject Read FLnkObj write SetLnkObj;
property EndY : integer read FEndY; property DragSrc: TObject Read FStartSrc;
Property LnkObj : TObject Read FLnkObj write SetLnkObj;
property DragSrc : TObject Read FStartSrc;
end; end;
implementation implementation
{ TDragObj } { TDragObj }
procedure TDragObj.SetDest(X, Y: Integer); procedure TDragObj.SetDest(X, Y: Integer);
begin begin
FEndX:=X; FEndX := X;
FEndY:=Y; FEndY := Y;
FOfsX:=FEndX-FstartX; FOfsX := FEndX-FstartX;
FOfsY:=FEndY-FstartY; FOfsY := FEndY-FstartY;
end; end;
procedure TDragObj.SetLnkObj(AValue: TObject); procedure TDragObj.SetLnkObj(AValue: TObject);
begin begin
if FLnkObj=AValue then Exit; if FLnkObj=AValue then Exit;
FreeAndNil(FLnkObj); FreeAndNil(FLnkObj);
FLnkObj:=AValue; FLnkObj := AValue;
end; end;
procedure TDragObj.SetOnDrag(AValue: TDragEvent); procedure TDragObj.SetOnDrag(AValue: TDragEvent);
begin begin
if FOnDrag=AValue then Exit; if FOnDrag=AValue then Exit;
FOnDrag:=AValue; FOnDrag := AValue;
end; end;
procedure TDragObj.SetOnEndDrag(AValue: TDragEvent); procedure TDragObj.SetOnEndDrag(AValue: TDragEvent);
begin begin
if FOnEndDrag=AValue then Exit; if FOnEndDrag=AValue then Exit;
FOnEndDrag:=AValue; FOnEndDrag := AValue;
end; end;
procedure TDragObj.DostartDrag(X, Y: Integer); procedure TDragObj.DostartDrag(X, Y: Integer);
begin begin
InDrag:=True; InDrag := True;
FStartSrc := FDragSrc; FStartSrc := FDragSrc;
DoDrag(X,Y); DoDrag(X,Y);
end; end;
procedure TDragObj.DoDrag(X, Y: integer); procedure TDragObj.DoDrag(X, Y: integer);
begin begin
if (X<>FEndX) or (Y<>FEndY) then if (X<>FEndX) or (Y<>FEndY) then
Begin begin
SetDest(X,Y); SetDest(X,Y);
if Assigned(FOnDrag) then if Assigned(FOnDrag) then
FOnDrag(Self); FOnDrag(Self);
@ -133,12 +132,12 @@ begin
FOnEndDrag(self); FOnEndDrag(self);
FreeAndNil(FLnkObj); FreeAndNil(FLnkObj);
FStartSrc := nil; FStartSrc := nil;
InDrag:=False; InDrag := False;
end; end;
function TDragObj.HasMoved(X, Y: integer): Boolean; function TDragObj.HasMoved(X, Y: integer): Boolean;
begin begin
Result:=(X<>FStartX) or (Y<>FStartY); Result := (X <> FStartX) or (Y <> FStartY);
end; end;
procedure TDragObj.AbortDrag; procedure TDragObj.AbortDrag;
@ -146,8 +145,8 @@ begin
if InDrag then if InDrag then
Begin Begin
DoDrag(FstartX,FStartY); DoDrag(FstartX,FStartY);
InDrag:=False; InDrag := False;
FMouseDown:=False; FMouseDown := False;
FDragSrc :=nil; FDragSrc :=nil;
FStartSrc := nil; FStartSrc := nil;
FreeAndNil(FLnkObj); FreeAndNil(FLnkObj);
@ -157,16 +156,16 @@ end;
procedure TDragObj.MouseDown(aDragSrc : TObject;X, Y: integer); procedure TDragObj.MouseDown(aDragSrc : TObject;X, Y: integer);
begin begin
if not(FMouseDown) then if not(FMouseDown) then
Begin begin
FDragSrc := aDragSrc; FDragSrc := aDragSrc;
FMouseDown := True; FMouseDown := True;
FStartX := X; FStartX := X;
FStartY := Y; FStartY := Y;
FEndX := X; FEndX := X;
FEndY := Y; FEndY := Y;
End end
Else else
AbortDrag; AbortDrag;
end; end;
@ -175,13 +174,13 @@ begin
FMouseX := X; FMouseX := X;
FMouseY := Y; FMouseY := Y;
if FMouseDown then if FMouseDown then
Begin begin
if InDrag then if InDrag then
DoDrag(X,Y) DoDrag(X,Y)
else else
Begin begin
if HasMoved(X,Y) then if HasMoved(X,Y) then
DoStartDrag(X,Y); DoStartDrag(X,Y);
end; end;
end; end;
end; end;
@ -190,10 +189,10 @@ end;
procedure TDragObj.MouseUp(X, Y: integer); procedure TDragObj.MouseUp(X, Y: integer);
begin begin
if FMouseDown then if FMouseDown then
Begin begin
FMouseDown:=False; FMouseDown := False;
if InDrag then if InDrag then
DoEndDrag(X,Y); DoEndDrag(X,Y);
FDragSrc := nil; FDragSrc := nil;
end; end;
end; end;

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

@ -39,7 +39,8 @@ const
Type 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; TTileIdArray = Array of TTileId;
@ -49,7 +50,7 @@ Type
MapProvider: TMapProvider; MapProvider: TMapProvider;
X: Int64; X: Int64;
Y: Int64; Y: Int64;
Center : TRealPoint; Center: TRealPoint;
Zoom: integer; Zoom: integer;
Height: integer; Height: integer;
Width: integer; Width: integer;
@ -100,21 +101,21 @@ Type
function IsCurrentWin(const aWin: TMapWindow) : boolean; function IsCurrentWin(const aWin: TMapWindow) : boolean;
protected protected
procedure ConstraintZoom(var aWin: TMapWindow); procedure ConstraintZoom(var aWin: TMapWindow);
function GetTileName(const Id: TTileId) : String; function GetTileName(const Id: TTileId): String;
procedure evDownload(Data: TObject;Job : TJob); procedure evDownload(Data: TObject; Job: TJob);
procedure TileDownloaded(Data: PtrInt); procedure TileDownloaded(Data: PtrInt);
Procedure RegisterProviders; Procedure RegisterProviders;
Procedure DrawTile(const TileId : TTileId;X,Y : integer;TileImg : TLazIntfImage); Procedure DrawTile(const TileId: TTileId; X,Y: integer; TileImg: TLazIntfImage);
function GetLetterSvr(id: integer): String; function GetLetterSvr(id: integer): String;
function GetYahooSvr(id: integer): String; function GetYahooSvr(id: integer): String;
function GetYahooY(const Tile : TTileId): string; function GetYahooY(const Tile: TTileId): string;
function GetYahooZ(const Tile : TTileId): string; function GetYahooZ(const Tile: TTileId): string;
function GetQuadKey(const Tile : TTileId): string; function GetQuadKey(const Tile: TTileId): string;
Procedure DoDrag(Sender : TDragObj); Procedure DoDrag(Sender: TDragObj);
public public
constructor Create(aOwner : TComponent);override; constructor Create(aOwner: TComponent); override;
destructor Destroy; override; destructor Destroy; override;
function AddMapProvider(OpeName: String; Url: String; function AddMapProvider(OpeName: String; Url: String;
@ -133,11 +134,12 @@ Type
procedure DblClick(Sender: TObject); procedure DblClick(Sender: TObject);
procedure MouseDown(Sender: TObject; Button: TMouseButton; procedure MouseDown(Sender: TObject; Button: TMouseButton;
{%H-}Shift: TShiftState; X, Y: Integer); {%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; procedure MouseUp(Sender: TObject; Button: TMouseButton;
{%H-}Shift: TShiftState; X, Y: Integer); {%H-}Shift: TShiftState; X, Y: Integer);
procedure MouseWheel(Sender: TObject; {%H-}Shift: TShiftState; WheelDelta: Integer; procedure MouseWheel(Sender: TObject; {%H-}Shift: TShiftState;
{%H-}MousePos: TPoint; var Handled: Boolean); WheelDelta: Integer; {%H-}MousePos: TPoint; var Handled: Boolean);
procedure ZoomOnArea(const aArea: TRealArea); procedure ZoomOnArea(const aArea: TRealArea);
property Center: TRealPoint read GetCenter write SetCenter; property Center: TRealPoint read GetCenter write SetCenter;
@ -146,8 +148,10 @@ Type
property Active: Boolean read FActive write SetActive default false; property Active: Boolean read FActive write SetActive default false;
property CacheOnDisk: Boolean read GetCacheOnDisk write SetCacheOnDisk; property CacheOnDisk: Boolean read GetCacheOnDisk write SetCacheOnDisk;
property CachePath: String read GetCachePath write SetCachePath; property CachePath: String read GetCachePath write SetCachePath;
property DownloadEngine: TMvCustomDownloadEngine read FDownloadEngine write SetDownloadEngine; property DownloadEngine: TMvCustomDownloadEngine
property DrawTitleInGuiThread: boolean read FDrawTitleInGuiThread write FDrawTitleInGuiThread; read FDownloadEngine write SetDownloadEngine;
property DrawTitleInGuiThread: boolean
read FDrawTitleInGuiThread write FDrawTitleInGuiThread;
property Height: integer read GetHeight write SetHeight; property Height: integer read GetHeight write SetHeight;
property JobQueue: TJobQueue read Queue; property JobQueue: TJobQueue read Queue;
property MapProvider: String read GetMapProvider write SetMapProvider; property MapProvider: String read GetMapProvider write SetMapProvider;
@ -161,6 +165,7 @@ Type
property OnZoomChange: TNotifyEvent read FOnZoomChange write FOnZoomChange; property OnZoomChange: TNotifyEvent read FOnZoomChange write FOnZoomChange;
end; end;
implementation implementation
uses uses
@ -171,7 +176,7 @@ type
{ TLaunchDownloadJob } { TLaunchDownloadJob }
TLaunchDownloadJob = Class(TJob) TLaunchDownloadJob = class(TJob)
private private
AllRun: boolean; AllRun: boolean;
Win: TMapWindow; Win: TMapWindow;
@ -180,14 +185,15 @@ type
FTiles: TTileIdArray; FTiles: TTileIdArray;
FStates: Array of integer; FStates: Array of integer;
protected protected
function pGetTask: integer;override; function pGetTask: integer; override;
procedure pTaskStarted(aTask: integer);override; procedure pTaskStarted(aTask: integer); override;
procedure pTaskEnded(aTask: integer; aExcept: Exception);override; procedure pTaskEnded(aTask: integer; aExcept: Exception); override;
public public
procedure ExecuteTask(aTask: integer; FromWaiting: boolean);override; procedure ExecuteTask(aTask: integer; FromWaiting: boolean); override;
function Running: boolean;override; function Running: boolean; override;
public public
Constructor Create(Eng: TMapViewerEngine; const Tiles: TTileIdArray; const aWin: TMapWindow); constructor Create(Eng: TMapViewerEngine; const Tiles: TTileIdArray;
const aWin: TMapWindow);
end; end;
@ -295,7 +301,7 @@ end;
{ TEnvTile } { TEnvTile }
constructor TEnvTile.Create(const aTile : TTileId;Const aWin : TMapWindow); constructor TEnvTile.Create(const aTile: TTileId; const aWin: TMapWindow);
begin begin
Tile := aTile; Tile := aTile;
Win := aWin; Win := aWin;
@ -336,7 +342,7 @@ end;
function TMapViewerEngine.AddMapProvider(OpeName: String; Url: String; function TMapViewerEngine.AddMapProvider(OpeName: String; Url: String;
MinZoom, MaxZoom, NbSvr: integer; GetSvrStr: TGetSvrStr; GetXStr: TGetValStr; MinZoom, MaxZoom, NbSvr: integer; GetSvrStr: TGetSvrStr; GetXStr: TGetValStr;
GetYStr: TGetValStr; GetZStr: TGetValStr) : TMapProvider; GetYStr: TGetValStr; GetZStr: TGetValStr): TMapProvider;
var var
idx :integer; idx :integer;
Begin Begin
@ -357,8 +363,8 @@ var
begin begin
MaxX := (Int64(aWin.Width) div TILE_SIZE) + 1; MaxX := (Int64(aWin.Width) div TILE_SIZE) + 1;
MaxY := (Int64(aWin.Height) div TILE_SIZE) + 1; MaxY := (Int64(aWin.Height) div TILE_SIZE) + 1;
startX := (-(aWin.X)) div TILE_SIZE; startX := -aWin.X div TILE_SIZE;
startY := (-(aWin.Y)) div TILE_SIZE; startY := -aWin.Y div TILE_SIZE;
Result.Left := startX; Result.Left := startX;
Result.Right := startX + MaxX; Result.Right := startX + MaxX;
Result.Top := startY; Result.Top := startY;
@ -712,10 +718,8 @@ var
nCenter: TRealPoint; nCenter: TRealPoint;
aPt: TPoint; aPt: TPoint;
Begin Begin
if Sender.LnkObj=nil then if Sender.LnkObj = nil then
begin
Sender.LnkObj := TMemObj.Create(MapWin); Sender.LnkObj := TMemObj.Create(MapWin);
end;
old := TMemObj(Sender.LnkObj); old := TMemObj(Sender.LnkObj);
aPt.X := old.FWin.Width DIV 2-Sender.OfsX; aPt.X := old.FWin.Width DIV 2-Sender.OfsX;
aPt.Y := old.FWin.Height DIV 2-Sender.OfsY; aPt.Y := old.FWin.Height DIV 2-Sender.OfsY;
@ -757,7 +761,7 @@ end;
procedure TMapViewerEngine.RegisterProviders; procedure TMapViewerEngine.RegisterProviders;
begin begin
AddMapProvider('Aucun','',0,30, 0); AddMapProvider('Aucun','',0,30, 0);
{ {
AddMapProvider('Google Satellite','http://khm%d.google.com/kh/v=82&x=%x%&y=%y%&z=%z%&s=Ga',4); AddMapProvider('Google Satellite','http://khm%d.google.com/kh/v=82&x=%x%&y=%y%&z=%z%&s=Ga',4);
AddMapProvider('Google Hybrid','http://khm%d.google.com/kh/v=82&x=%x%&y=%y%&z=%z%&s=Ga',4); AddMapProvider('Google Hybrid','http://khm%d.google.com/kh/v=82&x=%x%&y=%y%&z=%z%&s=Ga',4);
@ -771,7 +775,7 @@ begin
//AddMapProvider('Yahoo Hybrid','http://maps%serv%.yimg.com/ae/ximg?v=1.9&t=a&s=256&.intl=en&x=%x%&y=%y%&z=%z%&r=1', 0,20,3,@GetYahooSvr, nil, @getYahooY, @GetYahooZ); //[Random(3)+1, X, YahooY(Y), Z+1])); //AddMapProvider('Yahoo Hybrid','http://maps%serv%.yimg.com/ae/ximg?v=1.9&t=a&s=256&.intl=en&x=%x%&y=%y%&z=%z%&r=1', 0,20,3,@GetYahooSvr, nil, @getYahooY, @GetYahooZ); //[Random(3)+1, X, YahooY(Y), Z+1]));
//AddMapProvider('Yahoo Hybrid','http://maps%serv%.yimg.com/hx/tl?b=1&v=4.3&t=h&.intl=en&x=%x%&y=%y%&z=%z%&r=1' , 0,20,3,@GetYahooSvr, nil, @getYahooY, @GetYahooZ); //[Random(3)+1, X, YahooY(Y), Z+1])); //AddMapProvider('Yahoo Hybrid','http://maps%serv%.yimg.com/hx/tl?b=1&v=4.3&t=h&.intl=en&x=%x%&y=%y%&z=%z%&r=1' , 0,20,3,@GetYahooSvr, nil, @getYahooY, @GetYahooZ); //[Random(3)+1, X, YahooY(Y), Z+1]));
// opeName, Url, MinZoom, MaxZoom, NbSvr, GetSvrStr, GetXStr, GetYStr, GetZStr // opeName, Url, MinZoom, MaxZoom, NbSvr, GetSvrStr, GetXStr, GetYStr, GetZStr
MapWin.MapProvider := AddMapProvider('OpenStreetMap Mapnik', MapWin.MapProvider := AddMapProvider('OpenStreetMap Mapnik',
'http://%serv%.tile.openstreetmap.org/%z%/%x%/%y%.png', 'http://%serv%.tile.openstreetmap.org/%z%/%x%/%y%.png',
0, 19, 3, @GetLetterSvr); 0, 19, 3, @GetLetterSvr);
@ -877,7 +881,7 @@ var
begin begin
idx := lstProvider.IndexOf(aValue); idx := lstProvider.IndexOf(aValue);
if not ((aValue = '') or (idx <> -1)) then if not ((aValue = '') or (idx <> -1)) then
raise Exception.Create('Unknow Provider : ' + aValue); raise Exception.Create('Unknow Provider: ' + aValue);
if Assigned(MapWin.MapProvider) and (MapWin.MapProvider.Name = AValue) then Exit; if Assigned(MapWin.MapProvider) and (MapWin.MapProvider.Name = AValue) then Exit;
if idx <> -1 then if idx <> -1 then
begin begin

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

@ -5,7 +5,7 @@ unit mvExtraData;
interface interface
uses uses
Classes, SysUtils,graphics; Classes, SysUtils, graphics;
type type
@ -17,26 +17,26 @@ type
FId: integer; FId: integer;
procedure SetColor(AValue: TColor); procedure SetColor(AValue: TColor);
public public
constructor Create(aId : integer);virtual; constructor Create(aId: integer);virtual;
property Color : TColor read FColor write SetColor; property Color: TColor read FColor write SetColor;
property Id : integer read FId; property Id: integer read FId;
End; End;
implementation implementation
{ TDrawingExtraData } { TDrawingExtraData }
procedure TDrawingExtraData.SetColor(AValue: TColor); procedure TDrawingExtraData.SetColor(AValue: TColor);
begin begin
if FColor=AValue then Exit; if FColor = AValue then Exit;
FColor:=AValue; FColor := AValue;
end; end;
constructor TDrawingExtraData.Create(aId: integer); constructor TDrawingExtraData.Create(aId: integer);
begin begin
FId:=aId; FId := aId;
FColor:=clRed; FColor := clRed;
end; end;
end. end.

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

@ -62,7 +62,7 @@ type
ADownloadEngine: TMvCustomDownloadEngine): TRealPoint; ADownloadEngine: TMvCustomDownloadEngine): TRealPoint;
published published
property LocationName: string read FLocationName; property LocationName: string read FLocationName;
property OnNameFound : TNameFoundEvent read FOnNameFound write FOnNameFound; property OnNameFound: TNameFoundEvent read FOnNameFound write FOnNameFound;
end; end;
@ -195,51 +195,13 @@ begin
parser.Free; parser.Free;
end; end;
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; function TMVGeoNames.Search(ALocationName: String;
ADownloadEngine: TMvCustomDownloadEngine): TRealPoint; ADownloadEngine: TMvCustomDownloadEngine): TRealPoint;
{
const
LAT_ID = '<span class="latitude">';
LONG_ID = '<span class="longitude">';
}
var var
s: string; s: string;
function gs(id: string;Start : integer): string; function gs(id: string; Start: integer): string;
var var
i: Integer; i: Integer;
ln: Integer; ln: Integer;
@ -260,12 +222,6 @@ var
var var
ms: TMemoryStream; ms: TMemoryStream;
url: String; url: String;
{
iRes,i : integer;
lstRes : Array of TResRec;
iStartDescr : integer;
lst : TStringArray;
}
begin begin
FLocationName := ALocationName; FLocationName := ALocationName;
ms := TMemoryStream.Create; ms := TMemoryStream.Create;
@ -280,46 +236,6 @@ begin
end; end;
Result := Parse(PChar(s)); 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;
end. end.

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

@ -23,151 +23,159 @@ interface
uses uses
Classes, SysUtils,fgl,mvtypes,contnrs,syncobjs; Classes, SysUtils,fgl,mvtypes,contnrs,syncobjs;
const const
NO_ELE = -10000000; NO_ELE = -10000000;
NO_DATE = 0; NO_DATE = 0;
type type
TIdArray = Array of integer; TIdArray = Array of integer;
{ TGPSObj } { TGPSObj }
TGPSObj = Class TGPSObj = class
private private
BBoxSet : Boolean; BBoxSet: Boolean;
FBoundingBox : TRealArea; FBoundingBox: TRealArea;
FExtraData: TObject; FExtraData: TObject;
FName: String; FName: String;
FIdOwner : integer; FIdOwner: integer;
function GetBoundingBox: TRealArea; function GetBoundingBox: TRealArea;
procedure SetBoundingBox(AValue: TRealArea); procedure SetBoundingBox(AValue: TRealArea);
procedure SetExtraData(AValue: TObject); procedure SetExtraData(AValue: TObject);
public public
destructor Destroy;override; 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 Name: String read FName write FName;
property ExtraData : TObject read FExtraData write SetExtraData; property ExtraData: TObject read FExtraData write SetExtraData;
property BoundingBox : TRealArea read GetBoundingBox write SetBoundingBox; property BoundingBox: TRealArea read GetBoundingBox write SetBoundingBox;
end;
end; TGPSObjarray = Array of TGPSObj;
TGPSObjarray = Array of TGPSObj; { TGPSPoint }
{ TGPSPoint } TGPSPoint = class(TGPSObj)
private
FRealPt: TRealPoint;
FEle: Double;
FDateTime: TDateTime;
function GetLat: Double;
function GetLon: Double;
public
constructor Create(ALon,ALat : double;AEle : double=NO_ELE;ADateTime : TDateTime=NO_DATE);
class function CreateFrom(aPt: TRealPoint): TGPSPoint;
TGPSPoint = Class(TGPSObj) procedure GetArea(out Area: TRealArea);override;
private function HasEle: boolean;
FRealPt : TRealPoint; function HasDateTime: Boolean;
FEle : Double; function DistanceInKmFrom(OtherPt: TGPSPoint; UseEle: boolean=true): double;
FDateTime : TDateTime;
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;
property Lon : Double read GetLon; property Lon: Double read GetLon;
property Lat : Double read GetLat; property Lat: Double read GetLat;
property Ele : double read FEle; property Ele: double read FEle;
property DateTime : TDateTime read FDateTime; property DateTime: TDateTime read FDateTime;
property RealPoint : TRealPoint read FRealPt; property RealPoint: TRealPoint read FRealPt;
end; end;
TGPSPointList = specialize TFPGObjectList<TGPSPoint>; TGPSPointList = specialize TFPGObjectList<TGPSPoint>;
{ TGPSTrack } { TGPSTrack }
TGPSTrack = Class(TGPSObj) TGPSTrack = class(TGPSObj)
private private
FDateTime: TDateTime; FDateTime: TDateTime;
FPoints : TGPSPointList; FPoints: TGPSPointList;
function GetDateTime: TDateTime; function GetDateTime: TDateTime;
public public
constructor Create; constructor Create;
destructor Destroy;override; destructor Destroy; override;
Procedure GetArea(out Area : TRealArea);override; procedure GetArea(out Area: TRealArea); override;
Function TrackLengthInKm(UseEle : Boolean=true) : double; function TrackLengthInKm(UseEle: Boolean=true): double;
property Points : TGPSPointList read FPoints; property Points: TGPSPointList read FPoints;
property DateTime : TDateTime read GetDateTime write FDateTime; property DateTime: TDateTime read GetDateTime write FDateTime;
end; end;
TGPSObjList_ = specialize TFPGObjectList<TGPSObj>; TGPSObjList_ = specialize TFPGObjectList<TGPSObj>;
{ TGPSObjList } { TGPSObjList }
TGPSObjList = class(TGPSObjList_) TGPSObjList = class(TGPSObjList_)
private private
FRef : TObject; FRef: TObject;
public public
Destructor Destroy;override; destructor Destroy; override;
end; end;
{ TGPSObjectList } { TGPSObjectList }
TModifiedEvent = procedure (Sender : TObject;objs : TGPSObjList;Adding : boolean) of object;
TGPSObjectList = Class(TGPSObj) TModifiedEvent = procedure (Sender: TObject; objs: TGPSObjList;
private Adding: boolean) of object;
Crit: TCriticalSection;
FPending: TObjectList;
FRefCount: integer;
FOnModified: TModifiedEvent;
FUpdating: integer;
FItems: TGPSObjList;
function Getcount: integer;
protected
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);
function GetIdsArea(const Ids : TIdArray;IdOwner : integer) : TRealArea;
function Add(aItem : TGpsObj;IdOwner : integer) : integer; TGPSObjectList = class(TGPSObj)
Procedure DeleteById(const Ids : Array of integer); private
Crit: TCriticalSection;
FPending: TObjectList;
FRefCount: integer;
FOnModified: TModifiedEvent;
FUpdating: integer;
FItems: TGPSObjList;
function GetCount: integer;
protected
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
constructor Create;
destructor Destroy; override;
Procedure Clear(OwnedBy: integer);
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;
Procedure BeginUpdate; function Add(aItem: TGpsObj; IdOwner: integer): integer;
Procedure EndUpdate; procedure DeleteById(const Ids: Array of integer);
property Count : integer read Getcount; procedure BeginUpdate;
property OnModified : TModifiedEvent read FOnModified write FOnModified; procedure EndUpdate;
end;
function hasIntersectArea(const Area1 : TRealArea;const Area2 : TRealArea) : boolean; property Count: integer read GetCount;
function IntersectArea(const Area1 : TRealArea;const Area2 : TRealArea) : TRealArea; property OnModified: TModifiedEvent read FOnModified write FOnModified;
function PtInsideArea(const aPoint : TRealPoint;const Area : TRealArea) : boolean; end;
Function AreaInsideArea(const AreaIn : TRealArea;const AreaOut : TRealArea) : boolean;
Procedure ExtendArea(var AreaToExtend : TRealArea;Const Area : TRealArea); function HasIntersectArea(const Area1: TRealArea; const Area2: TRealArea): boolean;
Function GetAreaOf(objs : TGPSObjList) : TRealArea; 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;
implementation implementation
uses mvextradata;
uses
mvExtraData;
function hasIntersectArea(const Area1: TRealArea; const Area2: TRealArea): boolean; function hasIntersectArea(const Area1: TRealArea; const Area2: TRealArea): boolean;
begin begin
Result:=(Area1.TopLeft.Lon<=Area2.BottomRight.Lon) and (Area1.BottomRight.Lon>=Area2.TopLeft.Lon) and Result := (Area1.TopLeft.Lon <= Area2.BottomRight.Lon) and
(Area1.TopLeft.Lat>=Area2.BottomRight.Lat) and (Area1.BottomRight.Lat<=Area2.TopLeft.Lat); (Area1.BottomRight.Lon >= Area2.TopLeft.Lon) and
(Area1.TopLeft.Lat >= Area2.BottomRight.Lat) and
(Area1.BottomRight.Lat <= Area2.TopLeft.Lat);
end; end;
function IntersectArea(const Area1: TRealArea; const Area2: TRealArea function IntersectArea(const Area1: TRealArea; const Area2: TRealArea): TRealArea;
): TRealArea;
begin begin
Result:=Area1; Result := Area1;
if Result.TopLeft.Lon<Area2.topLeft.Lon then if Result.TopLeft.Lon<Area2.topLeft.Lon then
Result.TopLeft.Lon:=Area2.topLeft.Lon; Result.TopLeft.Lon:=Area2.topLeft.Lon;
if Result.TopLeft.Lat>Area2.topLeft.Lat then if Result.TopLeft.Lat>Area2.topLeft.Lat then
@ -180,15 +188,18 @@ end;
function PtInsideArea(const aPoint: TRealPoint; const Area: TRealArea): boolean; function PtInsideArea(const aPoint: TRealPoint; const Area: TRealArea): boolean;
begin begin
Result:=(Area.TopLeft.Lon<=aPoint.Lon) and (Area.BottomRight.Lon>=aPoint.Lon) and Result := (Area.TopLeft.Lon <= aPoint.Lon) and
(Area.TopLeft.Lat>=aPoint.Lat) and (Area.BottomRight.Lat<=aPoint.Lat); (Area.BottomRight.Lon >= aPoint.Lon) and
(Area.TopLeft.Lat >= aPoint.Lat) and
(Area.BottomRight.Lat <= aPoint.Lat);
end; end;
function AreaInsideArea(const AreaIn: TRealArea; const AreaOut: TRealArea function AreaInsideArea(const AreaIn: TRealArea; const AreaOut: TRealArea): boolean;
): boolean;
begin begin
Result:=(AreaIn.TopLeft.Lon>=AreaOut.TopLeft.Lon) and (AreaIn.BottomRight.Lon<=AreaOut.BottomRight.Lon) and Result := (AreaIn.TopLeft.Lon >= AreaOut.TopLeft.Lon) and
(AreaOut.TopLeft.Lat>=AreaIn.TopLeft.Lat) and (AreaOut.BottomRight.Lat<=AreaIn.BottomRight.Lat); (AreaIn.BottomRight.Lon <= AreaOut.BottomRight.Lon) and
(AreaOut.TopLeft.Lat >= AreaIn.TopLeft.Lat) and
(AreaOut.BottomRight.Lat <= AreaIn.BottomRight.Lat);
end; end;
procedure ExtendArea(var AreaToExtend: TRealArea; const Area: TRealArea); procedure ExtendArea(var AreaToExtend: TRealArea; const Area: TRealArea);
@ -205,17 +216,18 @@ begin
end; end;
function GetAreaOf(objs: TGPSObjList): TRealArea; function GetAreaOf(objs: TGPSObjList): TRealArea;
var i : integer; var
i: integer;
begin begin
Result.TopLeft.Lon:=0; Result.TopLeft.Lon := 0;
Result.TopLeft.Lat:=0; Result.TopLeft.Lat := 0;
Result.BottomRight.Lon:=0; Result.BottomRight.Lon := 0;
Result.BottomRight.Lat:=0; Result.BottomRight.Lat := 0;
if Objs.Count>0 then if Objs.Count>0 then
Begin begin
Result:=Objs[0].BoundingBox; 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); ExtendArea(Result, Objs[i].BoundingBox);
end; end;
end; end;
@ -224,7 +236,7 @@ end;
destructor TGPSObjList.Destroy; destructor TGPSObjList.Destroy;
begin begin
if Assigned(FRef) then if Assigned(FRef) then
TGPSObjectList(FRef).DecRef; TGPSObjectList(FRef).DecRef;
inherited Destroy; inherited Destroy;
end; end;
@ -234,24 +246,24 @@ procedure TGPSObj.SetExtraData(AValue: TObject);
begin begin
if FExtraData=AValue then Exit; if FExtraData=AValue then Exit;
if Assigned(FExtraData) then if Assigned(FExtraData) then
FreeAndNil(FExtraData); FreeAndNil(FExtraData);
FExtraData:=AValue; FExtraData := AValue;
end; end;
function TGPSObj.GetBoundingBox: TRealArea; function TGPSObj.GetBoundingBox: TRealArea;
begin begin
if not(BBoxSet) then if not(BBoxSet) then
Begin begin
GetArea(FBoundingBox); GetArea(FBoundingBox);
BBoxSet:=true; BBoxSet := true;
end; end;
Result:=FBoundingBox; Result := FBoundingBox;
end; end;
procedure TGPSObj.SetBoundingBox(AValue: TRealArea); procedure TGPSObj.SetBoundingBox(AValue: TRealArea);
begin begin
FBoundingBox:=AValue; FBoundingBox := AValue;
BBoxSet:=true; BBoxSet := true;
end; end;
destructor TGPSObj.Destroy; destructor TGPSObj.Destroy;
@ -262,39 +274,39 @@ end;
{ TGPSObjectList } { TGPSObjectList }
function TGPSObjectList.Getcount: integer; function TGPSObjectList.GetCount: integer;
begin begin
Result:=FItems.Count Result := FItems.Count
end; end;
procedure TGPSObjectList._Delete(Idx: Integer; var DelLst: TGPSObjList); // wp: was "out" procedure TGPSObjectList._Delete(Idx: Integer; var DelLst: TGPSObjList); // wp: was "out"
var var
Item: TGpsObj; Item: TGpsObj;
begin begin
Lock; Lock;
Try try
if not(Assigned(DelLst)) then if not(Assigned(DelLst)) then
Begin begin
DelLst:=TGpsObjList.Create(False); DelLst := TGpsObjList.Create(False);
DelLst.FRef:=Self; DelLst.FRef := Self;
inc(FRefCount); inc(FRefCount);
end;
if not Assigned(FPending) then
FPending:=TObjectList.Create(true);
Item:=Items.Extract(Items[Idx]);
FPending.Add(Item);
finally
UnLock;
end; end;
DelLst.Add(Item); if not Assigned(FPending) then
FPending := TObjectList.Create(true);
Item := Items.Extract(Items[Idx]);
FPending.Add(Item);
finally
UnLock;
end;
DelLst.Add(Item);
end; end;
procedure TGPSObjectList.FreePending; procedure TGPSObjectList.FreePending;
begin begin
if Assigned(FPending) then if Assigned(FPending) then
Begin begin
Lock; Lock;
Try try
FreeAndNil(FPending); FreeAndNil(FPending);
finally finally
UnLock; UnLock;
@ -324,41 +336,42 @@ end;
procedure TGPSObjectList.CallModified(lst: TGPSObjList; Adding: boolean); procedure TGPSObjectList.CallModified(lst: TGPSObjList; Adding: boolean);
begin begin
if (FUpdating=0) and Assigned(FOnModified) then if (FUpdating=0) and Assigned(FOnModified) then
FOnModified(self,lst,Adding) FOnModified(self, lst, Adding)
else else
lst.Free; lst.Free;
end; 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; function ToSelect(aId: integer): boolean;
var var
i: integer; i: integer;
begin begin
result:=false; result := false;
for i:=low(Ids) to high(Ids) do for i:=low(Ids) to high(Ids) do
if Ids[i]=aId then if Ids[i]=aId then
begin begin
result:=true; result := true;
break; break;
end; end;
end; end;
var var
i,nb : integer; i,nb : integer;
begin begin
SetLength(objs,length(Ids)); SetLength(objs, Length(Ids));
nb:=0; nb := 0;
Lock; Lock;
Try try
for i:=0 to pred(FItems.Count) do for i:=0 to pred(FItems.Count) do
begin begin
if (IdOwner=0) or (IdOwner=FItems[i].FIdOwner) then if (IdOwner = 0) or (IdOwner = FItems[i].FIdOwner) then
if Assigned(FItems[i].ExtraData) and FItems[i].ExtraData.InheritsFrom(TDrawingExtraData) then if Assigned(FItems[i].ExtraData) and FItems[i].ExtraData.InheritsFrom(TDrawingExtraData) then
Begin begin
if ToSelect(TDrawingExtraData(FItems[i].ExtraData).Id) then if ToSelect(TDrawingExtraData(FItems[i].ExtraData).Id) then
Begin begin
objs[nb]:=FItems[i]; objs[nb] := FItems[i];
nb+=1; nb+=1;
end; end;
end; end;
@ -366,26 +379,27 @@ begin
finally finally
Unlock; Unlock;
end; end;
SetLength(objs,nb); SetLength(objs, nb);
end; end;
procedure TGPSObjectList.GetArea(out Area: TRealArea); procedure TGPSObjectList.GetArea(out Area: TRealArea);
var i : integer; var
ptArea : TRealArea; i: integer;
ptArea: TRealArea;
begin begin
Area.BottomRight.lon:=0; Area.BottomRight.lon := 0;
Area.BottomRight.lat:=0; Area.BottomRight.lat := 0;
Area.TopLeft.lon:=0; Area.TopLeft.lon := 0;
Area.TopLeft.lat:=0; Area.TopLeft.lat := 0;
Lock; Lock;
Try try
if Items.Count>0 then if Items.Count > 0 then
begin begin
Area:=Items[0].BoundingBox; Area := Items[0].BoundingBox;
for i:=1 to pred(Items.Count) do for i:=1 to pred(Items.Count) do
begin begin
ptArea:=Items[i].BoundingBox; ptArea := Items[i].BoundingBox;
ExtendArea(Area,ptArea); ExtendArea(Area, ptArea);
end; end;
end; end;
finally finally
@ -394,21 +408,22 @@ begin
end; end;
function TGPSObjectList.GetObjectsInArea(const Area: TRealArea): TGPSObjList; function TGPSObjectList.GetObjectsInArea(const Area: TRealArea): TGPSObjList;
var i : integer; var
ItemArea : TRealArea; i: integer;
ItemArea: TRealArea;
begin begin
Result:=TGPSObjList.Create(false); Result := TGPSObjList.Create(false);
Lock; Lock;
Try try
Inc(FRefCount); Inc(FRefCount);
For i:=0 to pred(Items.Count) do for i:=0 to pred(Items.Count) do
Begin begin
ItemArea:=Items[i].BoundingBox; ItemArea := Items[i].BoundingBox;
If hasIntersectArea(Area,ItemArea) then if hasIntersectArea(Area,ItemArea) then
Result.Add(Items[i]); Result.Add(Items[i]);
end; end;
if Result.Count>0 then if Result.Count > 0 then
Result.FRef:=Self Result.FRef := Self
else else
Dec(FRefCount); Dec(FRefCount);
finally finally
@ -418,7 +433,7 @@ end;
constructor TGPSObjectList.Create; constructor TGPSObjectList.Create;
begin begin
Crit:=TCriticalSection.Create; Crit := TCriticalSection.Create;
FItems := TGPSObjList.Create(true); FItems := TGPSObjList.Create(true);
end; end;
@ -431,59 +446,63 @@ begin
end; end;
procedure TGPSObjectList.Clear(OwnedBy: integer); procedure TGPSObjectList.Clear(OwnedBy: integer);
var i : integer; var
DelObj : TGPSObjList; i: integer;
DelObj: TGPSObjList;
begin begin
DelObj:=nil; DelObj := nil;
Lock; Lock;
try 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 if (OwnedBy = 0) or (FItems[i].FIdOwner = OwnedBy) then
_Delete(i,DelObj); _Delete(i,DelObj);
finally finally
Unlock; Unlock;
end; end;
if Assigned(DelObj) then if Assigned(DelObj) then
CallModified(DelObj,false); CallModified(DelObj, false);
end; end;
procedure TGPSObjectList.ClearExcept(OwnedBy: integer; procedure TGPSObjectList.ClearExcept(OwnedBy: integer;
const ExceptLst : TIdArray; out Notfound: TIdArray); const ExceptLst: TIdArray; out Notfound: TIdArray);
var Found : TIdArray; var
Found: TIdArray;
function ToDel(aIt : TGPsObj) : boolean; function ToDel(aIt: TGPsObj): boolean;
var i,Id : integer; var
Begin i,Id: integer;
if (aIt.ExtraData=nil) or not(aIt.ExtraData.InheritsFrom(TDrawingExtraData)) then begin
result:=true if (aIt.ExtraData=nil) or not(aIt.ExtraData.InheritsFrom(TDrawingExtraData)) then
else Result := true
Begin else
Result:=true; Begin
Id:=TDrawingExtraData(aIt.ExtraData).Id; Result := true;
for i:=low(ExceptLst) to high(ExceptLst) do Id := TDrawingExtraData(aIt.ExtraData).Id;
if Id=ExceptLst[i] then for i := Low(ExceptLst) to High(ExceptLst) do
begin if Id = ExceptLst[i] then
result:=false; begin
SetLength(Found,Length(Found)+1); Result := false;
Found[high(Found)]:=Id; SetLength(Found, Length(Found)+1);
exit; Found[high(Found)] := Id;
end; exit;
end;
end;
end; end;
end;
var i,j : integer; var
IsFound : boolean; i,j: integer;
DelLst : TGPSObjList; IsFound: boolean;
DelLst: TGPSObjList;
begin begin
DelLst:=nil; DelLst := nil;
SetLength(NotFound,0); SetLength(NotFound, 0);
SetLength(Found,0); SetLength(Found, 0);
Lock; Lock;
try try
For i:=pred(FItems.Count) downto 0 do for i := pred(FItems.Count) downto 0 do
begin begin
if (FItems[i].FIdOwner=OwnedBy) or (OwnedBy=0) then if (FItems[i].FIdOwner = OwnedBy) or (OwnedBy = 0) then
Begin Begin
if ToDel(FItems[i]) then if ToDel(FItems[i]) then
_Delete(i,DelLst); _Delete(i,DelLst);
@ -492,77 +511,77 @@ begin
finally finally
Unlock; Unlock;
end; end;
For i:=low(ExceptLst) to high(ExceptLst) do for i:=low(ExceptLst) to high(ExceptLst) do
Begin begin
IsFound:=false; IsFound := false;
for j:=low(Found) to high(Found) do for j:=Low(Found) to High(Found) do
if Found[j]=ExceptLst[i] then if Found[j] = ExceptLst[i] then
begin begin
IsFound:=true; IsFound := true;
break; break;
end; end;
if not(IsFound) then if not IsFound then
Begin begin
SetLength(NotFound,length(NotFound)+1); SetLength(NotFound, Length(NotFound)+1);
NotFound[high(NotFound)]:=ExceptLst[i]; NotFound[high(NotFound)] := ExceptLst[i];
end; end;
end; end;
if Assigned(DelLst) then if Assigned(DelLst) then
CallModified(DelLst,false); CallModified(DelLst, false);
end; end;
function TGPSObjectList.GetIdsArea(const Ids: TIdArray;IdOwner : integer): TRealArea; function TGPSObjectList.GetIdsArea(const Ids: TIdArray; IdOwner: integer): TRealArea;
var Objs : TGPSObjarray; var
i : integer; Objs: TGPSObjarray;
i: integer;
begin begin
Result.BottomRight.Lat:=0; Result.BottomRight.Lat := 0;
Result.BottomRight.Lon:=0; Result.BottomRight.Lon := 0;
Result.TopLeft.Lat:=0; Result.TopLeft.Lat := 0;
Result.TopLeft.Lon:=0; Result.TopLeft.Lon := 0;
Lock; Lock;
Try try
IdsToObj(Ids,Objs,IdOwner); IdsToObj(Ids, Objs, IdOwner);
if length(Objs)>0 then if Length(Objs) > 0 then
Begin begin
Result:=Objs[0].BoundingBox; Result := Objs[0].BoundingBox;
for i:=succ(low(Objs)) to high(Objs) do for i:=succ(Low(Objs)) to High(Objs) do
begin ExtendArea(Result, Objs[i].BoundingBox);
ExtendArea(Result,Objs[i].BoundingBox);
end;
end; end;
finally finally
Unlock; Unlock;
end; end;
end; end;
function TGPSObjectList.Add(aItem: TGpsObj;IdOwner : integer): integer; function TGPSObjectList.Add(aItem: TGpsObj; IdOwner: integer): integer;
var mList : TGPSObjList; var
mList: TGPSObjList;
begin begin
aItem.FIdOwner:=IdOwner; aItem.FIdOwner := IdOwner;
Lock; Lock;
try try
Result:=Items.Add(aItem); Result := Items.Add(aItem);
mList:=TGPSObjList.Create(false); mList := TGPSObjList.Create(false);
mList.Add(aItem); mList.Add(aItem);
inc(FRefCount); inc(FRefCount);
mList.FRef:=Self; mList.FRef := Self;
finally finally
Unlock; Unlock;
end; end;
CallModified(mList,true); CallModified(mList, true);
end; end;
procedure TGPSObjectList.DeleteById(const Ids: array of integer); procedure TGPSObjectList.DeleteById(const Ids: array of integer);
function ToDelete(const AId : integer) : Boolean; function ToDelete(const AId: integer): Boolean;
var var
i: integer; i: integer;
begin begin
result:=false; result := false;
For i:=low(Ids) to high(Ids) do For i:=Low(Ids) to High(Ids) do
if Ids[i]=AId then if Ids[i] = AId then
Begin begin
result:=true; result := true;
exit; exit;
end; end;
end; end;
@ -572,7 +591,7 @@ var
i: integer; i: integer;
DelLst: TGPSObjList; DelLst: TGPSObjList;
begin begin
DelLst:=nil; DelLst := nil;
Lock; Lock;
try try
for i:=Pred(Items.Count) downto 0 do for i:=Pred(Items.Count) downto 0 do
@ -584,8 +603,9 @@ begin
Extr := TDrawingExtraData(Items[i]); Extr := TDrawingExtraData(Items[i]);
// !!! wp: There is a warning that TGPSObj and TDrawingExtraData are not related !!! // !!! wp: There is a warning that TGPSObj and TDrawingExtraData are not related !!!
if ToDelete(Extr.Id) then if ToDelete(Extr.Id) then
_Delete(i,DelLst); _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; end;
end; end;
@ -593,7 +613,7 @@ begin
Unlock; Unlock;
end; end;
if Assigned(DelLst) then if Assigned(DelLst) then
// wp: is this missing here: DelLst.Free;
end; end;
procedure TGPSObjectList.BeginUpdate; procedure TGPSObjectList.BeginUpdate;
@ -603,11 +623,11 @@ end;
procedure TGPSObjectList.EndUpdate; procedure TGPSObjectList.EndUpdate;
begin begin
if FUpdating>0 then if FUpdating > 0 then
begin begin
Dec(FUpdating); Dec(FUpdating);
if FUpdating=0 then if FUpdating = 0 then
CallModified(nil,true); CallModified(nil, true);
end; end;
end; end;
@ -616,12 +636,12 @@ end;
function TGPSTrack.GetDateTime: TDateTime; function TGPSTrack.GetDateTime: TDateTime;
begin begin
if FDateTime=0 then if FDateTime = 0 then
Begin Begin
if FPoints.Count>0 then if FPoints.Count > 0 then
FDateTime:=FPoints[0].DateTime; FDateTime := FPoints[0].DateTime;
end; end;
Result:=FDateTime; Result := FDateTime;
end; end;
constructor TGPSTrack.Create; constructor TGPSTrack.Create;
@ -636,66 +656,68 @@ begin
end; end;
procedure TGPSTrack.GetArea(out Area: TRealArea); procedure TGPSTrack.GetArea(out Area: TRealArea);
var i : integer; var
ptArea : TRealArea; i: integer;
ptArea: TRealArea;
begin begin
Area.BottomRight.lon:=0; Area.BottomRight.lon := 0;
Area.BottomRight.lat:=0; Area.BottomRight.lat := 0;
Area.TopLeft.lon:=0; Area.TopLeft.lon := 0;
Area.TopLeft.lat:=0; Area.TopLeft.lat := 0;
if FPoints.Count>0 then if FPoints.Count > 0 then
begin begin
Area:=FPoints[0].BoundingBox; Area := FPoints[0].BoundingBox;
for i:=1 to pred(FPoints.Count) do for i:=1 to pred(FPoints.Count) do
begin begin
ptArea:=FPoints[i].BoundingBox; ptArea := FPoints[i].BoundingBox;
ExtendArea(Area,ptArea); ExtendArea(Area, ptArea);
end; end;
end; end;
end; end;
function TGPSTrack.TrackLengthInKm(UseEle: Boolean): double; function TGPSTrack.TrackLengthInKm(UseEle: Boolean): double;
var i : integer; var
i: integer;
begin begin
Result:=0; Result := 0;
For i:=1 to pred(FPoints.Count) do for i:=1 to pred(FPoints.Count) do
begin result += FPoints[i].DistanceInKmFrom(FPoints[pred(i)], UseEle);
result+=FPoints[i].DistanceInKmFrom(FPoints[pred(i)],UseEle);
end;
end; end;
{ TGPSPoint } { TGPSPoint }
function TGPSPoint.GetLat: Double; function TGPSPoint.GetLat: Double;
begin begin
result:=FRealPt.Lat; result := FRealPt.Lat;
end; end;
function TGPSPoint.GetLon: Double; function TGPSPoint.GetLon: Double;
begin begin
result:=FRealPt.Lon; result := FRealPt.Lon;
end; end;
procedure TGPSPoint.GetArea(out Area: TRealArea); procedure TGPSPoint.GetArea(out Area: TRealArea);
begin begin
Area.TopLeft:=FRealPt; Area.TopLeft := FRealPt;
Area.BottomRight:=FRealPt; Area.BottomRight := FRealPt;
end; end;
function TGPSPoint.HasEle: boolean; function TGPSPoint.HasEle: boolean;
begin begin
Result:=FEle<>NO_ELE; Result := FEle <> NO_ELE;
end; end;
function TGPSPoint.HasDateTime: Boolean; function TGPSPoint.HasDateTime: Boolean;
begin begin
Result:=FDateTime<>NO_DATE; Result := FDateTime <> NO_DATE;
end; end;
function TGPSPoint.DistanceInKmFrom(OtherPt: TGPSPoint;UseEle : boolean): double; function TGPSPoint.DistanceInKmFrom(OtherPt: TGPSPoint; UseEle: boolean): double;
var a : double; var
lat1,lat2,lon1,lon2,t1,t2,t3,t4,t5,rad_dist : double; a: double;
DiffEle :Double; lat1, lat2, lon1, lon2, t1, t2, t3, t4, t5, rad_dist: double;
DiffEle: Double;
begin begin
a := PI / 180; a := PI / 180;
lat1 := lat * a; lat1 := lat * a;
@ -712,25 +734,25 @@ begin
result := (rad_dist * 3437.74677 * 1.1508) * 1.6093470878864446; result := (rad_dist * 3437.74677 * 1.1508) * 1.6093470878864446;
if UseEle and (FEle<>OtherPt.FEle) then if UseEle and (FEle<>OtherPt.FEle) then
if (HasEle) and (OtherPt.HasEle) then if (HasEle) and (OtherPt.HasEle) then
Begin begin
//FEle is assumed in Metter //FEle is assumed in Metter
DiffEle:=(FEle-OtherPt.Ele)/1000; DiffEle := (FEle-OtherPt.Ele)/1000;
Result:=sqrt(DiffEle*DiffEle+result*result); Result := sqrt(DiffEle*DiffEle+result*result);
end; end;
end; end;
constructor TGPSPoint.Create(ALon, ALat: double; AEle: double; constructor TGPSPoint.Create(ALon, ALat: double; AEle: double;
ADateTime: TDateTime); ADateTime: TDateTime);
begin begin
FRealPt.Lon:=ALon; FRealPt.Lon := ALon;
FRealPt.Lat:=ALat; FRealPt.Lat := ALat;
FEle:=AEle; FEle := AEle;
FDateTime:=ADateTime; FDateTime := ADateTime;
end; end;
class function TGPSPoint.CreateFrom(aPt: TRealPoint): TGPSPoint; class function TGPSPoint.CreateFrom(aPt: TRealPoint): TGPSPoint;
begin begin
Result:=Create(aPt.Lon,aPt.Lat); Result := Create(aPt.Lon,aPt.Lat);
end; end;
end. end.

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

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

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

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

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

@ -97,19 +97,23 @@ Type
{$ENDIF} {$ENDIF}
procedure DblClick; override; procedure DblClick; override;
Procedure DoDrawTile(const TileId: TTileId; X,Y: integer; TileImg: TLazIntfImage); 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; procedure DoOnResize; override;
Function IsActive : Boolean; function IsActive: Boolean;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y:Integer); override; procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X,Y: Integer); override; procedure MouseMove(Shift: TShiftState; X,Y: Integer); override;
procedure Paint; override; procedure Paint; override;
procedure OnGPSItemsModified(Sender: TObject; objs: TGPSObjList;Adding : boolean); procedure OnGPSItemsModified(Sender: TObject; objs: TGPSObjList;
Adding: boolean);
public public
constructor Create(AOwner: TComponent); override; constructor Create(AOwner: TComponent); override;
destructor Destroy; override; destructor Destroy; override;
procedure ClearBuffer; procedure ClearBuffer;
procedure GetMapProviders(lstProviders : TStrings); procedure GetMapProviders(lstProviders: TStrings);
function GetVisibleArea: TRealArea; function GetVisibleArea: TRealArea;
function LonLatToScreen(aPt: TRealPoint): TPoint; function LonLatToScreen(aPt: TRealPoint): TPoint;
function ScreenToLonLat(aPt: TPoint): TRealPoint; function ScreenToLonLat(aPt: TPoint): TRealPoint;
@ -134,9 +138,9 @@ Type
property UseThreads: boolean read GetUseThreads write SetUseThreads; property UseThreads: boolean read GetUseThreads write SetUseThreads;
property Width default 150; property Width default 150;
property Zoom: integer read GetZoom write SetZoom; property Zoom: integer read GetZoom write SetZoom;
property OnCenterMove: TNotifyEvent read GetOnCenterMove write SetOnCenterMove; property OnCenterMove: TNotifyEvent read GetOnCenterMove write SetOnCenterMove;
property OnZoomChange: TNotifyEvent read GetOnZoomChange write SetOnZoomChange; 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 OnDrawGpsPoint: TDrawGpsPointEvent read FOnDrawGpsPoint write FOnDrawGpsPoint;
property OnMouseDown; property OnMouseDown;
property OnMouseEnter; property OnMouseEnter;
@ -145,6 +149,7 @@ Type
property OnMouseUp; property OnMouseUp;
end; end;
implementation implementation
uses uses
@ -212,24 +217,24 @@ Type
{ TDrawObjJob } { TDrawObjJob }
TDrawObjJob = Class(TJob) TDrawObjJob = class(TJob)
private private
AllRun : boolean; AllRun: boolean;
Viewer : TMapView; Viewer: TMapView;
FRunning : boolean; FRunning: boolean;
FLst : TGPSObjList; FLst: TGPSObjList;
FStates : Array of integer; FStates: Array of integer;
FArea : TRealArea; FArea: TRealArea;
protected protected
function pGetTask: integer;override; function pGetTask: integer; override;
procedure pTaskStarted(aTask: integer);override; procedure pTaskStarted(aTask: integer); override;
procedure pTaskEnded(aTask: integer; aExcept: Exception);override; procedure pTaskEnded(aTask: integer; aExcept: Exception); override;
public public
procedure ExecuteTask(aTask: integer; FromWaiting: boolean);override; procedure ExecuteTask(aTask: integer; FromWaiting: boolean); override;
function Running : boolean;override; function Running: boolean;override;
public public
Constructor Create(aViewer: TMapView; aLst: TGPSObjList; const aArea: TRealArea); constructor Create(aViewer: TMapView; aLst: TGPSObjList; const aArea: TRealArea);
destructor Destroy;override; destructor Destroy; override;
end; end;
{ TDrawObjJob } { TDrawObjJob }
@ -240,51 +245,49 @@ var
begin begin
if not(AllRun) and not(Cancelled) then if not(AllRun) and not(Cancelled) then
begin begin
For i:=low(FStates) to high(FStates) do for i := Low(FStates) to High(FStates) do
if FStates[i]=0 then if FStates[i]=0 then
Begin begin
result:=i+1; result := i+1;
Exit; Exit;
end; end;
AllRun:=True; AllRun:=True;
end; end;
Result:=ALL_TASK_COMPLETED;
for i:=low(FStates) to high(FStates) do Result := ALL_TASK_COMPLETED;
if FStates[i]=1 then for i := Low(FStates) to High(FStates) do
begin if FStates[i]=1 then
Result:=NO_MORE_TASK; begin
Exit; Result := NO_MORE_TASK;
end; Exit;
end;
end; end;
procedure TDrawObjJob.pTaskStarted(aTask: integer); procedure TDrawObjJob.pTaskStarted(aTask: integer);
begin begin
FRunning:=True; FRunning := True;
FStates[aTask-1]:=1; FStates[aTask-1] := 1;
end; end;
procedure TDrawObjJob.pTaskEnded(aTask: integer; aExcept: Exception); procedure TDrawObjJob.pTaskEnded(aTask: integer; aExcept: Exception);
begin begin
if Assigned(aExcept) then if Assigned(aExcept) then
FStates[aTask-1]:=3 FStates[aTask-1] := 3
else else
FStates[aTask-1]:=2; FStates[aTask-1] := 2;
end; end;
procedure TDrawObjJob.ExecuteTask(aTask: integer; FromWaiting: boolean); procedure TDrawObjJob.ExecuteTask(aTask: integer; FromWaiting: boolean);
var iObj : integer; var
Obj : TGpsObj; iObj: integer;
Obj: TGpsObj;
begin begin
iObj:=aTask-1; iObj := aTask-1;
Obj:=FLst[iObj]; Obj := FLst[iObj];
if Obj.InheritsFrom(TGPSTrack) then if Obj.InheritsFrom(TGPSTrack) then
begin Viewer.DrawTrack(FArea, TGPSTrack(Obj));
Viewer.DrawTrack(FArea,TGPSTrack(Obj)); if Obj.InheritsFrom(TGPSPoint) then
end; Viewer.DrawPt(FArea, TGPSPoint(Obj));
if Obj.InheritsFrom(TGPSPoint) then
begin
Viewer.DrawPt(FArea,TGPSPoint(Obj));
end;
end; end;
function TDrawObjJob.Running: boolean; function TDrawObjJob.Running: boolean;
@ -451,8 +454,8 @@ begin
Engine.MouseWheel(self,Shift,WheelDelta,MousePos,Result); Engine.MouseWheel(self,Shift,WheelDelta,MousePos,Result);
end; end;
procedure TMapView.MouseDown(Button: TMouseButton; Shift: TShiftState; X, procedure TMapView.MouseDown(Button: TMouseButton; Shift: TShiftState;
Y: Integer); X, Y: Integer);
begin begin
inherited MouseDown(Button, Shift, X, Y); inherited MouseDown(Button, Shift, X, Y);
if IsActive then if IsActive then
@ -521,9 +524,9 @@ begin
end end
else else
begin begin
Canvas.Brush.Color:=InactiveColor; Canvas.Brush.Color := InactiveColor;
Canvas.Brush.Style:=bsSolid; Canvas.Brush.Style := bsSolid;
Canvas.FillRect(0,0,ClientWidth,ClientHeight); Canvas.FillRect(0, 0, ClientWidth, ClientHeight);
end; end;
end; end;
@ -532,14 +535,14 @@ procedure TMapView.OnGPSItemsModified(Sender: TObject; objs: TGPSObjList;
var var
Area,ObjArea,vArea: TRealArea; Area,ObjArea,vArea: TRealArea;
begin begin
if Adding and assigned(Objs) then if Adding and Assigned(Objs) then
begin begin
ObjArea := GetAreaOf(Objs); ObjArea := GetAreaOf(Objs);
vArea := GetVisibleArea; vArea := GetVisibleArea;
if hasIntersectArea(ObjArea,vArea) then if hasIntersectArea(ObjArea,vArea) then
begin begin
Area:=IntersectArea(ObjArea,vArea); Area := IntersectArea(ObjArea, vArea);
Engine.Jobqueue.AddJob(TDrawObjJob.Create(self,Objs,Area),Engine); Engine.Jobqueue.AddJob(TDrawObjJob.Create(self, Objs, Area), Engine);
end end
else else
objs.Free; objs.Free;
@ -551,53 +554,54 @@ begin
end; end;
end; end;
procedure TMapView.DrawTrack(const Area : TRealArea;trk : TGPSTrack); procedure TMapView.DrawTrack(const Area: TRealArea; trk: TGPSTrack);
var Old,New : TPoint; var
i : integer; Old,New: TPoint;
aPt : TRealPoint; i: integer;
LastInside,IsInside : boolean; aPt: TRealPoint;
trkColor : TColor; LastInside, IsInside: boolean;
Begin trkColor: TColor;
if trk.Points.Count>0 then begin
Begin if trk.Points.Count>0 then
trkColor:=clRed; begin
if trk.ExtraData<>nil then trkColor := clRed;
Begin if trk.ExtraData <> nil then
if trk.ExtraData.inheritsFrom(TDrawingExtraData) then begin
trkColor:=TDrawingExtraData(trk.ExtraData).Color; if trk.ExtraData.InheritsFrom(TDrawingExtraData) then
end; trkColor := TDrawingExtraData(trk.ExtraData).Color;
LastInside:=false; end;
For i:=0 to pred(trk.Points.Count) do LastInside := false;
Begin for i:=0 to pred(trk.Points.Count) do
aPt:=trk.Points[i].RealPoint; begin
IsInside:=PtInsideArea(aPt,Area); aPt := trk.Points[i].RealPoint;
if IsInside or LastInside then IsInside := PtInsideArea(aPt,Area);
Begin if IsInside or LastInside then
New:=Engine.LonLatToScreen(aPt); begin
if i>0 then New := Engine.LonLatToScreen(aPt);
Begin if i > 0 then
if not(LastInside) then begin
Old:=Engine.LonLatToScreen(trk.Points[pred(i)].RealPoint); if not LastInside then
{$IFDEF USE_RGBGRAPHICS} Old := Engine.LonLatToScreen(trk.Points[pred(i)].RealPoint);
Buffer.Canvas.OutlineColor := trkColor; {$IFDEF USE_RGBGRAPHICS}
Buffer.Canvas.Line(Old.X, Old.y, New.X, New.Y); Buffer.Canvas.OutlineColor := trkColor;
{$ENDIF} Buffer.Canvas.Line(Old.X, Old.y, New.X, New.Y);
{$IFDEF USE_LAZINTFIMAGE} {$ENDIF}
BufferCanvas.Pen.FPColor := TColorToFPColor(trkColor); {$IFDEF USE_LAZINTFIMAGE}
BufferCanvas.Line(Old.X, Old.Y, New.X, New.Y); BufferCanvas.Pen.FPColor := TColorToFPColor(trkColor);
{$ENDIF} BufferCanvas.Line(Old.X, Old.Y, New.X, New.Y);
end; {$ENDIF}
Old := New; end;
LastInside := IsInside; Old := New;
end; LastInside := IsInside;
end; end;
end; end;
end;
end; end;
procedure TMapView.DrawPt(const Area: TRealArea; aPOI: TGPSPoint); procedure TMapView.DrawPt(const Area: TRealArea; aPOI: TGPSPoint);
var var
PT : TPoint; PT: TPoint;
PtColor : TColor; PtColor: TColor;
begin begin
if Assigned(FOnDrawGpsPoint) then begin if Assigned(FOnDrawGpsPoint) then begin
{$IFDEF USE_RGBGRAPHICS} {$IFDEF USE_RGBGRAPHICS}
@ -609,17 +613,17 @@ begin
exit; exit;
end; end;
Pt:=Engine.LonLatToScreen(aPOI.RealPoint); Pt := Engine.LonLatToScreen(aPOI.RealPoint);
PtColor:=clRed; PtColor := clRed;
if aPOI.ExtraData<>nil then if aPOI.ExtraData <> nil then
Begin begin
if aPOI.ExtraData.inheritsFrom(TDrawingExtraData) then if aPOI.ExtraData.inheritsFrom(TDrawingExtraData) then
PtColor:=TDrawingExtraData(aPOI.ExtraData).Color; PtColor := TDrawingExtraData(aPOI.ExtraData).Color;
end; end;
{$IFDEF USE_RGBGRAPHICS} {$IFDEF USE_RGBGRAPHICS}
Buffer.canvas.OutlineColor:=ptColor; Buffer.Canvas.OutlineColor := ptColor;
Buffer.canvas.Line(Pt.X,Pt.y-5,Pt.X,Pt.Y+5); 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.Line(Pt.X-5, Pt.y, Pt.X+5, Pt.Y);
{$ENDIF} {$ENDIF}
{$IFDEF USE_LAZINTFIMAGE} {$IFDEF USE_LAZINTFIMAGE}
BufferCanvas.Pen.FPColor := TColorToFPColor(ptColor); BufferCanvas.Pen.FPColor := TColorToFPColor(ptColor);
@ -633,29 +637,30 @@ end;
procedure TMapView.CallAsyncInvalidate; procedure TMapView.CallAsyncInvalidate;
Begin Begin
if not(AsyncInvalidate) then if not(AsyncInvalidate) then
Begin begin
AsyncInvalidate:=true; AsyncInvalidate := true;
Engine.Jobqueue.QueueAsyncCall(@DoAsyncInvalidate,0); Engine.Jobqueue.QueueAsyncCall(@DoAsyncInvalidate, 0);
end; end;
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 var
aPt: TPoint; aPt: TPoint;
Area: TRealArea; Area: TRealArea;
lst: TGPSObjList; lst: TGPSObjList;
begin begin
aPt.X:=aLeft; aPt.X := aLeft;
aPt.Y:=aTop; aPt.Y := aTop;
Area.TopLeft:=Engine.ScreenToLonLat(aPt); Area.TopLeft := Engine.ScreenToLonLat(aPt);
aPt.X:=aRight; aPt.X := aRight;
aPt.Y:=aBottom; aPt.Y := aBottom;
Area.BottomRight:=Engine.ScreenToLonLat(aPt); Area.BottomRight := Engine.ScreenToLonLat(aPt);
if GPSItems.count>0 then if GPSItems.Count > 0 then
begin begin
lst:=GPSItems.GetObjectsInArea(Area); lst := GPSItems.GetObjectsInArea(Area);
if lst.Count>0 then if lst.Count > 0 then
Engine.Jobqueue.AddJob(TDrawObjJob.Create(self,lst,Area),Engine) Engine.Jobqueue.AddJob(TDrawObjJob.Create(self, lst, Area), Engine)
else else
begin begin
FreeAndNil(Lst); FreeAndNil(Lst);
@ -669,31 +674,31 @@ end;
procedure TMapView.DoAsyncInvalidate(Data: PtrInt); procedure TMapView.DoAsyncInvalidate(Data: PtrInt);
Begin Begin
Invalidate; Invalidate;
AsyncInvalidate:=false; AsyncInvalidate := false;
end; end;
procedure TMapView.DoDrawTile(const TileId: TTileId; X, Y: integer; procedure TMapView.DoDrawTile(const TileId: TTileId; X, Y: integer;
TileImg: TLazIntfImage); TileImg: TLazIntfImage);
{$IFDEF USE_RGBGRAPHICS} {$IFDEF USE_RGBGRAPHICS}
var var
temp : TRGB32Bitmap; temp: TRGB32Bitmap;
ri : TRawImage; ri: TRawImage;
BuffLaz : TLazIntfImage; BuffLaz: TLazIntfImage;
{$ENDIF} {$ENDIF}
begin begin
if Assigned(Buffer) then if Assigned(Buffer) then
begin begin
if Assigned(TileImg) then if Assigned(TileImg) then
Begin begin
{$IFDEF USE_RGBGRAPHICS} {$IFDEF USE_RGBGRAPHICS}
if (X>=0) and (Y>=0) then //http://mantis.freepascal.org/view.php?id=27144 if (X >= 0) and (Y >= 0) then //http://mantis.freepascal.org/view.php?id=27144
begin begin
ri.Init; ri.Init;
ri.Description.Init_BPP32_R8G8B8A8_BIO_TTB(Buffer.Width,Buffer.Height); ri.Description.Init_BPP32_R8G8B8A8_BIO_TTB(Buffer.Width,Buffer.Height);
ri.Data:=Buffer.Pixels; ri.Data := Buffer.Pixels;
BuffLaz := TLazIntfImage.Create(ri,false); BuffLaz := TLazIntfImage.Create(ri, false);
try try
BuffLaz.CopyPixels(TileImg,X,y); BuffLaz.CopyPixels(TileImg, X, Y);
ri.Init; ri.Init;
finally finally
FreeandNil(BuffLaz); FreeandNil(BuffLaz);
@ -702,11 +707,11 @@ begin
else else
begin begin
//i think it take more memory then the previous method but work in all case //i think it take more memory then the previous method but work in all case
temp:=TRGB32Bitmap.CreateFromLazIntfImage(TileImg); temp := TRGB32Bitmap.CreateFromLazIntfImage(TileImg);
try try
Buffer.Draw(X,Y,temp); Buffer.Draw(X, Y, temp);
finally finally
FreeAndNil(Temp); FreeAndNil(temp);
end; end;
end; end;
{$ENDIF} {$ENDIF}
@ -721,24 +726,24 @@ begin
end end
else else
{$IFDEF USE_RGBGRAPHICS} {$IFDEF USE_RGBGRAPHICS}
Buffer.Canvas.FillRect(X,Y,X+TILE_SIZE,Y+TILE_SIZE); Buffer.Canvas.FillRect(X, Y, X + TILE_SIZE, Y + TILE_SIZE);
{$ENDIF} {$ENDIF}
{$IFDEF USE_LAZINTFIMAGE} {$IFDEF USE_LAZINTFIMAGE}
begin begin
BufferCanvas.Brush.FPColor := ColWhite; BufferCanvas.Brush.FPColor := ColWhite;
BufferCanvas.FillRect(X, Y, X + TILE_SIZE, Y + TILE_SIZE); BufferCanvas.FillRect(X, Y, X + TILE_SIZE, Y + TILE_SIZE);
end; end;
{$ENDIF} {$ENDIF}
end; end;
DrawObjects(TileId,X,Y,X+TILE_SIZE,Y+TILE_SIZE); DrawObjects(TileId, X, Y, X + TILE_SIZE, Y + TILE_SIZE);
end; end;
function TMapView.IsActive: Boolean; function TMapView.IsActive: Boolean;
begin begin
if not(csDesigning in ComponentState) then if not(csDesigning in ComponentState) then
Result:=FActive Result := FActive
else else
Result:=false; Result := false;
end; end;
constructor TMapView.Create(AOwner: TComponent); constructor TMapView.Create(AOwner: TComponent);
@ -750,7 +755,7 @@ begin
FEngine := TMapViewerEngine.Create(self); FEngine := TMapViewerEngine.Create(self);
FBuiltinDownloadEngine := TMvDEFpc.Create(self); FBuiltinDownloadEngine := TMvDEFpc.Create(self);
{$IFDEF USE_RGBGRAPHICS} {$IFDEF USE_RGBGRAPHICS}
Buffer := TRGB32Bitmap.Create(Width,Height); Buffer := TRGB32Bitmap.Create(Width, Height);
{$ENDIF} {$ENDIF}
{$IFDEF USE_LAZINTFIMAGE} {$IFDEF USE_LAZINTFIMAGE}
CreateLazIntfImageAndCanvas(Buffer, BufferCanvas, Width, Height); CreateLazIntfImageAndCanvas(Buffer, BufferCanvas, Width, Height);
@ -812,17 +817,19 @@ begin
end; end;
procedure TMapView.CenterOnObj(obj: TGPSObj); procedure TMapView.CenterOnObj(obj: TGPSObj);
var Area : TRealArea; var
Pt : TRealPoint; Area: TRealArea;
Pt: TRealPoint;
begin begin
obj.GetArea(Area); obj.GetArea(Area);
Pt.Lon:=(Area.TopLeft.Lon+Area.BottomRight.Lon) /2; Pt.Lon := (Area.TopLeft.Lon + Area.BottomRight.Lon) /2;
Pt.Lat:=(Area.TopLeft.Lat+Area.BottomRight.Lat) /2; Pt.Lat := (Area.TopLeft.Lat + Area.BottomRight.Lat) /2;
Center:=Pt; Center := Pt;
end; end;
procedure TMapView.ZoomOnObj(obj: TGPSObj); procedure TMapView.ZoomOnObj(obj: TGPSObj);
var Area : TRealArea; var
Area: TRealArea;
begin begin
obj.GetArea(Area); obj.GetArea(Area);
Engine.ZoomOnArea(Area); Engine.ZoomOnArea(Area);
@ -834,14 +841,15 @@ begin
end; end;
function TMapView.GetVisibleArea: TRealArea; function TMapView.GetVisibleArea: TRealArea;
var aPt : TPoint; var
aPt: TPoint;
begin begin
aPt.X:=0; aPt.X := 0;
aPt.Y:=0; aPt.Y := 0;
Result.TopLeft:=Engine.ScreenToLonLat(aPt); Result.TopLeft := Engine.ScreenToLonLat(aPt);
aPt.X:=Width; aPt.X := Width;
aPt.Y:=Height; aPt.Y := Height;
Result.BottomRight:=Engine.ScreenToLonLat(aPt);; Result.BottomRight := Engine.ScreenToLonLat(aPt);;
end; end;
procedure TMapView.ClearBuffer; procedure TMapView.ClearBuffer;