TurboPowerIPro: fixed blurred text when rendered onto bitmap. issue #41299

This commit is contained in:
zeljan1 2024-12-31 20:17:10 +01:00
parent 59f26575d6
commit f0dae76cf2

View File

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