对话框在 Windows 8 中向左和向上移动
Dialog shifted to the left and upward in Windows 8
此对话框正好显示在按钮下方,但在 Windows 8 中,对话框向左和向上移动。如何在所有 Windows 版本中获得相同的结果?
procedure TForm1.Button3Click(Sender: TObject);
var p: TPoint;
begin
p := Button3.ClientToScreen(Point(0, Button3.Height));
MessageDlgPos('', mtInformation, [mbOK], 0, p.X, p.Y);
end;
更新:
如果我们打开窗体而不是对话框,并且如果该窗体具有 BorderStyle bsSizeable 或 bsSizeToolWin,则一切正常。否则(bsDialog、bsSingle、bsToolWindow),窗体打开时从上面的例子转变为对话框。
运行 您在 Windows 7 上显示的确切代码,我无法重现您在 Windows 7 屏幕截图中显示的相同对话框定位。 MessageDlgPos
window 以与 Windows 8 屏幕截图相同的方式向上和向左偏移:
话虽如此,我注意到您正在相对于按钮的 客户区 :
定位 MessageDlg
window
如果您希望对话框相对于其实际 底边 定位,您需要在按钮 Parent
上调用 ClientToScreen()
而不是在按钮上本身:
p := Button3.Parent.ClientToScreen(Point(Button3.Left, Button3.Top+Button3.Height));
虽然最终结果大致相同:
现在,为什么首先会出现重叠?因为 window 的位置使其非客户区的左上角落在指定坐标处:
您可以调整 window 坐标来解决这个问题:
p := Button3.Parent.ClientToScreen(Point(Button3.Left, Button3.Top + Button3.Height));
Inc(p.X, GetSystemMetrics(SM_CXFIXEDFRAME) + GetSystemMetrics(SM_CXBORDER));
Inc(p.Y, GetSystemMetrics(SM_CYFIXEDFRAME) + GetSystemMetrics(SM_CYBORDER));
这会让您更接近理想的位置:
请注意 Aero "tweaks" 系统指标,因此您可能需要使用 DwmGetWindowAttribute(DWMWA_EXTENDED_FRAME_BOUNDS)
and/or GetThemeSysSize()
之类的东西来获得更准确的指标。
在您的回答和评论以及一些额外的研究之后,我找到了这个解决方案。在 Windows 上测试 8、7 有 Aero,7 没有 Aero 和 XP。我希望有更简单和稳定的东西,但是 ...
uses DwmApi;
type
TNonClientMetricsX = packed record
cbSize: UINT;
iBorderWidth: Integer; iScrollWidth: Integer;
iScrollHeight: Integer; iCaptionWidth: Integer;
iCaptionHeight: Integer; lfCaptionFont: TLogFontA;
iSmCaptionWidth: Integer; iSmCaptionHeight: Integer;
lfSmCaptionFont: TLogFontA; iMenuWidth: Integer;
iMenuHeight: Integer; lfMenuFont: TLogFontA;
lfStatusFont: TLogFontA; lfMessageFont: TLogFontA;
iPaddedBorderWidth: Integer; // not defined in Delphi 2007
end;
function GetExtendedFrameOffset(BorderStyle: TFormBorderStyle): integer;
var
IsEnabled: BOOL;
NCM: TNonClientMetricsX;
begin
Result := 0;
if (DwmIsCompositionEnabled(IsEnabled) = S_OK) and IsEnabled and
(BorderStyle in [bsdialog, bsSingle, bsToolWindow]) then
begin
NCM.cbSize := SizeOf(NCM);
SystemParametersInfo(SPI_GETNONCLIENTMETRICS, SizeOf(NCM), @NCM, 0);
Result := NCM.iBorderWidth + NCM.iPaddedBorderWidth;
end;
end;
procedure TForm1.Button3Click(Sender: TObject);
var p: TPoint; offset: integer;
begin
p := Button3.ClientToScreen(Point(0, Button3.Height));
offset := GetExtendedFrameOffset(bsDialog);
MessageDlgPos('', mtInformation, [mbOK], 0, p.X + offset, p.Y + offset);
end;
更新:D2007 包含 DwmApi,因此无需与 LoadLibrary 并发
此对话框正好显示在按钮下方,但在 Windows 8 中,对话框向左和向上移动。如何在所有 Windows 版本中获得相同的结果?
procedure TForm1.Button3Click(Sender: TObject);
var p: TPoint;
begin
p := Button3.ClientToScreen(Point(0, Button3.Height));
MessageDlgPos('', mtInformation, [mbOK], 0, p.X, p.Y);
end;
更新: 如果我们打开窗体而不是对话框,并且如果该窗体具有 BorderStyle bsSizeable 或 bsSizeToolWin,则一切正常。否则(bsDialog、bsSingle、bsToolWindow),窗体打开时从上面的例子转变为对话框。
运行 您在 Windows 7 上显示的确切代码,我无法重现您在 Windows 7 屏幕截图中显示的相同对话框定位。 MessageDlgPos
window 以与 Windows 8 屏幕截图相同的方式向上和向左偏移:
话虽如此,我注意到您正在相对于按钮的 客户区 :
定位MessageDlg
window
如果您希望对话框相对于其实际 底边 定位,您需要在按钮 Parent
上调用 ClientToScreen()
而不是在按钮上本身:
p := Button3.Parent.ClientToScreen(Point(Button3.Left, Button3.Top+Button3.Height));
虽然最终结果大致相同:
现在,为什么首先会出现重叠?因为 window 的位置使其非客户区的左上角落在指定坐标处:
您可以调整 window 坐标来解决这个问题:
p := Button3.Parent.ClientToScreen(Point(Button3.Left, Button3.Top + Button3.Height));
Inc(p.X, GetSystemMetrics(SM_CXFIXEDFRAME) + GetSystemMetrics(SM_CXBORDER));
Inc(p.Y, GetSystemMetrics(SM_CYFIXEDFRAME) + GetSystemMetrics(SM_CYBORDER));
这会让您更接近理想的位置:
请注意 Aero "tweaks" 系统指标,因此您可能需要使用 DwmGetWindowAttribute(DWMWA_EXTENDED_FRAME_BOUNDS)
and/or GetThemeSysSize()
之类的东西来获得更准确的指标。
在您的回答和评论以及一些额外的研究之后,我找到了这个解决方案。在 Windows 上测试 8、7 有 Aero,7 没有 Aero 和 XP。我希望有更简单和稳定的东西,但是 ...
uses DwmApi;
type
TNonClientMetricsX = packed record
cbSize: UINT;
iBorderWidth: Integer; iScrollWidth: Integer;
iScrollHeight: Integer; iCaptionWidth: Integer;
iCaptionHeight: Integer; lfCaptionFont: TLogFontA;
iSmCaptionWidth: Integer; iSmCaptionHeight: Integer;
lfSmCaptionFont: TLogFontA; iMenuWidth: Integer;
iMenuHeight: Integer; lfMenuFont: TLogFontA;
lfStatusFont: TLogFontA; lfMessageFont: TLogFontA;
iPaddedBorderWidth: Integer; // not defined in Delphi 2007
end;
function GetExtendedFrameOffset(BorderStyle: TFormBorderStyle): integer;
var
IsEnabled: BOOL;
NCM: TNonClientMetricsX;
begin
Result := 0;
if (DwmIsCompositionEnabled(IsEnabled) = S_OK) and IsEnabled and
(BorderStyle in [bsdialog, bsSingle, bsToolWindow]) then
begin
NCM.cbSize := SizeOf(NCM);
SystemParametersInfo(SPI_GETNONCLIENTMETRICS, SizeOf(NCM), @NCM, 0);
Result := NCM.iBorderWidth + NCM.iPaddedBorderWidth;
end;
end;
procedure TForm1.Button3Click(Sender: TObject);
var p: TPoint; offset: integer;
begin
p := Button3.ClientToScreen(Point(0, Button3.Height));
offset := GetExtendedFrameOffset(bsDialog);
MessageDlgPos('', mtInformation, [mbOK], 0, p.X + offset, p.Y + offset);
end;
更新:D2007 包含 DwmApi,因此无需与 LoadLibrary 并发