Я создал этот небольшой пример приложения, чтобы продемонстрировать, как вести список элементов управления, в частности, ряд динамически создаваемых элементов управления TPanel, каждый из которых содержит несколько элементов управления. Кажется, все работает нормально, кроме одной странной вещи. Конечно, когда я закрываю свое приложение, оно проходит через все созданные элементы управления и освобождает их. Это работает отлично. Но странно, когда я пытаюсь удалить один из них, я получаю нарушение прав доступа в том же коде, который прекрасно работает при закрытии.
Просто для небольшого пояснения приведенного ниже кода есть фон TStringList, который содержит объект для каждой панели. Я также поддерживаю «Последний идентификатор», который я назначаю тегу этих панелей, а также дочерним элементам панели. Панели сбрасываются и выровнены внутри поля прокрутки, поэтому это похоже на элемент управления списком панелей с элементами управления. На каждую панель можно ссылаться либо по индексу, либо по уникальному идентификатору. Проблема началась с реализации кнопки «Удалить» на каждой панели, которая должна была удалить ее. Нажатие на эту кнопку удаления проверяет идентификатор в его свойстве тега и вызывает процедуру для удаления этого идентификатора. В отладке я проследил идентификатор и индекс, и он должен быть таким, каким он должен быть, но он не выполняет то, что должен делать ...
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.
и код DFM:
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
Панель со временем удаляет после 3 нарушений доступа:
EDIT:
После внесения нескольких дополнений в мой код и добавления исправления Дэвида это сработало, но теперь при удалении третьей из 5 панелей, при удалении слева направо, появляется еще один A / V. Но от удаления справа налево все работает нормально. Вот мой новый код ниже, DFM такой же, как и выше:
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.
Результатов этого нарушения доступа:
PS - я знаю, что другие части нового кода работают неправильно, но это вопрос другого вопроса: P