VPF::Работа со списком TList - Форум программистов

ALeXandrK

Дата 21.8.2007, 15:55 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 342
Регистрация: 31.1.2007
Где: Санкт-Петербург

Репутация: 3
Всего: 6

При закрытии программы вылетает ошибка Invalid Pointer Operation.

Я знаю, что она означает, но что именно её вызвало понять не могу.
Возможно, что я неправильно работаю со списком, но тогда в каком месте?

Список TList вроде сам очищается при уничтожении (судя по исходникам),
но именно при его уничтожении и возникает ошибка.

Вырезал из проекта нужную часть... посмотрите, помогите. Пожалуйста smile

P.s.: Ошибка вылетает, только если в списке больше одного элемента.

Это сообщение отредактировал(а) Snowy - 21.8.2007, 16:57

Присоединённый файл ( Кол-во скачиваний: 15 )

TList.rar 5,52 Kb

--------------------

Богат не/ни тот, у кого много, а тот, кому хватает

Bose

Дата 21.8.2007, 16:08 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 1458
Регистрация: 5.3.2005
Где: Riga, Latvia

Репутация: 23
Всего: 51

Цитата(ALeXandrK @ 21.8.2007, 15:55

)

Список TList вроде сам очищается при уничтожении (судя по исходникам),но именно при его уничтожении и возникает ошибка.

ошибка возникает при вызове freeandnil(ex)?

--------------------

Лучшее о Delphi за 2013 год. Подборка ссылок.

Rennigth

Дата 21.8.2007, 16:16 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 1708
Регистрация: 21.6.2004
Где: Moscow

Репутация: 49
Всего: 76

ALeXandrK, модуль uConstants дафай.

Добавлено через 3 минуты и 32 секунды
ALeXandrK, во первых TList сам за собой не подчищает объекты добавленные в него. Если нужен с самоочиткой используй TObjectList.

--------------------

(* Honesta mors turpi vita potior *)

ne0n

Дата 21.8.2007, 16:25 (ссылка)

(нет голосов)

Загрузка ...

PlayBoy

Профиль
Группа: Участник
Сообщений: 733
Регистрация: 5.8.2005
Где: Н.Новгород

Репутация: 1
Всего: 11

Rennigth, угу я тоже его у себя не нашел....
так что ALeXandrK, модуль в студию!!!

--------------------

http://sa-sec.org
как я вам? smile

Bose

Дата 21.8.2007, 16:26 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 1458
Регистрация: 5.3.2005
Где: Riga, Latvia

Репутация: 23
Всего: 51

ALeXandrK, ну и замудрил... Смешал классы и контролы... smile

Во-первых... Tlist не вызвает деструкторы объектов. Он только убирает ссылки на них. А об уничтожении самих объектов должен позаботиться кто-то другой. В данном случае, все твои объекты TExcercise уничтожает их родитель - ScrollBox1.

А Exception происходит из-за того, что что ты произвольно обращаешься со полем font у всех ExtraCaption. Во всех местах замени

Код


Font:=Object.Font;

на

Код


Font.assign(Object.Font);

и будет тебе щастье.

Точнее в методе

Код


procedure TExercise.Draw;
begin
  // здесь
  with Canvas do
  begin
    .....
//      Font:=ExtraCaption.Font; было
      Font. Assign(ExtraCaption.Font); //стало
....
//и здесь
//      ExtraCaption.Font:=Self.FontExtra;  // было
      ExtraCaption.Font.Assign(Self.FontExtra); // стало

А вообще мой совет, измени структуру классов, пока не запутался...

--------------------

Лучшее о Delphi за 2013 год. Подборка ссылок.

ALeXandrK

Дата 21.8.2007, 16:29 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 342
Регистрация: 31.1.2007
Где: Санкт-Петербург

Репутация: 3
Всего: 6

Цитата(Bose @ 21.8.2007, 16:08)

ошибка возникает при вызове freeandnil(ex)?

Если поставить Точку останова после, то ошибка не вылетает.
Файл обновил (добавил туда uConstants);

Цитата

ALeXandrK, во первых TList сам за собой не подчищает объекты добавленные в него. Если нужен с самоочиткой используй TObjectList.

