【问题标题】:TPanel does not AutoSize when containing a TWebBrowser包含 TWebBrowser 时,TPanel 不自动调整大小
【发布时间】:2015-02-01 11:38:45
【问题描述】:

我发现 Delphi 5 和 Delphi XE6 之间存在another 回归。

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

TPanel 包含任何其他控件时,例如TListView,面板将自动调整大小为包含的列表视图的大小:

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

一定是 TWebBrowser 的错

TWebBrowser VCL 包装器出错时,必须有一些自动调整大小的 VCL 管道。我需要知道 XE6 中的问题及其修复方法。

User user1611655 had a good workaround:

我遇到了类似的问题。

通过在TWebBrowser“下方”放置一个TPanel 并将网络浏览器与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

【问题讨论】:

  • 必须与您在放置 Web 浏览器时绘制框的方式相同,无论您制作的框尺寸如何,它仍然可以按照自己的意愿缩放。
  • 这与面板计算 Web 浏览器控件大小的方式有关。如果您将 TWebBrowser 放在面板上,然后使用键盘增加其尺寸,然后在对象检查器中关闭并重新打开面板的 AutoSize 属性,面板将自行调整到适当的大小。
  • 我认为它必须由TWebBrowser 的创建驱动。具体来说,覆盖默认值并重置自身。一旦它在那里似乎就不会发生,除了我仍然看到奇怪的行为。我认为控件会自动加载两次,第二次忽略您第一次可能指示它的任何内容(例如,位置/大小属性)。如果我在那里的某个地方找到像Application.ProcessMessages; 这样的东西,我不会感到惊讶...... :-)
  • 再一次,转发Windows消息可能只是简单的失败......
  • 通常我会设置WebBrowser1.Align := alClient。我改为更新Panel1 的大小。

标签: delphi delphi-xe6 twebbrowser


【解决方案1】:

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

  • 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;

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

解决办法是不要试图超越自己,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;

注意:任何发布到公共领域的代码。无需署名。

【讨论】:

    猜你喜欢
    • 2015-06-06
    • 1970-01-01
    • 2014-11-06
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 2021-07-24
    • 2017-04-29
    • 1970-01-01
    相关资源
    最近更新 更多