Problem z List index out of bounds

Witam
Mam taki kod:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, CheckLst, ComCtrls;

type
  TZdarzenie = class(TObject)
    Data : TDate;
    Czas : TTime;
    Tekst : string;
  end;
  TForm1 = class(TForm)
    Timer1: TTimer;
    Button1: TButton;
    CheckListBox1: TCheckListBox;
    Edit1: TEdit;
    DateTimePicker1: TDateTimePicker;
    DateTimePicker2: TDateTimePicker;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  Zdarzenie : TZdarzenie;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  S : string;
begin
  Zdarzenie := TZdarzenie.Create;
  Zdarzenie.Tekst := Edit1.Text;
  Zdarzenie.Data := DateTimePicker1.Date;
  Zdarzenie.Czas := DateTimePicker2.Time;
  S := DateToStr(Zdarzenie.Data) + ' - ' + TimeToStr(Zdarzenie.Czas);
  if CheckListBox1.Items.IndexOf(S) = -1 then
  begin
    CheckListBox1.AddItem(S, Zdarzenie);
    CheckListBox1.Checked[CheckListBox1.Items.Count - 1] := True;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Caption := 'Terminarz';
  Timer1.Enabled := True;
  Timer1.Interval := 1000;
  Application.Title := Caption;
  DateTimePicker1.Kind := dtkDate;
  DateTimePicker2.Kind := dtkTime;
  DateTimePicker1.Date := Date;
  DateTimePicker2.Time := Time;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  I : integer;
  DS, TS : string;
begin
  for I := 0 to CheckListBox1.Items.Count - 1 do
  begin
    if CheckListBox1.Checked[I] = True then
    begin
      Zdarzenie := TZdarzenie(CheckListBox1.Items.Objects[I]);
      DS := DateToStr(Zdarzenie.Data);
      TS := TimeToStr(Zdarzenie.Czas);
      if (Time > StrToTime(TS)) and (Date = StrToDate(DS))
        or (Date > StrToDate(DS)) then
      begin
        CheckListBox1.Items.Delete(I);
        MessageBox(Application.Handle, PChar(Zdarzenie.Tekst),
          PChar(Application.Title), MB_ICONINFORMATION + MB_OK);
      end;
    end;
  end;
end;

end.

Ma on na celu - po dodaniu wiadomości, daty i godziny - wywołać MessageBox (coś jak przypominacz). Wszystko działa, ale do pewnego momentu - jak nie dodam więcej niż 1 przypomnienie. Jeśli są 2 lub więcej przypomnień (w CheckListBox) to wywala błąd List index out of bounds (x) - gdzie x to liczba ile jest powiadomień. Szukałem na internecie, niby wszystko jest ok (jest for I := 0 to CheckListBox1.Items.Count** - 1** oraz .Items.Delete(I);), ale błąd nadal występuję. Nie chcę dawać try i except. Może ktoś wie gdzie jest błąd?
Korzystam z Delphi 2010.

Pomóc może zastosowanie pętli malejącej czyli Count - 1 downto 0 do, bo teraz po usunięciu elementu o indeksie I już masz inną ilośc elementów w Count i pętlą jakby "głupieje" stąd ten błąd. Inna metoda to zastosowanie pętli repeat ... unitl oraz odpowiednich ifów.

pomóc może, ale nie musi. usuwanie elementów z kolekcji podczas iterowania po niej to proszenie się o kłopoty.
spróbuj pętli for ... in, może jest odporna na to (nie próbowałem)

Może tak. Zamiast pętli For użyć While:

 while (I < CheckListBox1.Items.Count) do
  begin
    if CheckListBox1.Checked[I] = True then
    begin
      Zdarzenie := TZdarzenie(CheckListBox1.Items.Objects[I]);
      DS := DateToStr(Zdarzenie.Data);
      TS := TimeToStr(Zdarzenie.Czas);
      if (Time > StrToTime(TS)) and (Date = StrToDate(DS))
        or (Date > StrToDate(DS)) then
      begin
        CheckListBox1.Items.Delete(I);
        MessageBox(Application.Handle, PChar(Zdarzenie.Tekst),
          PChar(Application.Title), MB_ICONINFORMATION + MB_OK);
     continue; // nie inkrementuj I
      end;
    end;
	I:= I + 1;
  end;

Może i moje rozwiązanie nie jest najlepsze, ale ja to zawsze obchodziłem w ten sposób że po kasowaniu za pomocą goto dawałem jeszcze raz całą pętlę. Proste i działa :P .

olesio napisał(a)

Pomóc może zastosowanie pętli malejącej czyli Count - 1 downto 0 do, bo teraz po usunięciu elementu o indeksie I już masz inną ilośc elementów w Count i pętlą jakby "głupieje" stąd ten błąd. Inna metoda to zastosowanie pętli repeat ... unitl oraz odpowiednich ifów.

Czyli jak ma wyglądać ta linia? Bo for I := 0 to CheckListBox1.Items.Count - 1 downto 0 do nie chce mi działać...

zibicoder napisał(a)

Może tak. Zamiast pętli For użyć While:

 while (I < CheckListBox1.Items.Count) do
  begin
    if CheckListBox1.Checked[I] = True then
    begin
      Zdarzenie := TZdarzenie(CheckListBox1.Items.Objects[I]);
      DS := DateToStr(Zdarzenie.Data);
      TS := TimeToStr(Zdarzenie.Czas);
      if (Time > StrToTime(TS)) and (Date = StrToDate(DS))
        or (Date > StrToDate(DS)) then
      begin
        CheckListBox1.Items.Delete(I);
        MessageBox(Application.Handle, PChar(Zdarzenie.Tekst),
          PChar(Application.Title), MB_ICONINFORMATION + MB_OK);
     continue; // nie inkrementuj I
      end;
    end;
	I:= I + 1;
  end;

Niestety, kod w ogóle się nie wywołuje... Poza tym mam ostrzeżenie: Variable 'I' might not have been initialized.

Skoro 'pr0si' się przyczepili do mojego ukochanego goto, zostaje repeat.

i:=0;
repeat
if cośtam then
  begin
  DeleteItem(i);
  dec(i);
  end else cośtam;
inc(i);
until i>=length(tablica);

Działa :). Poprawny kod timera to:

procedure TForm1.Timer1Timer(Sender: TObject);
var
  i : integer;
  DS, TS : string;
begin
  i:= 0;
  while (i < CheckListBox1.Items.Count) do begin
    if CheckListBox1.Checked[i] = True then
    begin
      Zdarzenie := TZdarzenie(CheckListBox1.Items.Objects[i]);
      DS := DateToStr(Zdarzenie.Data);
      TS := TimeToStr(Zdarzenie.Czas);
      if (Time > StrToTime(TS)) and (Date = StrToDate(DS))
      or (Date > StrToDate(DS)) then
      begin
        CheckListBox1.Items.Delete(i);
        MessageBox(Application.Handle, PChar(Zdarzenie.Tekst),
          PChar(Application.Title), MB_ICONINFORMATION + MB_OK);
        continue;
      end;
    end;
     i:=i+1;
  end;
end;

Dzięki za pomoc! Temat można zamknąć.