Но если пройтись по самому TList, то можно увидеть, что очищает:

Код


destructor TList.Destroy;
begin
  Clear;
end;

procedure TList.Clear;
begin
  SetCount(0);
  SetCapacity(0);
end;

procedure TList.SetCount(NewCount: Integer);
var
  I: Integer;
begin
  if (NewCount < 0) or (NewCount > MaxListSize) then
    Error(@SListCountError, NewCount);
  if NewCount > FCapacity then
    SetCapacity(NewCount);
  if NewCount > FCount then
    FillChar(FList^[FCount], (NewCount - FCount) * SizeOf(Pointer), 0)
  else
    for I := FCount - 1 downto NewCount do
      Delete(I);                                                  // ВОТ ЭТО РАЗВЕ НЕ УДАЛЕНИЕ?
  FCount := NewCount;
end;

--------------------

Богат не/ни тот, у кого много, а тот, кому хватает

Bose

Дата 21.8.2007, 16:33 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 1458
Регистрация: 5.3.2005
Где: Riga, Latvia

Репутация: 23
Всего: 51

Delete(I); // ВОТ ЭТО РАЗВЕ НЕ УДАЛЕНИЕ?

Удаление. Удаление ссылки на объект, а не вызов деструктора объекта. smile

--------------------

Лучшее о Delphi за 2013 год. Подборка ссылок.

ALeXandrK

Дата 21.8.2007, 16:33 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 342
Регистрация: 31.1.2007
Где: Санкт-Петербург

Репутация: 3
Всего: 6

Цитата(Bose @ 21.8.2007, 16:26)

А Exception происходит из-за того, что что ты произвольно обращаешься со полем font у всех ExtraCaption.

Заменил - ничего не изменилось.

Цитата(Bose @ 21.8.2007, 16:33)

Удаление. Удаление ссылки на объект, а не вызов деструктора объекта.

Да, невнимательно я посмотрел smile

Цитата(Bose @ 21.8.2007, 16:26)

А вообще мой совет, измени структуру классов, пока не запутался...

Поподробнее можно?! В каком отношении изменить?

Е-мое... значит нужно использовать TObjectList | TClassList | что тут еще предложить можно?

Это сообщение отредактировал(а) ALeXandrK - 21.8.2007, 16:41

--------------------

Богат не/ни тот, у кого много, а тот, кому хватает

Bose

Дата 21.8.2007, 16:43 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 1458
Регистрация: 5.3.2005
Где: Riga, Latvia

Репутация: 23
Всего: 51

Цитата(ALeXandrK @ 21.8.2007, 16:33

)

Заменил - ничего не изменилось.

в двух местах?

--------------------

Лучшее о Delphi за 2013 год. Подборка ссылок.

ALeXandrK

Дата 21.8.2007, 16:44 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 342
Регистрация: 31.1.2007
Где: Санкт-Петербург

Репутация: 3
Всего: 6

Цитата(Bose @ 21.8.2007, 16:43)

Цитата(ALeXandrK @ 21.8.2007, 16:33

)

Заменил - ничего не изменилось.

в двух местах?

Конечно

--------------------

Богат не/ни тот, у кого много, а тот, кому хватает

Bose

Дата 21.8.2007, 16:44 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 1458
Регистрация: 5.3.2005
Где: Riga, Latvia

Репутация: 23
Всего: 51

в procedure TExercise.Draw;
и в procedure TExercisesList.Draw;

--------------------

Лучшее о Delphi за 2013 год. Подборка ссылок.

Rennigth

Дата 21.8.2007, 16:45 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 1708
Регистрация: 21.6.2004
Где: Moscow

Репутация: 49
Всего: 76

Ну и второе с фонтами чет ты переборщил. У Image-а вообще на кой второй создавать, да и не переприсваивать надо везде указатели, а ассигнить smile

Код


unit Unit2;

interface

uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, Contnrs;

type
  TExtraCaption = class(TObject)
  public
    Caption: string;
    Font: TFont;
    Visible: Boolean;
    constructor Create;
    destructor Destroy; override;
  end;

  TExercise = class(TImage)
  protected
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y:
        Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
        override;
  public
    BorderColor: TColor;
    Caption: string;
    Color: TColor;
    ExtraCaption: TExtraCaption;
