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.