LazMapViewer: Add DebugTiles property to show tile boundaries.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6922 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2019-05-17 21:29:35 +00:00
parent 1aaebb2780
commit 6b3072435f
3 changed files with 66 additions and 5 deletions

View File

@@ -54,6 +54,7 @@ object MainForm: TMainForm
end
object CbUseThreads: TCheckBox
AnchorSideLeft.Control = LblProviders
AnchorSideTop.Control = CbDoubleBuffer
Left = 9
Height = 19
Top = 40
@@ -67,11 +68,14 @@ object MainForm: TMainForm
object CbDoubleBuffer: TCheckBox
AnchorSideLeft.Control = CbUseThreads
AnchorSideLeft.Side = asrBottom
Left = 95
AnchorSideTop.Control = CbProviders
AnchorSideTop.Side = asrBottom
Left = 87
Height = 19
Top = 40
Width = 87
BorderSpacing.Left = 24
BorderSpacing.Left = 16
BorderSpacing.Top = 8
BorderSpacing.Right = 9
Caption = 'DblBuffering'
Checked = True
@@ -621,6 +625,19 @@ object MainForm: TMainForm
OnClick = BtnLoadGPXFileClick
TabOrder = 14
end
object CbDebugTiles: TCheckBox
AnchorSideLeft.Control = CbDoubleBuffer
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = CbDoubleBuffer
Left = 190
Height = 19
Top = 40
Width = 55
BorderSpacing.Left = 16
Caption = 'Debug'
OnChange = CbDebugTilesChange
TabOrder = 15
end
end
object MapView: TMapView
Left = 0

View File

@@ -26,6 +26,7 @@ type
CbUseThreads: TCheckBox;
CbMouseCoords: TGroupBox;
CbDistanceUnits: TComboBox;
CbDebugTiles: TCheckBox;
GbCenterCoords: TGroupBox;
GbScreenSize: TGroupBox;
InfoCenterLatitude: TLabel;
@@ -57,6 +58,7 @@ type
procedure BtnSearchClick(Sender: TObject);
procedure BtnGPSPointsClick(Sender: TObject);
procedure BtnSaveToFileClick(Sender: TObject);
procedure CbDebugTilesChange(Sender: TObject);
procedure CbDoubleBufferChange(Sender: TObject);
procedure CbFoundLocationsDrawItem(Control: TWinControl; Index: Integer;
ARect: TRect; State: TOwnerDrawState);
@@ -217,6 +219,11 @@ begin
ShowMessage('Map saved to "mapview.png".');
end;
procedure TMainForm.CbDebugTilesChange(Sender: TObject);
begin
MapView.DebugTiles := CbDebugTiles.Checked;
end;
procedure TMainForm.CbDoubleBufferChange(Sender: TObject);
begin
MapView.DoubleBuffered := CbDoubleBuffer.Checked;

View File

@@ -60,6 +60,7 @@ Type
FInactiveColor: TColor;
FPOIImage: TBitmap;
FOnDrawGpsPoint: TDrawGpsPointEvent;
FDebugTiles: Boolean;
FDefaultTrackColor: TColor;
FDefaultTrackWidth: Integer;
procedure CallAsyncInvalidate;
@@ -81,6 +82,7 @@ Type
procedure SetCacheOnDisk(AValue: boolean);
procedure SetCachePath({%H-}AValue: String);
procedure SetCenter(AValue: TRealPoint);
procedure SetDebugTiles(AValue: Boolean);
procedure SetDefaultTrackColor(AValue: TColor);
procedure SetDefaultTrackWidth(AValue: Integer);
procedure SetDownloadEngine(AValue: TMvCustomDownloadEngine);
@@ -100,7 +102,8 @@ Type
out ACanvas: TFPCustomCanvas; AWidth, AHeight: Integer);
{$ENDIF}
procedure DblClick; override;
Procedure DoDrawTile(const TileId: TTileId; X,Y: integer; TileImg: TLazIntfImage);
procedure DoDrawTile(const TileId: TTileId; X,Y: integer; TileImg: TLazIntfImage);
procedure DoDrawTileInfo(const TileID: TTileID; X,Y: Integer);
function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
MousePos: TPoint): Boolean; override;
procedure DoOnResize; override;
@@ -136,6 +139,7 @@ Type
property Align;
property CacheOnDisk: boolean read GetCacheOnDisk write SetCacheOnDisk;
property CachePath: String read GetCachePath write SetCachePath;
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;
@@ -404,18 +408,25 @@ begin
Engine.Center := AValue;
end;
procedure TMapView.SetDebugTiles(AValue: Boolean);
begin
if FDebugTiles = AValue then exit;
FDebugTiles := AValue;
Engine.Redraw;
end;
procedure TMapView.SetDefaultTrackColor(AValue: TColor);
begin
if FDefaultTrackColor = AValue then exit;
FDefaultTrackColor := AValue;
Invalidate;
Engine.Redraw;
end;
procedure TMapView.SetDefaultTrackWidth(AValue: Integer);
begin
if FDefaultTrackWidth = AValue then exit;
FDefaultTrackWidth := AValue;
Invalidate;
Engine.Redraw;
end;
procedure TMapView.SetDownloadEngine(AValue: TMvCustomDownloadEngine);
@@ -766,9 +777,35 @@ begin
end;
{$ENDIF}
end;
if FDebugTiles then
DoDrawTileInfo(TileID, X, Y);
DrawObjects(TileId, X, Y, X + TILE_SIZE, Y + TILE_SIZE);
end;
procedure TMapView.DoDrawTileInfo(const TileID: TTileID; X, Y: Integer);
begin
{$IFDEF USE_LCL}
Buffer.Canvas.Pen.Color := clGray;
Buffer.Canvas.Pen.Style := psSolid;
Buffer.Canvas.Line(X, Y, X, Y + TILE_SIZE);
Buffer.Canvas.Line(X, Y, X + TILE_SIZE, Y);
Buffer.Canvas.Line(X + TILE_SIZE, Y, X + TILE_SIZE, Y + TILE_SIZE);
Buffer.Canvas.Line(X + TILE_SIZE, Y + TILE_SIZE, X, Y + TILE_SIZE);
{$ENDIF}
{$IFDEF USE_RGBGRAPHICS}
{$ENDIF}
{$IFDEF USE_LAZINTFIMAGE}
BufferCanvas.Pen.FPColor := colGray;
BufferCanvas.Pen.Style := psSolid;
BufferCanvas.Line(X, Y, X, Y + TILE_SIZE);
BufferCanvas.Line(X, Y, X + TILE_SIZE, Y);
BufferCanvas.Line(X + TILE_SIZE, Y, X + TILE_SIZE, Y + TILE_SIZE);
BufferCanvas.Line(X, Y + TILE_SIZE, X + TILE_SIZE, Y + TILE_SIZE);
{$ENDIF}
end;
function TMapView.IsActive: Boolean;
begin
if not(csDesigning in ComponentState) then