问题
I've found a another regression between Delphi 5 and Delphi XE6.
I have a TPanel that is set to AutoSize itself to its contents (Panel is green):
When the TPanel contains any other control, e.g. a TListView, the panel will auto-size itself to the size of the contained listview:
But when the contained control is a TWebBrowser (or the replacement TEmbeddedWB), the panel will not auto-size:
Must be TWebBrowser's fault
There must be some VCL plumbing needed for auto-sizing that the TWebBrowser VCL wrapper gets wrong. What i need to know what was broken in XE6 and the fix for it.
User user1611655 had a good workaround:
I had a similar problem.
It was solved by putting a
TPanel"underneath" theTWebBrowser, and aligning the web browser toalClient.
I'm less interested in a workaround, as a fix - I can add it to our other pile of VCL source fixes. In reality, since i use the much improved TEmbeddedWB control, the fix can be put in there; leaving TWebBrowser broken.
Steps to Reproduce
The 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.
The 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
回答1:
The issue is caused by two regressions.
- One in in TWinControl.AlignControls
- The other was caused by a change put into TOleControl.SetBounds, although the actual bug is in TWinControl.WMWindowPosChanged.
The "Nothing autosizes ever" bug
The first bug i detailed in the Stackoverflow question 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;
The bug here is that it will not call DoAdjustSize unless either sfWidth or sfHeight scaling flags are present.
The fix is to not try to outsmart yourself, and DoAdjustSize regardless:
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;
The "Doesn't autosize on resize" bug
The previous fix makes the panel AutoSize when it contains child TControl or TWinControl. But there is another bug when the panel contains a TOleControl. The bug was introduced in Delphi XE. Unlike the above bug, caused by someone thinking they were being clever, this one is much more subtle.
When a TOleControl is resized, its SetBounds method is called. This is the original, functional, code:
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;
In XE2 timeframe, the code was changed to so that it notifies the underlying Ole control that it's bounds are about to change:
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;
Unbeknownst to the author, this exposes a bug in TWinControl. The problem with calling IOleInPlaceObject.SetObjectRects is that it the Ole control (e.g. Internet Explorer) turns around and sends the WM_WindowPosChanged message. The WMWindowPoschanged handler in TWinControl doesn't handle the message correctly.
While the regular SetBounds method correctly calls:
procedure SetBounds;
begin
UpdateAnchorRules;
UpdateExplicitBounds;
RequestAlign; //the important one we need
end;
The WMWindowPosChanged method only calls:
procedure WMWindowPosChanged;
begin
UpdateBounds; //which only calls UpdateAnchorRules
end;
This means that the WinControl adjusts its size; but its parent is never realigned to handle the new auto size.
The Fix
The fix is either:
- don't call
IOleInPlaceObject.SetObjectRectsfrom SetBounds at all. Delphi 5 didn't do it and it worked fine change WMWindowPosChanged so that it also calls 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;change UpdateBounds to also call RequestAlign:
procedure TWinControl.UpdateBounds; begin UpdateAnchorRules; //UpdateExplicitBounds; SetBounds calls this; why are we not calling it? RequestAlign; //in response to WM_WindowPosChanged end;
I settled on a fourth solution; one that leaves the bug intact, but fixes it enough for me.
The bug is that:
- WMWindowPosChanged doesn't handle size changes correctly
- but SetBounds does
So lets use SetBounds first.
Leverage the (mostly) correct code in SetBounds to do all the autosizing. Then we can call SetObjectRects. When WMWindowPosChanged receives its WM_WindowPosChanging message, it will have nothing to do - and therefore not do anything wrong.
tl;dr
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.
来源：https://stackoverflow.com/questions/27279670/tpanel-does-not-autosize-when-containing-a-twebbrowser