paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

LazMapViewer: Implement zoomed preview tiles. Patch by Ekkehard Domning. Adapt drawing engines and full demo projects.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8835 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz 2023-06-13 15:39:47 +00:00
parent d9eb6e9065
commit 875a3a826d
12 changed files with 300 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
components/lazmapviewer/examples/fulldemo/MapViewer_Demo.lpr
View File

@ -5,8 +5,8 @@ program MapViewer_Demo;
uses
{$IFDEF UNIX}cthreads,{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, printer4lazarus, Main, gpslistform, globals, gpsptform
{ you can add units after this };
Forms,
Main, gpslistform;
{$R *.res}

21
components/lazmapviewer/examples/fulldemo/main.lfm
View File

@ -855,13 +855,13 @@ object MainForm: TMainForm
State = cbChecked
TabOrder = 8
end
object ColorButton1: TColorButton
object clbBackColor: TColorButton
AnchorSideLeft.Control = cbCyclicView
AnchorSideTop.Control = CbUseThreads
AnchorSideTop.Control = CbDoubleBuffer
AnchorSideTop.Side = asrCenter
Left = 130
Height = 25
Top = 78
Top = 103
Width = 105
BorderWidth = 2
ButtonColorAutoSize = False
@ -869,7 +869,20 @@ object MainForm: TMainForm
ButtonColor = clWhite
Caption = 'Map backgr.'
Margin = 4
OnColorChanged = ColorButton1ColorChanged
OnColorChanged = clbBackColorColorChanged
end
object CbPreviewTiles: TCheckBox
AnchorSideLeft.Control = cbCyclicView
AnchorSideTop.Control = CbUseThreads
Left = 130
Height = 19
Top = 81
Width = 83
Caption = 'Preview tiles'
Checked = True
OnChange = CbPreviewTilesChange
State = cbChecked
TabOrder = 9
end
end
end

17
components/lazmapviewer/examples/fulldemo/main.pas
View File

@ -33,7 +33,8 @@ type
cbPOITextBgColor: TColorBox;
CbZoomToCursor: TCheckBox;
cbCyclicView: TCheckBox;
ColorButton1: TColorButton;
CbPreviewTiles: TCheckBox;
clbBackColor: TColorButton;
FontDialog: TFontDialog;
GbCenterCoords: TGroupBox;
GbScreenSize: TGroupBox;
@ -82,12 +83,13 @@ type
procedure CbFoundLocationsDrawItem(Control: TWinControl; Index: Integer;
ARect: TRect; State: TOwnerDrawState);
procedure cbPOITextBgColorChange(Sender: TObject);
procedure CbPreviewTilesChange(Sender: TObject);
procedure CbProvidersChange(Sender: TObject);
procedure CbShowPOIImageChange(Sender: TObject);
procedure CbUseThreadsChange(Sender: TObject);
procedure CbDistanceUnitsChange(Sender: TObject);
procedure CbZoomToCursorChange(Sender: TObject);
procedure ColorButton1ColorChanged(Sender: TObject);
procedure clbBackColorColorChanged(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormShow(Sender: TObject);
@ -381,6 +383,11 @@ begin
MapView.POITextBgColor := cbPOITextBgColor.Selected;
end;
procedure TMainForm.CbPreviewTilesChange(Sender: TObject);
begin
MapView.DrawPreviewTiles := CbPreviewTiles.Checked;
end;
procedure TMainForm.CbProvidersChange(Sender: TObject);
begin
MapView.MapProvider := CbProviders.Text;
@ -412,9 +419,9 @@ begin
MapView.ZoomToCursor := CbZoomToCursor.Checked;
end;
procedure TMainForm.ColorButton1ColorChanged(Sender: TObject);
procedure TMainForm.clbBackColorColorChanged(Sender: TObject);
begin
MapView.InactiveColor := ColorButton1.ButtonColor;
MapView.InactiveColor := clbBackColor.ButtonColor;
end;
procedure TMainForm.ClearFoundLocations;
@ -462,6 +469,7 @@ begin
CbUseThreads.Checked := MapView.UseThreads;
CbDoubleBuffer.Checked := MapView.DoubleBuffered;
CbPOITextBgColor.Selected := MapView.POITextBgColor;
ClbBackColor.ButtonColor := MapView.InactiveColor;
InfoPositionLongitude.Caption := '';
InfoPositionLatitude.Caption := '';
@ -740,6 +748,7 @@ begin
pt.Lat := StrToFloatDef(ini.ReadString('MapView', 'Center.Latitude', ''), 0.0, PointFormatSettings);
MapView.Center := pt;
MapView.InactiveColor := ini.ReadInteger('MapView', 'MapBkgrColor', MapView.InactiveColor);
clbBackColor.ButtonColor := MapView.InactiveColor;
s := ini.ReadString('MapView', 'DistanceUnits', '');
if s <> '' then begin

34
components/lazmapviewer/examples/fulldemo_with_addons/main.lfm
View File

@ -37,9 +37,9 @@ object MainForm: TMainForm
Height = 640
Top = 0
Width = 275
ActivePage = PgData
ActivePage = PgConfig
Align = alRight
TabIndex = 0
TabIndex = 1
TabOrder = 1
object PgData: TTabSheet
Caption = 'Data'
@ -875,6 +875,36 @@ object MainForm: TMainForm
State = cbChecked
TabOrder = 10
end
object CbPreviewTiles: TCheckBox
AnchorSideLeft.Control = CbCyclic
AnchorSideTop.Control = CbUseThreads
AnchorSideTop.Side = asrCenter
Left = 130
Height = 19
Top = 175
Width = 83
Caption = 'Preview tiles'
Checked = True
OnChange = CbPreviewTilesChange
State = cbChecked
TabOrder = 11
end
object clbBackColor: TColorButton
AnchorSideLeft.Control = CbPreviewTiles
AnchorSideTop.Control = CbDoubleBuffer
AnchorSideTop.Side = asrCenter
Left = 130
Height = 25
Top = 197
Width = 105
BorderWidth = 2
ButtonColorAutoSize = False
ButtonColorSize = 15
ButtonColor = clWhite
Caption = 'Map backgr.'
Margin = 4
OnColorChanged = clbBackColorColorChanged
end
end
end
object GeoNames: TMVGeoNames

18
components/lazmapviewer/examples/fulldemo_with_addons/main.pas
View File

@ -36,6 +36,8 @@ type
cbPOITextBgColor: TColorBox;
CbZoomToCursor: TCheckBox;
CbCyclic: TCheckBox;
CbPreviewTiles: TCheckBox;
clbBackColor: TColorButton;
FontDialog: TFontDialog;
GbCenterCoords: TGroupBox;
GbScreenSize: TGroupBox;
@ -83,12 +85,14 @@ type
procedure CbFoundLocationsDrawItem(Control: TWinControl; Index: Integer;
ARect: TRect; State: TOwnerDrawState);
procedure cbPOITextBgColorChange(Sender: TObject);
procedure CbPreviewTilesChange(Sender: TObject);
procedure CbProvidersChange(Sender: TObject);
procedure CbShowPOIImageChange(Sender: TObject);
procedure CbUseThreadsChange(Sender: TObject);
procedure CbDistanceUnitsChange(Sender: TObject);
procedure CbZoomToCursorChange(Sender: TObject);
procedure CbCyclicChange(Sender: TObject);
procedure clbBackColorColorChanged(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormShow(Sender: TObject);
@ -346,6 +350,11 @@ begin
MapView.POITextBgColor := cbPOITextBgColor.Selected;
end;
procedure TMainForm.CbPreviewTilesChange(Sender: TObject);
begin
MapView.DrawPreviewTiles := CbPreviewTiles.Checked;
end;
procedure TMainForm.CbProvidersChange(Sender: TObject);
begin
MapView.MapProvider := CbProviders.Text;
@ -380,6 +389,11 @@ begin
MapView.Cyclic := CbCyclic.Checked;
end;
procedure TMainForm.clbBackColorColorChanged(Sender: TObject);
begin
MapView.InactiveColor := clbBackColor.ButtonColor;
end;
procedure TMainForm.ClearFoundLocations;
var
i: Integer;
@ -420,6 +434,7 @@ begin
CbUseThreads.Checked := MapView.UseThreads;
CbDoubleBuffer.Checked := MapView.DoubleBuffered;
CbPOITextBgColor.Selected := MapView.POITextBgColor;
clbBackColor.ButtonColor := MapView.InactiveColor;
InfoPositionLongitude.Caption := '';
InfoPositionLatitude.Caption := '';
@ -610,6 +625,8 @@ begin
pt.Lon := StrToFloatDef(ini.ReadString('MapView', 'Center.Longitude', ''), 0.0, PointFormatSettings);
pt.Lat := StrToFloatDef(ini.ReadString('MapView', 'Center.Latitude', ''), 0.0, PointFormatSettings);
MapView.Center := pt;
MapView.InactiveColor := ini.ReadInteger('MapView', 'MapBkgrColor', MapView.InactiveColor);
clbBackColor.ButtonColor := MapView.InactiveColor;
s := ini.ReadString('MapView', 'DistanceUnits', '');
if s <> '' then begin
@ -737,6 +754,7 @@ begin
ini.WriteInteger('MapView', 'Zoom', MapView.Zoom);
ini.WriteString('MapView', 'Center.Longitude', FloatToStr(MapView.Center.Lon, PointFormatSettings));
ini.WriteString('MapView', 'Center.Latitude', FloatToStr(MapView.Center.Lat, PointFormatSettings));
ini.WriteInteger('MapView', 'MapBkgrColor', MapView.InactiveColor);
ini.WriteString('MapView', 'DistanceUnits', DistanceUnit_Names[DistanceUnit]);

24
components/lazmapviewer/source/addons/bgra_drawingengine/mvde_bgra.pas
View File

@ -57,6 +57,7 @@ type
procedure DrawBitmap(X, Y: Integer; ABitmap: TCustomBitmap;
UseAlphaChannel: Boolean); override;
procedure DrawLazIntfImage(X, Y: Integer; AImg: TLazIntfImage); override;
procedure DrawScaledLazIntfImage(DestRect, SrcRect: TRect; ASrcImg: TLazIntfImage); override;
procedure Ellipse(X1, Y1, X2, Y2: Integer); override;
procedure FillPixels(X1, Y1, X2, Y2: Integer; AColor: TColor); override;
procedure FillRect(X1, Y1, X2, Y2: Integer); override;
@ -138,6 +139,29 @@ begin
end;
end;
procedure TMvBGRADrawingEngine.DrawScaledLazIntfImage(
DestRect, SrcRect: TRect; ASrcImg: TLazIntfImage);
var
srcBmp: TBGRABitmap;
x, y, w, h: Integer;
c: TFPColor;
begin
w := SrcRect.Right - SrcRect.Left;
h := SrcRect.Bottom - SrcRect.Top;
srcBmp := TBGRABitmap.Create(w, h, clWhite);
try
for y := 0 to h-1 do
for x := 0 to w-1 do
begin
c := ASrcImg.Colors[SrcRect.Left + x, SrcRect.Top + y];
srcBmp.DrawPixel(x, y, FPColorToTColor(c));
end;
FBuffer.CanvasBGRA.StretchDraw(DestRect, srcBmp);
finally
srcBmp.Free;
end;
end;
procedure TMvBGRADrawingEngine.Ellipse(X1, Y1, X2, Y2: Integer);
begin
FBuffer.CanvasBGRA.Ellipse(X1, Y1, X2, Y2);

32
components/lazmapviewer/source/addons/rgbgraphics_drawingengine/mvde_rgbgraphics.pas
View File

@ -19,7 +19,7 @@ interface
uses
Classes, SysUtils, Types, Graphics, IntfGraphics,
mvDrawingEngine,
rgbGraphics;
rgbGraphics, rgbTypes;
type
@ -57,6 +57,7 @@ type
procedure DrawBitmap(X, Y: Integer; ABitmap: TCustomBitmap;
UseAlphaChannel: Boolean); override;
procedure DrawLazIntfImage(X, Y: Integer; AImg: TLazIntfImage); override;
procedure DrawScaledLazIntfImage(DestRect, SrcRect: TRect; ASrcImg: TLazIntfImage); override;
procedure Ellipse(X1, Y1, X2, Y2: Integer); override;
procedure FillPixels(X1, Y1, X2, Y2: Integer; AColor: TColor); override;
procedure FillRect(X1, Y1, X2, Y2: Integer); override;
@ -135,9 +136,10 @@ begin
{$IFDEF DARWIN}
rawImg.Description.Init_BPP32_A8R8G8B8_BIO_TTB(FBuffer.Width, FBuffer.Height);
{$ELSE}
rawImg.Description.Init_BPP32_B8G8R8_BIO_TTB(FBuffer.Width, FBuffer.Height);
// rawImg.Description.Init_BPP32_B8G8R8_BIO_TTB(FBuffer.Width, FBuffer.Height); // wp: why twice: here ...
// {$ENDIF}
rawImg.Description.Init_BPP32_B8G8R8A8_BIO_TTB(FBuffer.Width, FBuffer.Height); // ... and here again ???
{$ENDIF}
rawImg.Description.Init_BPP32_B8G8R8A8_BIO_TTB(FBuffer.Width, FBuffer.Height);
rawImg.Data := FBuffer.Pixels;
intfImg := TLazIntfImage.Create(rawImg, false);
try
@ -148,6 +150,30 @@ begin
end;
end;
procedure TMvRGBGraphicsDrawingEngine.DrawScaledLazIntfImage(
DestRect, SrcRect: TRect; ASrcImg: TLazIntfImage);
var
srcBmp: TRGB32Bitmap;
x, y, w, h: Integer;
c: TFPColor;
begin
w := SrcRect.Right - SrcRect.Left;
h := SrcRect.Bottom - SrcRect.Top;
srcBmp := TRGB32Bitmap.Create(w, h);
try
for y := 0 to h-1 do
for x := 0 to w-1 do
begin
c := ASrcImg.Colors[SrcRect.Left + x, SrcRect.Top + y];
srcBmp.Set32Pixel(x, y, ColorToRGB32Pixel(FPColorToTColor(c)));
end;
srcBmp.StretchTrunc(DestRect.Right - DestRect.Left, DestRect.Bottom - DestRect.Top);
FBuffer.Draw(DestRect.Left, DestRect.Top, srcBmp);
finally
srcBmp.Free;
end;
end;
procedure TMvRGBGraphicsDrawingEngine.Ellipse(X1, Y1, X2, Y2: Integer);
begin
FBuffer.Canvas.Ellipse(X1, Y1, X2, Y2);

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

@ -48,6 +48,7 @@ Type
destructor Destroy; override;
Procedure Add(MapProvider: TMapProvider; const TileId: TTileId; Stream: TMemoryStream);
Procedure GetFromCache(MapProvider: TMapProvider; const TileId: TTileId; out img: TLazIntfImage);
function GetPreviewFromCache(MapProvider: TMapProvider; var TileId: TTileId; out ARect: TRect): boolean;
function InCache(MapProvider: TMapProvider; const TileId: TTileId): Boolean;
property UseDisk: Boolean read FUseDisk write FUseDisk;
@ -347,6 +348,64 @@ begin
end;
end;
{ When TileId is not yet in the cache, the function decreases zoom level and
returns the TileID of a tile which already is in the cache, and in ARect
the rectangle coordinates to get an upscaled preview of the originally
requested tile. The function returns true in this case.
If the requested tile already is in the cache, or no containing tile is found
the function returns false indicating that not preview image must be
generated. }
function TPictureCache.GetPreviewFromCache(MapProvider: TMapProvider;
var TileId: TTileId; out ARect: TRect): boolean;
var
ltid: TTileId;
xfrac, yfrac: Double;
lDeltaZoom: Integer;
w, px, py: Integer;
begin
Result := false;
ARect := Rect(0, 0, 0, 0);
if (TileId.Z < 0) or
(TileId.X < 0) or
(TileId.Y < 0) then exit;
if InCache(MapProvider, TileID) then
exit;
if TileId.Z <= 0 then
exit; // The whole earth as a preview, is simply the earth
// The "preview" is the part of the containing tile that covers the location of the wanted tile
// Every decrement of Zoom reduces the tile area by 4 (half of x and y direction)
// So incrementing Z and dividing X and Y in the Id will lead us to the containing tile
// The fraction of the division points to the location of the preview
// e.g 0.5 = right or lower half of the tile, when divided by 2
ltid := TileId;
lDeltaZoom := 1;
w := TILE_SIZE;
repeat
w := w shr 1;
dec(ltid.Z);
lDeltaZoom := lDeltaZoom shl 1;
xfrac := TileId.X / lDeltaZoom; // xfrac, yfrac contains the tile number
yfrac := TileId.Y / lDeltaZoom;
ltid.X := Trunc(xfrac);
ltid.Y := Trunc(yfrac);
if InCache(MapProvider, ltid) then
begin // We found a tile in the cache that contains the preview
xfrac := xfrac - ltid.X; //xfrac and yfrac calculated for the position in the tile from the cache
yfrac := yfrac - ltid.Y;
px := Trunc(xfrac * TILE_SIZE); //x and y are the percentage of the tile width
py := Trunc(yfrac * TILE_SIZE);
ARect := Rect(px, py, px+w, py+w);
TileID := ltid;
Result := true;
exit;
end;
until (w <= 1) or (ltid.Z <= 0);
end;
function TPictureCache.InCache(MapProvider: TMapProvider;
const TileId: TTileId): Boolean;
var

36
components/lazmapviewer/source/mvde_intfgraphics.pas
View File

@ -17,7 +17,7 @@ interface
uses
Classes, SysUtils, Graphics, Types, LclVersion,
FPImage, FPCanvas, IntfGraphics,
FPImage, FPCanvas, IntfGraphics, LazCanvas,
mvDrawingEngine;
type
@ -54,6 +54,7 @@ type
procedure DrawBitmap(X, Y: Integer; ABitmap: TCustomBitmap;
UseAlphaChannel: Boolean); override;
procedure DrawLazIntfImage(X, Y: Integer; AImg: TLazIntfImage); override;
procedure DrawScaledLazIntfImage(DestRect, SrcRect: TRect; ASrcImg: TLazIntfImage); override;
procedure Ellipse(X1, Y1, X2, Y2: Integer); override;
procedure FillPixels(X1, Y1, X2, Y2: Integer; AColor: TColor); override;
procedure FillRect(X1, Y1, X2, Y2: Integer); override;
@ -223,6 +224,39 @@ begin
{$IFEND}
end;
{ Scales the rectangle SrcRect of the specified source image (ASrcImg) such
that it fits into the rectangle DestRect of the Buffer image. }
procedure TMvIntfGraphicsDrawingEngine.DrawScaledLazIntfImage(
DestRect, SrcRect: TRect; ASrcImg: TLazIntfImage);
var
img: TLazIntfImage;
w, h, x, y: Integer;
begin
if FCanvas = nil then
exit;
w := SrcRect.Right - SrcRect.Left;
h := SrcRect.Bottom - SrcRect.Top;
img := TLazIntfImage.Create(0, 0);
try
img.DataDescription := ASrcImg.DataDescription;
img.SetSize(w, h);
for y := 0 to h-1 do
for x := 0 to w-1 do
img.Colors[x, y] := ASrcImg.Colors[SrcRect.Left + x, SrcRect.Top + y];;
FCanvas.Interpolation := TFPSharpInterpolation.Create;
try
FCanvas.StretchDraw(DestRect.Left, DestRect.Top, DestRect.Width, DestRect.Height, img);
finally
FCanvas.Interpolation.Free;
FCanvas.Interpolation := nil;
end;
finally
img.Free;
end;
end;
procedure TMvIntfGraphicsDrawingEngine.Ellipse(X1, Y1, X2, Y2: Integer);
begin
if FCanvas <> nil then

1
components/lazmapviewer/source/mvdrawingengine.pas
View File

@ -43,6 +43,7 @@ type
procedure DrawBitmap(X, Y: Integer; ABitmap: TCustomBitmap;
UseAlphaChannel: Boolean); virtual; abstract;
procedure DrawLazIntfImage(X, Y: Integer; AImg: TLazIntfImage); virtual; abstract;
procedure DrawScaledLazIntfImage(DestRect, SrcRect: TRect; AImg: TLazIntfImage); virtual; abstract;
procedure Ellipse(X1, Y1, X2, Y2: Integer); virtual; abstract;
procedure FillPixels(X1, Y1, X2, Y2: Integer; AColor: TColor); virtual; abstract;
procedure FillRect(X1, Y1, X2, Y2: Integer); virtual; abstract;

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

@ -30,9 +30,12 @@ const
EARTH_ECCENTRICITY = sqrt(1 - sqr(EARTH_POLAR_RADIUS / EARTH_EQUATORIAL_RADIUS));
type
TDrawTileEvent = Procedure (const TileId: TTileId; X,Y: integer;
TDrawTileEvent = procedure (const TileId: TTileId; X,Y: integer;
TileImg: TLazIntfImage) of object;
TDrawStretchedTileEvent = procedure (const TileId: TTileId; X,Y: Integer;
TileImg: TLazIntfImage; const R: TRect) of object;
TTileIdArray = Array of TTileId;
TDistanceUnits = (duMeters, duKilometers, duMiles);
@ -62,10 +65,12 @@ type
FBkColor: TFPColor;
FCyclic: Boolean;
FDownloadEngine: TMvCustomDownloadEngine;
FDrawPreviewTiles: Boolean;
FDrawTitleInGuiThread: boolean;
FOnCenterMove: TNotifyEvent;
FOnChange: TNotifyEvent;
FOnDrawTile: TDrawTileEvent;
FOnDrawStretchedTile: TDrawStretchedTileEvent;
FOnZoomChange: TNotifyEvent;
lstProvider : TStringList;
Queue : TJobQueue;
@ -110,6 +115,7 @@ type
function GetTileName(const Id: TTileId): String;
procedure evDownload(Data: TObject; Job: TJob);
procedure TileDownloaded(Data: PtrInt);
procedure DrawStretchedTile(const TileId: TTileID; X, Y: Integer; TileImg: TLazIntfImage; const R: TRect);
Procedure DrawTile(const TileId: TTileId; X,Y: integer; TileImg: TLazIntfImage);
Procedure DoDrag(Sender: TDragObj);
public
@ -147,6 +153,7 @@ type
property BkColor: TFPColor read FBkColor write SetBkColor;
property Center: TRealPoint read GetCenter write SetCenter;
property DrawPreviewTiles : Boolean read FDrawPreviewTiles write FDrawPreviewTiles;
published
property Active: Boolean read FActive write SetActive default false;
@ -167,6 +174,7 @@ type
property OnCenterMove: TNotifyEvent read FOnCenterMove write FOnCenterMove;
property OnChange: TNotifyEvent Read FOnChange write FOnchange; //called when visiable area change
property OnDrawStretchedTile: TDrawStretchedTileEvent read FOnDrawStretchedTile write FOnDrawStretchedTile;
property OnDrawTile: TDrawTileEvent read FOnDrawTile write FOnDrawTile;
property OnZoomChange: TNotifyEvent read FOnZoomChange write FOnZoomChange;
end;
@ -376,6 +384,7 @@ end;
constructor TMapViewerEngine.Create(aOwner: TComponent);
begin
DrawTitleInGuiThread := true;
DrawPreviewTiles := true;
DragObj := TDragObj.Create;
DragObj.OnDrag := @DoDrag;
Cache := TPictureCache.Create(self);
@ -522,6 +531,13 @@ begin
MoveMapCenter(Sender);
end;
procedure TMapViewerEngine.DrawStretchedTile(const TileID: TTileID; X, Y: Integer;
TileImg: TLazIntfImage; const R: TRect);
begin
if Assigned(FOnDrawStretchedTile) then
FOnDrawStretchedTile(TileId, X, Y, TileImg, R);
end;
procedure TMapViewerEngine.DrawTile(const TileId: TTileId; X, Y: integer;
TileImg: TLazIntfImage);
begin
@ -1038,8 +1054,12 @@ var
x, y : Integer; //int64;
Tiles: TTileIdArray = nil;
iTile: Integer;
tile: TTileID;
numTiles: Integer;
px, py: Integer;
previewDrawn: Boolean;
previewImg: TLazIntfImage;
R: TRect;
begin
if not(Active) then
Exit;
@ -1066,9 +1086,24 @@ begin
// is not valid
if not Cache.InCache(AWin.MapProvider, Tiles[iTile]) then
begin
previewdrawn := False;
py := AWin.Y + Y * TILE_SIZE;
px := AWin.X + X * TILE_SIZE;
DrawTile(Tiles[iTile], px, py, nil);
if FDrawPreviewTiles then
begin
if IsValidTile(AWin, Tiles[iTile]) then // Invalid tiles probably will not be found in the cache
begin
tile := Tiles[iTile];
if Cache.GetPreviewFromCache(AWin.MapProvider, tile, R) then
begin
Cache.GetFromCache(AWin.MapProvider, tile, previewImg);
DrawStretchedTile(Tiles[iTile], px, py, previewImg, R);
previewDrawn := true;
end;
end;
end;
if not previewDrawn then
DrawTile(Tiles[iTile], px, py, nil); // Draw blank tile if preview cannot be generated
end;
if IsValidTile(AWin, Tiles[iTile]) then

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

@ -39,6 +39,7 @@ Type
FEngine: TMapViewerEngine;
FBuiltinDrawingEngine: TMvCustomDrawingEngine;
FDrawingEngine: TMvCustomDrawingEngine;
FDrawPreviewTiles: boolean;
FActive: boolean;
FGPSItems: TGPSObjectList;
FPOIImage: TBitmap;
@ -62,6 +63,7 @@ Type
function GetCyclic: Boolean;
function GetDownloadEngine: TMvCustomDownloadEngine;
function GetDrawingEngine: TMvCustomDrawingEngine;
function GetDrawPreviewTiles: Boolean;
function GetInactiveColor: TColor;
function GetMapProvider: String;
function GetOnCenterMove: TNotifyEvent;
@ -82,6 +84,7 @@ Type
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 SetMapProvider(AValue: String);
@ -102,6 +105,7 @@ Type
AsyncInvalidate : boolean;
procedure ActivateEngine;
procedure DblClick; override;
procedure DoDrawStretchedTile(const TileId: TTileID; X, Y: Integer; TileImg: TLazIntfImage; const R: TRect);
procedure DoDrawTile(const TileId: TTileId; X,Y: integer; TileImg: TLazIntfImage);
procedure DoDrawTileInfo(const {%H-}TileID: TTileID; X,Y: Integer);
function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
@ -148,6 +152,7 @@ Type
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 Font: TFont read FFont write SetFont stored IsFontStored;
property Height default 150;
property InactiveColor: TColor read GetInactiveColor write SetInactiveColor default clWhite;
@ -343,6 +348,11 @@ begin
Result := FDrawingEngine;
end;
function TMapView.GetDrawPreviewTiles: Boolean;
begin
Result := Engine.DrawPreviewTiles;
end;
function TMapView.GetInactiveColor: TColor;
begin
Result := FPColorToTColor(Engine.BkColor);
@ -454,6 +464,11 @@ begin
UpdateFont(nil);
end;
procedure TMapView.SetDrawPreviewTiles(AValue: Boolean);
begin
Engine.DrawPreviewTiles := AValue;
end;
procedure TMapView.SetFont(AValue: TFont);
begin
FFont.Assign(AValue);
@ -824,21 +839,28 @@ Begin
AsyncInvalidate := false;
end;
procedure TMapView.DoDrawStretchedTile(const TileId: TTileId; X, Y: Integer;
TileImg: TLazIntfImage; const R: TRect);
begin
if Assigned(TileImg) then
DrawingEngine.DrawScaledLazIntfImage(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);
DrawObjects(TileId, X, Y, X + TILE_SIZE, Y + TILE_SIZE);
end;
procedure TMapView.DoDrawTile(const TileId: TTileId; X, Y: integer;
TileImg: TLazIntfImage);
begin
if Assigned(TileImg) then begin
DrawingEngine.DrawLazIntfImage(X, Y, TileImg);
end
if Assigned(TileImg) then
DrawingEngine.DrawLazIntfImage(X, Y, TileImg)
else
DrawingEngine.FillPixels(X, Y, X + TILE_SIZE, Y + TILE_SIZE, InactiveColor);
{
DrawingEngine.BrushColor := InactiveColor;
DrawingEngine.BrushStyle := bsSolid;
DrawingEngine.FillRect(X, Y, X + TILE_SIZE, Y + TILE_SIZE);
end;
}
if FDebugTiles then
DoDrawTileInfo(TileID, X, Y);
@ -888,6 +910,8 @@ begin
FEngine.CachePath := 'cache/';
FEngine.CacheOnDisk := true;
FEngine.OnDrawTile := @DoDrawTile;
FEngine.OnDrawStretchedTile := @DoDrawStretchedTile;
FEngine.DrawPreviewTiles := True;
FEngine.DrawTitleInGuiThread := false;
FEngine.DownloadEngine := FBuiltinDownloadEngine;
FEngine.ZoomToCursor := True;