Listbox Einträge verschieben

[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.