Listbox Einträge verschieben

[ebber]

Hallo

wie kann ich in einer Listbox meine Einträge mit der Maus verschieben. Also z.B. auf einen klicken und dann mit der Maus nach oben ziehen, sodass er sich dann dort einreiht.

MfG

[bitsetter]

Hi,

hier habe ich sowas gefunden:
listbox drag and drop

[ebber]

Danke

ich habe nu diesen code

Delphi-Quellcode:

procedure TForm1.ListBox1DragDrop(Sender, Source: TObject; X, Y: Integer);
begin
ListBox1.Items.Move(ListBox1.ItemIndex,ListBox1.ItemAtPos(point(x,y),true));
end;

procedure TForm1.ListBox1DragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
if source is TListbox then accept:=true else accept:=false;
end;

Jetzt kann ich ein Ding nach oben ziehen.
Kann ich das auch noch anders machen also dass das was ich ziehe sofort mit der Maus nach oben wandert und nicht einfach nach oben springt (also so ähnlich wie in Winamp) ?

[bitsetter]

Hi,

also Winamp habe ich jetzt nicht installiert, aber ich schätze mal du meintest sowas hier:

Delphi-Quellcode:

procedure TForm1.ListBox1DragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
 if source is TListbox then
 begin
   accept:= true;
   ListBox1.Items.Move(ListBox1.ItemIndex,ListBox1.ItemAtPos(point(x,y),true));
   ListBox1.ItemIndex:= ListBox1.ItemAtPos(point(x,y),true);
 end
 else
    accept:= false;
end;

[ebber]

Ja genau sowas habe ich gesucht. Danke.

Ich habe hier noch diesen Code gefunden. Mit ihm kann man auch zwischen 2 Listboxen hin und her schieben.

Delphi-Quellcode:

procedure TForm1.ListBox1DragDrop(Sender, Source: TObject; X, Y: Integer);
var
  iTemp: Integer;
  ptTemp: TPoint;
  szTemp: string;
begin
  { change the x,y coordinates into a TPoint record }
  ptTemp.x := x;
  ptTemp.y := y;

  { Use a while loop instead of a for loop due to items possible being removed
   from listboxes this prevents an out of bounds exception }
  iTemp := 0;
   while iTemp <= TListBox(Source).Items.Count-1 do
  begin
    { look for the selected items as these are the ones we wish to move }
    if TListBox(Source).selected[iTemp] then
    begin
      { use a with as to make code easier to read }
      with Sender as TListBox do
      begin
      { need to use a temporary variable as when the item is deleted the
        indexing will change }
        szTemp := TListBox(Source).Items[iTemp];

        { delete the item that is being dragged  }
        TListBox(Source).Items.Delete(iTemp);

      { insert the item into the correct position in the listbox that it
       was dropped on }
        Items.Insert(itemAtPos(ptTemp, True), szTemp);
      end;
    end;
    Inc(iTemp);
  end;
end;

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

Wäre es möglich in das auch das einzufügen ?

Zitat:

Zitat von bitsetter

Hi,

Delphi-Quellcode:

procedure TForm1.ListBox1DragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
 if source is TListbox then
 begin
   accept:= true;
   ListBox1.Items.Move(ListBox1.ItemIndex,ListBox1.ItemAtPos(point(x,y),true));
   ListBox1.ItemIndex:= ListBox1.ItemAtPos(point(x,y),true);
 end
 else
    accept:= false;
end;

MfG

[Thomasl]

Ich habe den Code von bitsetter noch ein wenig abgeändert damit er mit allen listboxen geht
jetzt fehlt nur noch multiselect

Delphi-Quellcode:

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

if (Sender = Source) and (Sender is TListbox) and ((Source as Tlistbox).ItemIndex <> -1) then
 begin
   with Sender as TListbox do
    begin
      if ItemAtPos(point(x,y),true)= -1 then exit;
      Items.Move(ItemIndex,ItemAtPos(point(x,y),true));
      ItemIndex:= ItemAtPos(point(x,y),true);
    end;
  Accept:= true
 end
