lazmapviewer: Improved drawing code. Extend both fulldemo projects by map layers. Patch by Yuliyan Ivanov. Issue #39063.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9150 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz 2024-01-18 12:11:41 +00:00
parent 68988c40ab
commit 3750b0a3d7
7 changed files with 1207 additions and 632 deletions

File diff suppressed because it is too large Load Diff

View File

@ -7,7 +7,7 @@ interface
uses
Classes, SysUtils, Types, Forms, Controls, Graphics, Dialogs, ExtCtrls,
StdCtrls, ComCtrls, Buttons, IntfGraphics, ColorBox, Spin, PrintersDlgs,
mvGeoNames, mvMapViewer, mvTypes, mvGpsObj, mvDrawingEngine;
mvGeoNames, mvMapViewer, mvTypes, mvGpsObj, mvDrawingEngine, Grids;
type
@ -81,6 +81,10 @@ type
PrintDialog1: TPrintDialog;
rgPOIMode: TRadioGroup;
seProxyPort: TSpinEdit;
sgLayers: TStringGrid;
rgDrawMode: TRadioGroup;
lblOpacity: TLabel;
tbOpacity: TTrackBar;
ZoomTrackBar: TTrackBar;
procedure BtnGoToClick(Sender: TObject);
procedure BtnLoadGPXFileClick(Sender: TObject);
@ -118,7 +122,14 @@ type
procedure MapViewZoomChange(Sender: TObject);
procedure BtnLoadMapProvidersClick(Sender: TObject);
procedure BtnSaveMapProvidersClick(Sender: TObject);
procedure rgDrawModeSelectionChanged(Sender: TObject);
procedure rgPOIModeClick(Sender: TObject);
procedure sgLayersCheckboxToggled(sender: TObject; aCol, aRow: Integer;
aState: TCheckboxState);
procedure sgLayersEditingDone(Sender: TObject);
procedure sgLayersSelection(Sender: TObject; aCol, aRow: Integer);
procedure tbOpacityChange(Sender: TObject);
procedure UpdateLayers;
procedure ZoomTrackBarChange(Sender: TObject);
private
@ -160,9 +171,11 @@ const
MAX_LOCATIONS_HISTORY = 50;
MAP_PROVIDER_FILENAME = 'map-providers.xml';
USE_DMS = true;
_TILELAYERS_ID_ = 42;
var
PointFormatSettings: TFormatsettings;
TileLayer: array[0..9] of TGPSTileLayer;
function CalcIniName: String;
begin
@ -183,6 +196,7 @@ begin
MapView.GetMapProviders(CbProviders.Items);
CbProviders.ItemIndex := 0;
MapView.MapProvider := CbProviders.Text;
sgLayers.Columns[1].PickList.Assign(CbProviders.Items);
end else
ShowMessage(msg);
end;
@ -193,6 +207,12 @@ begin
MapView.Engine.WriteProvidersToXML(Application.Location + MAP_PROVIDER_FILENAME);
end;
procedure TMainForm.rgDrawModeSelectionChanged(Sender: TObject);
begin
TileLayer[Pred(sgLayers.Row)].DrawMode := TItemDrawMode(rgDrawMode.ItemIndex);
MapView.Redraw;
end;
procedure TMainForm.BtnSearchClick(Sender: TObject);
begin
ClearFoundLocations;
@ -349,11 +369,13 @@ end;
procedure TMainForm.cbCyclicViewChange(Sender: TObject);
begin
MapView.Cyclic := cbCyclicView.Checked;
UpdateLayers;
end;
procedure TMainForm.CbDebugTilesChange(Sender: TObject);
begin
MapView.DebugTiles := CbDebugTiles.Checked;
MapView.Invalidate;
end;
procedure TMainForm.CbDoubleBufferChange(Sender: TObject);
@ -423,6 +445,7 @@ end;
procedure TMainForm.CbUseThreadsChange(Sender: TObject);
begin
MapView.UseThreads := CbUseThreads.Checked;
UpdateLayers;
end;
procedure TMainForm.CbDistanceUnitsChange(Sender: TObject);
@ -458,6 +481,7 @@ var
homeDir: String;
cacheDir: String;
fn: String;
I: Integer;
begin
cInputQueryEditSizePercents := 0;
@ -483,6 +507,7 @@ begin
MapView.CachePath := cacheDir;
MapView.GetMapProviders(CbProviders.Items);
CbProviders.ItemIndex := CbProviders.Items.IndexOf(MapView.MapProvider);
sgLayers.Columns[1].PickList.Assign(CbProviders.Items);
MapView.DoubleBuffered := true;
MapView.Zoom := 1;
CbZoomToCursor.Checked := MapView.ZoomToCursor;
@ -499,12 +524,38 @@ begin
InfoViewportHeight.Caption := '';
GPSPointInfo.caption := '';
for I := 0 to High(TileLayer) do
begin
TileLayer[I] := TGPSTileLayer.Create;
with TileLayer[I] do
begin
Visible := False;
UseThreads := MapView.UseThreads;
DrawMode := idmUseOpacity;
Opacity := 0.25;
case I of
0: MapProvider := 'Google Satellite Only';
1: MapProvider := 'Google Terrain';
2: MapProvider := 'Maps For Free';
otherwise
MapProvider := '';
end;
end;
sgLayers.Cells[1, I + 1] := TileLayer[I].Visible.ToString;
sgLayers.Cells[2, I + 1] := TileLayer[I].MapProvider;
MapView.GPSLayer[I].Add(TileLayer[I], _TILELAYERS_ID_);
end;
ReadFromIni;
end;
procedure TMainForm.FormDestroy(Sender: TObject);
var
I: Integer;
begin
WriteToIni;
for I := 0 to High(TileLayer) do
MapView.GPSLayer[I].Delete(TileLayer[I]);
ClearFoundLocations;
FreeAndNil(POIImage)
end;
@ -742,6 +793,7 @@ begin
MapView.Engine.ClearMapProviders;
MapView.Engine.RegisterProviders;
MapView.GetMapProviders(CbProviders.Items);
sgLayers.Columns[1].PickList.Assign(CbProviders.Items);
end;
R := Screen.DesktopRect;
@ -829,6 +881,47 @@ begin
end;
end;
procedure TMainForm.sgLayersCheckboxToggled(sender: TObject; aCol,
aRow: Integer; aState: TCheckboxState);
begin
TileLayer[Pred(sgLayers.Row)].Visible := (aState = cbChecked);
MapView.Redraw;
end;
procedure TMainForm.sgLayersEditingDone(Sender: TObject);
var
S: String;
begin
if sgLayers.Col <> 2 then
Exit;
S := sgLayers.Cells[sgLayers.Col, sgLayers.Row];
TileLayer[Pred(sgLayers.Row)].MapProvider := S;
sgLayers.Cells[sgLayers.Col, sgLayers.Row] := S;
MapView.Redraw;
end;
procedure TMainForm.sgLayersSelection(Sender: TObject; aCol, aRow: Integer);
begin
rgDrawMode.ItemIndex := Ord(TileLayer[Pred(ARow)].DrawMode);
tbOpacity.Position := Round(TileLayer[Pred(ARow)].Opacity * 100);
end;
procedure TMainForm.tbOpacityChange(Sender: TObject);
begin
TileLayer[Pred(sgLayers.Row)].Opacity := tbOpacity.Position / 100;
MapView.Redraw;
end;
procedure TMainForm.UpdateLayers;
var
TL: TGPSTileLayer;
begin
// Notify tile layers for drawing engine change, it must be done implicitly
// but there is no other mechanism for now
for TL in TileLayer do
TL.ParentViewChanged;
end;
procedure TMainForm.UpdateCoords(X, Y: Integer);
var
rPt: TRealPoint;

