gpt4 book ai didi

delphi - TPanel 在包含 TWebBrowser 时不会自动调整大小

转载 作者:行者123 更新时间:2023-12-03 15:25:02 31 4
gpt4 key购买 nike

我找到了 another Delphi 5 和 Delphi XE6 之间的回归。

我有一个 TPanel,它被设置为其内容的 AutoSize 本身(面板为绿色):

enter image description here

TPanel包含任何其他控件时,例如一个TListView,面板将自动调整自身大小以适应所包含 ListView 的大小:

enter image description here

但是当包含的控件是 TWebBrowser (或替换 TEmbeddedWB )时,面板将不会自动调整大小:

enter image description here

一定是 TWebBrowser 的错误

自动调整大小肯定需要一些 VCL 管道,TWebBrowser VCL 包装器会出错。我需要知道 XE6 中的问题以及修复方法。

User user1611655 had a good workaround :

I had a similar problem.

It was solved by putting a TPanel "underneath" the TWebBrowser, and aligning the web browser to alClient.

我对解决方法不太感兴趣,作为修复 - 我可以将其添加到我们的其他一堆 VCL 源修复中。实际上,由于我使用了经过改进的 TEmbeddedWB 控件,因此可以将修复程序放在其中;让 TWebBrowser 损坏。

重现步骤

Form1.pas:

unit Unit1;

interface

uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, Vcl.ExtCtrls, Vcl.OleCtrls, SHDocVw;

type
TForm1 = class(TForm)
Panel1: TPanel;
WebBrowser1: TWebBrowser;
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

end.

Form1.dfm:

object Form1: TForm1
Left = 0
Top = 0
Caption = 'Form1'
ClientHeight = 248
ClientWidth = 373
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object Panel1: TPanel
Left = 32
Top = 32
Width = 209
Height = 97
AutoSize = True
BevelOuter = bvNone
Color = clLime
ParentBackground = False
TabOrder = 0
object WebBrowser1: TWebBrowser
Left = 0
Top = 0
Width = 190
Height = 161
ParentShowHint = False
ShowHint = False
TabOrder = 0
ControlData = {
4C00000023260000E40500000000000000000000000000000000000000000000
000000004C000000000000000000000001000000E0D057007335CF11AE690800
2B2E126208000000000000004C0000000114020000000000C000000000000046
8000000000000000000000000000000000000000000000000000000000000000
00000000000000000100000000000000000000000000000000000000}
end
end
end

最佳答案

该问题是由两个回归引起的。

  • TWinControl.AlignControls 中的一个
  • 另一个是由 TOleControl.SetBounds 中的更改引起的,尽管实际的错误是在 TWinControl.WMWindowPosChanged 中。

“永远不会自动调整大小”错误

我在 Stackoverflow 问题 TPanel does not AutoSize when containing a TPanel 中详细描述的第一个错误:

procedure TWinControl.AlignControls(AControl: TControl; var Rect: TRect);
begin
//...snip

// Apply any constraints
if Showing and ((sfWidth in FScalingFlags) or (sfHeight in FScalingFlags)) then
DoAdjustSize;

//...snip
end;

这里的错误是,除非存在 sfWidthsfHeight 缩放标志,否则它不会调用 DoAdjustSize

解决方法是不要试图超越自己,并且无论如何DoAdjustSize:

procedure TWinControl.AlignControls(AControl: TControl; var Rect: TRect);
begin
//...snip

// Apply any constraints
//QC125995: Don't look to scaling flags to decide if we should adjust size
if Showing {and ((sfWidth in FScalingFlags) or (sfHeight in FScalingFlags))} then
DoAdjustSize;

//...snip
end;

“调整大小时不自动调整大小”错误

先前的修复使面板在包含子 TControlTWinControl 时自动调整大小。但是当面板包含TOleControl时,还有另一个错误。该错误是在 Delphi XE 中引入的。与上面的错误不同,这个错误是由于某人认为自己很聪明而引起的,这个错误要微妙得多。

当调整TOleControl的大小时,会调用它的SetBounds方法。这是原始的功能代码:

procedure TOleControl.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
if ((AWidth <> Width) and (Width > 0)) or ((AHeight <> Height) and (Height > 0)) then
begin
//...snip: perhaps tweak AWidth and AHeight
end;

