diff --git a/components/lazmapviewer/examples/fulldemo/MapViewer_Demo.lpr b/components/lazmapviewer/examples/fulldemo/MapViewer_Demo.lpr index 81fbb649d..8579b1dda 100644 --- a/components/lazmapviewer/examples/fulldemo/MapViewer_Demo.lpr +++ b/components/lazmapviewer/examples/fulldemo/MapViewer_Demo.lpr @@ -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} diff --git a/components/lazmapviewer/examples/fulldemo/main.lfm b/components/lazmapviewer/examples/fulldemo/main.lfm index d973abea9..1c2ff4c82 100644 --- a/components/lazmapviewer/examples/fulldemo/main.lfm +++ b/components/lazmapviewer/examples/fulldemo/main.lfm @@ -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 diff --git a/components/lazmapviewer/examples/fulldemo/main.pas b/components/lazmapviewer/examples/fulldemo/main.pas index 0477ed09a..5ae6b689f 100644 --- a/components/lazmapviewer/examples/fulldemo/main.pas +++ b/components/lazmapviewer/examples/fulldemo/main.pas @@ -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 diff --git a/components/lazmapviewer/examples/fulldemo_with_addons/main.lfm b/components/lazmapviewer/examples/fulldemo_with_addons/main.lfm index aef6b3ef6..fceb8844d 100644 --- a/components/lazmapviewer/examples/fulldemo_with_addons/main.lfm +++ b/components/lazmapviewer/examples/fulldemo_with_addons/main.lfm @@ -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 diff --git a/components/lazmapviewer/examples/fulldemo_with_addons/main.pas b/components/lazmapviewer/examples/fulldemo_with_addons/main.pas index 583a325ab..0efc63cf2 100644 --- a/components/lazmapviewer/examples/fulldemo_with_addons/main.pas +++ b/components/lazmapviewer/examples/fulldemo_with_addons/main.pas @@ -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]); diff --git a/components/lazmapviewer/source/addons/bgra_drawingengine/mvde_bgra.pas b/components/lazmapviewer/source/addons/bgra_drawingengine/mvde_bgra.pas index 79fef95ba..ebb293597 100644 --- a/components/lazmapviewer/source/addons/bgra_drawingengine/mvde_bgra.pas +++ b/components/lazmapviewer/source/addons/bgra_drawingengine/mvde_bgra.pas @@ -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); diff --git a/components/lazmapviewer/source/addons/rgbgraphics_drawingengine/mvde_rgbgraphics.pas b/components/lazmapviewer/source/addons/rgbgraphics_drawingengine/mvde_rgbgraphics.pas index a597606c1..f09093dcc 100644 --- a/components/lazmapviewer/source/addons/rgbgraphics_drawingengine/mvde_rgbgraphics.pas +++ b/components/lazmapviewer/source/addons/rgbgraphics_drawingengine/mvde_rgbgraphics.pas @@ -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); diff --git a/components/lazmapviewer/source/mvcache.pas b/components/lazmapviewer/source/mvcache.pas index f26d0d8a1..71993a4d3 100644 --- a/components/lazmapviewer/source/mvcache.pas +++ b/components/lazmapviewer/source/mvcache.pas @@ -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 diff --git a/components/lazmapviewer/source/mvde_intfgraphics.pas b/components/lazmapviewer/source/mvde_intfgraphics.pas index 64545a355..ff50dae59 100644 --- a/components/lazmapviewer/source/mvde_intfgraphics.pas +++ b/components/lazmapviewer/source/mvde_intfgraphics.pas @@ -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 diff --git a/components/lazmapviewer/source/mvdrawingengine.pas b/components/lazmapviewer/source/mvdrawingengine.pas index ff873ef05..5542908b4 100644 --- a/components/lazmapviewer/source/mvdrawingengine.pas +++ b/components/lazmapviewer/source/mvdrawingengine.pas @@ -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; diff --git a/components/lazmapviewer/source/mvengine.pas b/components/lazmapviewer/source/mvengine.pas index 29ddcf9bb..4c6ca3f63 100644 --- a/components/lazmapviewer/source/mvengine.pas +++ b/components/lazmapviewer/source/mvengine.pas @@ -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 diff --git a/components/lazmapviewer/source/mvmapviewer.pas b/components/lazmapviewer/source/mvmapviewer.pas index 25fdf36c7..b6963bc27 100644 --- a/components/lazmapviewer/source/mvmapviewer.pas +++ b/components/lazmapviewer/source/mvmapviewer.pas @@ -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;