58f994c821
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9265 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2336 lines
60 KiB
ObjectPascal
2336 lines
60 KiB
ObjectPascal
{ Initial map viewer library:
|
|
Copyright (C) 2011 Maciej Kaczkowski / keit.co
|
|
|
|
Extensions:
|
|
(C) 2014 ti_dic@hotmail.com
|
|
(C) 2019 Werner Pamler (user wp at Lazarus forum https://forum.lazarus.freepascal.org
|
|
|
|
License: modified LGPL with linking exception (like RTL, FCL and LCL)
|
|
|
|
See the file COPYING.modifiedLGPL.txt, included in the Lazarus distribution,
|
|
for details about the license.
|
|
|
|
See also: https://wiki.lazarus.freepascal.org/FPC_modified_LGPL
|
|
}
|
|
|
|
// ToDo: Make Active work at designtime.
|
|
|
|
unit mvMapViewer;
|
|
|
|
{$MODE objfpc}{$H+}
|
|
{$WARN 6058 off : Call to subroutine "$1" marked as inline is not inlined}
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, Controls, GraphType, Graphics, FPImage, IntfGraphics,
|
|
Forms, ImgList, LCLVersion,
|
|
MvTypes, MvGPSObj, MvEngine, MvMapProvider, MvDownloadEngine, MvDrawingEngine,
|
|
mvCache;
|
|
|
|
Type
|
|
|
|
TDrawGpsPointEvent = procedure (Sender: TObject;
|
|
ADrawer: TMvCustomDrawingEngine; APoint: TGpsPoint) of object;
|
|
|
|
TMapViewOption =
|
|
(
|
|
mvoMouseDragging, // Allow dragging of the map with the mouse
|
|
mvoMouseZooming // Allow zooming into the map with the mouse
|
|
);
|
|
|
|
TMapViewOptions = set of TMapViewOption;
|
|
|
|
TCacheLocation = (clProfile, clTemp, clCustom);
|
|
|
|
const
|
|
DefaultMapViewOptions = [mvoMouseDragging, mvoMouseZooming];
|
|
|
|
type
|
|
TMapView = class;
|
|
TPointOfInterest = class;
|
|
TPointsOfInterest = class;
|
|
TGPSTileLayer = class;
|
|
TGPSComboLayer = class;
|
|
|
|
TPointOfInterestDrawEvent = procedure(Sender: TObject;
|
|
ADrawer: TMvCustomDrawingEngine; APoint: TPointOfInterest) of object;
|
|
|
|
{ TMapCollection }
|
|
|
|
generic TMapCollection<T, OT: class> = class(TOwnedCollection)
|
|
private
|
|
FMCOwner: OT;
|
|
function GetItems(Index: Integer): T;
|
|
procedure SetItems(Index: Integer; AValue: T);
|
|
public
|
|
constructor Create(AOwner: OT);
|
|
property MCOwner: OT read FMCOwner;
|
|
property Items[Index: Integer]: T read GetItems write SetItems; default;
|
|
end;
|
|
|
|
{ TMapItem }
|
|
|
|
TMapItem = class(TCollectionItem)
|
|
private
|
|
FCaption: TCaption;
|
|
FTag: PtrInt;
|
|
FVisible: Boolean;
|
|
procedure SetCaption(AValue: TCaption);
|
|
procedure SetVisible(AValue: Boolean);
|
|
protected
|
|
function GetDisplayName: string; override;
|
|
procedure ItemChanged; virtual; abstract;
|
|
published
|
|
property Caption: TCaption read FCaption write SetCaption;
|
|
property Visible: Boolean read FVisible write SetVisible default True;
|
|
property Tag: PtrInt read FTag write FTag default 0;
|
|
end;
|
|
|
|
{ TMapLayer }
|
|
|
|
TMapLayer = class(TMapItem)
|
|
private
|
|
FComboLayer: TGPSComboLayer;
|
|
FDrawMode: TItemDrawMode;
|
|
FUseThreads: Boolean;
|
|
FMapProvider: String;
|
|
FOpacity: Single;
|
|
FPointsOfInterest: TPointsOfInterest;
|
|
function GetMapProvider: String;
|
|
function GetMapView: TMapView;
|
|
function GetPointsOfInterest: TPointsOfInterest;
|
|
function GetUseThreads: Boolean;
|
|
procedure SetDrawMode(AValue: TItemDrawMode);
|
|
procedure SetMapProvider(AValue: String);
|
|
procedure SetOpacity(AValue: Single);
|
|
procedure SetPointsOfInterest(AValue: TPointsOfInterest);
|
|
procedure SetUseThreads(AValue: Boolean);
|
|
protected
|
|
procedure SetIndex(Value: Integer); override;
|
|
procedure ItemChanged; override;
|
|
public
|
|
constructor Create(ACollection: TCollection); override;
|
|
destructor Destroy; override;
|
|
property MapView: TMapView read GetMapView;
|
|
published
|
|
property MapProvider: String read GetMapProvider write SetMapProvider;
|
|
property UseThreads: Boolean read GetUseThreads write SetUseThreads default True;
|
|
property DrawMode: TItemDrawMode read FDrawMode write SetDrawMode default idmUseOpacity;
|
|
property Opacity: Single read FOpacity write SetOpacity default 0.25;
|
|
property PointsOfInterest: TPointsOfInterest read GetPointsOfInterest write SetPointsOfInterest;
|
|
end;
|
|
|
|
{ TMapLayers }
|
|
|
|
TMapLayers = class(specialize TMapCollection<TMapLayer, TMapView>)
|
|
protected
|
|
procedure Update(Item: TCollectionItem); override;
|
|
procedure FixOrder(APrevIndex, AIndex: Integer);
|
|
end;
|
|
|
|
{ TMapCenter }
|
|
|
|
TMapCenter = class(TPersistent)
|
|
private
|
|
FLatitude: Double;
|
|
FLongitude: Double;
|
|
FView: TMapView;
|
|
procedure SetLatitude(AValue: Double);
|
|
procedure SetLongitude(AValue: Double);
|
|
procedure SetViewCenter;
|
|
protected
|
|
function GetOwner: TPersistent; override;
|
|
public
|
|
constructor Create(AView: TMapView);
|
|
published
|
|
property Longitude: Double read FLongitude write SetLongitude;
|
|
property Latitude: Double read FLatitude write SetLatitude;
|
|
end;
|
|
|
|
{ TPointOfInterest }
|
|
|
|
TPointOfInterest = class(TMapItem)
|
|
private
|
|
FDateTime: TDateTime;
|
|
FElevation: Double;
|
|
FImageIndex: TImageIndex;
|
|
FLatitude: Double;
|
|
FLongitude: Double;
|
|
FOnDrawPoint: TPointOfInterestDrawEvent;
|
|
FPoint: TGPSPointOfInterest;
|
|
function GetLayer: TMapLayer;
|
|
function GetMapView: TMapView;
|
|
function IsDateTimeStored: Boolean;
|
|
function IsElevationStored: Boolean;
|
|
procedure SetDateTime(AValue: TDateTime);
|
|
procedure SetElevation(AValue: Double);
|
|
procedure SetImageIndex(AValue: TImageIndex);
|
|
procedure SetLatitude(AValue: Double);
|
|
procedure SetLongitude(AValue: Double);
|
|
procedure SetOnDrawPoint(AValue: TPointOfInterestDrawEvent);
|
|
protected
|
|
procedure SetIndex(Value: Integer); override;
|
|
procedure ItemChanged; override;
|
|
procedure DrawPoint(Sender: TObject; AGPSObj: TGPSObj; AArea: TRealArea);
|
|
public
|
|
constructor Create(ACollection: TCollection); override;
|
|
destructor Destroy; override;
|
|
property MapView: TMapView read GetMapView;
|
|
property Layer: TMapLayer read GetLayer;
|
|
published
|
|
property Longitude: Double read FLongitude write SetLongitude;
|
|
property Latitude: Double read FLatitude write SetLatitude;
|
|
property Elevation: Double read FElevation write SetElevation stored IsElevationStored;
|
|
property DateTime: TDateTime read FDateTime write SetDateTime stored IsDateTimeStored;
|
|
property ImageIndex: TImageIndex read FImageIndex write SetImageIndex default -1;
|
|
property OnDrawPoint: TPointOfInterestDrawEvent read FOnDrawPoint write SetOnDrawPoint;
|
|
end;
|
|
|
|
{ TPointsOfInterest }
|
|
|
|
TPointsOfInterest = class(specialize TMapCollection<TPointOfInterest, TMapLayer>)
|
|
protected
|
|
procedure Update(Item: TCollectionItem); override;
|
|
procedure FixOrder(APrevIndex, AIndex: Integer);
|
|
end;
|
|
|
|
{ TMapView }
|
|
|
|
TMapView = class(TCustomControl)
|
|
private
|
|
FCacheLocation: TCacheLocation;
|
|
FCachePath, FCacheFullPath: String;
|
|
FCenter: TMapCenter;
|
|
FDownloadEngine: TMvCustomDownloadEngine;
|
|
FBuiltinDownloadEngine: TMvCustomDownloadEngine;
|
|
FEngine: TMapViewerEngine;
|
|
FBuiltinDrawingEngine: TMvCustomDrawingEngine;
|
|
FDrawingEngine: TMvCustomDrawingEngine;
|
|
FDrawPreviewTiles: boolean;
|
|
FActive: boolean;
|
|
FLayers: TMapLayers;
|
|
FGPSItems: array [0..9] of TGPSObjectList;
|
|
FOptions: TMapViewOptions;
|
|
FPOIImage: TBitmap;
|
|
FPOITextBgColor: TColor;
|
|
FOnDrawGpsPoint: TDrawGpsPointEvent;
|
|
FDebugTiles: Boolean;
|
|
FDefaultTrackColor: TColor;
|
|
FDefaultTrackWidth: Integer;
|
|
FFont: TFont;
|
|
FPOIImages: TCustomImageList;
|
|
FPOIImagesWidth: Integer;
|
|
FCacheOnDisk: Boolean;
|
|
FZoomMax: Integer;
|
|
FZoomMin: Integer;
|
|
procedure CallAsyncInvalidate;
|
|
procedure DoAsyncInvalidate({%H-}Data: PtrInt);
|
|
procedure DrawObjects(const {%H-}TileId: TTileId; aLeft, aTop, aRight,aBottom: integer);
|
|
procedure DrawGpsObj(const {%H-}Area: TRealArea; AObj: TGPSObj);
|
|
function GetCacheMaxAge: Integer;
|
|
function GetCacheOnDisk: boolean;
|
|
function GetCenter: TRealPoint;
|
|
function GetCyclic: Boolean;
|
|
function GetDownloadEngine: TMvCustomDownloadEngine;
|
|
function GetDrawingEngine: TMvCustomDrawingEngine;
|
|
function GetDrawPreviewTiles: Boolean;
|
|
function GetGPSItems: TGPSObjectList;
|
|
function GetGPSLayer(Layer: Integer): TGPSObjectList;
|
|
function GetInactiveColor: TColor;
|
|
function GetLayers: TMapLayers;
|
|
function GetMapProvider: String;
|
|
function GetOnCenterMove: TNotifyEvent;
|
|
function GetOnChange: TNotifyEvent;
|
|
function GetOnZoomChange: TNotifyEvent;
|
|
function GetUseThreads: boolean;
|
|
function GetZoom: integer;
|
|
function GetZoomToCursor: Boolean;
|
|
function IsCacheMaxAgeStored: Boolean;
|
|
function IsCachePathStored: Boolean;
|
|
function IsFontStored: Boolean;
|
|
function IsLayersStored: Boolean;
|
|
procedure SetActive(AValue: boolean);
|
|
procedure SetCacheLocation(AValue: TCacheLocation);
|
|
procedure SetCacheMaxAge(AValue: Integer);
|
|
procedure SetCacheOnDisk(AValue: boolean);
|
|
procedure SetCachePath(AValue: String);
|
|
procedure SetCenter(AValue: TRealPoint);
|
|
procedure SetCyclic(AValue: Boolean);
|
|
procedure SetDebugTiles(AValue: Boolean);
|
|
procedure SetDefaultTrackColor(AValue: TColor);
|
|
procedure SetDefaultTrackWidth(AValue: Integer);
|
|
procedure SetDownloadEngine(AValue: TMvCustomDownloadEngine);
|
|
procedure SetDrawingEngine(AValue: TMvCustomDrawingEngine);
|
|
procedure SetDrawPreviewTiles(AValue: Boolean);
|
|
procedure SetFont(AValue: TFont);
|
|
procedure SetInactiveColor(AValue: TColor);
|
|
procedure SetLayers(const ALayers: TMapLayers);
|
|
procedure SetMapProvider(AValue: String);
|
|
procedure SetOnCenterMove(AValue: TNotifyEvent);
|
|
procedure SetOnChange(AValue: TNotifyEvent);
|
|
procedure SetOnZoomChange(AValue: TNotifyEvent);
|
|
procedure SetOptions(AValue: TMapViewOptions);
|
|
procedure SetPOIImage(const AValue: TBitmap);
|
|
procedure SetPOIImages(const AValue: TCustomImageList);
|
|
procedure SetPOIImagesWidth(AValue: Integer);
|
|
procedure SetPOITextBgColor(AValue: TColor);
|
|
procedure SetUseThreads(AValue: boolean);
|
|
procedure SetZoom(AValue: integer);
|
|
procedure SetZoomMax(AValue: Integer);
|
|
procedure SetZoomMin(AValue: Integer);
|
|
procedure SetZoomToCursor(AValue: Boolean);
|
|
procedure UpdateFont(Sender: TObject);
|
|
procedure UpdateImage(Sender: TObject);
|
|
|
|
protected
|
|
AsyncInvalidate : boolean;
|
|
procedure ActivateEngine;
|
|
procedure DblClick; override;
|
|
procedure DoDrawStretchedTile(const TileId: TTileID; X, Y: Integer; TileImg: TPictureCacheItem; const R: TRect);
|
|
procedure DoDrawTile(const TileId: TTileId; X,Y: integer; TileImg: TPictureCacheItem);
|
|
procedure DoDrawTileInfo(const {%H-}TileID: TTileID; X,Y: Integer);
|
|
procedure DoEraseBackground(const R: TRect);
|
|
procedure DoTileDownloaded(const TileId: TTileId);
|
|
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;
|
|
procedure MouseMove(Shift: TShiftState; X,Y: Integer); override;
|
|
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
|
procedure Paint; override;
|
|
procedure OnGPSItemsModified(Sender: TObject; objs: TGPSObjList;
|
|
Adding: boolean);
|
|
|
|
function CreateLayers: TMapLayers; virtual;
|
|
procedure UpdateLayers;
|
|
|
|
procedure ChangeCachePath(AOldLoc: TCacheLocation; ANewPath: String);
|
|
class function CacheDirectory(ALoc: TCacheLocation; ACustomPath: String): String;
|
|
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
function CyclicPointOf(APoint: TPoint; ARefX: LongInt; Eastwards: Boolean = True): TPoint;
|
|
function CyclicPointsOf(APoint: TPoint): TPointArray;
|
|
procedure DrawPointOfInterest(const {%H-}Area: TRealArea; APt: TGPSPointOfInterest);
|
|
procedure DrawPt(const {%H-}Area: TRealArea; APt: TGPSPoint);
|
|
procedure DrawTrack(const Area: TRealArea; trk: TGPSTrack);
|
|
procedure ClearBuffer;
|
|
procedure GetMapProviders(lstProviders: TStrings);
|
|
function GetVisibleArea: TRealArea;
|
|
function LonLatToScreen(aPt: TRealPoint): TPoint;
|
|
function ObjsAtScreenPt(X, Y: Integer; ATolerance: Integer = -1): TGPSObjarray;
|
|
procedure SaveToFile(AClass: TRasterImageClass; const AFileName: String);
|
|
function SaveToImage(AClass: TRasterImageClass): TRasterImage;
|
|
procedure SaveToStream(AClass: TRasterImageClass; AStream: TStream);
|
|
function ScreenToLonLat(aPt: TPoint): TRealPoint;
|
|
procedure CenterOnObj(obj: TGPSObj);
|
|
procedure Redraw; inline;
|
|
procedure ZoomOnArea(const aArea: TRealArea);
|
|
procedure ZoomOnObj(obj: TGPSObj);
|
|
procedure WaitEndOfRendering;
|
|
property Center: TRealPoint read GetCenter write SetCenter;
|
|
property Engine: TMapViewerEngine read FEngine;
|
|
property GPSItems: TGPSObjectList read GetGPSItems;
|
|
property GPSLayer[L: Integer]: TGPSObjectList read GetGPSLayer;
|
|
published
|
|
property Active: boolean read FActive write SetActive default false;
|
|
property Align;
|
|
property CacheOnDisk: boolean read GetCacheOnDisk write SetCacheOnDisk default true;
|
|
property CacheLocation: TCacheLocation read FCacheLocation write SetCacheLocation default clProfile;
|
|
property CachePath: String read FCachePath write SetCachePath stored IsCachePathStored;
|
|
property CacheFullPath: String read FCacheFullPath stored False;
|
|
property CacheMaxAge: Integer read GetCacheMaxAge write SetCacheMaxAge stored IsCacheMaxAgeStored;
|
|
property Cyclic: Boolean read GetCyclic write SetCyclic default false;
|
|
property DebugTiles: Boolean read FDebugTiles write SetDebugTiles default false;
|
|
property DefaultTrackColor: TColor read FDefaultTrackColor write SetDefaultTrackColor default clRed;
|
|
property DefaultTrackWidth: Integer read FDefaultTrackWidth write SetDefaultTrackWidth default 1;
|
|
property DownloadEngine: TMvCustomDownloadEngine read GetDownloadEngine write SetDownloadEngine;
|
|
property DrawingEngine: TMvCustomDrawingEngine read GetDrawingEngine write SetDrawingEngine;
|
|
property DrawPreviewTiles: Boolean read GetDrawPreviewTiles write SetDrawPreviewTiles default true;
|
|
property Options: TMapViewOptions read FOptions write SetOptions default DefaultMapViewOptions;
|
|
property Layers: TMapLayers read GetLayers write SetLayers stored IsLayersStored;
|
|
property Font: TFont read FFont write SetFont stored IsFontStored;
|
|
property Height default 150;
|
|
property InactiveColor: TColor read GetInactiveColor write SetInactiveColor default clWhite;
|
|
property MapProvider: String read GetMapProvider write SetMapProvider;
|
|
property MapCenter: TMapCenter read FCenter write FCenter;
|
|
property POIImage: TBitmap read FPOIImage write SetPOIImage;
|
|
property POIImages: TCustomImageList read FPOIImages write SetPOIImages;
|
|
property POIImagesWidth: Integer read FPOIImagesWidth write SetPOIImagesWidth default 0;
|
|
property POITextBgColor: TColor read FPOITextBgColor write SetPOITextBgColor default clNone;
|
|
property PopupMenu;
|
|
property UseThreads: boolean read GetUseThreads write SetUseThreads default false;
|
|
property Width default 150;
|
|
property Zoom: integer read GetZoom write SetZoom default 0;
|
|
property ZoomMax: Integer read FZoomMax write SetZoomMax default 19;
|
|
property ZoomMin: Integer read FZoomMin write SetZoomMin default 0;
|
|
property ZoomToCursor: Boolean read GetZoomToCursor write SetZoomToCursor default True;
|
|
property OnCenterMove: TNotifyEvent read GetOnCenterMove write SetOnCenterMove;
|
|
property OnZoomChange: TNotifyEvent read GetOnZoomChange write SetOnZoomChange;
|
|
property OnChange: TNotifyEvent read GetOnChange write SetOnChange;
|
|
property OnDrawGpsPoint: TDrawGpsPointEvent read FOnDrawGpsPoint write FOnDrawGpsPoint;
|
|
property OnMouseDown;
|
|
property OnMouseEnter;
|
|
property OnMouseLeave;
|
|
property OnMouseMove;
|
|
property OnMouseUp;
|
|
end;
|
|
|
|
{ TGPSTileLayerBase }
|
|
|
|
TGPSTileLayerBase = class(TGPSObj)
|
|
private
|
|
FDrawMode: TItemDrawMode;
|
|
FMapProvider: String;
|
|
FOpacity: Single;
|
|
FParentView: TMapView;
|
|
FEngine: TMapViewerEngine;
|
|
FParentViewChanged: Boolean;
|
|
function GetMapProvider: String;
|
|
function GetUseThreads: Boolean;
|
|
procedure DoTileDownloaded(const TileId: TTileId);
|
|
procedure DoDrawTile(const TileId: TTileId; X, Y: Integer; TileImg: TPictureCacheItem);
|
|
procedure SetDrawMode(AValue: TItemDrawMode);
|
|
procedure SetMapProvider(AValue: String);
|
|
procedure SetOpacity(AValue: Single);
|
|
procedure SetUseThreads(AValue: Boolean);
|
|
procedure SetParentView(AValue: TMapView);
|
|
protected
|
|
procedure TileDownloaded(const TileId: TTileId); virtual;
|
|
procedure DrawTile(const TileId: TTileId; X, Y: Integer; TileImg: TPictureCacheItem); virtual; abstract;
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
procedure GetArea(out Area: TRealArea); override;
|
|
procedure Draw(AView: TObject; Area: TRealArea); override;
|
|
procedure ParentViewChanged; virtual;
|
|
|
|
property MapProvider: String read GetMapProvider write SetMapProvider;
|
|
property UseThreads: Boolean read GetUseThreads write SetUseThreads;
|
|
property DrawMode: TItemDrawMode read FDrawMode write SetDrawMode;
|
|
property Opacity: Single read FOpacity write SetOpacity;
|
|
end;
|
|
|
|
{ TGPSTileLayer }
|
|
|
|
TGPSTileLayer = class(TGPSTileLayerBase)
|
|
protected
|
|
procedure DrawTile(const TileId: TTileId; X, Y: Integer;
|
|
TileImg: TPictureCacheItem); override;
|
|
public
|
|
procedure Draw(AView: TObject; Area: TRealArea); override;
|
|
procedure TileDownloaded(const TileId: TTileId); override;
|
|
end;
|
|
|
|
{ TGPSTileLayerLabels }
|
|
|
|
TGPSTileLayerLabels = class(TGPSTileLayerBase)
|
|
protected
|
|
procedure DrawTile(const TileId: TTileId; X, Y: Integer;
|
|
TileImg: TPictureCacheItem); override;
|
|
public
|
|
procedure Draw(AView: TObject; Area: TRealArea); override;
|
|
end;
|
|
|
|
{ TGPSComboLayer }
|
|
|
|
TGPSComboLayer = class(TGPSObjectList)
|
|
FTileLayer: TGPSTileLayer;
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
procedure GetArea(out Area: TRealArea); override;
|
|
procedure Draw(AView: TObject; Area: TRealArea); override;
|
|
property TileLayer: TGPSTileLayer read FTileLayer;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses
|
|
GraphMath, FileUtil, Types, Math,
|
|
mvJobQueue, mvExtraData, mvDLEFpc,
|
|
{$IFDEF MSWINDOWS}
|
|
mvDLEWin,
|
|
{$ENDIF}
|
|
mvDE_IntfGraphics;
|
|
|
|
const
|
|
LAYERS_ZOFFS = -9999;
|
|
_TILELAYERS_ID_ = -42; // OwnerIDs of the tile layers
|
|
|
|
{ Converts a length given in millimeters to screen pixels }
|
|
function mmToPx(AValue: Double): Integer;
|
|
begin
|
|
Result := round(AValue / 25.4 * ScreenInfo.PixelsPerInchX);
|
|
end;
|
|
|
|
type
|
|
|
|
{ TDrawObjJob }
|
|
|
|
TDrawObjJob = class(TJob)
|
|
private
|
|
AllRun: boolean;
|
|
Viewer: TMapView;
|
|
FRunning: boolean;
|
|
FLst: TGPSObjList;
|
|
FStates: Array of integer;
|
|
FArea: TRealArea;
|
|
protected
|
|
function pGetTask: integer; override;
|
|
procedure pTaskStarted(aTask: integer); override;
|
|
procedure pTaskEnded(aTask: integer; aExcept: Exception); override;
|
|
public
|
|
procedure ExecuteTask(aTask: integer; FromWaiting: boolean); override;
|
|
function Running: boolean;override;
|
|
public
|
|
constructor Create(aViewer: TMapView; aLst: TGPSObjList; const aArea: TRealArea);
|
|
destructor Destroy; override;
|
|
end;
|
|
|
|
{ TMapItem }
|
|
|
|
procedure TMapItem.SetCaption(AValue: TCaption);
|
|
begin
|
|
if FCaption=AValue then Exit;
|
|
FCaption:=AValue;
|
|
ItemChanged;
|
|
end;
|
|
|
|
procedure TMapItem.SetVisible(AValue: Boolean);
|
|
begin
|
|
if FVisible=AValue then Exit;
|
|
FVisible:=AValue;
|
|
ItemChanged;
|
|
end;
|
|
|
|
function TMapItem.GetDisplayName: string;
|
|
begin
|
|
if FCaption <> ''
|
|
then Result := FCaption
|
|
else Result := ClassName;
|
|
if not FVisible
|
|
then Result := Result + ' (Invisible)';
|
|
end;
|
|
|
|
{ TMapCollection }
|
|
|
|
function TMapCollection.GetItems(Index: Integer): T;
|
|
begin
|
|
Result := T(inherited GetItem(Index));
|
|
end;
|
|
|
|
procedure TMapCollection.SetItems(Index: Integer; AValue: T);
|
|
begin
|
|
(GetItems(Index) as TPersistent).Assign(AValue);
|
|
end;
|
|
|
|
constructor TMapCollection.Create(AOwner: OT);
|
|
begin
|
|
inherited Create(AOwner, T);
|
|
FMCOwner := AOwner;
|
|
end;
|
|
|
|
{ TGPSComboLayer }
|
|
|
|
procedure TGPSComboLayer.GetArea(out Area: TRealArea);
|
|
begin
|
|
FTileLayer.GetArea(Area);
|
|
end;
|
|
|
|
constructor TGPSComboLayer.Create;
|
|
begin
|
|
inherited Create;
|
|
FTileLayer := TGPSTileLayer.Create;
|
|
end;
|
|
|
|
destructor TGPSComboLayer.Destroy;
|
|
begin
|
|
FTileLayer.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TGPSComboLayer.Draw(AView: TObject; Area: TRealArea);
|
|
var
|
|
I: Integer;
|
|
Objs: TGPSObjList;
|
|
begin
|
|
inherited Draw(AView, Area);
|
|
FTileLayer.Draw(AView, Area);
|
|
Objs := GetObjectsInArea(Area);
|
|
try
|
|
if Objs.Count > 0 then
|
|
begin
|
|
for I := 0 to Pred(Objs.Count) do
|
|
if Objs[I].Visible then
|
|
Items[I].Draw(AView, Area)
|
|
end;
|
|
finally
|
|
FreeAndNil(Objs);
|
|
end;
|
|
end;
|
|
|
|
{ TPointsOfInterest }
|
|
|
|
procedure TPointsOfInterest.Update(Item: TCollectionItem);
|
|
begin
|
|
inherited Update(Item);
|
|
if Assigned(MCOwner.MapView) then
|
|
MCOwner.MapView.Invalidate;
|
|
end;
|
|
|
|
procedure TPointsOfInterest.FixOrder(APrevIndex, AIndex: Integer);
|
|
var
|
|
I, T, B: Integer;
|
|
begin
|
|
T := Min(APrevIndex, AIndex);
|
|
B := Max(APrevIndex, AIndex);
|
|
if APrevIndex < 0 then
|
|
begin
|
|
T := AIndex;
|
|
B := Pred(Count);
|
|
end;
|
|
for I := T to B do
|
|
MCOwner.FComboLayer.ChangeZOrder(Items[I].FPoint, I);
|
|
end;
|
|
|
|
{ TPointOfInterest }
|
|
|
|
function TPointOfInterest.GetMapView: TMapView;
|
|
begin
|
|
if Collection is TPointsOfInterest
|
|
then Result := (Collection as TPointsOfInterest).MCOwner.MapView
|
|
else Result := Nil;
|
|
end;
|
|
|
|
function TPointOfInterest.IsDateTimeStored: Boolean;
|
|
begin
|
|
Result := not (FDateTime = NO_DATE);
|
|
end;
|
|
|
|
function TPointOfInterest.IsElevationStored: Boolean;
|
|
begin
|
|
Result := not (FElevation = NO_ELE);
|
|
end;
|
|
|
|
procedure TPointOfInterest.SetDateTime(AValue: TDateTime);
|
|
begin
|
|
if FDateTime=AValue then Exit;
|
|
FDateTime:=AValue;
|
|
ItemChanged;
|
|
end;
|
|
|
|
procedure TPointOfInterest.SetElevation(AValue: Double);
|
|
begin
|
|
if FElevation=AValue then Exit;
|
|
FElevation:=AValue;
|
|
ItemChanged;
|
|
end;
|
|
|
|
function TPointOfInterest.GetLayer: TMapLayer;
|
|
begin
|
|
if Collection is TPointsOfInterest
|
|
then Result := (Collection as TPointsOfInterest).MCOwner
|
|
else Result := Nil;
|
|
end;
|
|
|
|
procedure TPointOfInterest.SetImageIndex(AValue: TImageIndex);
|
|
begin
|
|
if FImageIndex = AValue then Exit;
|
|
FImageIndex := AValue;
|
|
ItemChanged;
|
|
end;
|
|
|
|
procedure TPointOfInterest.SetLatitude(AValue: Double);
|
|
begin
|
|
if FLatitude = AValue then Exit;
|
|
FLatitude := AValue;
|
|
ItemChanged;
|
|
end;
|
|
|
|
procedure TPointOfInterest.SetLongitude(AValue: Double);
|
|
begin
|
|
if FLongitude = AValue then Exit;
|
|
FLongitude := AValue;
|
|
ItemChanged;
|
|
end;
|
|
|
|
procedure TPointOfInterest.SetOnDrawPoint(AValue: TPointOfInterestDrawEvent);
|
|
begin
|
|
if CompareMem(@FOnDrawPoint, @AValue, SizeOf(TMethod)) then
|
|
Exit;
|
|
FOnDrawPoint := AValue;
|
|
if Assigned(FOnDrawPoint)
|
|
then FPoint.OnDrawObj := @DrawPoint
|
|
else FPoint.OnDrawObj := Nil;
|
|
ItemChanged;
|
|
end;
|
|
|
|
procedure TPointOfInterest.SetIndex(Value: Integer);
|
|
var
|
|
PrevIndex: Integer;
|
|
begin
|
|
PrevIndex := Index;
|
|
inherited SetIndex(Value);
|
|
if (PrevIndex <> Index) and Assigned(Collection) then
|
|
TPointsOfInterest(Collection).FixOrder(PrevIndex, Self.Index);
|
|
end;
|
|
|
|
procedure TPointOfInterest.ItemChanged;
|
|
begin
|
|
FPoint.Lon := Longitude;
|
|
FPoint.Lat := Latitude;
|
|
FPoint.Name := Caption;
|
|
FPoint.ImageIndex := ImageIndex;
|
|
FPoint.Visible := Visible;
|
|
FPoint.Elevation := Elevation;
|
|
FPoint.DateTime := DateTime;
|
|
Changed(False);
|
|
end;
|
|
|
|
procedure TPointOfInterest.DrawPoint(Sender: TObject; AGPSObj: TGPSObj;
|
|
AArea: TRealArea);
|
|
begin
|
|
if Assigned(FOnDrawPoint) then
|
|
FOnDrawPoint(Sender, MapView.DrawingEngine, Self);
|
|
end;
|
|
|
|
constructor TPointOfInterest.Create(ACollection: TCollection);
|
|
begin
|
|
inherited Create(ACollection);
|
|
FImageIndex := -1;
|
|
FLongitude := MapView.Center.Lon;
|
|
FLatitude := MapView.Center.Lat;
|
|
FVisible := True;
|
|
FElevation := NO_ELE;
|
|
FDateTime := NO_DATE;
|
|
FPoint := TGPSPointOfInterest.Create(FLongitude, FLatitude);
|
|
Layer.FComboLayer.Add(FPoint, Pred(_TILELAYERS_ID_), Self.Index + 1);
|
|
end;
|
|
|
|
destructor TPointOfInterest.Destroy;
|
|
begin
|
|
if Assigned(FPoint) then
|
|
Layer.FComboLayer.Delete(FPoint);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
{ TMapCenter }
|
|
|
|
procedure TMapCenter.SetLongitude(AValue: Double);
|
|
begin
|
|
if FLongitude = AValue then Exit;
|
|
FLongitude := AValue;
|
|
SetViewCenter;
|
|
end;
|
|
|
|
procedure TMapCenter.SetLatitude(AValue: Double);
|
|
begin
|
|
if FLatitude = AValue then Exit;
|
|
FLatitude := AValue;
|
|
SetViewCenter;
|
|
end;
|
|
|
|
procedure TMapCenter.SetViewCenter;
|
|
var
|
|
R: TRealPoint;
|
|
begin
|
|
R.Init(FLongitude, FLatitude);
|
|
FView.SetCenter(R);
|
|
end;
|
|
|
|
function TMapCenter.GetOwner: TPersistent;
|
|
begin
|
|
Result := FView;
|
|
end;
|
|
|
|
constructor TMapCenter.Create(AView: TMapView);
|
|
begin
|
|
FView := AView;
|
|
end;
|
|
|
|
{ TMapLayer }
|
|
|
|
function TMapLayer.GetMapView: TMapView;
|
|
begin
|
|
if Collection is TMapLayers
|
|
then Result := (Collection as TMapLayers).MCOwner //MapView
|
|
else Result := Nil;
|
|
end;
|
|
|
|
function TMapLayer.GetPointsOfInterest: TPointsOfInterest;
|
|
begin
|
|
Result := FPointsOfInterest;
|
|
end;
|
|
|
|
function TMapLayer.GetMapProvider: String;
|
|
begin
|
|
Result := FComboLayer.TileLayer.MapProvider
|
|
end;
|
|
|
|
function TMapLayer.GetUseThreads: Boolean;
|
|
begin
|
|
Result := FUseThreads;
|
|
end;
|
|
|
|
procedure TMapLayer.SetDrawMode(AValue: TItemDrawMode);
|
|
begin
|
|
if FDrawMode=AValue then Exit;
|
|
FDrawMode:=AValue;
|
|
ItemChanged;
|
|
end;
|
|
|
|
procedure TMapLayer.SetMapProvider(AValue: String);
|
|
var
|
|
P: TMapProvider;
|
|
LPS, MPS: String;
|
|
begin
|
|
if FMapProvider = AValue then
|
|
Exit;
|
|
// Check compat. of provider projection type against the base provider.
|
|
if Assigned(MapView) then
|
|
begin
|
|
P := MapView.Engine.MapProviderByName(AValue);
|
|
if Assigned(P) and (MapView.Engine.MapProjectionType <> P.ProjectionType) then
|
|
begin
|
|
WriteStr(LPS, MapView.Engine.MapProjectionType);
|
|
WriteStr(MPS, P.ProjectionType);
|
|
raise EArgumentException.CreateFmt(
|
|
'%s has different projection type (%s) from the base map (%s).',
|
|
[AValue, LPS, MPS]);
|
|
end;
|
|
end;
|
|
FMapProvider := AValue;
|
|
ItemChanged;
|
|
end;
|
|
|
|
procedure TMapLayer.SetOpacity(AValue: Single);
|
|
begin
|
|
AValue := EnsureRange(AValue, 0.0, 1.0);
|
|
if FOpacity = AValue then
|
|
Exit;
|
|
FOpacity:=AValue;
|
|
ItemChanged;
|
|
end;
|
|
|
|
procedure TMapLayer.SetPointsOfInterest(AValue: TPointsOfInterest);
|
|
begin
|
|
FPointsOfInterest.Assign(AValue);
|
|
end;
|
|
|
|
procedure TMapLayer.SetUseThreads(AValue: Boolean);
|
|
begin
|
|
if FUseThreads = AValue then
|
|
Exit;
|
|
FUseThreads := AValue;
|
|
ItemChanged;
|
|
end;
|
|
|
|
procedure TMapLayer.SetIndex(Value: Integer);
|
|
var
|
|
PrevIndex: Integer;
|
|
begin
|
|
PrevIndex := Index;
|
|
inherited SetIndex(Value);
|
|
if (PrevIndex <> Index) and Assigned(Collection) then
|
|
TMapLayers(Collection).FixOrder(PrevIndex, Index);
|
|
end;
|
|
|
|
procedure TMapLayer.ItemChanged;
|
|
begin
|
|
if Assigned(FComboLayer) then
|
|
begin
|
|
FComboLayer.TileLayer.MapProvider := FMapProvider;
|
|
FComboLayer.TileLayer.UseThreads := FUseThreads;
|
|
FComboLayer.TileLayer.DrawMode := FDrawMode;
|
|
FComboLayer.TileLayer.Opacity := FOpacity;
|
|
FComboLayer.Visible := FVisible;
|
|
end;
|
|
Changed(False);
|
|
end;
|
|
|
|
constructor TMapLayer.Create(ACollection: TCollection);
|
|
begin
|
|
inherited Create(ACollection);
|
|
FUseThreads := True;
|
|
FDrawMode := idmUseOpacity;
|
|
FOpacity := 0.25;
|
|
FVisible := True;
|
|
FTag := 0;
|
|
|
|
FPointsOfInterest := TPointsOfInterest.Create(Self);
|
|
FComboLayer := TGPSComboLayer.Create;
|
|
MapView.GPSItems.Add(FComboLayer, _TILELAYERS_ID_, Self.Index - LAYERS_ZOFFS);
|
|
end;
|
|
|
|
destructor TMapLayer.Destroy;
|
|
begin
|
|
FPointsOfInterest.Free;
|
|
if Assigned(FComboLayer) then
|
|
MapView.GPSItems.Delete(FComboLayer);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
{ TMapLayers }
|
|
|
|
procedure TMapLayers.Update(Item: TCollectionItem);
|
|
begin
|
|
inherited Update(Item);
|
|
if Assigned(MCOwner) then
|
|
MCOwner.Invalidate;
|
|
end;
|
|
|
|
procedure TMapLayers.FixOrder(APrevIndex, AIndex: Integer);
|
|
var
|
|
I, T, B: Integer;
|
|
begin
|
|
T := Min(APrevIndex, AIndex);
|
|
B := Max(APrevIndex, AIndex);
|
|
if APrevIndex < 0 then
|
|
begin
|
|
T := AIndex;
|
|
B := Pred(Count);
|
|
end;
|
|
for I := T to B do
|
|
MCOwner.GPSItems.ChangeZOrder(Items[I].FComboLayer, I + LAYERS_ZOFFS);
|
|
end;
|
|
|
|
{ TDrawObjJob }
|
|
|
|
function TDrawObjJob.pGetTask: integer;
|
|
var
|
|
i: integer;
|
|
begin
|
|
if not(AllRun) and not(Cancelled) then
|
|
begin
|
|
for i := Low(FStates) to High(FStates) do
|
|
if FStates[i]=0 then
|
|
begin
|
|
result := i+1;
|
|
Exit;
|
|
end;
|
|
AllRun:=True;
|
|
end;
|
|
|
|
Result := ALL_TASK_COMPLETED;
|
|
for i := Low(FStates) to High(FStates) do
|
|
if FStates[i]=1 then
|
|
begin
|
|
Result := NO_MORE_TASK;
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
procedure TDrawObjJob.pTaskStarted(aTask: integer);
|
|
begin
|
|
FRunning := True;
|
|
FStates[aTask-1] := 1;
|
|
end;
|
|
|
|
procedure TDrawObjJob.pTaskEnded(aTask: integer; aExcept: Exception);
|
|
begin
|
|
if Assigned(aExcept) then
|
|
FStates[aTask-1] := 3
|
|
else
|
|
FStates[aTask-1] := 2;
|
|
end;
|
|
|
|
procedure TDrawObjJob.ExecuteTask(aTask: integer; FromWaiting: boolean);
|
|
var
|
|
iObj: integer;
|
|
Obj: TGpsObj;
|
|
begin
|
|
iObj := aTask-1;
|
|
Obj := FLst[iObj];
|
|
Viewer.DrawGpsObj(FArea, Obj);
|
|
end;
|
|
|
|
function TDrawObjJob.Running: boolean;
|
|
begin
|
|
Result := FRunning;
|
|
end;
|
|
|
|
constructor TDrawObjJob.Create(aViewer: TMapView; aLst: TGPSObjList;
|
|
const aArea: TRealArea);
|
|
begin
|
|
FArea := aArea;
|
|
FLst := aLst;
|
|
SetLength(FStates, FLst.Count);
|
|
Viewer := aViewer;
|
|
AllRun := false;
|
|
Name := 'DrawObj';
|
|
end;
|
|
|
|
destructor TDrawObjJob.Destroy;
|
|
begin
|
|
inherited Destroy;
|
|
FreeAndNil(FLst);
|
|
end;
|
|
|
|
|
|
{ TMapView }
|
|
|
|
procedure TMapView.SetActive(AValue: boolean);
|
|
begin
|
|
if FActive = AValue then Exit;
|
|
if AValue and (MapProvider = '') then
|
|
// Raising an exception won't let the component to be loaded
|
|
if not (csLoading in ComponentState) then
|
|
raise Exception.Create('MapProvider is not selected.');
|
|
FActive := AValue;
|
|
if FActive then
|
|
ActivateEngine
|
|
else
|
|
Engine.Active := false;
|
|
end;
|
|
|
|
procedure TMapView.SetCacheLocation(AValue: TCacheLocation);
|
|
var
|
|
NewPath: String;
|
|
OldLoc: TCacheLocation;
|
|
begin
|
|
if FCacheLocation = AValue then
|
|
Exit;
|
|
OldLoc := FCacheLocation;
|
|
FCacheLocation := AValue;
|
|
NewPath := CacheDirectory(AValue, CachePath);
|
|
if NewPath = Engine.CachePath then
|
|
Exit;
|
|
ChangeCachePath(OldLoc, NewPath);
|
|
end;
|
|
|
|
procedure TMapView.SetCacheMaxAge(AValue: Integer);
|
|
begin
|
|
if Engine.CacheMaxAge = AValue then
|
|
Exit;
|
|
Engine.CacheMaxAge := AValue;
|
|
UpdateLayers;
|
|
end;
|
|
|
|
function TMapView.GetCacheOnDisk: boolean;
|
|
begin
|
|
Result := FCacheOnDisk;
|
|
end;
|
|
|
|
function TMapView.GetCenter: TRealPoint;
|
|
begin
|
|
Result := Engine.Center;
|
|
end;
|
|
|
|
function TMapView.GetCyclic: Boolean;
|
|
begin
|
|
Result := Engine.Cyclic;
|
|
end;
|
|
|
|
function TMapView.GetDownloadEngine: TMvCustomDownloadEngine;
|
|
begin
|
|
if FDownloadEngine = nil then
|
|
Result := FBuiltinDownloadEngine
|
|
else
|
|
Result := FDownloadEngine;
|
|
end;
|
|
|
|
function TMapView.GetDrawingEngine: TMvCustomDrawingEngine;
|
|
begin
|
|
if FDrawingEngine = nil then
|
|
Result := FBuiltinDrawingEngine
|
|
else
|
|
Result := FDrawingEngine;
|
|
end;
|
|
|
|
function TMapView.GetDrawPreviewTiles: Boolean;
|
|
begin
|
|
Result := Engine.DrawPreviewTiles;
|
|
end;
|
|
|
|
function TMapView.GetGPSItems: TGPSObjectList;
|
|
begin
|
|
Result := GetGPSLayer(5);
|
|
end;
|
|
|
|
function TMapView.GetGPSLayer(Layer: Integer): TGPSObjectList;
|
|
begin
|
|
Result := FGPSItems[Layer mod 10];
|
|
end;
|
|
|
|
function TMapView.GetInactiveColor: TColor;
|
|
begin
|
|
Result := FPColorToTColor(Engine.BkColor);
|
|
end;
|
|
|
|
function TMapView.GetLayers: TMapLayers;
|
|
begin
|
|
Result := FLayers;
|
|
end;
|
|
|
|
function TMapView.GetMapProvider: String;
|
|
begin
|
|
result := Engine.MapProvider;
|
|
end;
|
|
|
|
function TMapView.GetOnCenterMove: TNotifyEvent;
|
|
begin
|
|
result := Engine.OnCenterMove;
|
|
end;
|
|
|
|
function TMapView.GetOnChange: TNotifyEvent;
|
|
begin
|
|
Result := Engine.OnChange;
|
|
end;
|
|
|
|
function TMapView.GetOnZoomChange: TNotifyEvent;
|
|
begin
|
|
Result := Engine.OnZoomChange;
|
|
end;
|
|
|
|
function TMapView.GetUseThreads: boolean;
|
|
begin
|
|
Result := Engine.UseThreads;
|
|
end;
|
|
|
|
function TMapView.GetZoom: integer;
|
|
begin
|
|
result := Engine.Zoom;
|
|
end;
|
|
|
|
function TMapView.GetZoomToCursor: Boolean;
|
|
begin
|
|
Result := Engine.ZoomToCursor;
|
|
end;
|
|
|
|
function TMapView.IsCacheMaxAgeStored: Boolean;
|
|
begin
|
|
Result := Engine.CacheMaxAge <> MaxInt;
|
|
end;
|
|
|
|
function TMapView.IsCachePathStored: Boolean;
|
|
begin
|
|
Result := not SameText(CachePath, 'cache/');
|
|
end;
|
|
|
|
function TMapView.IsFontStored: Boolean;
|
|
begin
|
|
Result := SameText(FFont.Name, 'default') and (FFont.Size = 0) and
|
|
(FFont.Style = []) and (FFont.Color = clBlack);
|
|
end;
|
|
|
|
function TMapView.IsLayersStored: Boolean;
|
|
begin
|
|
Result := True;
|
|
end;
|
|
|
|
procedure TMapView.SetCacheOnDisk(AValue: boolean);
|
|
begin
|
|
FCacheOnDisk := AValue;
|
|
if csDesigning in ComponentState
|
|
then Engine.CacheOnDisk := False
|
|
else Engine.CacheOnDisk := AValue;
|
|
UpdateLayers;
|
|
end;
|
|
|
|
procedure TMapView.SetCachePath(AValue: String);
|
|
var
|
|
NewPath: String;
|
|
begin
|
|
if FCachePath = AValue then
|
|
Exit;
|
|
FCachePath := AValue;
|
|
NewPath := CacheDirectory(CacheLocation, AValue);
|
|
if NewPath = Engine.CachePath then
|
|
Exit;
|
|
ChangeCachePath(CacheLocation, NewPath);
|
|
end;
|
|
|
|
procedure TMapView.SetCenter(AValue: TRealPoint);
|
|
begin
|
|
Engine.Center := AValue;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TMapView.SetCyclic(AValue: Boolean);
|
|
begin
|
|
Engine.Cyclic := AValue;
|
|
UpdateLayers;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TMapView.SetDebugTiles(AValue: Boolean);
|
|
begin
|
|
if FDebugTiles = AValue then exit;
|
|
FDebugTiles := AValue;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TMapView.SetDefaultTrackColor(AValue: TColor);
|
|
begin
|
|
if FDefaultTrackColor = AValue then exit;
|
|
FDefaultTrackColor := AValue;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TMapView.SetDefaultTrackWidth(AValue: Integer);
|
|
begin
|
|
if FDefaultTrackWidth = AValue then exit;
|
|
FDefaultTrackWidth := AValue;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TMapView.SetDownloadEngine(AValue: TMvCustomDownloadEngine);
|
|
begin
|
|
FDownloadEngine := AValue;
|
|
FEngine.DownloadEngine := GetDownloadEngine;
|
|
UpdateLayers;
|
|
end;
|
|
|
|
procedure TMapView.SetDrawingEngine(AValue: TMvCustomDrawingEngine);
|
|
begin
|
|
FDrawingEngine := AValue;
|
|
if AValue = nil then
|
|
begin
|
|
FBuiltinDrawingEngine.CreateBuffer(ClientWidth, ClientHeight);
|
|
FEngine.CacheItemClass := FBuiltinDrawingEngine.GetCacheItemClass;
|
|
end
|
|
else begin
|
|
FBuiltinDrawingEngine.CreateBuffer(0, 0);
|
|
FDrawingEngine.CreateBuffer(ClientWidth, ClientHeight);
|
|
FEngine.CacheItemClass := FDrawingEngine.GetCacheItemClass;
|
|
end;
|
|
UpdateFont(nil);
|
|
end;
|
|
|
|
procedure TMapView.SetDrawPreviewTiles(AValue: Boolean);
|
|
begin
|
|
Engine.DrawPreviewTiles := AValue;
|
|
end;
|
|
|
|
procedure TMapView.SetFont(AValue: TFont);
|
|
begin
|
|
FFont.Assign(AValue);
|
|
UpdateFont(nil);
|
|
end;
|
|
|
|
procedure TMapView.SetInactiveColor(AValue: TColor);
|
|
begin
|
|
Engine.BkColor := TColorToFPColor(AValue);
|
|
if not IsActive then
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TMapView.SetLayers(const ALayers: TMapLayers);
|
|
begin
|
|
FLayers.Assign(ALayers);
|
|
end;
|
|
|
|
procedure TMapView.ActivateEngine;
|
|
begin
|
|
Engine.SetSize(ClientWidth,ClientHeight);
|
|
Engine.Active := IsActive;
|
|
end;
|
|
|
|
procedure TMapView.SetMapProvider(AValue: String);
|
|
begin
|
|
//if AValue = '' then
|
|
// raise EArgumentException.Create('Empty map provider is not allowed.');
|
|
Engine.MapProvider := AValue;
|
|
if AValue = '' then
|
|
Active := False;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TMapView.SetOnCenterMove(AValue: TNotifyEvent);
|
|
begin
|
|
Engine.OnCenterMove := AValue;
|
|
end;
|
|
|
|
procedure TMapView.SetOnChange(AValue: TNotifyEvent);
|
|
begin
|
|
Engine.OnChange := AValue;
|
|
end;
|
|
|
|
procedure TMapView.SetOnZoomChange(AValue: TNotifyEvent);
|
|
begin
|
|
Engine.OnZoomChange := AValue;
|
|
end;
|
|
|
|
procedure TMapView.SetOptions(AValue: TMapViewOptions);
|
|
begin
|
|
if FOptions = AValue then Exit;
|
|
FOptions := AValue;
|
|
if Engine.InDrag and not (mvoMouseDragging in FOptions) then
|
|
begin
|
|
Engine.DragObj.AbortDrag;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TMapView.SetPOIImage(const AValue: TBitmap);
|
|
begin
|
|
if FPOIImage = AValue then exit;
|
|
FPOIImage := AValue;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TMapView.SetPOIImages(const AValue: TCustomImageList);
|
|
begin
|
|
if FPOIImages = AValue then exit;
|
|
FPOIImages := AValue;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TMapView.SetPOIImagesWidth(AValue: Integer);
|
|
begin
|
|
if FPOIImagesWidth = AValue then exit;
|
|
FPOIImagesWidth := AValue;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TMapView.SetPOITextBgColor(AValue: TColor);
|
|
begin
|
|
if FPOITextBgColor = AValue then exit;
|
|
FPOITextBgColor := AValue;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TMapView.SetUseThreads(AValue: boolean);
|
|
begin
|
|
Engine.UseThreads := aValue;
|
|
end;
|
|
|
|
procedure TMapView.SetZoom(AValue: integer);
|
|
begin
|
|
Engine.Zoom := EnsureRange(AValue, FZoomMin, FZoomMax);
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TMapView.SetZoomMax(AValue: Integer);
|
|
begin
|
|
if FZoomMax = AValue then Exit;
|
|
FZoomMax := EnsureRange(AValue, FZoomMin, 19);
|
|
Zoom := GetZoom;
|
|
end;
|
|
|
|
procedure TMapView.SetZoomMin(AValue: Integer);
|
|
begin
|
|
if FZoomMin = AValue then Exit;
|
|
FZoomMin := EnsureRange(AValue, 0, FZoomMax);
|
|
Zoom := GetZoom;
|
|
end;
|
|
|
|
procedure TMapView.SetZoomToCursor(AValue: Boolean);
|
|
begin
|
|
Engine.ZoomToCursor := AValue;
|
|
end;
|
|
|
|
function TMapView.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
|
|
MousePos: TPoint): Boolean;
|
|
begin
|
|
Result:=inherited DoMouseWheel(Shift, WheelDelta, MousePos);
|
|
if IsActive and (mvoMouseZooming in FOptions) then
|
|
begin
|
|
Engine.MouseWheel(self,Shift,WheelDelta,MousePos,Result);
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TMapView.MouseDown(Button: TMouseButton; Shift: TShiftState;
|
|
X, Y: Integer);
|
|
begin
|
|
inherited MouseDown(Button, Shift, X, Y);
|
|
if IsActive and (mvoMouseDragging in FOptions) then
|
|
begin
|
|
Engine.MouseDown(self,Button,Shift,X,Y);
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TMapView.MouseUp(Button: TMouseButton; Shift: TShiftState;
|
|
X, Y: Integer);
|
|
begin
|
|
inherited MouseUp(Button, Shift, X, Y);
|
|
if IsActive and (mvoMouseDragging in FOptions) then
|
|
begin
|
|
Engine.MouseUp(self,Button,Shift,X,Y);
|
|
Engine.Redraw;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TMapView.MouseMove(Shift: TShiftState; X, Y: Integer);
|
|
begin
|
|
inherited MouseMove(Shift, X, Y);
|
|
if IsActive and (mvoMouseDragging in FOptions) then
|
|
begin
|
|
Engine.MouseMove(self,Shift,X,Y);
|
|
if Engine.InDrag
|
|
then Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TMapView.Notification(AComponent: TComponent; Operation: TOperation);
|
|
begin
|
|
inherited;
|
|
if (AComponent = FPOIImages) and (Operation = opRemove) then
|
|
FPOIImages := nil;
|
|
end;
|
|
|
|
procedure TMapView.DblClick;
|
|
begin
|
|
inherited DblClick;
|
|
if IsActive then
|
|
begin
|
|
Engine.DblClick(self);
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TMapView.DoOnResize;
|
|
begin
|
|
inherited DoOnResize;
|
|
//cancel all rendering threads
|
|
Engine.CancelCurrentDrawing;
|
|
DrawingEngine.CreateBuffer(ClientWidth, ClientHeight);
|
|
if IsActive then
|
|
begin
|
|
Engine.SetSize(ClientWidth, ClientHeight);
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TMapView.Paint;
|
|
const
|
|
FREE_DRAG = 0; //(TILE_SIZE * TILE_SIZE) div 4;
|
|
|
|
procedure DrawCenter;
|
|
var
|
|
C: TPoint;
|
|
begin
|
|
C := Point(ClientWidth div 2, ClientHeight div 2);
|
|
Canvas.Pen.Color := clBlack;
|
|
Canvas.Pen.Width := 1;
|
|
Canvas.Line(C.X, C.Y - 15, C.X, C.Y + 15);
|
|
Canvas.Line(C.X - 15, C.Y, C.X + 15, C.Y);
|
|
end;
|
|
|
|
procedure InactiveDraw;
|
|
begin
|
|
Canvas.Brush.Color := InactiveColor;
|
|
Canvas.Brush.Style := bsSolid;
|
|
Canvas.FillRect(0, 0, ClientWidth, ClientHeight);
|
|
end;
|
|
|
|
procedure FullRedraw;
|
|
var
|
|
W: Integer;
|
|
begin
|
|
Engine.Redraw;
|
|
W := Canvas.Width;
|
|
if Cyclic then
|
|
W := Min(1 shl Zoom * TILE_SIZE, W);
|
|
DrawObjects(Default(TTileId), 0, 0, W - 1, Canvas.Height);
|
|
DrawingEngine.PaintToCanvas(Canvas);
|
|
if DebugTiles then
|
|
DrawCenter;
|
|
end;
|
|
|
|
procedure DragDraw;
|
|
var
|
|
O: TPoint;
|
|
begin
|
|
O := Point(Engine.DragObj.OfsX, Engine.DragObj.OfsY);
|
|
// Free drag up to half of the tile
|
|
if ((O.X * O.X + O.Y * O.Y) < FREE_DRAG) then
|
|
begin
|
|
DrawingEngine.PaintToCanvas(Canvas);
|
|
DrawingEngine.PaintToCanvas(Canvas, O);
|
|
if DebugTiles then
|
|
DrawCenter;
|
|
end
|
|
else
|
|
FullRedraw;
|
|
end;
|
|
|
|
begin
|
|
inherited Paint;
|
|
if IsActive
|
|
then if Engine.InDrag
|
|
then DragDraw
|
|
else FullRedraw
|
|
else
|
|
InactiveDraw;
|
|
end;
|
|
|
|
procedure TMapView.OnGPSItemsModified(Sender: TObject; objs: TGPSObjList;
|
|
Adding: boolean);
|
|
var
|
|
Area, objArea, visArea: TRealArea;
|
|
begin
|
|
if Adding and Assigned(Objs) then
|
|
begin
|
|
objArea := GetAreaOf(Objs);
|
|
visArea := GetVisibleArea;
|
|
if hasIntersectArea(objArea, visArea) then
|
|
begin
|
|
Area := IntersectArea(objArea, visArea);
|
|
Invalidate;
|
|
end
|
|
end
|
|
else
|
|
Engine.Redraw;
|
|
end;
|
|
|
|
procedure TMapView.DrawTrack(const Area: TRealArea; trk: TGPSTrack);
|
|
var
|
|
I, L, T, WS: Integer;
|
|
ClipRect: TRect;
|
|
iPt1, iPt2, iPt3, iPt4: TPoint;
|
|
ToEast: Boolean;
|
|
pt1, pt2: TRealPoint;
|
|
trkColor: TColor;
|
|
trkWidth: Integer;
|
|
|
|
procedure ClipDrawLine(P1, P2: TPoint); inline;
|
|
begin
|
|
if not ClipLineToRect(ClipRect, P1, P2) then
|
|
DrawingEngine.Line(P1.X, P1.Y, P2.X, P2.Y);
|
|
end;
|
|
|
|
begin
|
|
if not trk.Visible or (trk.Points.Count = 0) then
|
|
exit;
|
|
|
|
// Determine track color
|
|
if trk.LineColor = clDefault then
|
|
begin
|
|
trkColor := ColorToRGB(FDefaultTrackColor);
|
|
if (trk.ExtraData <> nil) and trk.ExtraData.InheritsFrom(TDrawingExtraData) then
|
|
trkColor := TDrawingExtraData(trk.ExtraData).Color;
|
|
end else
|
|
trkColor := ColorToRGB(trk.LineColor);
|
|
|
|
// Determine track width
|
|
if trk.LineWidth = -1 then
|
|
begin
|
|
trkWidth := FDefaultTrackWidth;
|
|
if (trk.ExtraData <> nil) and trk.ExtraData.InheritsFrom(TTrackExtraData) then
|
|
trkWidth := mmToPx(TTrackExtraData(trk.ExtraData).Width);
|
|
end else
|
|
trkWidth := mmToPx(trk.LineWidth);
|
|
if trkWidth < 1 then trkWidth := 1;
|
|
|
|
|
|
DrawingEngine.PenColor := trkColor;
|
|
DrawingEngine.PenWidth := trkWidth;
|
|
|
|
// Clipping rectangle
|
|
if Cyclic then
|
|
ClipRect := Rect(0, 0, ClientWidth, ClientHeight)
|
|
else
|
|
begin
|
|
L := Max(0, Engine.MapLeft);
|
|
T := Max(0, Engine.MapTop);
|
|
WS := ZoomFactor(Zoom) * TILE_SIZE;
|
|
ClipRect := Rect(L, T, Min(Engine.MapLeft + WS, ClientWidth),
|
|
Min(Engine.MapTop + WS, ClientHeight));
|
|
end;
|
|
|
|
pt1 := trk.Points[0].RealPoint;
|
|
iPt1 := Engine.LonLatToScreen(pt1);
|
|
for I := 1 to Pred(trk.Points.Count) do
|
|
begin
|
|
pt2 := trk.Points[I].RealPoint;
|
|
iPt2 := Engine.LonLatToScreen(pt2);
|
|
ToEast := GoingEast(pt1.Lon, pt2.Lon); // Eastwards?
|
|
iPt2 := CyclicPointOf(iPt2, iPt1.X, ToEast); // Nearest iPt2 to iPt1
|
|
|
|
// Rightmost cyclic copy of the segment
|
|
if ToEast then
|
|
begin
|
|
iPt3 := CyclicPointOf(iPt1, ClipRect.Right); // Left point
|
|
iPt4 := (iPt2 - iPt1); // delta to the right point
|
|
end
|
|
else
|
|
begin
|
|
iPt3 := CyclicPointOf(iPt2, ClipRect.Right); // Left point
|
|
iPt4 := (iPt1 - iPt2); // delta to the right point
|
|
end;
|
|
|
|
// Draw all copies of the segment, right to left
|
|
repeat
|
|
ClipDrawLine(iPt3, iPt3 + iPt4);
|
|
iPt3 := CyclicPointOf(iPt3, Pred(iPt3.X), False); // Next left cyclic iPt3
|
|
until Max(iPt3.X, iPt3.X + iPt4.X) < ClipRect.Left;
|
|
|
|
pt1 := pt2;
|
|
iPt1 := iPt2;
|
|
end;
|
|
end;
|
|
|
|
procedure TMapView.DrawPointOfInterest(const Area: TRealArea; APt: TGPSPointOfInterest);
|
|
var
|
|
pt: TPoint;
|
|
ptCyc: TPointArray;
|
|
ptColor: TColor;
|
|
extent: TSize;
|
|
s: String;
|
|
bmp: TBitmap;
|
|
w, h: Integer;
|
|
|
|
procedure DrawOne(pt: TPoint);
|
|
begin
|
|
if Assigned(bmp) then
|
|
DrawingEngine.DrawBitmap(pt.X - w div 2, pt.Y - h, bmp, true)
|
|
else
|
|
begin
|
|
// ... or as cross
|
|
ptColor := clRed;
|
|
if (APt.ExtraData <> nil) and APt.ExtraData.InheritsFrom(TDrawingExtraData) then
|
|
ptColor := TDrawingExtraData(APt.ExtraData).Color;
|
|
DrawingEngine.PenColor := ptColor;
|
|
DrawingEngine.PenWidth := 3;
|
|
DrawingEngine.Line(pt.X, pt.Y - 5, pt.X, pt.Y + 5);
|
|
DrawingEngine.Line(pt.X - 5, pt.Y, pt.X + 5, pt.Y);
|
|
pt.Y := pt.Y + 5;
|
|
end;
|
|
if FPOITextBgColor = clNone then
|
|
DrawingEngine.BrushStyle := bsClear
|
|
else
|
|
begin
|
|
DrawingEngine.BrushStyle := bsSolid;
|
|
DrawingEngine.BrushColor := FPOITextBgColor;
|
|
end;
|
|
DrawingEngine.TextOut(pt.X - extent.CX div 2, pt.Y + 5, s);
|
|
end;
|
|
|
|
begin
|
|
pt := Engine.LonLatToScreen(APt.RealPoint);
|
|
|
|
bmp := Nil;
|
|
try
|
|
// Draw point as symbol from image list ...
|
|
if Assigned(FPOIImages) and (APt.ImageIndex <> -1) and (APt.ImageIndex < FPOIImages.Count) then
|
|
begin
|
|
bmp := TBitmap.Create;
|
|
FPOIImages.GetBitmap(APt.ImageIndex, bmp);
|
|
{$IF LCL_FullVersion >= 2000000}
|
|
w := FPOIImages.WidthForPPI[FPOIImagesWidth, Font.PixelsPerInch];
|
|
h := FPOIImages.HeightForPPI[FPOIImagesWidth, Font.PixelsPerInch];
|
|
{$ELSE}
|
|
w := FPOIImages.Width;
|
|
h := FPOIImages.Height;
|
|
{$IFEND}
|
|
end;
|
|
|
|
// Draw point text
|
|
s := APt.Name;
|
|
if FPOITextBgColor <> clNone then
|
|
s := ' ' + s + ' ';
|
|
extent := DrawingEngine.TextExtent(s);
|
|
if Cyclic then
|
|
begin
|
|
ptCyc := CyclicPointsOf(pt);
|
|
for pt in ptCyc do
|
|
DrawOne(pt);
|
|
end
|
|
else
|
|
DrawOne(pt);
|
|
finally
|
|
bmp.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TMapView.DrawPt(const Area: TRealArea; APt: TGPSPoint);
|
|
var
|
|
Pt: TPoint;
|
|
PtCyc: TPointArray;
|
|
PtColor: TColor;
|
|
extent: TSize;
|
|
s: String;
|
|
|
|
procedure DrawOne(Pt: TPoint);
|
|
begin
|
|
// Draw point marker
|
|
if Assigned(FPOIImage) and not (FPOIImage.Empty) then
|
|
DrawingEngine.DrawBitmap(Pt.X - FPOIImage.Width div 2, Pt.Y - FPOIImage.Height, FPOIImage, true)
|
|
else begin
|
|
DrawingEngine.PenColor := ptColor;
|
|
DrawingEngine.PenWidth := 3;
|
|
DrawingEngine.Line(Pt.X, Pt.Y - 5, Pt.X, Pt.Y + 5);
|
|
DrawingEngine.Line(Pt.X - 5, Pt.Y, Pt.X + 5, Pt.Y);
|
|
Pt.Y := Pt.Y + 5;
|
|
end;
|
|
|
|
// Draw point text
|
|
s := APt.Name;
|
|
if FPOITextBgColor = clNone then
|
|
DrawingEngine.BrushStyle := bsClear
|
|
else begin
|
|
DrawingEngine.BrushStyle := bsSolid;
|
|
DrawingEngine.BrushColor := FPOITextBgColor;
|
|
s := ' ' + s + ' ';
|
|
end;
|
|
extent := DrawingEngine.TextExtent(s);
|
|
DrawingEngine.Textout(Pt.X - extent.CX div 2, Pt.Y + 5, s);
|
|
end;
|
|
|
|
begin
|
|
if Assigned(FOnDrawGpsPoint) then begin
|
|
FOnDrawGpsPoint(Self, DrawingEngine, APt);
|
|
exit;
|
|
end;
|
|
|
|
Pt := Engine.LonLatToScreen(APt.RealPoint);
|
|
PtColor := clRed;
|
|
if APt.ExtraData <> nil then
|
|
begin
|
|
if APt.ExtraData.inheritsFrom(TDrawingExtraData) then
|
|
PtColor := TDrawingExtraData(APt.ExtraData).Color;
|
|
end;
|
|
|
|
PtCyc := CyclicPointsOf(Pt);
|
|
for Pt in PtCyc do
|
|
DrawOne(Pt);
|
|
end;
|
|
|
|
procedure TMapView.DrawGpsObj(const Area: TRealArea; AObj: TGPSObj);
|
|
begin
|
|
GPSItems.Lock;
|
|
try
|
|
AObj.Draw(Self, Area);
|
|
finally
|
|
GPSItems.Unlock;
|
|
end;
|
|
end;
|
|
|
|
function TMapView.GetCacheMaxAge: Integer;
|
|
begin
|
|
Result := Engine.CacheMaxAge;
|
|
end;
|
|
|
|
procedure TMapView.CallAsyncInvalidate;
|
|
Begin
|
|
if not(AsyncInvalidate) then
|
|
begin
|
|
AsyncInvalidate := true;
|
|
Engine.Jobqueue.QueueAsyncCall(@DoAsyncInvalidate, 0);
|
|
end;
|
|
end;
|
|
|
|
procedure TMapView.DrawObjects(const TileId: TTileId;
|
|
aLeft, aTop,aRight,aBottom: integer);
|
|
var
|
|
Area: TRealArea;
|
|
lst: TGPSObjList;
|
|
I, J: Integer;
|
|
begin
|
|
Area.TopLeft := Engine.ScreenToLonLat(Point(aLeft, aTop));
|
|
Area.BottomRight := Engine.ScreenToLonLat(Point(aRight, aBottom));
|
|
|
|
for J := 0 to High(FGPSItems) do
|
|
if FGPSItems[J].Visible and (FGPSItems[J].Count > 0) then
|
|
begin
|
|
lst := FGPSItems[J].GetObjectsInArea(Area);
|
|
try
|
|
if lst.Count > 0 then
|
|
begin
|
|
for I := 0 to Pred(lst.Count) do
|
|
if lst[I].Visible then
|
|
DrawGpsObj(Area, lst[I]);
|
|
end;
|
|
finally
|
|
FreeAndNil(Lst);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TMapView.DoAsyncInvalidate(Data: PtrInt);
|
|
Begin
|
|
Invalidate;
|
|
AsyncInvalidate := false;
|
|
end;
|
|
|
|
procedure TMapView.DoDrawStretchedTile(const TileId: TTileID; X, Y: Integer;
|
|
TileImg: TPictureCacheItem; const R: TRect);
|
|
begin
|
|
if Assigned(TileImg) then
|
|
DrawingEngine.DrawScaledCacheItem(Rect(X, Y, X + TILE_SIZE, Y + TILE_SIZE), R, TileImg)
|
|
else
|
|
DrawingEngine.FillPixels(X, Y, X + TILE_SIZE, Y + TILE_SIZE, InactiveColor);
|
|
|
|
if FDebugTiles then
|
|
DoDrawTileInfo(TileID, X, Y);
|
|
|
|
end;
|
|
|
|
procedure TMapView.DoDrawTile(const TileId: TTileId; X, Y: integer;
|
|
TileImg: TPictureCacheItem);
|
|
begin
|
|
if Assigned(TileImg) then
|
|
DrawingEngine.DrawCacheItem(X, Y, TileImg)
|
|
else
|
|
DrawingEngine.FillPixels(X, Y, X + TILE_SIZE, Y + TILE_SIZE, InactiveColor);
|
|
|
|
if FDebugTiles then
|
|
DoDrawTileInfo(TileID, X, Y);
|
|
|
|
end;
|
|
|
|
procedure TMapView.DoDrawTileInfo(const TileID: TTileID; X, Y: Integer);
|
|
begin
|
|
DrawingEngine.PenColor := clGray;
|
|
DrawingEngine.PenWidth := 1;
|
|
DrawingEngine.Line(X, Y, X, Y + TILE_SIZE);
|
|
DrawingEngine.Line(X, Y, X + TILE_SIZE, Y);
|
|
DrawingEngine.Line(X + TILE_SIZE, Y, X + TILE_SIZE, Y + TILE_SIZE);
|
|
DrawingEngine.Line(X, Y + TILE_SIZE, X + TILE_SIZE, Y + TILE_SIZE);
|
|
end;
|
|
|
|
procedure TMapView.DoEraseBackground(const R: TRect);
|
|
begin
|
|
DrawingEngine.FillPixels(R.Left, R.Top, R.Right, R.Bottom, InactiveColor);
|
|
end;
|
|
|
|
procedure TMapView.DoTileDownloaded(const TileId: TTileId);
|
|
begin
|
|
// TODO: Include tile information to optimize redraw.
|
|
CallAsyncInvalidate;
|
|
end;
|
|
|
|
function TMapView.IsActive: Boolean;
|
|
begin
|
|
Result := FActive
|
|
end;
|
|
|
|
constructor TMapView.Create(AOwner: TComponent);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
inherited Create(AOwner);
|
|
Width := 150;
|
|
Height := 150;
|
|
|
|
FLayers := CreateLayers;
|
|
|
|
FActive := false;
|
|
FOptions := DefaultMapViewOptions;
|
|
|
|
FDefaultTrackColor := clRed;
|
|
FDefaultTrackWidth := 1;
|
|
|
|
for I := 0 to High(FGPSItems) do
|
|
begin
|
|
FGPSItems[I] := TGPSObjectList.Create;
|
|
FGPSItems[I].OnModified := @OnGPSItemsModified;
|
|
end;
|
|
|
|
{$IFDEF MSWindows}
|
|
FBuiltinDownloadEngine := TMvDEWin.Create(self);
|
|
{$ELSE}
|
|
FBuiltinDownloadEngine := TMvDEFpc.Create(self);
|
|
{$ENDIF}
|
|
FBuiltinDownloadEngine.Name := 'BuiltInDLE';
|
|
|
|
FCacheLocation := clProfile;
|
|
|
|
FEngine := TMapViewerEngine.Create(self);
|
|
FEngine.BkColor := colWhite;
|
|
{FEngine.}CachePath := 'cache/';
|
|
FEngine.CacheOnDisk := true;
|
|
FEngine.OnDrawTile := @DoDrawTile;
|
|
FEngine.OnDrawStretchedTile := @DoDrawStretchedTile;
|
|
FEngine.OnEraseBackground := @DoEraseBackground;
|
|
FEngine.OnTileDownloaded := @DoTileDownloaded;
|
|
FEngine.DrawPreviewTiles := True;
|
|
FEngine.DrawTitleInGuiThread := false;
|
|
FEngine.DownloadEngine := FBuiltinDownloadEngine;
|
|
FEngine.ZoomToCursor := True;
|
|
|
|
FBuiltinDrawingEngine := TMvIntfGraphicsDrawingEngine.Create(self);
|
|
FEngine.CacheItemClass := FBuiltinDrawingEngine.GetCacheItemClass;
|
|
FBuiltinDrawingEngine.Name := 'BuiltInDE';
|
|
FBuiltinDrawingEngine.CreateBuffer(Width, Height);
|
|
|
|
FFont := TFont.Create;
|
|
FFont.Name := 'default';
|
|
FFont.Size := 0;
|
|
FFont.Style := [];
|
|
FFont.Color := clBlack;
|
|
FFont.OnChange := @UpdateFont;
|
|
|
|
FPOIImage := TBitmap.Create;
|
|
FPOIImage.OnChange := @UpdateImage;
|
|
FPOITextBgColor := clNone;
|
|
|
|
FCenter := TMapCenter.Create(Self);
|
|
FCenter.Longitude := 0.0;
|
|
FCenter.Latitude := 0.0;
|
|
|
|
FZoomMin := 0;
|
|
FZoomMax := 19;
|
|
Zoom := 1;
|
|
end;
|
|
|
|
destructor TMapView.Destroy;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Active := False;
|
|
Engine.Jobqueue.RemoveAsyncCalls(Self);
|
|
FFont.Free;
|
|
FreeAndNil(FPOIImage);
|
|
FLayers.Free;
|
|
for I := 0 to High(FGPSItems) do
|
|
FreeAndNil(FGPSItems[I]);
|
|
FCenter.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TMapView.CyclicPointOf(APoint: TPoint; ARefX: LongInt;
|
|
Eastwards: Boolean): TPoint;
|
|
var
|
|
WorldSize: Int64;
|
|
begin
|
|
Result := APoint;
|
|
WorldSize := ZoomFactor(Zoom) * TILE_SIZE;
|
|
if Eastwards then
|
|
begin
|
|
while Result.X < ARefX do
|
|
Inc(Result.X, WorldSize);
|
|
while Result.X >= ARefX + WorldSize do
|
|
Dec(Result.X, WorldSize);
|
|
end
|
|
else
|
|
begin
|
|
while Result.X > ARefX do
|
|
Dec(Result.X, WorldSize);
|
|
while Result.X <= ARefX - WorldSize do
|
|
Inc(Result.X, WorldSize);
|
|
end;
|
|
end;
|
|
|
|
function TMapView.CyclicPointsOf(APoint: TPoint): TPointArray;
|
|
var
|
|
I, R, L, WorldSize: LongInt;
|
|
begin
|
|
Result := Default(TPointArray);
|
|
if not Cyclic then
|
|
begin
|
|
SetLength(Result, 1);
|
|
Result[0] := APoint;
|
|
end
|
|
else
|
|
begin
|
|
WorldSize := ZoomFactor(Zoom) * TILE_SIZE;
|
|
SetLength(Result, 1 + Canvas.Width div WorldSize);
|
|
Result[0] := APoint;
|
|
I := 1; R := APoint.X + WorldSize; L := APoint.X - WorldSize;
|
|
while (R < Canvas.Width) or (L >= 0) do
|
|
begin
|
|
if R < Canvas.Width then
|
|
begin
|
|
Result[I].Y := APoint.Y;
|
|
Result[I].X := R;
|
|
Inc(I);
|
|
end;
|
|
if L >= 0 then
|
|
begin
|
|
Result[I].Y := APoint.Y;
|
|
Result[I].X := L;
|
|
Inc(I);
|
|
end;
|
|
Inc(R, WorldSize);
|
|
Dec(L, WorldSize);
|
|
end;
|
|
if I < Length(Result) then
|
|
SetLength(Result, I);
|
|
end;
|
|
end;
|
|
|
|
procedure TMapView.SaveToFile(AClass: TRasterImageClass; const AFileName: String);
|
|
var
|
|
stream: TFileStream;
|
|
begin
|
|
stream := TFileStream.Create(AFileName, fmCreate + fmShareDenyNone);
|
|
try
|
|
SaveToStream(AClass, stream);
|
|
finally
|
|
stream.Free;
|
|
end;
|
|
end;
|
|
|
|
function TMapView.SaveToImage(AClass: TRasterImageClass): TRasterImage;
|
|
begin
|
|
Result := DrawingEngine.SaveToImage(AClass);
|
|
end;
|
|
|
|
procedure TMapView.SaveToStream(AClass: TRasterImageClass; AStream: TStream);
|
|
var
|
|
img: TRasterImage;
|
|
begin
|
|
img := SaveToImage(AClass);
|
|
try
|
|
img.SaveToStream(AStream);
|
|
finally
|
|
img.Free;
|
|
end;
|
|
end;
|
|
|
|
function TMapView.ScreenToLonLat(aPt: TPoint): TRealPoint;
|
|
begin
|
|
Result:=Engine.ScreenToLonLat(aPt);
|
|
end;
|
|
|
|
function TMapView.LonLatToScreen(aPt: TRealPoint): TPoint;
|
|
begin
|
|
Result:=Engine.LonLatToScreen(aPt);
|
|
end;
|
|
|
|
procedure TMapView.GetMapProviders(lstProviders: TStrings);
|
|
var
|
|
L: TStringList;
|
|
begin
|
|
L := TStringList.Create;
|
|
try
|
|
Engine.GetMapProviders(L);
|
|
L.Sort;
|
|
lstProviders.Assign(L);
|
|
finally
|
|
L.Free;
|
|
end;
|
|
// Engine.GetMapProviders(lstProviders);
|
|
end;
|
|
|
|
procedure TMapView.WaitEndOfRendering;
|
|
begin
|
|
Engine.Jobqueue.WaitAllJobTerminated(Engine);
|
|
end;
|
|
|
|
function TMapView.ObjsAtScreenPt(X, Y: Integer; ATolerance: Integer = -1): TGPSObjarray;
|
|
const
|
|
DELTA = 3;
|
|
var
|
|
rArea: TRealArea;
|
|
gpsList: TGPSObjList;
|
|
i, J: Integer;
|
|
L: TGPSObjectList;
|
|
begin
|
|
Result := nil;
|
|
|
|
if ATolerance = -1 then
|
|
ATolerance := DELTA;
|
|
|
|
// Define area of +/-ATolerance pixels around the screen point
|
|
rArea.TopLeft := ScreenToLonLat(Point(X-ATolerance, Y-ATolerance));
|
|
rArea.BottomRight := ScreenToLonLat(Point(X+ATolerance, Y+ATolerance));
|
|
|
|
// Collect Objects in this are
|
|
for J := 0 to 9 do
|
|
begin
|
|
gpsList := FGPSItems[J].GetObjectsInArea(rArea);
|
|
try
|
|
SetLength(Result, gpsList.Count);
|
|
for i := 0 to gpsList.Count-1 do
|
|
if gpsList[i] is TGPSPoint then
|
|
Result[i] := gpsList[i];
|
|
finally
|
|
gpsList.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TMapView.CenterOnObj(obj: TGPSObj);
|
|
var
|
|
Area: TRealArea;
|
|
Pt: TRealPoint;
|
|
begin
|
|
obj.GetArea(Area);
|
|
Pt.Lon := (Area.TopLeft.Lon + Area.BottomRight.Lon) /2;
|
|
Pt.Lat := (Area.TopLeft.Lat + Area.BottomRight.Lat) /2;
|
|
Center := Pt;
|
|
end;
|
|
|
|
procedure TMapView.ZoomOnObj(obj: TGPSObj);
|
|
var
|
|
Area: TRealArea;
|
|
begin
|
|
obj.GetArea(Area);
|
|
Engine.ZoomOnArea(Area);
|
|
end;
|
|
|
|
procedure TMapView.ZoomOnArea(const aArea: TRealArea);
|
|
begin
|
|
Engine.ZoomOnArea(aArea);
|
|
end;
|
|
|
|
procedure TMapView.Redraw;
|
|
begin
|
|
Invalidate;
|
|
end;
|
|
|
|
function TMapView.GetVisibleArea: TRealArea;
|
|
var
|
|
mapWidth: Int64;
|
|
begin
|
|
Result.TopLeft := Engine.ScreenToLonLat(Point(0, 0));
|
|
Result.BottomRight := Engine.ScreenToLonLat(Point(Width, Height));
|
|
if Cyclic then
|
|
begin
|
|
mapWidth := ZoomFactor(Engine.Zoom) * TILE_SIZE;
|
|
if Width >= mapWidth then
|
|
begin
|
|
Result.TopLeft.Lon := -180;
|
|
Result.BottomRight.Lon := 180;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TMapView.ClearBuffer;
|
|
begin
|
|
DrawingEngine.CreateBuffer(ClientWidth, ClientHeight); // ???
|
|
end;
|
|
|
|
procedure TMapView.UpdateFont(Sender: TObject);
|
|
begin
|
|
if SameText(FFont.Name, 'default') then
|
|
DrawingEngine.FontName := Screen.SystemFont.Name
|
|
else
|
|
DrawingEngine.FontName := FFont.Name;
|
|
if FFont.Size = 0 then
|
|
DrawingEngine.FontSize := Screen.SystemFont.Size
|
|
else
|
|
DrawingEngine.FontSize := FFont.Size;
|
|
DrawingEngine.FontStyle := FFont.Style;
|
|
DrawingEngine.FontColor := ColorToRGB(FFont.Color);
|
|
Engine.Redraw;
|
|
end;
|
|
|
|
procedure TMapView.UpdateImage(Sender: TObject);
|
|
begin
|
|
Engine.Redraw;
|
|
end;
|
|
|
|
function TMapView.CreateLayers: TMapLayers;
|
|
begin
|
|
Result := TMapLayers.Create(Self);
|
|
end;
|
|
|
|
procedure TMapView.UpdateLayers;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
for I := 0 to Pred(FLayers.Count) do
|
|
FLayers[I].FComboLayer.TileLayer.ParentViewChanged;
|
|
end;
|
|
|
|
procedure TMapView.ChangeCachePath(AOldLoc: TCacheLocation; ANewPath: String);
|
|
var
|
|
OldPath: String;
|
|
begin
|
|
OldPath := Engine.CachePath;
|
|
FCacheFullPath := ANewPath;
|
|
//ForceDirectories(ANewPath);
|
|
Engine.CachePath := ANewPath;
|
|
UpdateLayers;
|
|
if AOldLoc = clTemp then
|
|
DeleteDirectory(OldPath, False);
|
|
end;
|
|
|
|
class function TMapView.CacheDirectory(ALoc: TCacheLocation;
|
|
ACustomPath: String): String;
|
|
const
|
|
LazMVCacheFolder: String = '.lazmapcache/';
|
|
begin
|
|
case ALoc of
|
|
clProfile: Result := Concat(GetUserDir, LazMVCacheFolder);
|
|
clTemp: Result := Concat(GetTempDir(True), LazMVCacheFolder);
|
|
otherwise
|
|
Result := ACustomPath;
|
|
end;
|
|
end;
|
|
|
|
{ TGPSTileLayerBase }
|
|
|
|
function TGPSTileLayerBase.GetMapProvider: String;
|
|
begin
|
|
Result := FEngine.MapProvider;
|
|
end;
|
|
|
|
function TGPSTileLayerBase.GetUseThreads: Boolean;
|
|
begin
|
|
Result := FEngine.UseThreads;
|
|
end;
|
|
|
|
procedure TGPSTileLayerBase.SetParentView(AValue: TMapView);
|
|
begin
|
|
if (FParentView = AValue) and not FParentViewChanged then
|
|
Exit;
|
|
FEngine.Active := False;
|
|
FParentView := AValue;
|
|
if not Assigned(FParentView) then
|
|
Exit;
|
|
FEngine.DownloadEngine := FParentView.DownloadEngine;
|
|
FEngine.CacheItemClass := FParentView.Engine.CacheItemClass;
|
|
FEngine.CachePath := FParentView.Engine.CachePath;
|
|
FEngine.CacheOnDisk := FParentView.Engine.CacheOnDisk;
|
|
FEngine.CacheMaxAge := FParentView.Engine.CacheMaxAge;
|
|
FEngine.Cyclic := FParentView.Engine.Cyclic;
|
|
FEngine.CopyMapWindowFrom(FParentView.Engine);
|
|
FEngine.Active := True;
|
|
end;
|
|
|
|
procedure TGPSTileLayerBase.DoTileDownloaded(const TileId: TTileId);
|
|
begin
|
|
TileDownLoaded(TileId);
|
|
if Assigned(FParentView) then
|
|
FParentView.Redraw;
|
|
end;
|
|
|
|
procedure TGPSTileLayerBase.DoDrawTile(const TileId: TTileId; X, Y: Integer;
|
|
TileImg: TPictureCacheItem);
|
|
begin
|
|
DrawTile(TileId, X, Y, TileImg);
|
|
end;
|
|
|
|
procedure TGPSTileLayerBase.SetDrawMode(AValue: TItemDrawMode);
|
|
begin
|
|
if FDrawMode = AValue then Exit;
|
|
FDrawMode := AValue;
|
|
if Assigned(FParentView) then
|
|
FParentView.Redraw;
|
|
end;
|
|
|
|
procedure TGPSTileLayerBase.TileDownloaded(const TileId: TTileId);
|
|
begin
|
|
; // Intentionally empty
|
|
end;
|
|
|
|
procedure TGPSTileLayerBase.SetMapProvider(AValue: String);
|
|
begin
|
|
if AValue = FMapProvider then
|
|
Exit;
|
|
FMapProvider := AValue;
|
|
FEngine.MapProvider := FMapProvider;
|
|
end;
|
|
|
|
procedure TGPSTileLayerBase.SetOpacity(AValue: Single);
|
|
begin
|
|
if FOpacity = AValue then Exit;
|
|
FOpacity := AValue;
|
|
if Assigned(FParentView) then
|
|
FParentView.Redraw;
|
|
end;
|
|
|
|
procedure TGPSTileLayerBase.SetUseThreads(AValue: Boolean);
|
|
begin
|
|
FEngine.UseThreads := AValue;
|
|
end;
|
|
|
|
constructor TGPSTileLayerBase.Create;
|
|
begin
|
|
inherited;
|
|
FEngine := TMapViewerEngine.Create(Nil);
|
|
FMapProvider := FEngine.MapProvider;
|
|
FEngine.OnTileDownloaded := @DoTileDownloaded;
|
|
FEngine.OnDrawTile := @DoDrawTile;
|
|
end;
|
|
|
|
destructor TGPSTileLayerBase.Destroy;
|
|
begin
|
|
FEngine.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TGPSTileLayerBase.GetArea(out Area: TRealArea);
|
|
begin
|
|
if Assigned(FParentView)
|
|
then Area := FParentView.GetVisibleArea // Always over visible area
|
|
else Area.Init(-180.0, 90.0, 180.0, -90.0); // Worldwide
|
|
end;
|
|
|
|
procedure TGPSTileLayerBase.Draw(AView: TObject; Area: TRealArea);
|
|
begin
|
|
SetParentView(AView as TMapView);
|
|
FEngine.CopyMapWindowFrom(FParentView.Engine);
|
|
end;
|
|
|
|
procedure TGPSTileLayerBase.ParentViewChanged;
|
|
begin
|
|
FParentViewChanged := True;
|
|
end;
|
|
|
|
{ TGPSTileLayerLabels }
|
|
|
|
procedure TGPSTileLayerLabels.DrawTile(const TileId: TTileId; X, Y: Integer;
|
|
TileImg: TPictureCacheItem);
|
|
begin
|
|
; // Intentionally blank
|
|
end;
|
|
|
|
procedure TGPSTileLayerLabels.Draw(AView: TObject; Area: TRealArea);
|
|
var
|
|
V: TMapView;
|
|
PtTL, PtBR, Pt0, Pt: TPoint;
|
|
X, Y, Z, W, H: Integer;
|
|
S: String;
|
|
extent: TSize;
|
|
begin
|
|
inherited Draw(AView, Area);
|
|
V := FParentView;
|
|
PtTL := V.Engine.LonLatToWorldScreen(Area.TopLeft);
|
|
PtBR := V.Engine.LonLatToWorldScreen(Area.BottomRight);
|
|
X := -PtTL.X div TILE_SIZE;
|
|
Y := -PtTL.Y div TILE_SIZE;
|
|
Pt0 := Point(V.Engine.MapLeft + X * TILE_SIZE,
|
|
V.Engine.MapTop + Y * TILE_SIZE);
|
|
Pt := Pt0;
|
|
H := Y + (PtBR.Y - PtTL.Y) div TILE_SIZE;
|
|
while Y <= H do
|
|
begin
|
|
X := -PtTL.X div TILE_SIZE;
|
|
W := X + (PtBR.X - PtTL.X) div TILE_SIZE;
|
|
while X <= W do
|
|
begin
|
|
Z := V.Zoom;
|
|
V.DrawingEngine.BrushStyle := bsSolid;
|
|
V.DrawingEngine.BrushColor := clCream;
|
|
S := Format(' %d-%d-%d ', [X, Y, Z]);
|
|
extent := V.DrawingEngine.TextExtent(S);
|
|
V.DrawingEngine.TextOut(Pt.X + (TILE_SIZE - extent.CX) div 2,
|
|
Pt.Y + (TILE_SIZE - extent.CY) div 2, S);
|
|
Inc(Pt.X, TILE_SIZE);
|
|
Inc(X);
|
|
end;
|
|
Pt.X := Pt0.X;
|
|
Inc(Pt.Y, TILE_SIZE);
|
|
Inc(Y);
|
|
end;
|
|
end;
|
|
|
|
{ TGPSTileLayer }
|
|
|
|
procedure TGPSTileLayer.DrawTile(const TileId: TTileId; X, Y: Integer;
|
|
TileImg: TPictureCacheItem);
|
|
begin
|
|
if not Assigned(FParentView) or not Assigned(TileImg) then
|
|
Exit;
|
|
FParentView.DrawingEngine.DrawCacheItem(X, Y, TileImg, FDrawMode, FOpacity);
|
|
end;
|
|
|
|
procedure TGPSTileLayer.Draw(AView: TObject; Area: TRealArea);
|
|
begin
|
|
inherited Draw(AView, Area);
|
|
FEngine.Redraw;
|
|
end;
|
|
|
|
procedure TGPSTileLayer.TileDownloaded(const TileId: TTileId);
|
|
begin
|
|
FEngine.Redraw;
|
|
end;
|
|
|
|
end.
|
|
|