else Accept:= false;

end;

[ebber]

Danke.

Würde es noch jemand hinbekommen dass man Mulitselect machen kann und es von einer zur anderen Listbox verschieben kann ? Oder nur 1 davon ?

MfG

[SirThornberry]

@ebber: Bei welcher Stelle kommst du denn beim Multiselect nicht weiter? Wir sind da um bei Problemen zu helfen. Bisher ging es aber die ganze Zeit so das andere für dich gesucht haben und andere dir die Lösung auf dem Tablett serviert haben. Du musst auch etwas eigeninitiative zeigen. Bisher ist nicht erkennbar das du selbst etwas versucht hast, du hast immer nur gefragt (ohne zu erwähnen was du bereits hast und wo du genau hängst) und hast dann die komplette Lösung bekommen. Programmieren besteht nicht darin die abeit anderer zu kopieren sondern unter anderem darin selbst nachzudenken und Lösungen zu suchen.

[ebber]

Das ist mir klar und du hast völlig recht. Ich finde das was ich macha auch nicht besonders gut, aber ich bräuchte das für ein Programm das ich gerade macha und meine programmiererischen Fähigkeiten reichen dafür leider aus. Ich bedanke mich für die Hilfen.

MfG

[Thomasl]

Weil ich es für mein eigenes Programm brauche und hier die ansätze gefunden habe
(ich Programmiere mir einen MP3 Player mit BASS.DLL)

Das rüberschieben zu einer anderen listbox dürfte einfacher sein (brauche ich aber nicht).

Gibt es noch einen einfacheren weg?
Bekommt man das flacken beim verschieben noch weg?


dragmode := dmAutomatic
multiselect := true
extendedselect := true

Delphi-Quellcode:

var
  Form1: TForm1;
  Listindex : integer;

implementation

{$R *.dfm}

procedure TForm1.ListBox2DragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
var
 n,offset,maxoffset,minoffset : integer;
 SourceSel : array of boolean;
begin
 if (Sender = Source) and (Sender is TListbox) and ((Source as Tlistbox).ItemIndex <> -1) then
 begin
  with Source as TListbox do
   begin
    //Selected Sichern und max offset feststellen
    SetLength(SourceSel,Count);
    for n := 0 to Count -1 do
     begin
      SourceSel[n] := Selected[n];
      if SourceSel[n] then maxoffset := n - Count;
     end;

    //Min Offset feststellen
    for n := Count -1 downto 0 do
     if SourceSel[n] then minoffset := n ;

    //Um wieviele Felder verschieben
    offset:= Listindex - ItemAtPos(point(x,y),true);

    //Verschieben begrenzen
    if (ItemAtPos(point(x,y),true) = -1) then exit;
    if (offset <= maxoffset) then exit;
    if (offset >  minoffset) then exit;

    //Verschieben
    if offset > 0 then
     begin
      for n := 0 to Count -1 do
       if SourceSel[n] then Items.Move(n,n - offset);
     end
    else if offset < 0 then
     begin
      for n := Count -1 downto 0 do
       if SourceSel[n] then Items.Move(n,n - offset);
     end;

    //Selected setzen
    for n := 0 to Count -1 do
     if (n + offset) >= Count then Selected[n] := false else
     Selected[n] := SourceSel[n + offset];

    //Itemindex neu setzen
    Listindex := Listindex - offset;
    itemindex := Listindex;

  end; //with listbox
  Accept:= true
 end
 else Accept:= false;
end;

procedure TForm1.ListBox2MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
 with Sender as TListBox do
  Listindex := ItemAtPos(point(x,y),true);
end;

[bitsetter]

Moin,

@Thomasl, hier ist meine Version:

Delphi-Quellcode:

procedure TForm1.ListBox1DragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
var
   verschieben, ItemPos, i: integer;
