Reordenação de Items em ListBox

unit ListBoxReorder_Form;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ActnList, StdCtrls, ExtCtrls;
 
type
  TScrollZone = (szNone, szTop, szBottom);
 
  TMainForm = class(TForm)
    ActionList: TActionList;
    ListBox: TListBox;
    ScrollTimer: TTimer;
    DownAction: TAction;
    DownButton: TButton;
    FirstAction: TAction;
    FirstButton: TButton;
    LastAction: TAction;
    LastButton: TButton;
    UpAction: TAction;
    UpButton: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FirstActionExecute(Sender: TObject);
    procedure FirstActionUpdate(Sender: TObject);
    procedure UpActionExecute(Sender: TObject);
    procedure UpActionUpdate(Sender: TObject);
    procedure DownActionExecute(Sender: TObject);
    procedure DownActionUpdate(Sender: TObject);
    procedure LastActionExecute(Sender: TObject);
    procedure LastActionUpdate(Sender: TObject);
    procedure ListBoxStartDrag(Sender: TObject; var DragObject: TDragObject);
    procedure ListBoxDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure ListBoxDragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure ListBoxEndDrag(Sender, Target: TObject; X, Y: Integer);
    procedure ScrollTimerExecute(Sender: TObject);
  private
    FScrollZone: TScrollZone;
    procedure InitListBox;
    function IsSelected: Boolean;
    procedure MoveItem(NewIndex: Integer);
    function GetScrollZone(X, Y: Integer): TScrollZone;
  end;
 
var
  MainForm: TMainForm;
 
implementation
 
{$R *.dfm}
 
{ Inicializa ListBox.Items para demonstração }
procedure TMainForm.FormCreate(Sender: TObject);
begin
  InitListBox;
  ListBox.DragMode := dmAutomatic;
end;
 
{ Inicializa ListBox.Items com nomes de arquivos da pasta System32 }
procedure TMainForm.InitListBox;
var
  F: TSearchRec;
begin
  ListBox.Items.BeginUpdate;
  if FindFirst('C:\Windows\System32\*.*', faArchive, F) = 0 then
    repeat
      ListBox.Items.Add(F.Name);
    until FindNext(F) <> 0;
  FindClose(F);
  ListBox.Items.EndUpdate;
  ListBox.ItemIndex := 0;
end;
 
{ Indica se algum item do ListBox está selecionado }
function TMainForm.IsSelected: Boolean;
begin
  Result := ListBox.ItemIndex <> -1;
end;
 
{ Move um item do ListBox para outra posição,
  seleciona a nova posição no ListBox e
  atribui o foco ao ListBox. }
procedure TMainForm.MoveItem(NewIndex: Integer);
begin
  ListBox.Items.Move(ListBox.ItemIndex, NewIndex);
  ListBox.ItemIndex := NewIndex;
  ListBox.SetFocus;
end;
 
procedure TMainForm.DownActionExecute(Sender: TObject);
begin
  MoveItem(ListBox.ItemIndex + 1);
end;
 
procedure TMainForm.DownActionUpdate(Sender: TObject);
begin
  DownAction.Enabled := IsSelected and
    (ListBox.ItemIndex < ListBox.Items.Count - 1);
end;
 
procedure TMainForm.FirstActionExecute(Sender: TObject);
begin
  MoveItem(0);
end;
 
procedure TMainForm.FirstActionUpdate(Sender: TObject);
begin
  FirstAction.Enabled := IsSelected and (ListBox.ItemIndex > 0);
end;
 
procedure TMainForm.LastActionExecute(Sender: TObject);
begin
  MoveItem(ListBox.Items.Count - 1);
end;
 
procedure TMainForm.LastActionUpdate(Sender: TObject);
begin
  LastAction.Enabled := IsSelected and
    (ListBox.ItemIndex < ListBox.Items.Count - 1);
end;
 
procedure TMainForm.UpActionExecute(Sender: TObject);
begin
  MoveItem(ListBox.ItemIndex - 1);
end;
 
procedure TMainForm.UpActionUpdate(Sender: TObject);
begin
  UpAction.Enabled := IsSelected and (ListBox.ItemIndex > 0);
end;
 
{ Inicializa FScrollZone com szNone }
procedure TMainForm.ListBoxStartDrag(Sender: TObject;
  var DragObject: TDragObject);
begin
  FScrollZone := szNone;
end;
 
{ Define se a posição do mouse aponta para um item válido
  do ListBox que permita soltar o item arrastado (Accept).
  Inicia ou cancela o timer de scroll automático. }
procedure TMainForm.ListBoxDragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
var
  NewZone: TScrollZone;
begin
  Accept := (Source = ListBox) and
    (ListBox.ItemAtPos(Point(X, Y), True) <> -1);
  NewZone := GetScrollZone(X, Y);
  if NewZone <> FScrollZone then
  begin
    FScrollZone := NewZone;
    if (FScrollZone <> szNone) then
    begin
      ScrollTimer.Interval := 1000;
      ScrollTimer.Enabled := True;
    end
    else
      ScrollTimer.Enabled := False;
  end;
end;
 
{ Move item selecionado para nova posição }
procedure TMainForm.ListBoxDragDrop(Sender, Source: TObject; X, Y: Integer);
var
  NewIndex: Integer;
begin
  NewIndex := ListBox.ItemAtPos(Point(X, Y), True);
  if NewIndex <> -1 then
    MoveItem(NewIndex);
end;
 
{ Desliga timer de scroll no fim do drag and drop }
procedure TMainForm.ListBoxEndDrag(Sender, Target: TObject; X, Y: Integer);
begin
  ScrollTimer.Enabled := False;
end;
 
{ Retorna a szTop se mouse está na área da primeira linha visível do
  ListBox, szBottom se mouse está na área da última linha visível do
  ListBox ou szNone caso contrátrio. }
function TMainForm.GetScrollZone(X, Y: Integer): TScrollZone;
begin
  if (Y < ListBox.ItemHeight) then
    Result := szTop
  else
    if (Y >= ListBox.ClientHeight - ListBox.ItemHeight) then
      Result := szBottom
    else
      Result := szNone;
end;
 
{ Faz scroll de uma linha para cima ou para baixo conforme a zona
  de scroll definida pela posição do mouse. Redefine intervalo
  do timer para 0.2s após o primeiro scroll. }
procedure TMainForm.ScrollTimerExecute(Sender: TObject);
begin
  ScrollTimer.Interval := 200;
  if (FScrollZone = szTop) then
  begin
    ListBox.Perform(WM_VSCROLL, SB_LINEUP, 0);
    ListBox.Perform(WM_VSCROLL, SB_ENDSCROLL, 0);
  end
  else
    if (FScrollZone = szBottom) then
    begin
      ListBox.Perform(WM_VSCROLL, SB_LINEDOWN, 0);
      ListBox.Perform(WM_VSCROLL, SB_ENDSCROLL, 0);
    end;
end;
 
end.