View File

@ -6,7 +6,7 @@ interface
uses
Classes, SysUtils, Types, Forms, Controls, Graphics, Dialogs,
ExtCtrls, StdCtrls, ComCtrls, Buttons, IntfGraphics, ColorBox, Spin,
ExtCtrls, StdCtrls, ComCtrls, Buttons, IntfGraphics, ColorBox, Spin, Grids,
mvGeoNames, mvMapViewer, mvTypes, mvGpsObj, mvDrawingEngine,
mvDE_RGBGraphics, mvDE_BGRA, mvDLEFPC, mvDLEWin, mvDLESynapse;
@ -16,6 +16,7 @@ type
TMainForm = class(TForm)
Bevel1: TBevel;
Bevel2: TBevel;
BtnSearch: TButton;
BtnGoTo: TButton;
BtnGPSPoints: TButton;
@ -27,6 +28,8 @@ type
CbFoundLocations: TComboBox;
CbLocations: TComboBox;
CbProviders: TComboBox;
lblOpacity: TLabel;
rgDrawMode: TRadioGroup;
rbProxyData: TRadioButton;
rbSystemProxy: TRadioButton;
CbUseThreads: TCheckBox;
@ -83,6 +86,9 @@ type
PgConfig: TTabSheet;
rbNoProxy: TRadioButton;
seProxyPort: TSpinEdit;
pgLayers: TTabSheet;
sgLayers: TStringGrid;
tbOpacity: TTrackBar;
ZoomTrackBar: TTrackBar;
procedure BtnGoToClick(Sender: TObject);
procedure BtnLoadGPXFileClick(Sender: TObject);
@ -121,6 +127,13 @@ type
procedure BtnLoadMapProvidersClick(Sender: TObject);
procedure BtnSaveMapProvidersClick(Sender: TObject);
procedure rbProxyChange(Sender: TObject);
procedure rgDrawModeSelectionChanged(Sender: TObject);
procedure sgLayersCheckboxToggled(Sender: TObject; aCol, aRow: Integer;
aState: TCheckboxState);
procedure sgLayersEditingDone(Sender: TObject);
procedure sgLayersSelection(Sender: TObject; aCol, aRow: Integer);
procedure tbOpacityChange(Sender: TObject);
procedure UpdateLayers;
procedure ZoomTrackBarChange(Sender: TObject);
private
@ -167,9 +180,11 @@ const
MAX_LOCATIONS_HISTORY = 50;
MAP_PROVIDER_FILENAME = 'map-providers.xml';
USE_DMS = true;
_TILELAYERS_ID_ = 42;
var
PointFormatSettings: TFormatsettings;
TileLayer: array[0..9] of TGPSTileLayer;
function CalcIniName: String;
@ -177,7 +192,6 @@ begin
Result := ChangeFileExt(Application.ExeName, '.ini');
end;
{ TMainForm }
procedure TMainForm.BtnLoadMapProvidersClick(Sender: TObject);
@ -191,6 +205,7 @@ begin
MapView.GetMapProviders(CbProviders.Items);
CbProviders.ItemIndex := 0;
MapView.MapProvider := CbProviders.Text;
sgLayers.Columns[1].PickList.Assign(CbProviders.Items);
end else
ShowMessage(msg);
end;
@ -206,6 +221,53 @@ begin
UpdateDownloadEngineProxy;
end;
procedure TMainForm.rgDrawModeSelectionChanged(Sender: TObject);
begin
TileLayer[Pred(sgLayers.Row)].DrawMode := TItemDrawMode(rgDrawMode.ItemIndex);
MapView.Redraw;
end;
procedure TMainForm.sgLayersCheckboxToggled(Sender: TObject; aCol,
aRow: Integer; aState: TCheckboxState);
begin
TileLayer[Pred(sgLayers.Row)].Visible := (aState = cbChecked);
MapView.Redraw;
end;
procedure TMainForm.sgLayersEditingDone(Sender: TObject);
var
S: String;
begin
if sgLayers.Col <> 2 then
Exit;
S := sgLayers.Cells[sgLayers.Col, sgLayers.Row];
TileLayer[Pred(sgLayers.Row)].MapProvider := S;
sgLayers.Cells[sgLayers.Col, sgLayers.Row] := S;
MapView.Redraw;
end;
procedure TMainForm.sgLayersSelection(Sender: TObject; aCol, aRow: Integer);
begin
rgDrawMode.ItemIndex := Ord(TileLayer[Pred(ARow)].DrawMode);
tbOpacity.Position := Round(TileLayer[Pred(ARow)].Opacity * 100);
end;
procedure TMainForm.tbOpacityChange(Sender: TObject);
begin
TileLayer[Pred(sgLayers.Row)].Opacity := tbOpacity.Position / 100;
MapView.Redraw;
end;
procedure TMainForm.UpdateLayers;
var
TL: TGPSTileLayer;
begin
// Notify tile layers for drawing engine change, it must be done implicitly
// but there is no other mechanism for now
for TL in TileLayer do
TL.ParentViewChanged;
end;
procedure TMainForm.BtnSearchClick(Sender: TObject);
begin
ClearFoundLocations;
@ -284,6 +346,7 @@ end;
procedure TMainForm.CbDebugTilesChange(Sender: TObject);
begin
MapView.DebugTiles := CbDebugTiles.Checked;
MapView.Invalidate;
end;
procedure TMainForm.CbDownloadEngineChange(Sender: TObject);
@ -328,6 +391,7 @@ begin
MapView.DrawingEngine := FBGRADrawingEngine;
end;
end;
UpdateLayers;
end;
procedure TMainForm.CbDoubleBufferChange(Sender: TObject);
@ -390,6 +454,7 @@ end;
procedure TMainForm.CbUseThreadsChange(Sender: TObject);
begin
MapView.UseThreads := CbUseThreads.Checked;
UpdateLayers;
end;
procedure TMainForm.CbDistanceUnitsChange(Sender: TObject);
@ -406,6 +471,7 @@ end;
procedure TMainForm.CbCyclicChange(Sender: TObject);
begin
MapView.Cyclic := CbCyclic.Checked;
UpdateLayers;
end;
procedure TMainForm.clbBackColorColorChanged(Sender: TObject);
@ -430,6 +496,7 @@ var
fn: String;
homeDir: String;
cacheDir: String;
I: Integer;
begin
cInputQueryEditSizePercents := 0;
@ -454,6 +521,7 @@ begin
end;
MapView.CachePath := cacheDir;
MapView.GetMapProviders(CbProviders.Items);
sgLayers.Columns[1].PickList.Assign(CbProviders.Items);
CbProviders.ItemIndex := CbProviders.Items.IndexOf(MapView.MapProvider);
MapView.DoubleBuffered := true;
MapView.Zoom := 1;
@ -471,10 +539,34 @@ begin
InfoViewportHeight.Caption := '';
GPSPointInfo.Caption := '';
for I := 0 to High(TileLayer) do
begin
TileLayer[I] := TGPSTileLayer.Create;
with TileLayer[I] do
begin
Visible := False;
UseThreads := MapView.UseThreads;
DrawMode := idmUseOpacity;
Opacity := 0.25;
case I of
0: MapProvider := 'Google Satellite Only';
1: MapProvider := 'Google Terrain';
2: MapProvider := 'Maps For Free';
otherwise
MapProvider := '';
end;
end;
sgLayers.Cells[1, I + 1] := TileLayer[I].Visible.ToString;
sgLayers.Cells[2, I + 1] := TileLayer[I].MapProvider;
MapView.GPSLayer[I].Add(TileLayer[I], _TILELAYERS_ID_);
end;
ReadFromIni;
end;
procedure TMainForm.FormDestroy(Sender: TObject);
var
I: Integer;
begin
WriteToIni;
ClearFoundLocations;
@ -629,6 +721,7 @@ begin
MapView.Engine.ClearMapProviders;
MapView.Engine.RegisterProviders;
MapView.GetMapProviders(CbProviders.Items);
sgLayers.Columns[1].PickList.Assign(CbProviders.Items);
end;
R := Screen.DesktopRect;

