View Issue Details

IDProjectCategoryView StatusLast Update
0034249LazarusLCLpublic2018-09-20 17:07
Reporterbald zhangAssigned Towp 
PrioritynormalSeverityminorReproducibilityalways
Status closedResolutionfixed 
Platformwin32OSWindowsOS Version10
Product Version1.9 (SVN)Product Build 
Target VersionFixed in Version 
Summary0034249: ItemHeight shrinked after first shown when TListBox.Style is OwnerDrawFixed
Descriptionfound this issue in 0034223
make a test program and reproduced, 1.8.4 and trunk version is the same.

Windows 10, 4k display, 192dpi

Form2 is created only once, ShowModal when Form1.Button1 click
the first time, ListBox drawing good, ItemHeight is (31)
then became to (20) everytime it shown.

because I run 1.8.4 with environment: __COMPAT_LAYER = "GdiDPIScaling DPIUnaware"
always got 96dpi, so not met this in PathEditor


another smaller problem: Form's Left and Top not scaled, at design-time(96dpi) they are (+300+200, Form1), at run-time(192dpi), should be (+600+400) but not.
TagsNo tags attached.
Fixed in Revisionr59094
LazTarget1.10
WidgetsetWin32/Win64
Attached Files
  • listbox-drawfixed.7z (61,573 bytes)
  • customlistbox.patch (1,438 bytes)
    Index: lcl/include/customlistbox.inc
    ===================================================================
    --- lcl/include/customlistbox.inc	(revision 59050)
    +++ lcl/include/customlistbox.inc	(working copy)
    @@ -128,6 +128,12 @@
       UnlockSelectionChange;
     end;
     
    +procedure TCustomListbox.DestroyWnd;
    +begin
    +  if FCanvas <> nil then TControlCanvas(FCanvas).FreeHandle;
    +  inherited;
    +end;
    +
     {------------------------------------------------------------------------------
      procedure TCustomListBox.FinalizeWnd
     ------------------------------------------------------------------------------}
    @@ -296,9 +302,10 @@
       begin
         if Self.ItemHeight <> 0 then
           AHeight := Self.ItemHeight
    -    else
    +    else begin
    +      Canvas.Font := Font;
           AHeight := Canvas.TextHeight('Hg');
    -
    +    end;
         MeasureItem(Integer(ItemId), AHeight);
         if AHeight > 0 then
           ItemHeight := AHeight;
    Index: lcl/stdctrls.pp
    ===================================================================
    --- lcl/stdctrls.pp	(revision 59050)
    +++ lcl/stdctrls.pp	(working copy)
    @@ -548,6 +548,7 @@
         function CalculateStandardItemHeight: Integer;
         procedure CreateParams(var Params: TCreateParams); override;
         procedure InitializeWnd; override;
    +    procedure DestroyWnd; override;
         procedure FinalizeWnd; override;
         class function GetControlClassDefaultSize: TSize; override;
         procedure CheckIndex(const AIndex: Integer);
    
    customlistbox.patch (1,438 bytes)

Relationships

related to 0034223 closedJuha Manninen PathEditor: bad align in 192dpi 

Activities

bald zhang

2018-09-11 02:06

reporter  

bald zhang

2018-09-11 02:06

reporter  

listbox-drawfixed.7z (61,573 bytes)

Juha Manninen

2018-09-11 11:10

developer   ~0110645

Lazarus trunk 1.9 has improved HiDPI support. Thus it is important to test with it and fix it there. I changed the product version to 1.9 and target to 1.10.

Juha Manninen

2018-09-11 11:19

developer   ~0110647

Does it work correctly if Style <> OwnerDrawFixed?
I spotted code made by Paul Ishenin at 2010:

function TCustomListBox.CalculateStandardItemHeight: Integer;
var
  B: TBitmap;
begin
  // Paul: This will happen only once if Style = lbStandard then CheckListBox is
  // OwnerDrawFixed in real (under windows). Handle is not allocated and we
  // can not use Canvas since it will cause recursion but we need correct font height
  B := TBitmap.Create;
  try
    B.Canvas.Font := Font;
    Result := B.Canvas.TextHeight('Fj');
  finally
    B.Free;
  end;
end;

I am not planning to study the issue more as my development OS is not Windows.

