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:
wp_xxyyzz 2021-08-20 10:23:04 +00:00
parent 6312921fac
commit b10c38f5d7
7 changed files with 54 additions and 21 deletions

View File

@ -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

View File

@ -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

View File

@ -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;

View File

@ -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;

View File

@ -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;

View File

@ -15,7 +15,7 @@ unit mvMapProvider;
interface
uses
Classes, SysUtils, laz2_xmlwrite, laz2_dom;
Classes, SysUtils, laz2_dom;
type

View File

@ -20,6 +20,7 @@ uses
const
TILE_SIZE = 256;
PALETTE_PAGE = 'Misc';
DEFAULT_POI_TEXT_WIDTH = 300;
Type
{ TArea }