Search code examples
delphidelphi-7panel

Deleting dynamic controls - Access Violations in one scenario, but not another

I whipped up this little sample application to demonstrate how to maintain a list of controls, specifically a number of dynamically created TPanel controls, each containing a number of sub-controls. Everything seems to work fine, except for one weird thing. Of course when I close my app, it goes through all the created controls and free's them. This works perfectly. But strangely, when I try to delete one of them, I get an access violation in the same code which works perfectly upon closing.

Just to explain the code below a little, there's a TStringList in the background which contains an object for each panel. I also maintain a "Last ID" which I assign to the tag of these panels, as well as the panel's child controls. The panels are dumped and aligned inside of a scroll box, so it's like a list control of panels with controls. Each panel can be referenced either by its Index or by its unique ID. The trouble started when implementing a 'Delete' button on each panel which is supposed to remove it. Clicking this delete button checks the ID in its tag property, and calls a procedure to delete that ID. In debug, I traced the ID and Index and it is what it's supposed to be, but it doesn't do what it's supposed to do...

unit uMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, Buttons, XPMan;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Label1: TLabel;
    BitBtn1: TBitBtn;
    pMain: TScrollBox;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
  private
    FLastID: Integer;
    FPanels: TStringList;
    function GetPanel(Index: Integer): TPanel;
    procedure DelPanClick(Sender: TObject);
    function GetPanelID(ID: Integer): TPanel;
  public
    function GetID: Integer;
    property Panels[Index: Integer]: TPanel read GetPanel;
    property PanelByID[ID: Integer]: TPanel read GetPanelID;
    function Add: TPanel;
    procedure Delete(const Index: Integer);
    procedure DeleteID(const ID: Integer);
    function Count: Integer;
    procedure Clear;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function TForm1.Add: TPanel;
const
  MARGINS = 8;
var
  L1, L2: TLabel;
  E1: TEdit;
  C1: TComboBox;
  B1: TBitBtn;
begin
  Result:= TPanel.Create(nil);
  Result.Parent:= pMain;
  Result.Align:= alLeft;
  Result.Width:= 150;
  Result.ParentBackground:= True;
  Result.ParentBackground:= False; //TPanel/XPMan color trick...
  Result.Color:= clSilver;
  Result.Tag:= GetID;

  L1:= TLabel.Create(Result);
  L1.Parent:= Result;
  L1.Left:= MARGINS;
  L1.Top:= MARGINS;
  L1.Caption:= 'Some Text Box';
  L1.Font.Style:= [fsBold];
  L1.Tag:= Result.Tag;

  E1:= TEdit.Create(Result);
  E1.Parent:= Result;
  E1.Left:= MARGINS;
  E1.Top:= L1.Top + L1.Height + MARGINS;
  E1.Width:= Result.ClientWidth - (MARGINS * 2);
  E1.Anchors:= [akLeft,akTop,akRight];
  E1.Text:= 'Some String Value';
  E1.Tag:= Result.Tag;

  L2:= TLabel.Create(Result);
  L2.Parent:= Result;
  L2.Left:= MARGINS;
  L2.Top:= E1.Top + E1.Height + (MARGINS * 2);
  L2.Caption:= 'Some Combo Box';
  L2.Font.Style:= [fsBold];
  L2.Tag:= Result.Tag;

  C1:= TComboBox.Create(Result);
  C1.Parent:= Result;
  C1.Left:= MARGINS;
  C1.Top:= L2.Top + L2.Height + MARGINS;
  C1.Width:= Result.ClientWidth - (MARGINS * 2);
  C1.Style:= csDropDownList;
  C1.Items.Append('Some Selected Value');
  C1.Items.Append('Some Other Value');
  C1.ItemIndex:= 0;
  C1.Tag:= Result.Tag;

  B1:= TBitBtn.Create(Result);
  B1.Parent:= Result;
  B1.Width:= 60;
  B1.Height:= 25;
  B1.Left:= MARGINS;
  B1.Top:= Result.ClientHeight - B1.Height - MARGINS;
  B1.Anchors:= [akLeft,akBottom];
  B1.Caption:= 'Delete';
  B1.OnClick:= DelPanClick;
  B1.Tag:= Result.Tag;

  FPanels.AddObject(IntToStr(Result.Tag), Result);

