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

LazMapViewer: Fix default font height in BGRADrawingEngine

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9683 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz 2025-03-14 21:44:51 +00:00
parent 2eb97a3732
commit 8e3611f53a
1 changed files with 16 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
components/lazmapviewer/source/addons/bgra_drawingengine/mvde_bgra.pas
View File

@ -47,6 +47,8 @@ type
FFontColor: TColor;
FFontSize: Integer;
FFontStyle: TFontStyles;
procedure ApplyFont;
protected
function GetBrushColor: TColor; override;
function GetBrushStyle: TBrushStyle; override;
@ -387,8 +389,21 @@ begin
FBuffer.CanvasBGRA.Pen.Width := AValue;
end;
procedure TMvBGRADrawingEngine.ApplyFont;
var
fntSize: Integer;
begin
FBuffer.CanvasBGRA.Font.Name := FFontName;
if FFontSize = 0 then fntSize := 10 else fntSize := FFontSize;
FBuffer.CanvasBGRA.Font.Height := -Round(ScreenInfo.PixelsPerInchY / 72.0 * fntSize);
FBuffer.CanvasBGRA.Font.Style := FFontStyle;
FBuffer.CanvasBGRA.Font.Color := FFontColor;
FBuffer.CanvasBGRA.Font.Antialiasing := true;
end;
function TMvBGRADrawingEngine.TextExtent(const AText: String): TSize;
begin
ApplyFont;
Result := FBuffer.CanvasBGRA.TextExtent(AText);
end;
@ -396,11 +411,7 @@ procedure TMvBGRADrawingEngine.TextOut(X, Y: Integer; const AText: String);
begin
if (AText <> '') then
begin
FBuffer.CanvasBGRA.Font.Name := FFontName;
FBuffer.CanvasBGRA.Font.Height := -Round(ScreenInfo.PixelsPerInchY / 72.0 * FFontSize);
FBuffer.CanvasBGRA.Font.Style := FFontStyle;
FBuffer.CanvasBGRA.Font.Color := FFontColor;
FBuffer.CanvasBGRA.Font.Antialiasing := true;
ApplyFont;
FBuffer.CanvasBGRA.TextOut(X, Y, AText);
end;
end;