bald zhang

2018-09-13 04:24

reporter   ~0110712

ok, I'll try...

wp

2018-09-14 09:47

developer   ~0110732

I think the form's Top/Left coordinates are not scaled intentionally because if the same monitor is switched from normal resolution to high resolution then the form might move out of the screen.

Calling CalculateStandardItemHeight in TCustomListbox.LMMeasureItem instead of Canvas.TextHeight('Hg') resolves the issue. But because you mention that this is a Windows-only issue I feel that it should be fixed within the widget-set code.

I wonder why Paul added this function, but it has never been called.

wp

2018-09-14 12:13

developer   ~0110740

Last edited: 2018-09-14 13:12

View 3 revisions

There's a related issue, it happens with every TListbox with style lbOwnerDrawFixed even when opened for the first time, in Windows and in Linux: Change the font height to something large, such as 24, and the items will be truncated in height even if ItemHeight is 0 (which means "automatic detection of item height"). Delphi does not have this issue because they don't allow ItemHeight to be 0.

Please test this code (in lcl/include/customlistbox.inc), it fixes both your and my issue:

procedure TCustomListBox.LMMeasureItem(var TheMessage: TLMMeasureItem);
var
  AHeight: Integer;
begin
  with TheMessage.MeasureItemStruct^ do
  begin
    if Self.ItemHeight <> 0 then
      AHeight := Self.ItemHeight
    else
      AHeight := CalculateStandardItemHeight;
      // replaces: AHeight := Canvas.TextHeight('Hg');

    MeasureItem(Integer(ItemId), AHeight);
    if AHeight > 0 then
      ItemHeight := AHeight;
  end;
end;

bald zhang

2018-09-14 16:46

reporter   ~0110749

after change to GetTextExtentPoint, test app is good now.

in my research, Canvas.TextHeight('Hg') return valid number *only* first time, then it return 0 always.
win32 api GetTextExtentPoint() return false, but no error code found.

Canvas.Handle is different between here and code in Form2, I have no knowledge about this...

bald zhang

2018-09-17 06:54

reporter   ~0110820

linux/qt5 is ok with this change.

form's Top/Left is not a issue to me, only notice that when make this test case.

wp

2018-09-18 01:12

developer   ~0110844

> linux/qt5 is ok with this change.

Are you talking of the "GetTextExtentPoint" change?

bald zhang

2018-09-18 07:21

reporter   ~0110845

> Are you talking of the "GetTextExtentPoint" change?

yes, if no other problem, I think we can close it.


> form's Top/Left issue

as my opinion, we could ignore it. if bother somebody else, then we open another report.

wp

2018-09-18 09:40

developer   ~0110846

Last edited: 2018-09-18 11:38

View 2 revisions

>> Are you talking of the "GetTextExtentPoint" change?
> yes, if no other problem, I think we can close it.

I am not happy with it because
- we fix here a widgetset-related issue by global code. Who knows that we don't break widgetset XYZ here?
- Canvas.TextHeight does not work although it essentially calls GetTextExtentPoint which does work

wp

2018-09-18 12:01

developer   ~0110847

I think now I found the issue: TCustomListbox uses a TControlCanvas, but does not destroy the canvas handle when its DestroyWnd is called. This happens when the form is closed. When the same form is opened for a second time the listbox handle is recreated but the canvas handle is not. Therefore Canvas.TextHeight does not return a valid result; that GetTextExtentPoint returns a valid result appears to me very fragile.

The other bug is that immediately after handle creation the listbox canvas does not yet have the correct font. Therefore, Canvas.TextHeight returns an incorrect height if the font has been changed from default.

Before I commit the new version I'd ask you to test the patch "customlistbox.patch".

wp

2018-09-18 12:02

developer  

customlistbox.patch (1,438 bytes)
Index: lcl/include/customlistbox.inc
===================================================================
--- lcl/include/customlistbox.inc	(revision 59050)
+++ lcl/include/customlistbox.inc	(working copy)
@@ -128,6 +128,12 @@
   UnlockSelectionChange;
 end;
 
+procedure TCustomListbox.DestroyWnd;
+begin
+  if FCanvas <> nil then TControlCanvas(FCanvas).FreeHandle;
+  inherited;
+end;
+
 {------------------------------------------------------------------------------
  procedure TCustomListBox.FinalizeWnd
 ------------------------------------------------------------------------------}
