MavViewer: Easier usage of GpsPoint and GpsTracks. Less hints and warnings. GpxReader LoadFromFile/Stream returns the ID of the items loaded.
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8078 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
parent
6312921fac
commit
b10c38f5d7
@ -66,7 +66,7 @@ uses
|
||||
|
||||
function IsValidPNG(AStream: TStream): Boolean;
|
||||
var
|
||||
s: string;
|
||||
s: string = '';
|
||||
y: Int64;
|
||||
begin
|
||||
if Assigned(AStream) then
|
||||
@ -84,7 +84,7 @@ end;
|
||||
|
||||
function IsValidJPEG(AStream: TStream): Boolean;
|
||||
var
|
||||
s: string;
|
||||
s: string = '';
|
||||
y: Int64;
|
||||
begin
|
||||
if Assigned(AStream) then
|
||||
|
@ -68,8 +68,9 @@ type
|
||||
implementation
|
||||
|
||||
uses
|
||||
LCLType,
|
||||
FPImgCanv, GraphType;
|
||||
LCLType, LCLIntf,
|
||||
FPImgCanv, GraphType,
|
||||
mvTypes;
|
||||
|
||||
function InRange(x, min, max: Integer): Boolean;
|
||||
begin
|
||||
@ -370,6 +371,7 @@ end;
|
||||
function TMvIntfGraphicsDrawingEngine.TextExtent(const AText: String): TSize;
|
||||
var
|
||||
bmp: TBitmap;
|
||||
R: TRect;
|
||||
begin
|
||||
bmp := TBitmap.Create;
|
||||
try
|
||||
@ -377,7 +379,9 @@ begin
|
||||
bmp.Canvas.Font.Name := FFontName;
|
||||
bmp.Canvas.Font.Size := FFontSize;
|
||||
bmp.Canvas.Font.Style := FFontStyle;
|
||||
Result := bmp.Canvas.TextExtent(AText);
|
||||
R := Rect(0, 0, DEFAULT_POI_TEXT_WIDTH, 0);
|
||||
DrawText(bmp.Canvas.Handle, PChar(AText), Length(AText), R, DT_WORDBREAK + DT_CALCRECT);
|
||||
Result := Size(R.Width, R.Height);
|
||||
finally
|
||||
bmp.Free;
|
||||
end;
|
||||
@ -394,6 +398,8 @@ var
|
||||
fc, tc: TFPColor;
|
||||
intens, intens0: Int64;
|
||||
alpha: Double;
|
||||
R: TRect;
|
||||
txtFlags: Integer = DT_CENTER + DT_WORDBREAK;
|
||||
begin
|
||||
if (FCanvas = nil) or (AText = '') then
|
||||
exit;
|
||||
@ -406,12 +412,13 @@ begin
|
||||
bmp.Canvas.Font.Size := FFontSize;
|
||||
bmp.Canvas.Font.Style := FFontStyle;
|
||||
bmp.Canvas.Font.Color := FFontColor;
|
||||
ex := bmp.Canvas.TextExtent(AText);
|
||||
ex := TextExtent(AText);
|
||||
R := Rect(0, 0, ex.CX, ex.CY);
|
||||
bmp.SetSize(ex.CX, ex.CY);
|
||||
if GetBrushStyle <> bsClear then begin
|
||||
bmp.Canvas.Brush.Color := GetBrushColor;
|
||||
bmp.Canvas.FillRect(0, 0, bmp.Width, bmp.Height);
|
||||
bmp.Canvas.TextOut(0, 0, AText);
|
||||
DrawText(bmp.Canvas.Handle, PChar(AText), Length(AText), R, txtFlags);
|
||||
DrawBitmap(X, Y, bmp, false);
|
||||
end else
|
||||
begin
|
||||
@ -419,8 +426,9 @@ begin
|
||||
bmp.Canvas.Brush.Color := clBlack
|
||||
else
|
||||
bmp.Canvas.Brush.Color := clWhite;
|
||||
bmp.Canvas.FillRect(0, 0, bmp.Width, bmp.Height);
|
||||
bmp.Canvas.TextOut(0, 0, AText);
|
||||
bmp.Canvas.FillRect(R); //0, 0, bmp.Width, bmp.Height);
|
||||
DrawText(bmp.Canvas.Handle, PChar(AText), Length(AText), R, txtFlags);
|
||||
// bmp.Canvas.TextOut(0, 0, AText);
|
||||
|
||||
img := bmp.CreateIntfImage;
|
||||
try
|
||||
|
@ -39,6 +39,7 @@ type
|
||||
procedure SetExtraData(AValue: TObject);
|
||||
public
|
||||
destructor Destroy; override;
|
||||
procedure Assign(AObj: TGPSObj); virtual;
|
||||
procedure GetArea(out Area: TRealArea); virtual; abstract;
|
||||
property Name: String read FName write FName;
|
||||
property ExtraData: TObject read FExtraData write SetExtraData;
|
||||
@ -63,6 +64,7 @@ type
|
||||
class function CreateFrom(aPt: TRealPoint; AElevation: Double = NO_ELE;
|
||||
ADateTime: TDateTime = NO_DATE): TGPSPoint;
|
||||
|
||||
procedure Assign(AObj: TGPSObj); override;
|
||||
procedure GetArea(out Area: TRealArea);override;
|
||||
function HasElevation: boolean;
|
||||
function HasDateTime: Boolean;
|
||||
@ -244,6 +246,11 @@ end;
|
||||
|
||||
{ TGPSObj }
|
||||
|
||||
procedure TGPSObj.Assign(AObj: TGPSObj);
|
||||
begin
|
||||
FName := AObj.Name;
|
||||
end;
|
||||
|
||||
procedure TGPSObj.SetExtraData(AValue: TObject);
|
||||
begin
|
||||
if FExtraData=AValue then Exit;
|
||||
@ -367,6 +374,7 @@ procedure TGPSObjectList.IdsToObj(const Ids: TIdArray; out objs: TGPSObjArray;
|
||||
var
|
||||
i,nb : integer;
|
||||
begin
|
||||
objs := nil;
|
||||
SetLength(objs, Length(Ids));
|
||||
nb := 0;
|
||||
Lock;
|
||||
@ -607,8 +615,7 @@ begin
|
||||
begin
|
||||
if Items[i].ExtraData.InheritsFrom(TDrawingExtraData) then
|
||||
begin
|
||||
Extr := TDrawingExtraData(Items[i]);
|
||||
// !!! wp: There is a warning that TGPSObj and TDrawingExtraData are not related !!!
|
||||
Extr := TDrawingExtraData(Items[i].ExtraData);
|
||||
if ToDelete(Extr.Id) then
|
||||
_Delete(i, DelLst);
|
||||
// !!! wp: DelLst is a local var and was created by _Delete but is
|
||||
@ -695,6 +702,17 @@ end;
|
||||
|
||||
{ TGPSPoint }
|
||||
|
||||
procedure TGPSPoint.Assign(AObj: TGpsObj);
|
||||
begin
|
||||
if (AObj is TGPSPoint) then
|
||||
begin
|
||||
inherited Assign(AObj);
|
||||
FRealPt := TGPSPoint(AObj).RealPoint;
|
||||
FElevation := TGPSPoint(AObj).Elevation;
|
||||
FDateTime := TGPSPoint(AObj).DateTime;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TGPSPoint.GetLat: Double;
|
||||
begin
|
||||
result := FRealPt.Lat;
|
||||
|
@ -33,8 +33,8 @@ type
|
||||
procedure ReadTrackSegment(ANode: TDOMNode; ATrack: TGpsTrack);
|
||||
procedure ReadWayPoints(ANode: TDOMNode; AList: TGpsObjectList);
|
||||
public
|
||||
procedure LoadFromFile(AFileName: String; AList: TGpsObjectList; out ABounds: TRealArea);
|
||||
procedure LoadFromStream(AStream: TStream; AList: TGpsObjectList; out ABounds: TRealArea);
|
||||
function LoadFromFile(AFileName: String; AList: TGpsObjectList; out ABounds: TRealArea): Integer;
|
||||
function LoadFromStream(AStream: TStream; AList: TGpsObjectList; out ABounds: TRealArea): Integer;
|
||||
end;
|
||||
|
||||
|
||||
@ -150,21 +150,25 @@ end;
|
||||
|
||||
{ TGpxReader }
|
||||
|
||||
procedure TGpxReader.LoadFromFile(AFileName: String; AList: TGpsObjectList;
|
||||
out ABounds: TRealArea);
|
||||
{ Loads the specified gpx file and stores the tracks, points etc. in the provided
|
||||
list. All items share the same mapviewer ID which is selected randomly and
|
||||
return as function result. ABounds is the geo rectangle enclosing the items. }
|
||||
function TGpxReader.LoadFromFile(AFileName: String; AList: TGpsObjectList;
|
||||
out ABounds: TRealArea): Integer;
|
||||
var
|
||||
stream: TStream;
|
||||
begin
|
||||
stream := TFileStream.Create(AFileName, fmOpenRead + fmShareDenyNone);
|
||||
try
|
||||
LoadFromStream(stream, AList, ABounds);
|
||||
Result := LoadFromStream(stream, AList, ABounds);
|
||||
finally
|
||||
stream.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TGpxReader.LoadFromStream(AStream: TStream; AList: TGpsObjectList;
|
||||
out ABounds: TRealArea);
|
||||
{ See LoadFromFile. }
|
||||
function TGpxReader.LoadFromStream(AStream: TStream; AList: TGpsObjectList;
|
||||
out ABounds: TRealArea): Integer;
|
||||
var
|
||||
doc: TXMLDocument = nil;
|
||||
begin
|
||||
@ -180,6 +184,7 @@ begin
|
||||
ABounds.TopLeft.Lat := FMaxLat;
|
||||
ABounds.BottomRight.Lon := FMaxLon;
|
||||
ABounds.BottomRight.Lat := FMinLat;
|
||||
Result := ID;
|
||||
finally
|
||||
doc.Free;
|
||||
end;
|
||||
|
@ -485,6 +485,7 @@ function TJobQueue.pFindJobByName(const aName: string;
|
||||
var
|
||||
iRes, i: integer;
|
||||
begin
|
||||
Result := nil;
|
||||
SetLength(Result, Jobs.Count);
|
||||
iRes := 0;
|
||||
for i := 0 to pred(Jobs.Count) do
|
||||
@ -621,7 +622,7 @@ function TJobQueue.CancelAllJob(ByLauncher: TObject): TJobArray;
|
||||
var
|
||||
i, iJob: integer;
|
||||
begin
|
||||
SetLength(Result, 0);
|
||||
Result := nil;
|
||||
if FUseThreads then
|
||||
begin
|
||||
EnterCriticalSection;
|
||||
@ -758,7 +759,7 @@ end;
|
||||
|
||||
procedure TJob.Cancel;
|
||||
var
|
||||
lst: Array of TRestartTask;
|
||||
lst: Array of TRestartTask = nil;
|
||||
i, idx: integer;
|
||||
begin
|
||||
Queue.EnterCriticalSection;
|
||||
|
@ -15,7 +15,7 @@ unit mvMapProvider;
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, laz2_xmlwrite, laz2_dom;
|
||||
Classes, SysUtils, laz2_dom;
|
||||
|
||||
type
|
||||
|
||||
|
@ -20,6 +20,7 @@ uses
|
||||
const
|
||||
TILE_SIZE = 256;
|
||||
PALETTE_PAGE = 'Misc';
|
||||
DEFAULT_POI_TEXT_WIDTH = 300;
|
||||
|
||||
Type
|
||||
{ TArea }
|
||||
|
Loading…
Reference in New Issue
Block a user