inherited SetBounds(ALeft, ATop, AWidth, AHeight);
end;

在 XE2 时间范围内,代码已更改为,以便通知底层 Ole 控件其边界即将更改:

procedure TOleControl.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
var
LRect: TRect;
begin
if ((AWidth <> Width) and (Width > 0)) or ((AHeight <> Height) and (Height > 0)) then
begin
//...snip: perhaps tweak AWidth and AHeight

//Notify the underlying Ole control that its bounds are about to change
if FOleInplaceObject <> nil then
begin
LRect := Rect(Left, Top, Left+AWidth, Top+AHeight);
FOleInplaceObject.SetObjectRects(LRect, LRect);
end;
end;

inherited SetBounds(ALeft, ATop, AWidth, AHeight);
end;

作者不知道的是,这暴露了 TWinControl 中的一个错误。调用IOleInPlaceObject.SetObjectRects的问题是 Ole 控件(例如 Internet Explorer)转身并发送 WM_WindowPosChanged信息。 TWinControl 中的 WMWindowPoschanged 处理程序无法正确处理该消息。

虽然常规 SetBounds 方法正确调用:

procedure SetBounds;
begin
UpdateAnchorRules;
UpdateExplicitBounds;
RequestAlign; //the important one we need
end;

WMWindowPosChanged 方法仅调用:

procedure WMWindowPosChanged;
begin
UpdateBounds; //which only calls UpdateAnchorRules
end;

这意味着WinControl调整了它的大小;但其父级永远不会重新调整以处理新的自动大小。

修复

修复方法是:

  • 根本不要从 SetBounds 调用 IOleInPlaceObject.SetObjectRects。 Delphi 5 没有做到,而且运行得很好
  • 更改 WMWindowPosChanged,以便它也调用 RequestAlign:

      procedure TWinControl.WMWindowPosChanged;
    begin
    UpdateBounds;
    RequestAlign; //don't forget to autosize our parent since we're changing our size behind our backs (e.g. TOleControl)
    end;
  • 更改 UpdateBounds 以同时调用 RequestAlign:

     procedure TWinControl.UpdateBounds;
    begin
    UpdateAnchorRules;
    //UpdateExplicitBounds; SetBounds calls this; why are we not calling it?
    RequestAlign; //in response to WM_WindowPosChanged
    end;

我选择了第四种解决方案;一个完整保留错误的方法,但对我来说已经足够修复它了。

错误在于:

  • WMWindowPosChanged 无法正确处理尺寸更改
  • 但是SetBounds可以

所以我们首先使用SetBounds

利用SetBounds中(大部分)正确的代码来完成所有自动调整大小。然后我们可以调用SetObjectRects。当 WMWindowPosChanged 收到其 WM_WindowPosChanging 消息时,它将无事可做 - 因此不会做任何错误。

tl;博士

procedure TOleControl.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
var
LRect: TRect;
begin
if ((AWidth <> Width) and (Width > 0)) or ((AHeight <> Height) and (Height > 0)) then
begin
//...snip: perhaps fiddle with AWidth or AHeight

{Removed. Call *after* inheirted SetBounds
//Notify the underlying Ole control that its bounds are about to change
if FOleInplaceObject <> nil then
begin
LRect := Rect(Left, Top, Left+AWidth, Top+AHeight);
FOleInplaceObject.SetObjectRects(LRect, LRect);
end;}
end;

inherited SetBounds(ALeft, ATop, AWidth, AHeight);

//moved to call *after* SetBounds, we need SetBounds to happen first.
//TWinControl's WMWindowPosChanged does not handle autosizing correctly
//while SetBounds does.
//Notify the underlying Ole control that its bounds are already about to change
if FOleInplaceObject <> nil then
begin
LRect := Rect(Left, Top, Left+AWidth, Top+AHeight);
FOleInplaceObject.SetObjectRects(LRect, LRect);
end;
end;

Note: Any code released into public domain. No attribution required.

关于delphi - TPanel 在包含 TWebBrowser 时不会自动调整大小,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/27279670/

31 4 0
Copyright 2021 - 2024 cfsdn All Rights Reserved 蜀ICP备2022000587号
广告合作:1813099741@qq.com 6ren.com