begin
  if (Source is TListbox) and ((Source as Tlistbox).SelCount> 0) then
    with Source as TListbox do
    begin
      ItemPos:= ItemAtPos(point(x, y), true);
      if (ItemPos< 0) or (ItemPos>= Items.Count) then
      exit;
      if Selected[ItemPos] then
        ItemIndex:= ItemPos;
      verschieben:= ItemIndex- ItemPos;
      if verschieben<> 0 then
      begin
        if verschieben> 0 then
          i:= 0
        else
          i:= pred(Items.Count);
        while (i>= 0) and (i< Items.Count) do
        begin
          if Selected[i] then
          begin
            if (i- verschieben>= 0) and (i- verschieben< Items.Count) then
            begin
            Items.Move(i, i- verschieben);
            Selected[i]:= false;
            Selected[i- verschieben]:= true;
            end
            else
              break;
          end;
          if verschieben> 0 then
            inc(i)
          else
            dec(i);
        end;
      end;
      Accept:= true
    end
    else
      Accept:= false;
end;

[ebber]

Danke an euch.

@Thomasl

Zitat:

Bekommt man das flacken beim verschieben noch weg?

Also bei mir machts das nicht.

[Thomasl]

Das Flickern ist auch beim code von bitsetter da
nach ein wenig suche im forum http://www.delphipraxis.net/internal...light=flickern
habe ich es doch noch wegbekommen

Delphi-Quellcode:

var
  Form1: TForm1;
  Listindex : integer;

implementation

{$R *.dfm}

procedure TForm1.ListBox2DragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
var
 n,offset,maxoffset,minoffset : integer;
 SourceSel : array of boolean;
begin
 if (Sender = Source) and (Sender is TListbox) and ((Source as Tlistbox).ItemIndex <> -1) then
 begin
  with Source as TListbox do
   begin


    //Selected Sichern und max offset feststellen
    SetLength(SourceSel,Count);
    for n := 0 to Count -1 do
     begin
      SourceSel[n] := Selected[n];
      if SourceSel[n] then maxoffset := n - Count;
     end;

    //Min Offset feststellen
    for n := Count -1 downto 0 do
     if SourceSel[n] then minoffset := n ;

    //Um wieviele Felder verschieben
    offset:= Listindex - ItemAtPos(point(x,y),true);


    //Verschieben begrenzen
    if (ItemAtPos(point(x,y),true) = -1) then exit;
    if (offset <= maxoffset) then exit;
    if (offset >  minoffset) then exit;
    if  offset = 0 then exit;

    //Zeichnen ausschalten
    Self.Perform(wm_SetRedraw, 0, 0);

    //Verschieben
    if offset > 0 then
     begin
      for n := 0 to Count -1 do
       if SourceSel[n] then Items.Move(n,n - offset);
     end
    else if offset < 0 then
     begin
      for n := Count -1 downto 0 do
       if SourceSel[n] then Items.Move(n,n - offset);
     end;

    //Selected setzen
    for n := 0 to Count -1 do
     if (n + offset) >= Count then Selected[n] := false else
     Selected[n] := SourceSel[n + offset];

    //Itemindex neu setzen
    Listindex := Listindex - offset;
    itemindex := Listindex;

    //Zeichen einschalten
    Self.Perform(wm_SetRedraw, 1, 0);
    repaint;
  end; //with listbox
  Accept:= true
 end
 else Accept:= false;
end;

procedure TForm1.ListBox2MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
 with Sender as TListBox do
  Listindex := ItemAtPos(point(x,y),true);

end;

[TERWI]

Das ist zwar schon fast ein prähistorischer Thread ... hole den aber trotzdem noch mal hoch.
Weil: War auf der Suche nach eben so einer Funktion, aber das funzte alles nicht wirklich toll und war n.E.n. etwas überladen.
Hier mal meine (Kurz-) Version, die beim Live-Verschieben auch die Listbox richtig scrollt.

Delphi-Quellcode:

procedure TForm.OnDragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
var
  Position, BotIndex : integer;
