Einzelnen Beitrag anzeigen

Benutzerbild von TERWI
TERWI

Registriert seit: 29. Mär 2008
Ort: D-49626
381 Beiträge
 
Delphi 11 Alexandria
 
#15

Listbox Einträge verschieben - mit MultiSelect

  Alt 20. Nov 2019, 13:32
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.

Geändert von TERWI (20. Nov 2019 um 13:39 Uhr)
  Mit Zitat antworten Zitat