当将对运行时DPI切换的支持添加到forms类时,未考虑诸如菜单之类的基本UI元素。
菜单绘制从根本上被破坏了,因为它依赖于Screen.MenuFont,它是系统范围的度量标准,不特定于监视器。因此,虽然可以相对简单地正确缩放表单本身,但是,如果缩放恰好与加载到Screen对象中的任何指标匹配,则显示在菜单上的菜单只能正常工作。
这是主菜单栏,其弹出菜单以及表单上所有弹出菜单的问题。如果将表单移到DPI与系统指标不同的监视器中,则这些方法都无法扩展。
真正完成这项工作的唯一方法是修复VCL。等待Embarcadero充实多DPI并不是真正的选择。
查看VCL代码,基本问题是将Screen.MenuFont属性分配给菜单画布,而不是选择适合于将在其上显示菜单的监视器的字体。可以通过在VCL源中搜索Screen.MenuFont来找到受影响的类。
解决此限制而不必完全重新编写所涉及的类的正确方法是什么?
我的第一个倾向是使用弯路来跟踪菜单弹出窗口,并在用于设置菜单时覆盖Screen.MenuFont属性。这似乎太过分了。
这是一种目前有效的解决方案。使用Delphi Detours库,将此单元添加到dpr使用列表中(我必须将其放在其他表单之前的列表顶部附近),从而根据包含以下内容的表单将正确的字体大小应用于菜单画布任何弹出菜单中的菜单项。该解决方案特意忽略了顶层菜单(主菜单栏),因为VCL不能正确处理那里的所有者测量的项目。
unit slMenuDPIFix;
// add this unit to the main application dpr file BEFORE ANY FORMS in the uses list.
interface
implementation
uses
Winapi.Windows, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Menus, slScaleUtils, Math,
DDetours;
type
TMenuClass = class(TMenu);
TMenuItemClass = class(TMenuItem);
var
TrampolineMenuCreate: procedure(const Self: TMenuClass; AOwner: TComponent) = nil;
TrampolineMenuItemAdvancedDrawItem: procedure(const Self: TMenuItemClass; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState; TopLevel: Boolean) = nil;
TrampolineMenuItemMeasureItem: procedure(const Self: TMenuItemClass; ACanvas: TCanvas; var Width, Height: Integer) = nil;
function GetPopupDPI(const MenuItem: TMenuItemClass): Integer;
var
pm: TMenu;
pcf: TCustomForm;
begin
Result := Screen.PixelsPerInch;
pm := MenuItem.GetParentMenu;
if Assigned(pm) and (pm.Owner is TControl) then
pcf := GetParentForm(TControl(pm.Owner))
else
pcf := nil;
if Assigned(pcf) and (pcf is TForm) then
Result := TForm(pcf).PixelsPerInch;
end;
procedure MenuCreateHooked(const Self: TMenuClass; AOwner: TComponent);
begin
TrampolineMenuCreate(Self, AOwner);
Self.OwnerDraw := True; // force always ownerdraw.
end;
procedure MenuItemAdvancedDrawItemHooked(const Self: TMenuItemClass; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState; TopLevel: Boolean);
begin
if (not TopLevel) then
begin
ACanvas.Font.Height := MulDiv(ACanvas.Font.Height, GetPopupDPI(Self), Screen.PixelsPerInch);
end;
TrampolineMenuItemAdvancedDrawItem(Self, ACanvas, ARect, State, TopLevel);
end;
procedure MenuItemMeasureItemHooked(const Self: TMenuItemClass; ACanvas: TCanvas; var Width, Height: Integer);
var
lHeight: Integer;
pdpi: Integer;
begin
pdpi := GetPopupDPI(Self);
if (Self.Caption <> cLineCaption) and (pdpi <> Screen.PixelsPerInch) then
begin
ACanvas.Font.Height := MulDiv(ACanvas.Font.Height, pdpi, Screen.PixelsPerInch);
lHeight := ACanvas.TextHeight('|') + MulDiv(6, pdpi, Screen.PixelsPerInch);
end else
lHeight := 0;
TrampolineMenuItemMeasureItem(Self, ACanvas, Width, Height);
if lHeight > 0 then
Height := Max(Height, lHeight);
end;
initialization
TrampolineMenuCreate := InterceptCreate(@TMenuClass.Create, @MenuCreateHooked);
TrampolineMenuItemAdvancedDrawItem := InterceptCreate(@TMenuItemClass.AdvancedDrawItem, @MenuItemAdvancedDrawItemHooked);
TrampolineMenuItemMeasureItem := InterceptCreate(@TMenuItemClass.MeasureItem, @MenuItemMeasureItemHooked);
finalization
InterceptRemove(@TrampolineMenuCreate);
InterceptRemove(@TrampolineMenuItemAdvancedDrawItem);
InterceptRemove(@TrampolineMenuItemMeasureItem);
end.
一个人可以同样轻松地修补Vcl.Menus,但我不想这样做。
本文收集自互联网,转载请注明来源。
如有侵权,请联系 [email protected] 删除。
我来说两句