paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-01 21:20:28 +02:00
Code Issues Packages Projects Releases Wiki Activity

win32: correct vista+ menu size for other DPIs (issue #0017878)

Browse Source 
git-svn-id: trunk@28196 -
This commit is contained in:
paul 2010-11-13 02:16:03 +00:00
parent 1805cdf4fb
commit 78a7d0a8a8
2 changed files with 29 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
lcl/graphics.pp
View File

@ -1948,8 +1948,12 @@ function CreateBitmapFromFPImage(Img: TFPCustomImage): TBitmap;
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 @@ const
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 @@ begin
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,

20
lcl/interfaces/win32/win32wsmenus.pp
View File

@ -367,17 +367,17 @@ var
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 @@ begin
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 @@ begin
// 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;