Skip to content

Commit dca7a9a

Browse files
committed
fix: backport Lazarus Qt6 HiDPI scaling
Lazarus 4.8 blurs bitmap-backed controls on scaled Wayland displays. Backport upstream #41299, targeted for Lazarus 5.0, only for Linux Qt6 builds. https://gitlab.com/freepascal.org/lazarus/lazarus/-/work_items/41299
1 parent ae2b908 commit dca7a9a

7 files changed

Lines changed: 339 additions & 1 deletion

.gitattributes

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -37,4 +37,5 @@
3737
.gitignore export-ignore
3838
.gitattributes export-ignore
3939

40-
# Add scripts that do not need to be exported, here
40+
# Add scripts that do not need to be exported, here
41+
extra/lazarus-patches/**/*.patch -whitespace

.github/workflows/lazarus.yaml

Lines changed: 23 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -116,6 +116,18 @@ jobs:
116116
name: ${{ matrix.operating-system }}-QT5
117117
path: out/qt5/heidisql
118118

119+
- name: Patch Lazarus 4.8 for QT6
120+
if: ${{ matrix.operating-system == 'ubuntu-latest' }}
121+
run: |
122+
LAZARUS_DIR="/usr/share/lazarus/4.8.0"
123+
test -f "$LAZARUS_DIR/lcl/include/lclintf.inc"
124+
for p in "$GITHUB_WORKSPACE"/extra/lazarus-patches/4.8/*.patch; do
125+
sudo patch -d "$LAZARUS_DIR" -p1 --dry-run < "$p"
126+
sudo patch -d "$LAZARUS_DIR" -p1 < "$p"
127+
done
128+
grep -Fq "QPaintDevice_devicePixelRatioF" "$LAZARUS_DIR/lcl/interfaces/qt6/qtwscontrols.pp"
129+
grep -Fq "LCLIntf.SetCanvasScaleFactor(NodeBitmap.Canvas.Handle, ScaleFactor);" "$LAZARUS_DIR/components/virtualtreeview/laz.virtualtrees.pas"
130+
119131
- name: Build HeidiSQL (Ubuntu QT6)
120132
if: ${{ matrix.operating-system == 'ubuntu-latest' }}
121133
run: |
@@ -170,6 +182,17 @@ jobs:
170182
sudo dpkg -i /tmp/libqt6pas6-dev.deb || sudo apt-get install -f -y
171183
rm -f /tmp/libqt6pas6.deb /tmp/libqt6pas6-dev.deb
172184
185+
- name: Patch Lazarus 4.8 for QT6
186+
run: |
187+
LAZARUS_DIR="/usr/share/lazarus/4.8.0"
188+
test -f "$LAZARUS_DIR/lcl/include/lclintf.inc"
189+
for p in "$GITHUB_WORKSPACE"/extra/lazarus-patches/4.8/*.patch; do
190+
sudo patch -d "$LAZARUS_DIR" -p1 --dry-run < "$p"
191+
sudo patch -d "$LAZARUS_DIR" -p1 < "$p"
192+
done
193+
grep -Fq "QPaintDevice_devicePixelRatioF" "$LAZARUS_DIR/lcl/interfaces/qt6/qtwscontrols.pp"
194+
grep -Fq "LCLIntf.SetCanvasScaleFactor(NodeBitmap.Canvas.Handle, ScaleFactor);" "$LAZARUS_DIR/components/virtualtreeview/laz.virtualtrees.pas"
195+
173196
- name: Build HeidiSQL (Linux ARM64 QT6)
174197
run: |
175198
echo Building with QT6 on ARM64 using Lazarus 4.8
Lines changed: 28 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,28 @@
1+
diff --git a/lcl/interfaces/qt6/qtwscontrols.pp b/lcl/interfaces/qt6/qtwscontrols.pp
2+
index 84396a1..9f28b3d 100644
3+
--- a/lcl/interfaces/qt6/qtwscontrols.pp
4+
+++ b/lcl/interfaces/qt6/qtwscontrols.pp
5+
@@ -6,6 +6,7 @@
6+
class procedure DestroyHandle(const AWinControl: TWinControl); override;
7+
class procedure Invalidate(const AWinControl: TWinControl); override;
8+
class procedure AddControl(const AControl: TControl); override;
9+
+ class function GetCanvasScaleFactor(const AControl: TControl): Double; override;
10+
class function GetClientBounds(const AWincontrol: TWinControl; var ARect: TRect): Boolean; override;
11+
class function GetClientRect(const AWincontrol: TWinControl; var ARect: TRect): Boolean; override;
12+
class function GetDesignInteractive(const AWinControl: TWinControl; AClientPos: TPoint): Boolean; override;
13+
@@ -33,6 +34,15 @@ begin
14+
end;
15+
end;
16+
17+
+class function TQtWSWinControl.GetCanvasScaleFactor(const AControl: TControl
18+
+ ): Double;
19+
+begin
20+
+ Result := 1;
21+
+ if not WSCheckHandleAllocated(TWinControl(AControl), 'GetCanvasScaleFactor') then
22+
+ Exit;
23+
+ Result := QPaintDevice_devicePixelRatioF(QWidget_to_QPaintDevice(TQtWidget(TWinControl(AControl).Handle).Widget));
24+
+end;
25+
+
26+
class function TQtWSWinControl.GetClientBounds(const AWincontrol: TWinControl;
27+
var ARect: TRect): Boolean;
28+
begin
Lines changed: 43 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,43 @@
1+
diff --git a/lcl/include/intfbaselcl.inc b/lcl/include/intfbaselcl.inc
2+
index d9b5da7..9d17e87 100644
3+
--- a/lcl/include/intfbaselcl.inc
4+
+++ b/lcl/include/intfbaselcl.inc
5+
@@ -11,6 +11,10 @@ procedure TWidgetSet.SendCachedLCLMessages;
6+
begin
7+
end;
8+
9+
+procedure TWidgetSet.SetCanvasScaleFactor(DC: HDC; const AScaleRatio: double);
10+
+begin
11+
+end;
12+
+
13+
function TWidgetSet.SetCaretRespondToFocus(handle: HWND;
14+
ShowHideOnFocus: boolean): Boolean;
15+
begin
16+
diff --git a/lcl/include/lclintf.inc b/lcl/include/lclintf.inc
17+
index e2147d8..45d4fb5 100644
18+
--- a/lcl/include/lclintf.inc
19+
+++ b/lcl/include/lclintf.inc
20+
@@ -12,6 +12,11 @@ procedure SendCachedLCLMessages;
21+
begin
22+
end;
23+
24+
+procedure SetCanvasScaleFactor(DC: HDC; const AScaleRatio: double);
25+
+begin
26+
+ WidgetSet.SetCanvasScaleFactor(DC, AScaleRatio);
27+
+end;
28+
+
29+
function SetCaretRespondToFocus(Handle: hWnd; ShowHideOnFocus: boolean):Boolean;
30+
begin
31+
Result := WidgetSet.SetCaretRespondToFocus(Handle,ShowHideOnFocus);
32+
diff --git a/lcl/include/lclintfh.inc b/lcl/include/lclintfh.inc
33+
index a726824..f315942 100644
34+
--- a/lcl/include/lclintfh.inc
35+
+++ b/lcl/include/lclintfh.inc
36+
@@ -4,6 +4,7 @@ procedure RemovePipeEventHandler(var AHandler: PPipeEventHandler); {$IFDEF IF_BA
37+
function RequestInput(const InputCaption, InputPrompt : String; MaskInput : Boolean; var Value : String) : Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
38+
39+
procedure SendCachedLCLMessages; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
40+
+procedure SetCanvasScaleFactor(DC: HDC; const AScaleRatio: double); {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
41+
function SetCaretRespondToFocus(handle: HWND; ShowHideOnFocus: boolean): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
42+
function SetComboMinDropDownSize(Handle: HWND; MinItemsWidth, MinItemsHeight, MinItemCount: integer): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
43+
procedure SetEventHandlerFlags(AHandler: PEventHandler; NewFlags: dword); {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
Lines changed: 34 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,34 @@
1+
diff --git a/lcl/interfaces/qt6/qtlclintf.inc b/lcl/interfaces/qt6/qtlclintf.inc
2+
index d6251f8..5aaf334 100644
3+
--- a/lcl/interfaces/qt6/qtlclintf.inc
4+
+++ b/lcl/interfaces/qt6/qtlclintf.inc
5+
@@ -8,6 +8,18 @@ begin
6+
// todo
7+
end;
8+
9+
+procedure TQtWidgetSet.SetCanvasScaleFactor(DC: HDC; const AScaleRatio: double);
10+
+var
11+
+ QtDc: TQtDeviceContext absolute DC;
12+
+begin
13+
+ if IsValidDC(DC) and (QtDC.vImage <> nil) and (QtDC.vImage.Handle <> nil) then
14+
+ begin
15+
+ QPainter_end(QtDC.Widget);
16+
+ QImage_setDevicePixelRatio(QtDC.vImage.Handle, AScaleRatio);
17+
+ QPainter_begin(QtDC.Widget, QtDC.vImage.Handle);
18+
+ end;
19+
+end;
20+
+
21+
procedure TQtWidgetSet.SetEventHandlerFlags(AHandler: PEventHandler;
22+
NewFlags: dword);
23+
var
24+
diff --git a/lcl/interfaces/qt6/qtlclintfh.inc b/lcl/interfaces/qt6/qtlclintfh.inc
25+
index d8f0123..86c9c15 100644
26+
--- a/lcl/interfaces/qt6/qtlclintfh.inc
27+
+++ b/lcl/interfaces/qt6/qtlclintfh.inc
28+
@@ -3,5 +3,6 @@ procedure RemovePipeEventHandler(var AHandler: PPipeEventHandler); override;
29+
procedure RemoveProcessEventHandler(var AHandler: PProcessEventHandler); override;
30+
31+
procedure SetEventHandlerFlags(AHandler: PEventHandler; NewFlags: dword); override;
32+
+procedure SetCanvasScaleFactor(DC: HDC; const AScaleRatio: double); override;
33+
function SetComboMinDropDownSize(Handle: HWND; MinItemsWidth, MinItemsHeight, MinItemCount: integer): boolean; override;
34+
procedure SetRubberBandRect(const ARubberBand: HWND; const ARect: TRect); override;
Lines changed: 53 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,53 @@
1+
diff --git a/lcl/interfaces/qt6/qtwinapi.inc b/lcl/interfaces/qt6/qtwinapi.inc
2+
--- a/lcl/interfaces/qt6/qtwinapi.inc
3+
+++ b/lcl/interfaces/qt6/qtwinapi.inc
4+
@@ -6845,6 +6845,12 @@ var
5+
else
6+
QPixmap_copy(APixmap, ATempPixmap, 0, 0, QPixmap_width(APixmap), QPixmap_height(APixmap));
7+
8+
+ if (AMaskImg = nil) and QPixmap_isNull(ATempPixmap) then
9+
+ begin
10+
+ QPixmap_destroy(ATempPixmap);
11+
+ exit;
12+
+ end;
13+
+
14+
if AMaskImg <> nil then
15+
begin
16+
// apply mask to pixmap
17+
@@ -6855,8 +6861,8 @@ var
18+
19+
if IsRectEmpty(MaskRect) or (MaskRect.Size <> DstRect.Size) then
20+
begin
21+
- if (QPixmap_width(ATempPixmap) < (DstRect.Right - DstRect.Left)) or
22+
- (QPixmap_Height(ATempPixmap) < (DstRect.Bottom - DstRect.Top)) then
23+
+ if not QPixmap_isNull(ATempPixmap) and ((QPixmap_width(ATempPixmap) < (DstRect.Right - DstRect.Left)) or
24+
+ (QPixmap_Height(ATempPixmap) < (DstRect.Bottom - DstRect.Top))) then
25+
QPixmap_scaled(AMaskPix, AScaledPix, QPixmap_width(ATempPixmap), QPixmap_height(ATempPixmap))
26+
else
27+
QPixmap_scaled(AMaskPix, AScaledPix, Width, Height);
28+
@@ -6874,13 +6880,20 @@ var
29+
end;
30+
end;
31+
32+
- if ARenderHint then
33+
- QPainter_setRenderHint(DstQDC.Widget, QPainterSmoothPixmapTransform, True);
34+
+ if not QPixmap_isNull(ATempPixmap) then
35+
+ begin
36+
+ if ARenderHint then
37+
+ QPainter_setRenderHint(DstQDC.Widget, QPainterSmoothPixmapTransform, True);
38+
39+
- QPainter_drawPixmap(DstQDC.Widget, X, Y, Width, Height, ATempPixmap);
40+
+ if (QPixmap_width(ATempPixmap) = Width) and (QPixmap_height(ATempPixmap) = Height) and (Rop = SRCCOPY) then
41+
+ begin
42+
+ QPainter_drawPixmap(DstQDC.Widget, X, Y, ATempPixmap);
43+
+ end else
44+
+ QPainter_drawPixmap(DstQDC.Widget, X, Y, Width, Height, ATempPixmap);
45+
46+
- if ARenderHint then
47+
- QPainter_setRenderHint(DstQDC.Widget, QPainterSmoothPixmapTransform, not ARenderHint);
48+
+ if ARenderHint then
49+
+ QPainter_setRenderHint(DstQDC.Widget, QPainterSmoothPixmapTransform, not ARenderHint);
50+
+ end;
51+
52+
QPixmap_destroy(ATempPixmap);
53+
end;
Lines changed: 156 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,156 @@
1+
diff --git a/components/virtualtreeview/laz.virtualtrees.pas b/components/virtualtreeview/laz.virtualtrees.pas
2+
--- a/components/virtualtreeview/laz.virtualtrees.pas
3+
+++ b/components/virtualtreeview/laz.virtualtrees.pas
4+
@@ -9244,9 +9244,7 @@ procedure TVirtualTreeColumns.PaintHeader(DC: HDC; const R: TRect; HOffset: Integer);
5+
var
6+
VisibleFixedWidth: Integer;
7+
RTLOffset: Integer;
8+
- {$ifdef LCLCocoa}
9+
sc : Double;
10+
- {$endif}
11+
12+
procedure PaintFixedArea;
13+
14+
@@ -9258,20 +9256,16 @@ procedure TVirtualTreeColumns.PaintHeader(DC: HDC; const R: TRect; HOffset: Integer);
15+
end;
16+
17+
begin
18+
+ if Assigned(Header) and Assigned(Header.TreeView) then
19+
+ sc := Header.Treeview.GetCanvasScaleFactor
20+
+ else
21+
+ sc := 1.0;
22+
// Adjust size of the header bitmap
23+
with TWithSafeRect(FHeader.Treeview.FHeaderRect) do
24+
begin
25+
- FHeaderBitmap.Width := Max(Right, R.Right - R.Left);
26+
- FHeaderBitmap.Height := Bottom;
27+
- {$ifdef LCLCocoa}
28+
- if Assigned(Header) and Assigned(Header.TreeView) then
29+
- sc := Header.Treeview.GetCanvasScaleFactor
30+
- else
31+
- sc := 1.0;
32+
- FHeaderBitmap.Width := Round(FHeaderBitmap.Width * sc);
33+
- FHeaderBitmap.Height := Round(FHeaderBitmap.Height * sc);
34+
- CGContextScaleCTM(TCocoaBitmapContext(FHeaderBitmap.Canvas.Handle).CGContext, sc, sc);
35+
- {$endif}
36+
+ FHeaderBitmap.Clear;
37+
+ FHeaderBitmap.SetSize(Round(Max(Right, R.Right - R.Left) * sc), Round(Bottom * sc));
38+
+ LCLIntf.SetCanvasScaleFactor(FHeaderBitmap.Canvas.Handle, sc);
39+
end;
40+
41+
VisibleFixedWidth := GetVisibleFixedWidth;
42+
@@ -9296,15 +9290,7 @@ begin
43+
44+
// Blit the result to target.
45+
with TWithSafeRect(R) do
46+
- {$ifdef LCLCocoa}
47+
- StretchBlt(DC, Left, Top, Right - Left, Bottom - Top,
48+
- FHeaderBitmap.Canvas.Handle,
49+
- Left, Top,
50+
- FHeaderBitmap.Width, FHeaderBitmap.Height,
51+
- SRCCOPY);
52+
- {$else}
53+
- BitBlt(DC, Left, Top, Right - Left, Bottom - Top, FHeaderBitmap.Canvas.Handle, Left, Top, SRCCOPY);
54+
- {$endif}
55+
+ BitBlt(DC, Left, Top, Round((Right - Left) * sc), Round((Bottom - Top) * sc), FHeaderBitmap.Canvas.Handle, Left, Top, SRCCOPY);
56+
end;
57+
58+
//----------------------------------------------------------------------------------------------------------------------
59+
@@ -30671,18 +30657,9 @@ var
60+
CellIsTouchingClientRight: Boolean;
61+
CellIsInLastColumn: Boolean;
62+
ColumnIsFixed: Boolean;
63+
-
64+
- {$ifdef LCLCocoa}
65+
- sc: Double; // the retina scale. 1.0 for no-retina
66+
- cg: CGContextRef; // tracking the Context of Bitmap
67+
- cglast: CGContextRef; // the last Context of Bitmap.
68+
- // The scale is applied only when the context changes
69+
- {$endif}
70+
+ ScaleFactor: double;
71+
begin
72+
- {$ifdef LCLCocoa}
73+
- cglast := nil;
74+
- sc := GetCanvasScaleFactor;
75+
- {$endif}
76+
+ ScaleFactor := GetCanvasScaleFactor;
77+
{$ifdef DEBUG_VTV}Logger.EnterMethod([lcPaint],'PaintTree');{$endif}
78+
{$ifdef DEBUG_VTV}Logger.Send([lcPaint, lcHeaderOffset],'Window',Window);{$endif}
79+
{$ifdef DEBUG_VTV}Logger.Send([lcPaint, lcHeaderOffset],'Target',Target);{$endif}
80+
@@ -30725,12 +30702,9 @@ begin
81+
else
82+
NodeBitmap.PixelFormat := PixelFormat;
83+
84+
- {$ifdef LCLCocoa}
85+
- NodeBitmap.Width := Round(PaintWidth*sc);
86+
- cg := TCocoaBitmapContext(NodeBitmap.Canvas.Handle).CGContext;
87+
- {$else}
88+
- NodeBitmap.Width := PaintWidth;
89+
- {$endif}
90+
+ NodeBitmap.Width := Round(PaintWidth * ScaleFactor);
91+
+ NodeBitmap.Height := 1;
92+
+ LCLIntf.SetCanvasScaleFactor(NodeBitmap.Canvas.Handle, ScaleFactor);
93+
94+
// Make sure the buffer bitmap and target bitmap use the same transformation mode.
95+
{$ifndef Gtk}
96+
@@ -30849,19 +30823,9 @@ begin
97+
if Height < PaintInfo.Node.NodeHeight then
98+
begin
99+
// Avoid that the VCL copies the bitmap while changing its height.
100+
- {$ifdef LCLCocoa}
101+
- if Height > 0 then SetSize(1,1); // can't go to 0, must keep canvas
102+
- SetSize(Round(PaintWidth*sc), Round(PaintInfo.Node.NodeHeight * sc));
103+
- cg := TCocoaBitmapContext(NodeBitmap.Canvas.Handle).CGContext;
104+
- if cglast <> cg then
105+
- begin
106+
- CGContextScaleCTM(cg, sc, sc);
107+
- cglast := cg;
108+
- end;
109+
- {$else}
110+
if Height > 0 then SetSize(1,1); // can't go to 0, must keep canvas
111+
- SetSize(PaintWidth, PaintInfo.Node.NodeHeight);
112+
- {$endif}
113+
+ SetSize(Round(PaintWidth * ScaleFactor), Round(PaintInfo.Node.NodeHeight * ScaleFactor));
114+
+ LCLIntf.SetCanvasScaleFactor(NodeBitmap.Canvas.Handle, ScaleFactor);
115+
{$ifdef UseSetCanvasOrigin}
116+
SetCanvasOrigin(Canvas, Window.Left, 0);
117+
{$else}
118+
@@ -31182,25 +31146,9 @@ begin
119+
if not (poUnbuffered in PaintOptions) then
120+
with TWithSafeRect(TargetRect), NodeBitmap do
121+
begin
122+
- {$ifdef LCLCocoa}
123+
- StretchBlt(
124+
- TargetCanvas.Handle,
125+
- Left,
126+
- Top + YCorrect,
127+
- PaintWidth,
128+
- PaintInfo.Node.NodeHeight - YCorrect,
129+
- Canvas.Handle,
130+
- Window.Left,
131+
- Round(YCorrect * sc),
132+
- NodeBitmap.Width,
133+
- Round(PaintInfo.Node.NodeHeight * sc) - Round(YCorrect * sc),
134+
- SRCCOPY
135+
- );
136+
- {$else}
137+
BitBlt(TargetCanvas.Handle, Left,
138+
- Top {$ifdef ManualClipNeeded} + YCorrect{$endif}, Width, PaintInfo.Node.NodeHeight, Canvas.Handle, Window.Left,
139+
+ Top {$ifdef ManualClipNeeded} + YCorrect{$endif}, Round(Width * ScaleFactor), Round(PaintInfo.Node.NodeHeight * ScaleFactor), Canvas.Handle, Window.Left,
140+
{$ifdef ManualClipNeeded}YCorrect{$else}0{$endif}, SRCCOPY);
141+
- {$endif}
142+
end;
143+
end;
144+
end;
145+
@@ -31241,8 +31189,9 @@ begin
146+
// Avoid unnecessary copying of bitmap content. This will destroy the DC handle too.
147+
NodeBitmap.Height := 0;
148+
NodeBitmap.PixelFormat := pf32Bit;
149+
- NodeBitmap.Width := TargetRect.Right - TargetRect.Left;
150+
- NodeBitmap.Height := TargetRect.Bottom - TargetRect.Top;
151+
+ NodeBitmap.Width := Round((TargetRect.Right - TargetRect.Left) * ScaleFactor);
152+
+ NodeBitmap.Height := Round((TargetRect.Bottom - TargetRect.Top) * ScaleFactor);
153+
+ LCLIntf.SetCanvasScaleFactor(NodeBitmap.Canvas.Handle, ScaleFactor);
154+
end;
155+
156+
{$ifdef DEBUG_VTV}Logger.Send([lcPaintDetails],'NodeBitmap.Handle after changing height to background',NodeBitmap.Handle);{$endif}

0 commit comments

Comments
 (0)