end;

procedure TForm1.Clear;
begin
  while Count > 0 do
    Delete(0);
end;

function TForm1.Count: Integer;
begin
  Result:= FPanels.Count;
end;

procedure TForm1.Delete(const Index: Integer);
var
  P: TPanel;
begin
  if (Index >= 0) and (Index < FPanels.Count) then begin
    try
      P:= TPanel(FPanels.Objects[Index]);
      if assigned(P) then begin
        P.Free; //<----- AV
      end;
    except
      on e: exception do begin
        raise Exception.Create('Failed to delete panel: '+e.Message);
      end;
    end;
    FPanels.Delete(Index);
  end else begin
    raise Exception.Create('Panel index out of bounds ('+IntToStr(Index)+')');
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FLastID:= 100;
  pMain.Align:= alClient;
  FPanels:= TStringList.Create;
  Add;
  Add;
  Add;   
  Add;
  Add;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  Clear;
  FPanels.Free;
end;

function TForm1.GetPanel(Index: Integer): TPanel;
begin
  Result:= TPanel(FPanels.Objects[Index]);
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
  Add;
end;

procedure TForm1.DelPanClick(Sender: TObject);
begin
  if Sender is TBitBtn then begin
    DeleteID(TBitBtn(Sender).Tag);
  end;
end;

function TForm1.GetID: Integer;
begin
  Inc(FLastID);
  Result:= FLastID;
end;

procedure TForm1.DeleteID(const ID: Integer);
var
  X: Integer;
begin
  X:= FPanels.IndexOf(IntToStr(ID));
  if X >= 0 then begin
    Delete(X);
  end else begin
    raise Exception.Create('Invalid ID ('+IntToStr(ID)+')');
  end;
end;

function TForm1.GetPanelID(ID: Integer): TPanel;
var
  X: Integer;
begin   
  X:= FPanels.IndexOf(IntToStr(ID));
  if X >= 0 then begin
    Result:= TPanel(FPanels.Objects[X]);
  end else begin
    raise Exception.Create('Invalid ID ('+IntToStr(ID)+')');
  end;
end;

end.

And the DFM code:

object Form1: TForm1
  Left = 385
  Top = 556
  Width = 540
  Height = 247
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  PixelsPerInch = 96
  TextHeight = 13
  object Panel1: TPanel
    Left = 0
    Top = 0
    Width = 524
    Height = 33
    Align = alTop
    BevelWidth = 2
    Color = clWhite
    ParentBackground = False
    TabOrder = 0
    DesignSize = (
      524
      33)
    object Label1: TLabel
      Left = 8
      Top = 6
      Width = 218
      Height = 20
      Caption = 'Sample Dynamic Panel List'
      Font.Charset = DEFAULT_CHARSET
      Font.Color = clWindowText
      Font.Height = -16
      Font.Name = 'MS Sans Serif'
      Font.Style = [fsBold]
      ParentFont = False
    end
    object BitBtn1: TBitBtn
      Left = 450
      Top = 8
      Width = 57
      Height = 17
      Anchors = [akTop, akRight]
      Caption = 'Add'
      TabOrder = 0
      OnClick = BitBtn1Click
    end
  end
  object pMain: TScrollBox
    Left = 0
    Top = 33
    Width = 475
    Height = 176
    Align = alLeft
    Anchors = [akLeft, akTop, akRight, akBottom]
    BorderStyle = bsNone
    Color = clSkyBlue
    ParentColor = False
    TabOrder = 1
  end
end

The panel eventually deletes, after these 3 access violations:

3 Access Violations

EDIT:

After making a few additions to my code, and adding David's fix, it did work, but now another A/V comes upon deleting the third of 5 panels, if deleting from left to right. But from deleting right to left, it all works fine. Here's my new code below, DFM is the same as above:

unit uMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, Buttons, XPMan;

