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

LazMapViewer: Fix text size issue in BGRABitmap drawing engine. Improved detection of default font name and size.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9322 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz 2024-04-04 16:56:38 +00:00
parent 0562f757ef
commit 6faf17d531
2 changed files with 15 additions and 116 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -347,7 +347,7 @@ end;
procedure TMvBGRADrawingEngine.SetPenColor(AValue: TColor);
begin
FBuffer.CanvasBGRA.pen.Color := AValue;
FBuffer.CanvasBGRA.Pen.Color := AValue;
end;
procedure TMvBGRADrawingEngine.SetPenWidth(AValue: Integer);
@ -356,120 +356,22 @@ begin
end;
function TMvBGRADrawingEngine.TextExtent(const AText: String): TSize;
var
bmp: TBitmap;
begin
bmp := TBitmap.Create;
try
bmp.SetSize(1, 1);
bmp.Canvas.Font.Name := FFontName;
bmp.Canvas.Font.Size := FFontSize;
bmp.Canvas.Font.Style := FFontStyle;
Result := bmp.Canvas.TextExtent(AText);
finally
bmp.Free;
end;
Result := FBuffer.CanvasBGRA.TextExtent(AText);
end;
(*
procedure TMvBGRADrawingEngine.TextOut(X, Y: Integer; const AText: String);
var
bmp: TBitmap;
ex: TSize;
img: TLazIntfImage;
brClr: TFPColor;
imgClr: TFPColor;
i, j: Integer;
begin
if (AText = '') then
exit;
bmp := TBitmap.Create;
try
bmp.PixelFormat := pf32Bit;
bmp.SetSize(1, 1);
bmp.Canvas.Font.Name := FFontName;
bmp.Canvas.Font.Size := FFontSize;
bmp.Canvas.Font.Style := FFontStyle;
bmp.Canvas.Font.Color := FFontColor;
ex := bmp.Canvas.TextExtent(AText);
bmp.SetSize(ex.CX, ex.CY);
bmp.Canvas.Brush.Color := GetBrushColor;
if GetBrushStyle = bsClear then
bmp.Canvas.Brush.Style := bsSolid
else
bmp.Canvas.Brush.Style := GetBrushStyle;
bmp.Canvas.FillRect(0, 0, bmp.Width, bmp.Height);
bmp.Canvas.TextOut(0, 0, AText);
img := bmp.CreateIntfImage;
try
if GetBrushStyle = bsClear then begin
brClr := TColorToFPColor(GetBrushColor);
for j := 0 to img.Height - 1 do
for i := 0 to img.Width - 1 do begin
imgClr := img.Colors[i, j];
if (imgClr.Red = brClr.Red) and (imgClr.Green = brClr.Green) and (imgClr.Blue = brClr.Blue) then
Continue;
FBuffer.Canvas.SetColor(X + i, Y + j, FPColorToTColor(imgClr));
end;
end else
for j := 0 to img.Height - 1 do
for i := 0 to img.Width - 1 do
FBuffer.Canvas.SetColor(X + i, Y + j, FPColorToTColor(img.Colors[i, j]));
finally
img.Free;
end;
finally
bmp.Free;
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;
FBuffer.CanvasBGRA.TextOut(X, Y, AText);
end;
end;
*)
procedure TMvBGRADrawingEngine.TextOut(X, Y: Integer; const AText: String);
var
bmp: TBitmap;
ex: TSize;
begin
if (AText = '') then
exit;
FBuffer.CanvasBGRA.Font.Name := FFontName;
FBuffer.CanvasBGRA.Font.Height := Round((96.0 / 72.0) * FFontSize);
FBuffer.CanvasBGRA.Font.Style := FFontStyle;
FBuffer.CanvasBGRA.Font.Color := FFontColor;
FBuffer.CanvasBGRA.TextOut(X, Y, AText);
(*
bmp := TBitmap.Create;
try
bmp.PixelFormat := pf32Bit;
bmp.SetSize(1, 1);
bmp.Canvas.Font.Name := FFontName;
bmp.Canvas.Font.Size := FFontSize;
bmp.Canvas.Font.Style := FFontStyle;
bmp.Canvas.Font.Color := FFontColor;
ex := bmp.Canvas.TextExtent(AText);
bmp.SetSize(ex.CX, ex.CY);
if GetBrushStyle <> bsClear then begin
bmp.Canvas.Brush.Color := GetBrushColor;
bmp.Canvas.FillRect(0, 0, bmp.Width, bmp.Height);
bmp.Canvas.TextOut(0, 0, AText);
DrawBitmap(X, Y, bmp, false);
end else
begin
if FFontColor = clWhite then
bmp.Canvas.Brush.Color := clBlack
else
bmp.Canvas.Brush.Color := clWhite;
bmp.Canvas.FillRect(0, 0, bmp.Width, bmp.Height);
bmp.Canvas.TextOut(0, 0, AText);
DrawBitmapOT(X, Y, bmp, FFontColor, bmp.Canvas.Brush.Color);
end;
finally
bmp.Free;
end;
*)
end;
function TMvBGRADrawingEngine.GetCacheItemClass: TPictureCacheItemClass;
begin

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

@ -2848,15 +2848,12 @@ begin
end;
procedure TMapView.UpdateFont(Sender: TObject);
var
fd: TFontData;
begin
if SameText(FFont.Name, 'default') then
DrawingEngine.FontName := Screen.SystemFont.Name
else
DrawingEngine.FontName := FFont.Name;
if FFont.Size = 0 then
DrawingEngine.FontSize := Screen.SystemFont.Size
else
DrawingEngine.FontSize := FFont.Size;
fd := GetFontData(FFont.Handle);
DrawingEngine.FontName := fd.Name;
DrawingEngine.FontSize := abs(round(fd.Height / FFont.PixelsPerInch * 72));
DrawingEngine.FontStyle := FFont.Style;
DrawingEngine.FontColor := ColorToRGB(FFont.Color);
Invalidate;