begin
  with Sender as TListBox do  // or TCheckListBox ...
  begin
    Position := ItemAtPos(point(x,y), true);  // get position
    if (Position < 0) then exit;              // position outside listbox ?
    if (ItemIndex = Position) then exit;           // position changed ?
    BotIndex := TopIndex + ClientHeight div ItemHeight;  // get act. bottom-index
    if (TopIndex > 0) AND ((Position - 1) < TopIndex) then   // pos. near top-index ?
      SendMessage(Handle,WM_VSCROLL,SB_LINEUP,0);  // scroll up line
//      SendMessage(Handle,WM_VSCROLL,SB_PAGEUP,0);  // scroll up page
    if (BotIndex < (Count - 2)) AND ((Position + 2) > BotIndex) then   // pos. near bot-index ?
      SendMessage(Handle,WM_VSCROLL,SB_LINEDOWN,0);  // scroll down line
//      SendMessage(Handle,WM_VSCROLL,SB_PAGEDOWN,0);   // scroll down page
    Items.Move(ItemIndex, Position);   // move entry
    // move dependend data here same as item !
    ItemIndex := Position;  // DO NOT FORGET: set index to new position !!!
  end;
end;

Das funzt aktuell nur mit jeweils einem Eintrag, den man beliebig hin- und herschieben kann.
Werde noch daran basteln, das mit MulitSelect zu erweitern.

[TERWI]

Hier mal meine Version mit der Möglichkeit, einzelne oder auch mehrere Elemente zu verschieben, die nicht unbedingt zusammenhängen müssen.
Das funktioniert einwandfrei, auch wenn die Anzahl der Einträge größer als die angezeigten ist.

Delphi-Quellcode:

procedure TForm.OnDragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
var
  lb : TListBox;
  position, botIndex, i, nmove, nmax, selfirst, sellast : integer;

  procedure MoveItem();
  begin
    if lb.Selected[i] then   // one ore more item selected !?
    begin
      lb.Items.Move(i, i + nmove);   // move entry
      lb.Selected[i + nmove] := true;  // remain and HIGHLIGHT item (again)
      // move dependend data here same as item - e.g. in TLIST!
    end;
  end;

begin
  lb := Sender as TListBox;   // or TCheckListBox ...
  position := lb.ItemAtPos(Point(x,y), true); // get pick-position
  if (position < 0) then exit;                // position outside listbox ?
  if (lb.ItemIndex = position) then exit;     // position changed ?
  nmove := position - lb.Itemindex;           // number of pos. to move (+ / -)
  botIndex := lb.TopIndex + lb.ClientHeight div lb.ItemHeight;  // calc listindex bottom
  nmax := lb.Items.Count - 1;                 // remain max. num of items

  selfirst := nmax;      // default
  sellast := 0;          // default
  for i := 0 to nmax do
  begin
    if lb.Selected[i] then                // one ore more item selected !?
    begin
      if (i > sellast) then sellast := i;   // remain first selection
      if (i < selfirst) then selfirst := i; // remain last selection
    end;
  end;

  if (nmove < 0) AND ((selfirst + nmove) >= 0) then    // MOVE UP
  begin
    if ((selfirst + nmove) <= lb.TopIndex) then   // reached top-index ?
      SendMessage(lb.Handle,WM_VSCROLL,SB_LINEUP,0);  // scroll up line
    for i := 0 to nmax do MoveItem();  // move first to last item
  end;
  if (nmove > 0) AND ((sellast + nmove) <= nmax) then  // MOVE DOWN
  begin
    if ((selfirst + nmove) > botIndex) then   // reached bot-index ?
      SendMessage(lb.Handle,WM_VSCROLL,SB_LINEDOWN,0);  // scroll down line
    for i := nmax downto 0 do MoveItem();  // move last to first item
  end;
  lb.ItemIndex := position;    // (re-) set index to pick-position !
end;

... und nicht vergessen: MULTISELECT der Listbox auf true zu setzen - DRAGMODE logo auf dmAutomatic.