@@ -296,9 +302,10 @@
   begin
     if Self.ItemHeight <> 0 then
       AHeight := Self.ItemHeight
-    else
+    else begin
+      Canvas.Font := Font;
       AHeight := Canvas.TextHeight('Hg');
-
+    end;
     MeasureItem(Integer(ItemId), AHeight);
     if AHeight > 0 then
       ItemHeight := AHeight;
Index: lcl/stdctrls.pp
===================================================================
--- lcl/stdctrls.pp	(revision 59050)
+++ lcl/stdctrls.pp	(working copy)
@@ -548,6 +548,7 @@
     function CalculateStandardItemHeight: Integer;
     procedure CreateParams(var Params: TCreateParams); override;
     procedure InitializeWnd; override;
+    procedure DestroyWnd; override;
     procedure FinalizeWnd; override;
     class function GetControlClassDefaultSize: TSize; override;
     procedure CheckIndex(const AIndex: Integer);
customlistbox.patch (1,438 bytes)

bald zhang

2018-09-18 12:32

reporter   ~0110848

> after change to GetTextExtentPoint, test app is good now.

this post I sent days ago is a typo, "GetTextExtentPoint" should be "CalculateStandardItemHeight" because first time my post was fail, the second time when I editing, I type a wrong name.

sorry about that.


> I am not happy with it because...

agree


> Before I commit the new version I'd ask you to test the patch "customlistbox.patch".

I will test it and give you a feedback.

bald zhang

2018-09-20 10:33

reporter   ~0110895

patch tested.

Win10, 4k, 192dpi - passed.
Linux/qt5, 4k, 192dpi - passed.

anything else to be tested?

wp

2018-09-20 12:58

developer   ~0110896

Applied, thanks for testing. Close if OK.

Note: Fix will be included in v2.0RC2.

bald zhang

2018-09-20 17:07

reporter   ~0110900

base my test, it's ok now.

Issue History

Date Modified Username Field Change
2018-09-11 02:06 bald zhang New Issue
2018-09-11 02:06 bald zhang File Added: listbox-itemheight-half-sized.png
2018-09-11 02:06 bald zhang File Added: listbox-drawfixed.7z
2018-09-11 11:04 Juha Manninen Relationship added related to 0034223
2018-09-11 11:10 Juha Manninen LazTarget => 1.10
2018-09-11 11:10 Juha Manninen Note Added: 0110645
2018-09-11 11:10 Juha Manninen Product Version 1.8.4 => 1.9 (SVN)
2018-09-11 11:10 Juha Manninen Target Version => 1.10
2018-09-11 11:19 Juha Manninen Note Added: 0110647
2018-09-13 04:24 bald zhang Note Added: 0110712
2018-09-14 09:47 wp Note Added: 0110732
2018-09-14 11:23 wp Assigned To => wp
2018-09-14 11:23 wp Status new => assigned
2018-09-14 12:13 wp Note Added: 0110740
2018-09-14 13:11 wp Note Edited: 0110740 View Revisions
2018-09-14 13:12 wp Note Edited: 0110740 View Revisions
2018-09-14 16:46 bald zhang Note Added: 0110749
2018-09-17 06:54 bald zhang Note Added: 0110820
2018-09-18 01:12 wp Note Added: 0110844
2018-09-18 07:21 bald zhang Note Added: 0110845
2018-09-18 09:40 wp Note Added: 0110846
2018-09-18 11:38 wp Note Edited: 0110846 View Revisions
2018-09-18 12:01 wp Note Added: 0110847
2018-09-18 12:02 wp File Added: customlistbox.patch
2018-09-18 12:32 bald zhang Note Added: 0110848
2018-09-20 10:33 bald zhang Note Added: 0110895
2018-09-20 12:58 wp Fixed in Revision => r59094
2018-09-20 12:58 wp Note Added: 0110896
2018-09-20 12:58 wp Status assigned => resolved
2018-09-20 12:58 wp Resolution open => fixed
2018-09-20 12:58 wp Target Version 1.10 =>
2018-09-20 17:07 bald zhang Note Added: 0110900
2018-09-20 17:07 bald zhang Status resolved => closed