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:
parent
68988c40ab
commit
3750b0a3d7
File diff suppressed because it is too large
Load Diff
@ -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;
|
||||
|
File diff suppressed because it is too large
Load Diff
@ -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;
|
||||
|
@ -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;
|
||||
|
@ -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
|
||||
|
@ -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;
|
||||
|
Loading…
Reference in New Issue
Block a user