In Delphi calling FlipChildren on THeadercontrol is rasing an error

Question

I just came across a behavior in Delphi which seems to be a bug to me.

In Delphi, just drop a THeaderControl on a form and assign at least one section to it. If you call FlipChildren(true) on that current form a "list index out of bounds" error is getting raised. It looks like there's a problem within the FlipChildren procedure of TCustomHeaderControl.

Since the same behavior is reproducible in various versions of Delphi (I've tried Delphi 6 and Delphi 2010), i'm a bit reluctant to classify this one as a bug. Anyone else have encountered this issue before?

Answer 1

It is categorically a bug. I expect that the code worked way back in Delphi 1, but that the implementation of THeaderSections changed in a way that broke it. And it would seem that you are the first person to execute the code since then!

Here is the code:

procedure TCustomHeaderControl.FlipChildren(AllLevels: Boolean);
var
  Loop, FirstWidth, LastWidth: Integer;
  ASectionsList: THeaderSections;
begin
  if HandleAllocated and
     (Sections.Count > 0) then
  begin
    { Get the true width of the last section }
    LastWidth := ClientWidth;
    FirstWidth := Sections[0].Width;
    for Loop := 0 to Sections.Count - 2 do Dec(LastWidth, Sections[Loop].Width);
    { Flip 'em }
    ASectionsList := THeaderSections.Create(Self);
    try
      for Loop := 0 to Sections.Count - 1 do with ASectionsList.Add do
        Assign(Self.Sections[Loop]);
      for Loop := 0 to Sections.Count - 1 do
        Sections[Loop].Assign(ASectionsList[Sections.Count - Loop - 1]);
    finally
      ASectionsList.Free;
    end;
    { Set the width of the last Section }
    if Sections.Count > 1 then
    begin
      Sections[Sections.Count-1].Width := FirstWidth;
      Sections[0].Width := LastWidth;
    end;
    UpdateSections;
  end;
end;

The idea is to build a temporary list of header sections, assigning properties from the true sections. Then loop over the temporary list in reverse order assigning back to the true list of header sections. But it doesn't work.

The entire code is bogus because there is actually only one collection involved. The collection associated with the control. The design of THeaderSections assumes that there will be a one-to-one relationship between header controls and THeaderSections objects. As can readily be observed, ASectionsList.Add actually adds items to SectionsList!

So, when this code finishes running

for Loop := 0 to Sections.Count - 1 do with ASectionsList.Add do
  Assign(Self.Sections[Loop]);

you will observe that Sections.Count has doubled, and ASectionsList.Count is still zero. So then when we proceed to run

for Loop := 0 to Sections.Count - 1 do
  Sections[Loop].Assign(ASectionsList[Sections.Count - Loop - 1]);

the access of ASectionsList[Sections.Count - Loop - 1] is out of bounds.

The code is astoundingly bad. I am simply appalled by it. All that is needed is a simple integer array containing the widths. Here is how it should look, implemented with an interposer:

type
  THeaderControl = class(Vcl.ComCtrls.THeaderControl)
  public
    procedure FlipChildren(AllLevels: Boolean); override;
  end;

procedure THeaderControl.FlipChildren(AllLevels: Boolean);
var
  Index, Count: Integer;
  Widths: TArray<Integer>;
begin
  Count := Sections.Count;
  if Count>1 then
  begin
    SetLength(Widths, Count);
    for Index := 0 to Count-2 do
      Widths[Index] := Sections[Index].Width;
    Widths[Count-1] := ClientWidth;
    for Index := 0 to Count-2 do
      dec(Widths[Count-1], Widths[Index]);
    Sections.BeginUpdate;
    try
      for Index := 0 to Sections.Count-1 do
        Sections[Index].Width := Widths[Count-Index-1];
    finally
      Sections.EndUpdate;
    end;
  end;
end;

I suggest that you submit a QC report.