const
  LABEL_1 =     0;
  EDIT_1 =      1;
  LABEL_2 =     2;
  COMBO_1 =     3;
  BUTTON_1 =    4;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Label1: TLabel;
    BitBtn1: TBitBtn;
    pMain: TScrollBox;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
  private
    FLastID: Integer;
    FPanels: TStringList;
    function GetPanel(Index: Integer): TPanel;
    procedure DelPanClick(Sender: TObject);
    function GetPanelID(ID: Integer): TPanel;
    function GetBtn1(Index: Integer): TBitBtn;
    function GetCbo1(Index: Integer): TComboBox;
    function GetEdt1(Index: Integer): TEdit;
    function GetLbl1(Index: Integer): TLabel;
    function GetLbl2(Index: Integer): TLabel;
    function GetBtn1ID(ID: Integer): TBitBtn;
    function GetCbo1ID(ID: Integer): TComboBox;
    function GetEdt1ID(ID: Integer): TEdit;
    function GetLbl1ID(ID: Integer): TLabel;
    function GetLbl2ID(ID: Integer): TLabel;
  public
    function GetID: Integer;
    property Panels[Index: Integer]: TPanel read GetPanel;
    property Lbl1[Index: Integer]: TLabel read GetLbl1;
    property Lbl2[Index: Integer]: TLabel read GetLbl2;
    property Edt1[Index: Integer]: TEdit read GetEdt1;
    property Cbo1[Index: Integer]: TComboBox read GetCbo1;
    property Btn1[Index: Integer]: TBitBtn read GetBtn1;    
    property PanelByID[ID: Integer]: TPanel read GetPanelID;
    property Lbl1ByID[Index: Integer]: TLabel read GetLbl1ID;
    property Lbl2ByID[Index: Integer]: TLabel read GetLbl2ID;
    property Edt1ByID[Index: Integer]: TEdit read GetEdt1ID;
    property Cbo1ByID[Index: Integer]: TComboBox read GetCbo1ID;
    property Btn1ByID[Index: Integer]: TBitBtn read GetBtn1ID;
    function Add: TPanel;
    procedure Delete(const Index: Integer);
    procedure DeleteID(const ID: Integer);
    function Count: Integer;
    procedure Clear;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function TForm1.Add: TPanel;
const
  MARGINS = 8;
var
  L1, L2: TLabel;
  E1: TEdit;
  C1: TComboBox;
  B1: TBitBtn;
begin
  Result:= TPanel.Create(nil);
  Result.Parent:= pMain;
  Result.Align:= alLeft;
  Result.Width:= 150;
  Result.ParentBackground:= True;
  Result.ParentBackground:= False; //TPanel/XPMan color trick...
  Result.Color:= clSilver;
  Result.Tag:= GetID;

  //LABEL_1 =     0;
  //EDIT_1 =      1;
  //LABEL_2 =     2;
  //COMBO_1 =     3;
  //BUTTON_1 =    4;

  L1:= TLabel.Create(Result);
  L1.Parent:= Result;
  L1.Left:= MARGINS;
  L1.Top:= MARGINS;
  L1.Caption:= 'Some Text Box';
  L1.Font.Style:= [fsBold];
  L1.Tag:= Result.Tag;

  E1:= TEdit.Create(Result);
  E1.Parent:= Result;
  E1.Left:= MARGINS;
  E1.Top:= L1.Top + L1.Height + MARGINS;
  E1.Width:= Result.ClientWidth - (MARGINS * 2);
  E1.Anchors:= [akLeft,akTop,akRight];
  E1.Text:= 'Some String Value';
  E1.Tag:= Result.Tag;

  L2:= TLabel.Create(Result);
  L2.Parent:= Result;
  L2.Left:= MARGINS;
  L2.Top:= E1.Top + E1.Height + (MARGINS * 2);
  L2.Caption:= 'Some Combo Box';
  L2.Font.Style:= [fsBold];
  L2.Tag:= Result.Tag;

  C1:= TComboBox.Create(Result);
  C1.Parent:= Result;
  C1.Left:= MARGINS;
  C1.Top:= L2.Top + L2.Height + MARGINS;
  C1.Width:= Result.ClientWidth - (MARGINS * 2);
  C1.Style:= csDropDownList;
  C1.Items.Append('Some Selected Value');
  C1.Items.Append('Some Other Value');
  C1.ItemIndex:= 0;
  C1.Tag:= Result.Tag;

  B1:= TBitBtn.Create(Result);
  B1.Parent:= Result;
  B1.Width:= 60;
  B1.Height:= 25;
  B1.Left:= MARGINS;
  B1.Top:= Result.ClientHeight - B1.Height - MARGINS;
  B1.Anchors:= [akLeft,akBottom];
  B1.Caption:= 'Delete';
  B1.OnClick:= DelPanClick;
  B1.Tag:= Result.Tag;

  FPanels.AddObject(IntToStr(Result.Tag), Result);

