From afa88e870966b3b2770d3fcc255f90bb4d9c7369 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Sun, 11 Jun 2023 22:17:22 +0000 Subject: [PATCH] LazMapViewer: Avoid drawing artefacts when the mapview is dragged. Patch by Ekkehard Domning. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8830 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../lazmapviewer/examples/fulldemo/main.lfm | 24 +++++++-- .../lazmapviewer/examples/fulldemo/main.pas | 10 +++- components/lazmapviewer/source/mvengine.pas | 49 +++++++++++++++++-- .../lazmapviewer/source/mvmapviewer.pas | 17 ++++--- 4 files changed, 85 insertions(+), 15 deletions(-) diff --git a/components/lazmapviewer/examples/fulldemo/main.lfm b/components/lazmapviewer/examples/fulldemo/main.lfm index 095c67727..d973abea9 100644 --- a/components/lazmapviewer/examples/fulldemo/main.lfm +++ b/components/lazmapviewer/examples/fulldemo/main.lfm @@ -40,9 +40,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' @@ -834,6 +834,7 @@ object MainForm: TMainForm Width = 100 BorderSpacing.Left = 6 BorderSpacing.Top = 8 + BorderSpacing.Right = 24 Caption = 'Zoom to cursor' Checked = True OnChange = CbZoomToCursorChange @@ -848,13 +849,28 @@ object MainForm: TMainForm Height = 19 Top = 56 Width = 77 - BorderSpacing.Left = 24 Caption = 'Cyclic view' Checked = True OnChange = cbCyclicViewChange State = cbChecked TabOrder = 8 end + object ColorButton1: TColorButton + AnchorSideLeft.Control = cbCyclicView + AnchorSideTop.Control = CbUseThreads + AnchorSideTop.Side = asrCenter + Left = 130 + Height = 25 + Top = 78 + Width = 105 + BorderWidth = 2 + ButtonColorAutoSize = False + ButtonColorSize = 15 + ButtonColor = clWhite + Caption = 'Map backgr.' + Margin = 4 + OnColorChanged = ColorButton1ColorChanged + end end end object GeoNames: TMVGeoNames @@ -872,7 +888,7 @@ object MainForm: TMainForm MinFontSize = 0 MaxFontSize = 0 Left = 808 - Top = 104 + Top = 200 end object POIImages: TImageList Height = 48 diff --git a/components/lazmapviewer/examples/fulldemo/main.pas b/components/lazmapviewer/examples/fulldemo/main.pas index cc46b3278..0477ed09a 100644 --- a/components/lazmapviewer/examples/fulldemo/main.pas +++ b/components/lazmapviewer/examples/fulldemo/main.pas @@ -33,6 +33,7 @@ type cbPOITextBgColor: TColorBox; CbZoomToCursor: TCheckBox; cbCyclicView: TCheckBox; + ColorButton1: TColorButton; FontDialog: TFontDialog; GbCenterCoords: TGroupBox; GbScreenSize: TGroupBox; @@ -86,6 +87,7 @@ type procedure CbUseThreadsChange(Sender: TObject); procedure CbDistanceUnitsChange(Sender: TObject); procedure CbZoomToCursorChange(Sender: TObject); + procedure ColorButton1ColorChanged(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure FormShow(Sender: TObject); @@ -410,6 +412,11 @@ begin MapView.ZoomToCursor := CbZoomToCursor.Checked; end; +procedure TMainForm.ColorButton1ColorChanged(Sender: TObject); +begin + MapView.InactiveColor := ColorButton1.ButtonColor; +end; + procedure TMainForm.ClearFoundLocations; var i: Integer; @@ -732,6 +739,7 @@ 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); s := ini.ReadString('MapView', 'DistanceUnits', ''); if s <> '' then begin @@ -877,7 +885,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]); if HERE_AppID <> '' then diff --git a/components/lazmapviewer/source/mvengine.pas b/components/lazmapviewer/source/mvengine.pas index 401913f7d..daa26c41a 100644 --- a/components/lazmapviewer/source/mvengine.pas +++ b/components/lazmapviewer/source/mvengine.pas @@ -20,7 +20,7 @@ unit mvEngine; interface uses - Classes, SysUtils, IntfGraphics, Controls, Math, + Classes, SysUtils, IntfGraphics, Controls, Math, GraphType, FPImage, mvTypes, mvJobQueue, mvMapProvider, mvDownloadEngine, mvCache, mvDragObj; const @@ -59,9 +59,11 @@ type DragObj : TDragObj; Cache : TPictureCache; FActive: boolean; + FBkColor: TFPColor; FCyclic: Boolean; FDownloadEngine: TMvCustomDownloadEngine; FDrawTitleInGuiThread: boolean; + FEmptyTileImg: TLazIntfImage; FOnCenterMove: TNotifyEvent; FOnChange: TNotifyEvent; FOnDrawTile: TDrawTileEvent; @@ -81,6 +83,7 @@ type function IsValidTile(const aWin: TMapWindow; const aTile: TTIleId): boolean; procedure MoveMapCenter(Sender: TDragObj); procedure SetActive(AValue: boolean); + procedure SetBkColor(AValue: TFPColor); procedure SetCacheOnDisk(AValue: Boolean); procedure SetCachePath(AValue: String); procedure SetCenter(ACenter: TRealPoint); @@ -104,6 +107,7 @@ type function IsCurrentWin(const aWin: TMapWindow) : boolean; protected procedure AdjustZoomCenter(var AWin: TMapWindow); + function CreateBlankImg: TLazIntfImage; procedure ConstraintZoom(var aWin: TMapWindow); function GetTileName(const Id: TTileId): String; procedure evDownload(Data: TObject; Job: TJob); @@ -143,6 +147,7 @@ type WheelDelta: Integer; {%H-}MousePos: TPoint; var Handled: Boolean); procedure ZoomOnArea(const aArea: TRealArea); + property BkColor: TFPColor read FBkColor write SetBkColor; property Center: TRealPoint read GetCenter write SetCenter; published @@ -377,6 +382,8 @@ begin DragObj.OnDrag := @DoDrag; Cache := TPictureCache.Create(self); lstProvider := TStringList.Create; + FBkColor := colWhite; + FEmptyTileImg := CreateBlankImg; RegisterProviders; Queue := TJobQueue.Create(8); Queue.OnIdle := @Cache.CheckCacheSize; @@ -436,7 +443,7 @@ begin startY := -aWin.Y div TILE_SIZE; Result.Left := startX - 1; Result.Right := startX + MaxX; - Result.Top := startY; + Result.Top := startY - 1; Result.Bottom := startY + MaxY; end; @@ -485,6 +492,22 @@ begin end; end; +function TMapViewerEngine.CreateBlankImg: TLazIntfImage; +var + rawImg: TRawImage; +begin + rawImg.Init; + {$IFDEF DARWIN} + rawImg.Description.Init_BPP32_A8R8G8B8_BIO_TTB(TILE_SIZE, TILE_SIZE); + {$ELSE} + rawImg.Description.Init_BPP32_B8G8R8_BIO_TTB(TILE_SIZE, TILE_SIZE); + {$ENDIF} + rawImg.CreateData(True); + + Result := TLazIntfImage.Create(rawImg, true); + Result.FillPixels(FBkColor); +end; + { Returns true when the visible window crosses the date line, i.e. the longitudes at the left of the window are > 0, and those at the right are < 0. } function TMapViewerEngine.CrossesDateline: Boolean; @@ -1028,17 +1051,19 @@ begin Redraw(MapWin); end; -procedure TMapViewerEngine.Redraw(const AWin: TmapWindow); +procedure TMapViewerEngine.Redraw(const AWin: TMapWindow); var TilesVis: TArea; x, y : Integer; //int64; Tiles: TTileIdArray = nil; iTile: Integer; numTiles: Integer; + px, py: Integer; begin if not(Active) then Exit; Queue.CancelAllJob(self); + TilesVis := CalculateVisibleTiles(AWin); SetLength(Tiles, (TilesVis.Bottom - TilesVis.Top + 1) * (TilesVis.Right - TilesVis.Left + 1)); iTile := Low(Tiles); @@ -1055,6 +1080,16 @@ begin Tiles[iTile].X := X; Tiles[iTile].Y := Y; Tiles[iTile].Z := AWin.Zoom; + + // Avoid tiling artefacts when a tile does not exist (lowest zoom) or + // is not valid + if not Cache.InCache(AWin.MapProvider, Tiles[iTile]) then + begin + py := AWin.Y + Y * TILE_SIZE; + px := AWin.X + X * TILE_SIZE; + DrawTile(Tiles[iTile], px, py, FEmptyTileImg); + end; + if IsValidTile(AWin, Tiles[iTile]) then inc(iTile); end; @@ -1181,6 +1216,14 @@ begin end; end; +procedure TMapViewerEngine.SetBkColor(AValue: TFPColor); +begin + if FBkColor = AValue then Exit; + FBkColor := AValue; + FEmptyTileImg.FillPixels(FBkColor); + Redraw(MapWin); +end; + procedure TMapViewerEngine.SetCacheOnDisk(AValue: Boolean); begin if Cache.UseDisk = AValue then Exit; diff --git a/components/lazmapviewer/source/mvmapviewer.pas b/components/lazmapviewer/source/mvmapviewer.pas index b1eb3e1e4..027559dfd 100644 --- a/components/lazmapviewer/source/mvmapviewer.pas +++ b/components/lazmapviewer/source/mvmapviewer.pas @@ -22,7 +22,7 @@ unit mvMapViewer; interface uses - Classes, SysUtils, Controls, Graphics, IntfGraphics, Forms, ImgList, LCLVersion, + Classes, SysUtils, Controls, Graphics, FPImage, IntfGraphics, Forms, ImgList, LCLVersion, MvTypes, MvGPSObj, MvEngine, MvMapProvider, MvDownloadEngine, MvDrawingEngine; Type @@ -41,7 +41,6 @@ Type FDrawingEngine: TMvCustomDrawingEngine; FActive: boolean; FGPSItems: TGPSObjectList; - FInactiveColor: TColor; FPOIImage: TBitmap; FPOITextBgColor: TColor; FOnDrawGpsPoint: TDrawGpsPointEvent; @@ -63,6 +62,7 @@ Type function GetCyclic: Boolean; function GetDownloadEngine: TMvCustomDownloadEngine; function GetDrawingEngine: TMvCustomDrawingEngine; + function GetInactiveColor: TColor; function GetMapProvider: String; function GetOnCenterMove: TNotifyEvent; function GetOnChange: TNotifyEvent; @@ -150,7 +150,7 @@ Type property DrawingEngine: TMvCustomDrawingEngine read GetDrawingEngine write SetDrawingEngine; property Font: TFont read FFont write SetFont stored IsFontStored; property Height default 150; - property InactiveColor: TColor read FInactiveColor write SetInactiveColor default clWhite; + property InactiveColor: TColor read GetInactiveColor write SetInactiveColor default clWhite; property MapProvider: String read GetMapProvider write SetMapProvider; property POIImage: TBitmap read FPOIImage write SetPOIImage; property POIImages: TCustomImageList read FPOIImages write SetPOIImages; @@ -343,6 +343,11 @@ begin Result := FDrawingEngine; end; +function TMapView.GetInactiveColor: TColor; +begin + Result := FPColorToTColor(Engine.BkColor); +end; + function TMapView.GetMapProvider: String; begin result := Engine.MapProvider; @@ -457,9 +462,7 @@ end; procedure TMapView.SetInactiveColor(AValue: TColor); begin - if FInactiveColor = AValue then - exit; - FInactiveColor := AValue; + Engine.BkColor := TColorToFPColor(AValue); if not IsActive then Invalidate; end; @@ -866,7 +869,6 @@ begin FActive := false; FDefaultTrackColor := clRed; FDefaultTrackWidth := 1; - FInactiveColor := clWhite; FGPSItems := TGPSObjectList.Create; FGPSItems.OnModified := @OnGPSItemsModified; @@ -879,6 +881,7 @@ begin FBuiltinDownloadEngine.Name := 'BuiltInDLE'; FEngine := TMapViewerEngine.Create(self); + FEngine.BkColor := colWhite; FEngine.CachePath := 'cache/'; FEngine.CacheOnDisk := true; FEngine.OnDrawTile := @DoDrawTile;