paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-29 11:10:16 +02:00
Code Issues Packages Projects Releases Wiki Activity

IpHtml: draw crisp text on bitmap when canvas scale factor > 1. issue #41299

Browse Source
This commit is contained in:
zeljan1 2025-01-02 09:38:04 +01:00
parent 86b6b6cca4
commit 7ceec9b428
1 changed files with 17 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
components/turbopower_ipro/iphtml.pas
View File

@ -3383,6 +3383,8 @@ procedure TIpHtml.Render(TargetCanvas: TCanvas; TargetPageRect: TRect;
APageTop, APageBottom: Integer; UsePaintBuffer: Boolean; const TopLeft: TPoint);
var
i : Integer;
AScale: Double;
R: TRect;
begin
FClientRect.TopLeft := TopLeft; {Point(0, 0);}
FClientRect.Right := TargetPageRect.Right - TargetPageRect.Left;
@ -3415,14 +3417,19 @@ begin
FPageViewBottom := APageBottom;
FPageViewTop := APageTop;
if UsePaintBuffer then begin
if UsePaintBuffer then
begin
AScale := 1;
if (PaintBuffer = nil)
or (PaintBufferBitmap.Width <> FClientRect.Right)
or (PaintBufferBitmap.Height <> FClientRect.Bottom) then begin
PaintBufferBitmap.Free;
PaintBufferBitmap := TBitmap.Create;
PaintBufferBitmap.Width := FClientRect.Right;
PaintBufferBitmap.Height := FClientRect.Bottom;
if Assigned(Application) and Assigned(Application.MainForm) then
AScale := Application.MainForm.GetCanvasScaleFactor;
PaintBufferBitmap.Width := Round(FClientRect.Right * AScale);
PaintBufferBitmap.Height := Round(FClientRect.Bottom * AScale);
LCLIntf.SetDeviceScaleRatio(PaintBufferBitmap.Handle, AScale);
PaintBuffer := PaintBufferBitmap.Canvas;
end;
FTarget := PaintBuffer;
@ -3437,7 +3444,13 @@ begin
for i := 0 to Pred(ControlList.Count) do
TIpHtmlNode(ControlList[i]).HideUnmarkedControl;
if UsePaintBuffer then
TargetCanvas.CopyRect(FClientRect, PaintBuffer, FClientRect)
begin
R := FClientRect;
R.Right := Round(R.Right * AScale);
R.Bottom := Round(R.Bottom * AScale);
TargetCanvas.CopyRect(R, PaintBuffer, R);
FClientRect := R;
end
else
if PaintBufferBitmap <> nil then
PaintBuffer := PaintBufferBitmap.Canvas