end;

procedure TForm1.Clear;
begin
  while Count > 0 do
    Delete(0);
end;

function TForm1.Count: Integer;
begin
  Result:= FPanels.Count;
end;

procedure TForm1.Delete(const Index: Integer);
var
  P: TPanel;
begin
  if (Index >= 0) and (Index < FPanels.Count) then begin
    try
      P:= Panels[Index];
      while P.ControlCount > 0 do
        P.Controls[0].Free;
      P.Free;
    except
      on e: exception do begin
        raise Exception.Create('Failed to delete panel: '+e.Message);
      end;
    end;
    FPanels.Delete(Index);
  end else begin
    raise Exception.Create('Panel index out of bounds ('+IntToStr(Index)+')');
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  X: Integer;
begin
  FLastID:= 100;
  pMain.Align:= alClient;
  FPanels:= TStringList.Create;
  Add;
  Add;
  Add;
  Add;
  Add;
  for X:= 0 to Count - 1 do begin
    Edt1[X].Text:= IntToStr(X);
    Lbl1[X].Caption:= IntToStr(X);
    Lbl2[X].Caption:= IntToStr(X);
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  Clear;
  FPanels.Free;
end;

function TForm1.GetPanel(Index: Integer): TPanel;
begin
  Result:= TPanel(FPanels.Objects[Index]);
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
  Add;
end;

procedure TForm1.DelPanClick(Sender: TObject);
begin
  if Sender is TBitBtn then begin
    DeleteID(TBitBtn(Sender).Tag);
  end;
end;

function TForm1.GetID: Integer;
begin
  Inc(FLastID);
  Result:= FLastID;
end;

procedure TForm1.DeleteID(const ID: Integer);
var
  X: Integer;
begin
  X:= FPanels.IndexOf(IntToStr(ID));
  if X >= 0 then begin
    Delete(X);
  end else begin
    raise Exception.Create('Invalid ID ('+IntToStr(ID)+')');
  end;
end;

function TForm1.GetPanelID(ID: Integer): TPanel;
var
  X: Integer;
begin   
  X:= FPanels.IndexOf(IntToStr(ID));
  if X >= 0 then begin
    Result:= TPanel(FPanels.Objects[X]);
  end else begin
    raise Exception.Create('Invalid ID ('+IntToStr(ID)+')');
  end;
end;

function TForm1.GetBtn1(Index: Integer): TBitBtn;
begin
  if (Index >= 0) and (Index < FPanels.Count) then begin
    Result:= TBitBtn(Panels[Index].Controls[BUTTON_1]);
  end else begin
    raise Exception.Create('Index out of bounds ('+IntToStr(Index)+')');
  end;
end;

function TForm1.GetCbo1(Index: Integer): TComboBox;
begin
  if (Index >= 0) and (Index < FPanels.Count) then begin
    Result:= TComboBox(Panels[Index].Controls[COMBO_1]);
  end else begin
    raise Exception.Create('Index out of bounds ('+IntToStr(Index)+')');
  end;
end;

function TForm1.GetEdt1(Index: Integer): TEdit;
begin
  if (Index >= 0) and (Index < FPanels.Count) then begin
    Result:= TEdit(Panels[Index].Controls[EDIT_1]);
  end else begin
    raise Exception.Create('Index out of bounds ('+IntToStr(Index)+')');
  end;
end;

