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

LazMapViewer: Fix TMapView.Font streaming.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9706 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz 2025-03-26 09:40:43 +00:00
parent 5932f46825
commit e92d81a180
1 changed files with 21 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -556,7 +556,6 @@ type
FDebugTiles: Boolean;
FDefaultTrackColor: TColor;
FDefaultTrackWidth: Integer;
FFont: TFont;
FPOIImages: TCustomImageList;
FPOIImagesWidth: Integer;
FCacheOnDisk: Boolean;
@ -609,7 +608,6 @@ type
function IsCacheMaxAgeStored: Boolean;
function IsCacheMemMaxItemCountStored : Boolean;
function IsCachePathStored: Boolean;
function IsFontStored: Boolean;
function IsLayersStored: Boolean;
procedure SetActive(AValue: boolean);
procedure SetCacheLocation(AValue: TCacheLocation);
@ -625,7 +623,6 @@ type
procedure SetDownloadEngine(AValue: TMvCustomDownloadEngine);
procedure SetDrawingEngine(AValue: TMvCustomDrawingEngine);
procedure SetDrawPreviewTiles(AValue: Boolean);
procedure SetFont(AValue: TFont);
procedure SetInactiveColor(AValue: TColor);
procedure SetLayers(const ALayers: TMapLayers);
procedure SetMapProvider(AValue: String);
@ -646,7 +643,6 @@ type
procedure SetZoomMax(AValue: Integer);
procedure SetZoomMin(AValue: Integer);
procedure SetZoomToCursor(AValue: Boolean);
procedure UpdateFont(Sender: TObject);
procedure UpdateImage(Sender: TObject);
protected
@ -669,6 +665,8 @@ type
procedure DoZoomChanging(Sender: TObject; NewZoom: Integer; var Allow: Boolean);
function FindObjsAtScreenPt(X, Y: Integer; ATolerance: Integer;
AVisibleOnly: Boolean; AClass: TGPSObjClass = nil): TGPSObjArray;
procedure FontChanged(Sender: TObject); override;
procedure FontToDrawingEngine;
function IsActive: Boolean; inline;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
@ -770,11 +768,12 @@ type
property DrawPreviewTiles: Boolean read GetDrawPreviewTiles write SetDrawPreviewTiles default true;
property Options: TMapViewOptions read FOptions write SetOptions default DefaultMapViewOptions;
property Layers: TMapLayers read GetLayers write SetLayers stored IsLayersStored;
property Font: TFont read FFont write SetFont stored IsFontStored;
property Font;
property Height default 150;
property InactiveColor: TColor read GetInactiveColor write SetInactiveColor default clWhite;
property MapProvider: String read GetMapProvider write SetMapProvider;
property MapCenter: TMapCenter read FCenter write FCenter;
property ParentFont;
property PluginManager: TMvCustomPluginManager read FPluginManager write SetPluginManager;
property POIImage: TCustomBitmap read FPOIImage write SetPOIImage;
property POIImages: TCustomImageList read FPOIImages write SetPOIImages;
@ -2656,12 +2655,6 @@ begin
Result := not SameText(CachePath, 'cache/');
end;
function TMapView.IsFontStored: Boolean;
begin
Result := SameText(FFont.Name, 'default') and (FFont.Size = 0) and
(FFont.Style = []) and (FFont.Color = clBlack);
end;
function TMapView.IsLayersStored: Boolean;
begin
Result := True;
@ -2748,7 +2741,8 @@ begin
FDrawingEngine.CreateBuffer(ClientWidth, ClientHeight);
FEngine.CacheItemClass := FDrawingEngine.GetCacheItemClass;
end;
UpdateFont(nil);
FontToDrawingEngine;
Invalidate;
end;
procedure TMapView.SetDrawPreviewTiles(AValue: Boolean);
@ -2757,12 +2751,6 @@ begin
Invalidate;
end;
procedure TMapView.SetFont(AValue: TFont);
begin
FFont.Assign(AValue);
UpdateFont(nil);
end;
procedure TMapView.SetInactiveColor(AValue: TColor);
begin
Engine.BkColor := TColorToFPColor(AValue);
@ -3571,6 +3559,9 @@ begin
DrawingEngine.PenColor := ptColor;
end;
// Prepare text font
FontToDrawingEngine;
// Prepare point text
txt := APt.Name;
if FPOITextBgColor <> clNone then
@ -3822,13 +3813,6 @@ begin
FBuiltinPluginManager := TMvCustomPluginManager.Create(Self);
FBuiltinPluginManager.Name := 'BuiltinPM';
FFont := TFont.Create;
FFont.Name := 'default';
FFont.Size := 0;
FFont.Style := [];
FFont.Color := clBlack;
FFont.OnChange := @UpdateFont;
FPOIImage := TPortableNetworkGraphic.Create; //TBitmap.Create;
FPOIImage.OnChange := @UpdateImage;
FPOITextBgColor := clNone;
@ -3853,7 +3837,6 @@ var
begin
Active := False;
Engine.Jobqueue.RemoveAsyncCalls(Self);
FFont.Free;
FreeAndNil(FPOIImage);
FLayers.Free;
for I := 0 to High(FGPSItems) do
@ -4229,16 +4212,22 @@ begin
DrawingEngine.CreateBuffer(ClientWidth, ClientHeight); // ???
end;
procedure TMapView.UpdateFont(Sender: TObject);
procedure TMapView.FontChanged(Sender: TObject);
begin
inherited;
FontToDrawingEngine;
Invalidate;
end;
procedure TMapView.FontToDrawingEngine;
var
fd: TFontData;
begin
fd := GetFontData(FFont.Handle);
fd := GetFontData(Font.Handle);
DrawingEngine.FontName := fd.Name;
DrawingEngine.FontSize := abs(round(fd.Height / FFont.PixelsPerInch * 72));
DrawingEngine.FontStyle := FFont.Style;
DrawingEngine.FontColor := ColorToRGB(FFont.Color);
Invalidate;
DrawingEngine.FontSize := abs(round(fd.Height / Font.PixelsPerInch * 72));
DrawingEngine.FontStyle := Font.Style;
DrawingEngine.FontColor := ColorToRGB(Font.Color);
end;
procedure TMapView.UpdateImage(Sender: TObject);