View File

@ -69,7 +69,6 @@ type
procedure SetFontStyle(AValue: TFontStyles); override;
procedure SetPenColor(AValue: TColor); override;
procedure SetPenWidth(AValue: Integer); override;
public
destructor Destroy; override;
procedure CreateBuffer(AWidth, AHeight: Integer); override;

View File

@ -36,6 +36,8 @@ type
TDrawStretchedTileEvent = procedure (const TileId: TTileId; X,Y: Integer;
TileImg: TPictureCacheItem; const R: TRect) of object;
TEraseBackgroundEvent = procedure (const R: TRect) of Object;
TTileDownloadedEvent = procedure (const TileId: TTileId) of object;
TTileIdArray = Array of TTileId;
@ -74,6 +76,7 @@ type
FOnChange: TNotifyEvent;
FOnDrawTile: TDrawTileEvent;
FOnDrawStretchedTile: TDrawStretchedTileEvent;
FOnEraseBackground: TEraseBackgroundEvent;
FOnTileDownloaded: TTileDownloadedEvent;
FOnZoomChange: TNotifyEvent;
lstProvider : TStringList;
@ -123,6 +126,7 @@ type
function GetTileName(const Id: TTileId): String;
procedure evDownload(Data: TObject; Job: TJob);
procedure TileDownloaded(Data: PtrInt);
procedure EraseBackground(const R: TRect);
procedure DrawTileFromCache(constref ATile: TTileId; constref AWin: TMapWindow);
procedure DrawStretchedTile(const TileId: TTileID; X, Y: Integer; TileImg: TPictureCacheItem; const R: TRect);
Procedure DrawTile(const TileId: TTileId; X,Y: integer; TileImg: TPictureCacheItem);
@ -194,6 +198,7 @@ type
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 OnEraseBackground: TEraseBackgroundEvent read FOnEraseBackground write FOnEraseBackground;
property OnTileDownloaded: TTileDownloadedEvent read FOnTileDownloaded write FOnTileDownloaded;
property OnZoomChange: TNotifyEvent read FOnZoomChange write FOnZoomChange;
end;
@ -357,25 +362,25 @@ function TMapViewerEngine.CalculateVisibleTiles(const aWin: TMapWindow; out
Area: TArea): Boolean;
var
MaxX, MaxY, startX, startY: int64;
WorldSize: Int64;
WorldMax: Int64;
begin
Area := Default(TArea);
Result := True;
WorldSize := 1 shl AWin.Zoom;
Result := (aWin.X <= 0) and (aWin.Y <= 0);
WorldMax := 1 shl AWin.Zoom - 1;
MaxX := Int64(aWin.Width) div TILE_SIZE + 1;
MaxY := Int64(aWin.Height) div TILE_SIZE + 1;
if (MaxX > WorldSize) or (MaxY > WorldSize) then
if (MaxX > WorldMax) or (MaxY > WorldMax) then
begin
Result := False;
MaxX := Min(WorldSize - 1, MaxX);
MaxY := Min(WorldSize - 1, MaxY);
MaxX := Min(WorldMax, MaxX);
MaxY := Min(WorldMax, MaxY);
end;
startX := -aWin.X div TILE_SIZE;
startY := -aWin.Y div TILE_SIZE;
if (startX < 0) or (startY < 0) then
begin
startX := Max(0, -aWin.X div TILE_SIZE);
startY := Max(0, -aWin.Y div TILE_SIZE);
startX := Max(0, startX);
startY := Max(0, startY);
Result := False;
end;
Area.Left := startX;
@ -1025,13 +1030,27 @@ var
end;
end;
procedure EraseBackground;
procedure EraseAround;
var
I, J: Integer;
T, L, B, R: Integer;
begin
for J := 0 to (AWin.Height div TILE_SIZE) + 1 do
for I := 0 to (AWin.Width div TILE_SIZE) + 1 do
DrawTile(tile, I * TILE_SIZE, J * TILE_SIZE, Nil);
T := -AWin.Y div TILE_SIZE - Max(0, Sign(AWin.Y));
B := T + AWin.Height div TILE_SIZE + 1;
L := -AWin.X div TILE_SIZE - Max(0, Sign(AWin.X));
R := L + AWin.Width div TILE_SIZE + 1;
if T < TilesVis.top then // Erase above top
EraseBackground(Rect(0, 0, AWin.Width, AWin.Y + TilesVis.top * TILE_SIZE));
if L < TilesVis.left then // Erase on the left
EraseBackground(Rect(0, AWin.Y + TilesVis.top * TILE_SIZE,
AWin.X + TilesVis.left * TILE_SIZE,
AWin.Y + (TilesVis.bottom + 1) * TILE_SIZE));
if R > TilesVis.right then // Erase on the right
EraseBackground(Rect(AWin.X + (TilesVis.right + 1) * TILE_SIZE,
AWin.Y + TilesVis.top * TILE_SIZE, AWin.Width,
AWin.Y + (TilesVis.bottom + 1) * TILE_SIZE));
if B > TilesVis.bottom then // Erase below
EraseBackground(Rect(0, AWin.Y + (TilesVis.bottom + 1) * TILE_SIZE,
AWin.Width, AWin.Height));
end;
begin
@ -1039,7 +1058,7 @@ begin
Exit;
if not CalculateVisibleTiles(AWin, TilesVis) then
EraseBackground;
EraseAround;
SetLength(Tiles, (TilesVis.Bottom - TilesVis.Top + 1) * (TilesVis.Right - TilesVis.Left + 1));
iTile := Low(Tiles);
numTiles := 1 shl AWin.Zoom;
@ -1273,6 +1292,12 @@ begin
end;
end;
procedure TMapViewerEngine.EraseBackground(const R: TRect);
begin
if Assigned(FOnEraseBackground) then
FOnEraseBackground(R);
end;
procedure TMapViewerEngine.DrawTileFromCache(constref ATile: TTileId; constref
AWin: TMapWindow);
var