//    FFont: TFont;
    Hours: Byte;
    IdExercise: Integer;
    IdGroup: Integer;
    IdSubject: Integer;
    IdTeacher: Integer;
    constructor Create(const AParent:TWinControl; const idExercise, idTeacher,
        idSubject, idGroup:integer; const Text:string; const Amount:byte; const
        Color:TColor); reintroduce; overload;
    destructor Destroy; override;
    procedure Draw;
    procedure Hide;
  end;

  TExercisesList = class(TObjectList)
  public
    Font: TFont;
    FontExtra: TFont;
    Height: Integer;
    IntervalHeight: Integer;
    IntervalWidth: Integer;
    Parent: TWinControl;
    Width: Integer;
    constructor Create(AOwner: TWinControl);
    procedure Draw;
    function Find(Id: Integer): TExercise;
    procedure Hide;
  end;

implementation

uses
  Math{, uConstants};

{
******************************** TExtraCaption *********************************
}
constructor TExtraCaption.Create;
begin
  Font := TFont.Create;
  Font.Size := 8;//'fntExerciseExtraSize;
  Font.Color:= clRed;//fntExerciseExtraColor;
  Font.Style:= [];//fntExerciseExtraStyle;
end;

destructor TExtraCaption.Destroy;
begin
  Font.Free;
  inherited;
end;

{
********************************** TExercise ***********************************
}
constructor TExercise.Create(const AParent:TWinControl; const idExercise,
    idTeacher, idSubject, idGroup:integer; const Text:string; const Amount:byte;
    const Color:TColor);
begin
  inherited Create(nil);
  Self.Parent := AParent;
  Self.idExercise := idExercise;
  Self.idTeacher := idTeacher;
  Self.idSubject := idSubject;
  Self.IdGroup := idGroup;
  Caption := Text;
  Self.Color := Color;
  Hours := Amount;
  BorderColor := clInactiveBorder;
  ExtraCaption  := TExtraCaption.Create;
  if Hours > 0 then
  begin
    ExtraCaption.Caption := inttostr(Hours);
    ExtraCaption.Visible := true;
  end
  else ExtraCaption.Visible := false;
end;

destructor TExercise.Destroy;
begin
  ExtraCaption.Free;
  inherited;
end;

procedure TExercise.Draw;
var
  Text: string;
begin
  with Canvas do
  begin
    Lock;
    try
      Brush.Color := Color;
      FillRect(ClientRect);
      // Печатаем дополнительный текст внизу справа,
      if ExtraCaption.Visible then
      begin
        Text:= ExtraCaption.Caption;
        TextOut(Width-TextWidth(Text)-1, Height-TextHeight(Text)-1, Text);
      end;
      // Печатаем основной текст по центру
      Canvas.Font.Assign(Font);
      Text := Caption;
      TextOut((Width-TextWidth(Text)) div 2, (Height-TextHeight(Text)) div 2,Text);
      // Рисуем рамку
      Brush.Color := BorderColor;
      FrameRect(ClientRect);
    finally
      Unlock;
    end;
  end;

  Visible := True;
end;

procedure TExercise.Hide;
begin
  Visible := False;
end;

procedure TExercise.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y:
    Integer);
begin
  inherited;
end;

procedure TExercise.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  inherited;
end;

procedure TExercise.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y:
    Integer);
begin
  inherited;
end;

{
******************************** TExercisesList ********************************
}
constructor TExercisesList.Create(AOwner: TWinControl);
begin
  inherited Create;
  Parent := AOwner;
//  IntervalHeight := bIntervalHeight;
//  IntervalWidth := bIntervalWidth;
  IntervalHeight := 10;
  IntervalWidth := 10;

  Font := TFont.Create;
  Font.Size := 8;//fntExerciseSize;
  Font.Color := clRed;//fntExerciseColor;
  Font.Style := [];//fntExerciseStyle;

  FontExtra := TFont.Create;
  FontExtra.Size := 8;//fntExerciseSize;
  FontExtra.Color := clRed;//fntExerciseColor;
  FontExtra.Style := [];//fntExerciseStyle;

