View Issue Details

IDProjectCategoryView StatusLast Update
0017878LazarusLCLpublic2010-11-13 22:19
ReporterlainzAssigned ToPaul Ishenin 
PrioritynormalSeveritymajorReproducibilityalways
Status closedResolutionfixed 
Product Version0.9.29 (SVN)Product Build 
Target Version1.0.0Fixed in Version0.9.29 (SVN) 
Summary0017878: Other High DPI issue: Menu size is lower than Windows default size.
DescriptionLazarus LCL isn't designed to load the size of objects from Windows to work in Other DPI modes than 96dpi?

See the image attached: lazarus menu / notepad menu (the size used by notepad is the size used by all windows applications, but lazarus compiled applications).
TagsHighDPI
Fixed in Revision28196
LazTarget1.0
WidgetsetWin32/Win64
Attached Files
  • menu.png (48,381 bytes)
    menu.png (48,381 bytes)
  • menu200.png (18,198 bytes)
    menu200.png (18,198 bytes)
  • menu.patch (4,317 bytes)
    Index: graphics.pp
    ===================================================================
    --- graphics.pp	(revision 28169)
    +++ graphics.pp	(working copy)
    @@ -1948,8 +1948,12 @@
     var
       { Stores information about the current screen
         - initialized on Interface startup }
    -  ScreenInfo: TScreenInfo=(PixelsPerInchX:72;PixelsPerInchY:72;
    -                           ColorDepth:24;Initialized:false;);
    +  ScreenInfo: TScreenInfo = (
    +    PixelsPerInchX: 72;
    +    PixelsPerInchY: 72;
    +    ColorDepth: 24;
    +    Initialized: False;
    +  );
     
       FontResourceCache: TFontHandleCache;
       PenResourceCache: TPenHandleCache;
    @@ -1983,6 +1987,9 @@
     
     function DbgS(const Style: TFontStyles): string; overload;
     
    +function ScaleX(const SizeX, FromDPI: Integer): Integer;
    +function ScaleY(const SizeY, FromDPI: Integer): Integer;
    +
     procedure Register;
     procedure UpdateHandleObjects;
     
    @@ -2208,6 +2215,16 @@
       end;
     end;
     
    +function ScaleX(const SizeX, FromDPI: Integer): Integer;
    +begin
    +  Result := MulDiv(SizeX, ScreenInfo.PixelsPerInchX, FromDPI);
    +end;
    +
    +function ScaleY(const SizeY, FromDPI: Integer): Integer;
    +begin
    +  Result := MulDiv(SizeY, ScreenInfo.PixelsPerInchY, FromDPI);
    +end;
    +
     procedure Register;
     begin
       RegisterClasses([TBitmap,TPixmap,TPortableNetworkGraphic,
    Index: interfaces/win32/win32wsmenus.pp
    ===================================================================
    --- interfaces/win32/win32wsmenus.pp	(revision 28172)
    +++ interfaces/win32/win32wsmenus.pp	(working copy)
    @@ -367,17 +367,17 @@
       AFont, OldFont: HFONT;
     begin
       Theme := TWin32ThemeServices(ThemeServices).Theme[teMenu];
    -  GetThemeMargins(Theme, 0, MENU_POPUPITEM, 0, TMT_CONTENTMARGINS, nil, Result.ItemMargins);
    -  GetThemePartSize(Theme, 0, MENU_POPUPCHECK, 0, nil, TS_TRUE, Result.CheckSize);
    -  GetThemeMargins(Theme, 0, MENU_POPUPCHECK, 0, TMT_CONTENTMARGINS, nil, Result.CheckMargins);
    -  GetThemeMargins(Theme, 0, MENU_POPUPCHECKBACKGROUND, 0, TMT_CONTENTMARGINS, nil, Result.CheckBgMargins);
    -  GetThemePartSize(Theme, 0, MENU_POPUPGUTTER, 0, nil, TS_TRUE, Result.GutterSize);
    -  GetThemePartSize(Theme, 0, MENU_POPUPSUBMENU, 0, nil, TS_TRUE, Result.SubMenuSize);
    -  GetThemeMargins(Theme, 0, MENU_POPUPSUBMENU, 0, TMT_CONTENTMARGINS, nil, Result.SubMenuMargins);
    +  GetThemeMargins(Theme, DC, MENU_POPUPITEM, 0, TMT_CONTENTMARGINS, nil, Result.ItemMargins);
    +  GetThemePartSize(Theme, DC, MENU_POPUPCHECK, 0, nil, TS_TRUE, Result.CheckSize);
    +  GetThemeMargins(Theme, DC, MENU_POPUPCHECK, 0, TMT_CONTENTMARGINS, nil, Result.CheckMargins);
    +  GetThemeMargins(Theme, DC, MENU_POPUPCHECKBACKGROUND, 0, TMT_CONTENTMARGINS, nil, Result.CheckBgMargins);
    +  GetThemePartSize(Theme, DC, MENU_POPUPGUTTER, 0, nil, TS_TRUE, Result.GutterSize);
    +  GetThemePartSize(Theme, DC, MENU_POPUPSUBMENU, 0, nil, TS_TRUE, Result.SubMenuSize);
    +  GetThemeMargins(Theme, DC, MENU_POPUPSUBMENU, 0, TMT_CONTENTMARGINS, nil, Result.SubMenuMargins);
     
       if AMenuItem.IsLine then
       begin
    -    GetThemePartSize(Theme, 0, MENU_POPUPSEPARATOR, 0, nil, TS_TRUE, Result.SeparatorSize);
    +    GetThemePartSize(Theme, DC, MENU_POPUPSEPARATOR, 0, nil, TS_TRUE, Result.SeparatorSize);
         FillChar(Result.TextMargins, SizeOf(Result.TextMargins), 0);
         FillChar(Result.TextSize, SizeOf(Result.TextSize), 0);
       end
    @@ -469,7 +469,7 @@
       end
       else
       begin
    -    Result.cy := Metrics.CheckSize.cy + Metrics.CheckMargins.cyTopHeight + Metrics.CheckMargins.cyBottomHeight;
    +    Result.cy := Metrics.CheckSize.cy + ScaleY(Metrics.CheckMargins.cyTopHeight + Metrics.CheckMargins.cyBottomHeight, 96);
         if AMenuItem.HasIcon then
         begin
           Result.cy := Max(Result.cy, AMenuItem.GetIconSize.y);
    @@ -655,7 +655,7 @@
       // calc check/image rect
       CheckRect := ARect;
       CheckRect.Right := CheckRect.Left + Metrics.CheckSize.cx + Metrics.CheckMargins.cxRightWidth + Metrics.CheckMargins.cxLeftWidth;
    -  CheckRect.Bottom := CheckRect.Top + Metrics.CheckSize.cy + Metrics.CheckMargins.cyTopHeight + Metrics.CheckMargins.cyBottomHeight;
    +  CheckRect.Bottom := CheckRect.Top + Metrics.CheckSize.cy + ScaleY(Metrics.CheckMargins.cyTopHeight + Metrics.CheckMargins.cyBottomHeight, 96);
       // draw gutter
       GutterRect := CheckRect;
       GutterRect.Left := GutterRect.Right + Metrics.CheckBgMargins.cxRightWidth - Metrics.CheckMargins.cxRightWidth;
    
    menu.patch (4,317 bytes)

Activities

2010-11-08 14:13

 

menu.png (48,381 bytes)
menu.png (48,381 bytes)

Paul Ishenin

2010-11-09 03:12

manager   ~0042902

Please give me instructions how to change the DPI on windows 7. I set the screen size to 125% and have no differences between lazarus menus and notepad menus in size.

lainz

2010-11-09 16:25

reporter   ~0042920

Last edited: 2010-11-09 16:33

Go to control panel > Screen > there are 3 options 100, 125 and 150%
Set 150%, and apply.

EDIT: when you set 150% or more the program you are running must be compatible with High DPI or is blured (like scaling a bitmap).

Create a new project with menu and add a manifest:
http://www.lazarus.freepascal.org/index.php/topic,10924.msg54623.html

Check the size of menĂº items "blue selection", the menu bar is ok.

2010-11-09 17:31

 

menu200.png (18,198 bytes)
menu200.png (18,198 bytes)

lainz

2010-11-09 17:31

reporter   ~0042924

See attachment 200%

Paul Ishenin

2010-11-10 04:19

manager   ~0042935

Yes. Lazarus applications does not support Vista+ Dpi settings. Therefore vista (w7) just zooms all the graphics. This result in different sizes.

To add support for Vista+ dpi I added an option to the project options which calls "Dpi Aware application". This does not solve the problem of menus but at least they start to look more clear.

2010-11-10 11:31

 

menu.patch (4,317 bytes)
Index: graphics.pp
===================================================================
--- graphics.pp	(revision 28169)
+++ graphics.pp	(working copy)
@@ -1948,8 +1948,12 @@
 var
   { Stores information about the current screen
     - initialized on Interface startup }
-  ScreenInfo: TScreenInfo=(PixelsPerInchX:72;PixelsPerInchY:72;
-                           ColorDepth:24;Initialized:false;);
+  ScreenInfo: TScreenInfo = (
+    PixelsPerInchX: 72;
+    PixelsPerInchY: 72;
+    ColorDepth: 24;
+    Initialized: False;
+  );
 
   FontResourceCache: TFontHandleCache;
   PenResourceCache: TPenHandleCache;
@@ -1983,6 +1987,9 @@
 
 function DbgS(const Style: TFontStyles): string; overload;
 
+function ScaleX(const SizeX, FromDPI: Integer): Integer;
+function ScaleY(const SizeY, FromDPI: Integer): Integer;
+
 procedure Register;
 procedure UpdateHandleObjects;
 
@@ -2208,6 +2215,16 @@
   end;
 end;
 
+function ScaleX(const SizeX, FromDPI: Integer): Integer;
+begin
+  Result := MulDiv(SizeX, ScreenInfo.PixelsPerInchX, FromDPI);
+end;
+
+function ScaleY(const SizeY, FromDPI: Integer): Integer;
+begin
+  Result := MulDiv(SizeY, ScreenInfo.PixelsPerInchY, FromDPI);
+end;
+
 procedure Register;
 begin
   RegisterClasses([TBitmap,TPixmap,TPortableNetworkGraphic,
Index: interfaces/win32/win32wsmenus.pp
===================================================================
--- interfaces/win32/win32wsmenus.pp	(revision 28172)
+++ interfaces/win32/win32wsmenus.pp	(working copy)
@@ -367,17 +367,17 @@
   AFont, OldFont: HFONT;
 begin
   Theme := TWin32ThemeServices(ThemeServices).Theme[teMenu];
-  GetThemeMargins(Theme, 0, MENU_POPUPITEM, 0, TMT_CONTENTMARGINS, nil, Result.ItemMargins);
-  GetThemePartSize(Theme, 0, MENU_POPUPCHECK, 0, nil, TS_TRUE, Result.CheckSize);
-  GetThemeMargins(Theme, 0, MENU_POPUPCHECK, 0, TMT_CONTENTMARGINS, nil, Result.CheckMargins);
-  GetThemeMargins(Theme, 0, MENU_POPUPCHECKBACKGROUND, 0, TMT_CONTENTMARGINS, nil, Result.CheckBgMargins);
-  GetThemePartSize(Theme, 0, MENU_POPUPGUTTER, 0, nil, TS_TRUE, Result.GutterSize);
-  GetThemePartSize(Theme, 0, MENU_POPUPSUBMENU, 0, nil, TS_TRUE, Result.SubMenuSize);
-  GetThemeMargins(Theme, 0, MENU_POPUPSUBMENU, 0, TMT_CONTENTMARGINS, nil, Result.SubMenuMargins);
+  GetThemeMargins(Theme, DC, MENU_POPUPITEM, 0, TMT_CONTENTMARGINS, nil, Result.ItemMargins);
+  GetThemePartSize(Theme, DC, MENU_POPUPCHECK, 0, nil, TS_TRUE, Result.CheckSize);
+  GetThemeMargins(Theme, DC, MENU_POPUPCHECK, 0, TMT_CONTENTMARGINS, nil, Result.CheckMargins);
+  GetThemeMargins(Theme, DC, MENU_POPUPCHECKBACKGROUND, 0, TMT_CONTENTMARGINS, nil, Result.CheckBgMargins);
+  GetThemePartSize(Theme, DC, MENU_POPUPGUTTER, 0, nil, TS_TRUE, Result.GutterSize);
+  GetThemePartSize(Theme, DC, MENU_POPUPSUBMENU, 0, nil, TS_TRUE, Result.SubMenuSize);
+  GetThemeMargins(Theme, DC, MENU_POPUPSUBMENU, 0, TMT_CONTENTMARGINS, nil, Result.SubMenuMargins);
 
   if AMenuItem.IsLine then
   begin
-    GetThemePartSize(Theme, 0, MENU_POPUPSEPARATOR, 0, nil, TS_TRUE, Result.SeparatorSize);
+    GetThemePartSize(Theme, DC, MENU_POPUPSEPARATOR, 0, nil, TS_TRUE, Result.SeparatorSize);
     FillChar(Result.TextMargins, SizeOf(Result.TextMargins), 0);
     FillChar(Result.TextSize, SizeOf(Result.TextSize), 0);
   end
@@ -469,7 +469,7 @@
   end
   else
   begin
-    Result.cy := Metrics.CheckSize.cy + Metrics.CheckMargins.cyTopHeight + Metrics.CheckMargins.cyBottomHeight;
+    Result.cy := Metrics.CheckSize.cy + ScaleY(Metrics.CheckMargins.cyTopHeight + Metrics.CheckMargins.cyBottomHeight, 96);
     if AMenuItem.HasIcon then
     begin
       Result.cy := Max(Result.cy, AMenuItem.GetIconSize.y);
@@ -655,7 +655,7 @@
   // calc check/image rect
   CheckRect := ARect;
   CheckRect.Right := CheckRect.Left + Metrics.CheckSize.cx + Metrics.CheckMargins.cxRightWidth + Metrics.CheckMargins.cxLeftWidth;
-  CheckRect.Bottom := CheckRect.Top + Metrics.CheckSize.cy + Metrics.CheckMargins.cyTopHeight + Metrics.CheckMargins.cyBottomHeight;
+  CheckRect.Bottom := CheckRect.Top + Metrics.CheckSize.cy + ScaleY(Metrics.CheckMargins.cyTopHeight + Metrics.CheckMargins.cyBottomHeight, 96);
   // draw gutter
   GutterRect := CheckRect;
   GutterRect.Left := GutterRect.Right + Metrics.CheckBgMargins.cxRightWidth - Metrics.CheckMargins.cxRightWidth;
menu.patch (4,317 bytes)

Paul Ishenin

2010-11-10 11:32

manager   ~0042941

Apply the attached patch. It makes menu height the same as in standard applications. Also please check whether something else requires the change.

lainz

2010-11-10 18:12

reporter   ~0042950

I don't know how to apply the patch, i always downloaded the "daily snapshot" to check issues and report here.

Other things:
- TToolBar DropDown menu item: the width of the "arrow" part of the button isn't resized.
- Messages included in lazarus "DialogMessage" text are cutted at the bottom: resize the height of the dialog form.

All other components may be scaled by the developer because the dpi isn't the same when designing, i try to create the DpiScaling unit (see comment (0042920)), but work's for one component at time.

Paul Ishenin

2010-11-11 02:26

manager   ~0042955

Yesterday I applied a patch which adds ScaleBy() and ScaleControl to LCL. You can try to fix the LCL code to auto apply scaling. I suppose for this task TForm should store a PixelsPerInch property as it does in delphi and call ScaleBy() on form load if PixelsPerInch are different.

But at the moment LCL can't create applications which supports different DPIs. If you want you can try to improve it by supplying patches.

To apply the patch I suggest you to install TortoiseSVN application, then checkout t the Lazarus source code and apply the patch using TortoiseSVN. Then you need to build Lazarus youself. This is not difficult. Doing this once you will not need to wait for daily snapshots anymore.

lainz

2010-11-11 19:56

reporter   ~0042968

Ok i will download the SVN.
I'm a amateur rookie programmer, but i love programming.
I will try to make possible the scaling of dpi, or help within my means.

lainz

2010-11-12 18:22

reporter   ~0042990

I can build sucefully lazarus svn and fpc svn from sources.

The patch works: now the size is ok.

You can set to resolved the issue.

Paul Ishenin

2010-11-13 03:16

manager   ~0043000

Ok, then please update, retest and close.

lainz

2010-11-13 22:19

reporter   ~0043022

Excelent, working menu's and dialogs.

Issue History

Date Modified Username Field Change
2010-11-08 14:13 lainz New Issue
2010-11-08 14:13 lainz File Added: menu.png
2010-11-08 14:13 lainz Widgetset => Win32/Win64
2010-11-08 14:18 Paul Ishenin Status new => assigned
2010-11-08 14:18 Paul Ishenin Assigned To => Paul Ishenin
2010-11-08 14:19 Paul Ishenin LazTarget => 1.0
2010-11-08 14:19 Paul Ishenin Target Version => 1.0.0
2010-11-09 03:12 Paul Ishenin Note Added: 0042902
2010-11-09 03:12 Paul Ishenin Status assigned => feedback
2010-11-09 16:25 lainz Note Added: 0042920
2010-11-09 16:33 lainz Note Edited: 0042920
2010-11-09 17:31 lainz File Added: menu200.png
2010-11-09 17:31 lainz Note Added: 0042924
2010-11-10 04:19 Paul Ishenin Note Added: 0042935
2010-11-10 04:19 Paul Ishenin Status feedback => confirmed
2010-11-10 11:31 Paul Ishenin File Added: menu.patch
2010-11-10 11:32 Paul Ishenin Note Added: 0042941
2010-11-10 18:12 lainz Note Added: 0042950
2010-11-11 02:26 Paul Ishenin Note Added: 0042955
2010-11-11 19:56 lainz Note Added: 0042968
2010-11-12 18:22 lainz Note Added: 0042990
2010-11-13 03:16 Paul Ishenin Fixed in Revision => 28196
2010-11-13 03:16 Paul Ishenin Status confirmed => resolved
2010-11-13 03:16 Paul Ishenin Fixed in Version => 0.9.29 (SVN)
2010-11-13 03:16 Paul Ishenin Resolution open => fixed
2010-11-13 03:16 Paul Ishenin Note Added: 0043000
2010-11-13 22:19 lainz Status resolved => closed
2010-11-13 22:19 lainz Note Added: 0043022
2011-06-28 16:00 lainz Tag Attached: HighDPI