View File

@ -111,6 +111,7 @@ Type
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;
@ -713,20 +714,35 @@ begin
end;
procedure TMapView.Paint;
begin
inherited Paint;
if IsActive then
begin
Engine.Redraw;
DrawObjects(Default(TTileId), 0, 0, Canvas.Width, Canvas.Height);
DrawingEngine.PaintToCanvas(Canvas);
end
else
procedure Inactive;
begin
Canvas.Brush.Color := InactiveColor;
Canvas.Brush.Style := bsSolid;
Canvas.FillRect(0, 0, ClientWidth, ClientHeight);
end;
procedure Redrw;
begin
Engine.Redraw;
DrawObjects(Default(TTileId), 0, 0, Canvas.Width, Canvas.Height);
DrawingEngine.PaintToCanvas(Canvas);
end;
procedure Drag;
begin
// Placeholder for dragging visuals
Redrw;
end;
begin
inherited Paint;
if IsActive
then if Engine.InDrag
then Drag
else Redrw
else
Inactive;
end;
procedure TMapView.OnGPSItemsModified(Sender: TObject; objs: TGPSObjList;
@ -1010,6 +1026,11 @@ begin
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.
@ -1055,6 +1076,7 @@ begin
FEngine.CacheOnDisk := true;
FEngine.OnDrawTile := @DoDrawTile;
FEngine.OnDrawStretchedTile := @DoDrawStretchedTile;
FEngine.OnEraseBackground := @DoEraseBackground;
FEngine.OnTileDownloaded := @DoTileDownloaded;
FEngine.DrawPreviewTiles := True;
FEngine.DrawTitleInGuiThread := false;