end;

procedure TExercisesList.Draw;
var
  AlsoWidth, AlsoHeight, i: Integer;
  Exercise: TExercise;
begin
  AlsoWidth:=IntervalWidth;
  AlsoHeight:=IntervalHeight;

  for I := 0 to Self.Count - 1 do
  begin
    Exercise := TExercise(Self.Items[I]);
    if Width+AlsoWidth+IntervalWidth>Parent.Width  then
    begin
      AlsoHeight:=AlsoHeight+Height+IntervalHeight;
      AlsoWidth:=IntervalWidth;
    end;
    with Exercise do
    begin
      Left := AlsoWidth;
      Top :=  AlsoHeight;
      width := Self.Width;
      Height := Self.Height;
      Font.Assign(Self.Font);
      ExtraCaption.Font.Assign(Self.FontExtra);
      Visible := True;
      Draw;
    end;
    AlsoWidth:=AlsoWidth+Width+IntervalWidth;
  end;
end;

function TExercisesList.Find(Id: Integer): TExercise;
var
  I: Integer;
  Exercise: TExercise;
begin
  Result := nil;
  for I := 0 to Count - 1 do
  begin
    Exercise := TExercise(Items[I]);
    if Exercise.idExercise = Id then
      Result := Exercise;
  end;
end;

procedure TExercisesList.Hide;
var
  i: Integer;
  Exercise: TExercise;
begin
  for I := 0 to Self.Count - 1 do
  begin
    Exercise := TExercise(Self.Items[I]);
    Exercise.Hide;
  end;
end;

end.

Добавлено через 1 минуту и 21 секунду
О блин, тут уже палемика пока я возился... smile

Вообщем этот код уже нормально работает, только константы свои верни, я отбалды ставил.

Добавлено через 2 минуты и 3 секунды
Плюс, он ужо от ObjectList, так что о освобождении не надо заботиться smile

--------------------

(* Honesta mors turpi vita potior *)

Bose

Дата 21.8.2007, 16:50 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 1458
Регистрация: 5.3.2005
Где: Riga, Latvia

Репутация: 23
Всего: 51

Цитата(ALeXandrK @ 21.8.2007, 16:33

)

Е-мое... значит нужно использовать TObjectList или что тут еще замутить можно?

С таким кодом лучше не используй - замучаешься отслеживать Access Violationы.

Сначала лучше определиться, кто именно будет отвечать за TExcercise объекты - Контрол на котором он лежит(Parent), или TExcerciseList.

--------------------

Лучшее о Delphi за 2013 год. Подборка ссылок.

ALeXandrK

Дата 21.8.2007, 16:51 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 342
Регистрация: 31.1.2007
Где: Санкт-Петербург

Репутация: 3
Всего: 6

Со шрифтами я конечно накосячил...

Rennigth, Bose: Спасибо! Выручили... Всем по репе smile

Остался только один вопрос без ответа:

Цитата(Bose)

А вообще мой совет, измени структуру классов, пока не запутался...

Изменить каким образом?

P.s.: за TExcercise отвечает TExcerciseList.
Список этот очищается до закрытия формы и соответственно контролу,
на котором были, TExcercise ничего удалять не нужно, да он это и
не будет делать. (уже все работает)

Это сообщение отредактировал(а) ALeXandrK - 21.8.2007, 16:54

--------------------

Богат не/ни тот, у кого много, а тот, кому хватает

Rennigth

Дата 21.8.2007, 16:55 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 1708
Регистрация: 21.6.2004
Где: Moscow

Репутация: 49
Всего: 76

Цитата(ALeXandrK @ 21.8.2007, 16:51

)

Изменить каким образом?

Да не, в принципе все нормально, только я бы не юзал TImage, а наследовался бы от TCustomControl, или вообще от TGraphicControl, в зависимости от твоих задач. Image тажелый гад.

Добавлено через 1 минуту и 6 секунд

Цитата(ALeXandrK @ 21.8.2007, 16:51

)

Rennigth, Bose: Спасибо! Выручили... Всем по репе

А хде репа? smile

--------------------

(* Honesta mors turpi vita potior *)

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Общие вопросы \| Следующая тема »