Entsprechendes Listbox item nach drag löschen

[Popov]

Da ich es schon lange nicht gemacht habe, mal so zum Spaß:

Delphi-Quellcode:

{08/15 Klasse um sie als Objekt an ListBox-Item anzuheften. Kann auch was anderes sein, Hauptsache Objekt.}
type
  TTest = class
    private
      FText: String;
    public
      constructor Create(S: String);
      property Text: String read FText;
  end;

constructor TTest.Create(S: String);
begin
  inherited Create;
  FText := S;
end;

//------------------------------------------------------------------------

procedure TForm1.FormCreate(Sender: TObject);
var
  i: Integer;
  Test: TTest;
begin
  for i := 1 to 4 do
  begin
    Test := TTest.Create('Objekt von ListBox1' + IntToStr(i));
    with ListBox1 do Items.AddObject(Name + IntToStr(i), Test);
    Test := TTest.Create('Objekt von ListBox2' + IntToStr(i));
    with ListBox2 do Items.AddObject(Name + IntToStr(i), Test);
    Test := TTest.Create('Objekt von ListBox3' + IntToStr(i));
    with ListBox3 do Items.AddObject(Name + IntToStr(i), Test);
    Test := TTest.Create('Objekt von ListBox4' + IntToStr(i));
    with ListBox4 do Items.AddObject(Name + IntToStr(i), Test);
  end;

  with ListBox1 do DragMode := dmAutomatic;
  with ListBox2 do DragMode := dmAutomatic;
  with ListBox3 do DragMode := dmAutomatic;
  with ListBox4 do DragMode := dmAutomatic;
end;

procedure TForm1.ListBox1DragDrop(Sender, Source: TObject; X, Y: Integer);
var
  LB1, LB2: TListBox;
begin
  if not ((Sender is TListBox) and (Source is TListBox)) then Exit;

  LB1 := TListBox(Source);
  LB2 := TListBox(Sender);

  if LB1.ItemIndex < 0 then Exit;

  LB2.AddItem(LB1.Items[LB1.ItemIndex], LB1.Items.Objects[LB1.ItemIndex]);
  LB1.Items.Delete(LB1.ItemIndex);
end;

procedure TForm1.ListBox1DragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  Accept := Source is TListBox;
end;

procedure TForm1.ListBox1DblClick(Sender: TObject);
var
  Test: TTest;
  LB: TListBox;
begin
  if not (Sender is TListBox) then Exit;

  LB := TListBox(Sender);
  if LB.ItemIndex < 0 then Exit;

  Test := TTest(LB.Items.Objects[LB.ItemIndex]);

  ShowMessage('Text Item: ' + LB.Items[LB.ItemIndex] + ^j +
              'Text Objekt: ' + Test.Text );
end;

Eigentlich müßten die Objekte in den ListBoxen vorher noch freigegeben werden. Das habe ich hier gelassen.

//Achso, alle vier ListBoxen nutzen überall die gleichen Prozeduren.