function TForm1.GetLbl1(Index: Integer): TLabel;
begin
  if (Index >= 0) and (Index < FPanels.Count) then begin
    Result:= TLabel(Panels[Index].Controls[LABEL_1]);
  end else begin
    raise Exception.Create('Index out of bounds ('+IntToStr(Index)+')');
  end;
end;

function TForm1.GetLbl2(Index: Integer): TLabel;
begin
  if (Index >= 0) and (Index < FPanels.Count) then begin
    Result:= TLabel(Panels[Index].Controls[LABEL_2]);
  end else begin
    raise Exception.Create('Index out of bounds ('+IntToStr(Index)+')');
  end;
end;

function TForm1.GetBtn1ID(ID: Integer): TBitBtn;
var
  X: Integer;
begin
  X:= FPanels.IndexOf(IntToStr(ID));
  if X >= 0 then begin
    Result:= TBitBtn(PanelByID[ID].Controls[BUTTON_1]);
  end else begin
    raise Exception.Create('Invalid Panel ID ('+IntToStr(ID)+')');
  end;
end;

function TForm1.GetCbo1ID(ID: Integer): TComboBox;
var
  X: Integer;
begin
  X:= FPanels.IndexOf(IntToStr(ID));
  if X >= 0 then begin
    Result:= TComboBox(PanelByID[ID].Controls[COMBO_1]);
  end else begin
    raise Exception.Create('Invalid Panel ID ('+IntToStr(ID)+')');
  end;
end;

function TForm1.GetEdt1ID(ID: Integer): TEdit;
var
  X: Integer;
begin
  X:= FPanels.IndexOf(IntToStr(ID));
  if X >= 0 then begin
    Result:= TEdit(PanelByID[ID].Controls[EDIT_1]);
  end else begin
    raise Exception.Create('Invalid Panel ID ('+IntToStr(ID)+')');
  end;
end;

function TForm1.GetLbl1ID(ID: Integer): TLabel;  
var
  X: Integer;
begin
  X:= FPanels.IndexOf(IntToStr(ID));
  if X >= 0 then begin
    Result:= TLabel(PanelByID[ID].Controls[LABEL_1]);
  end else begin
    raise Exception.Create('Invalid Panel ID ('+IntToStr(ID)+')');
  end;
end;

function TForm1.GetLbl2ID(ID: Integer): TLabel;
var
  X: Integer;
begin
  X:= FPanels.IndexOf(IntToStr(ID));
  if X >= 0 then begin
    Result:= TLabel(PanelByID[ID].Controls[LABEL_2]);
  end else begin
    raise Exception.Create('Invalid Panel ID ('+IntToStr(ID)+')');
  end;
end;

end.

Results in this access violation:

Second AV

PS - I know other parts of the new code don't work right, but that's a matter of another question :P

Solution

  • You need to destroy the components within the panel before destroying the panel itself. I'm not sure why this is so but the debugger was telling me that your controls were attempting to handle messages after the panel started destroying itself. That's not good.

    This version of your Delete method gets the job done. Before we kill the panel, we iterate around its children killing each of them until there are none left.

    procedure TForm1.Delete(const Index: Integer);
var
  P: TPanel;
begin
  if (Index >= 0) and (Index < FPanels.Count) then begin
    try
      P := TPanel(FPanels.Objects[Index]);
      while P.ControlCount>0 do
        P.Controls[0].Free;
      P.Free;
    except
      on e: exception do begin
        raise Exception.Create('Failed to delete panel: '+e.Message);
      end;
    end;
    FPanels.Delete(Index);
  end else begin
    raise Exception.Create('Panel index out of bounds ('+IntToStr(Index)+')');
  end;
end;

    Update

    This code is probably still broken because the button is destroyed from its own event handler. That's bound to lead to runtime errors since code will execute on an object that has been destroyed.

    Solve that problem by not deleting in the event handler. Instead post a message to the form and delete upon receipt of that message.

    procedure TForm1.DelPanClick(Sender: TObject); 
begin
  if Sender is TBitBtn then begin
    PostMessage(Handle, WM_USER, TBitBtn(Sender).Tag, 0);
  end; 
end;

    Then write a message handler and call DeleteID from there.