DÉPLACER LES ITEMS D'UNE TLISTVIEW PAR DRAG AND DROP

{

   Auteur        : Krzysiu
   E-mail        :
   Internet      :
   Date création : 22/02/2008
   Date révision : 23/02/2008


 DEPLACEMENTS DES ITEMS D'UNE LISTVIEW PAR DRAG AND DROP


       Suite à une recherche désespérée sur code source,
       Fortement inspriré du code de Japee (merci)
       Merci à JLN pour les conseils finaux
       Merci à Delphiprog pour le TObjectList

Comment deplacer en Drag & Drop les items d'un list view

cahier des charges :

- Les items sont insérés à l'endroit du lâcher : ils sont insérés ou ajoutés,
  selon l'emplacement choisi dans la List View.
- La multi-sélection est autorisée.
- Les items sont déposés dans l'ordre où ils ont été trouvés.
- Le glisser-déposer fonctionne dans les 2 sens.
- Le glisser-déposer à l'intérieur de la même ListView et entre deux ListView.

une interface graphique pour tester toutes les possibilités.

}

unit UMain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, ComCtrls,Contnrs;
type
  TfrmMain = class(TForm)
    btnInitialize: TButton;
    btnClearLV1: TButton;
    btnClearLV2: TButton;
    ListView1: TListView;
    ListView2: TListView;
    Panel1: TPanel;
    Splitter1: TSplitter;
    procedure FormCreate(Sender: TObject);
    procedure btnInitializeClick(Sender: TObject);
    procedure btnClearLV1Click(Sender: TObject);
    procedure ListView1DragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure btnClearLV2Click(Sender: TObject);
    procedure ListView1DragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.DFM}

procedure TfrmMain.ListView1DragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  Accept:=(Sender is TListView);
end;

procedure TfrmMain.ListView1DragDrop(Sender, Source: TObject; X, Y: Integer);
var
  i: Integer;
  CursorPos: TPoint;
  Index: Integer;
  List: TObjectList;
  SItems:TListItem;

begin
  List := TObjectList.Create(true);  //Creation d'un TObjectList qui va servir à transporter les items séléctioné
  try
    with TListView(Source) do
    begin
      for i:= 0 to Items.Count-1 do  //Ajoute les items séléctioné dans le TObjectList dans            l'ordre du ListView
      begin
        if Items.Item[i].Selected then
        begin
          SItems:=TlistItem.Create(Items);
          SItems.Assign(Items.Item[i]);
          List.Add(SItems);
        end;
      end;
      for i:=Items.Count-1 downto 0 do   //Supprime les items séléctioné dansd l'ordre inverse
      begin
        if Items.Item[i].Selected then
          Items.Item[i].Delete;
      end;
    end;
    CursorPos := Point(X, Y);

     with TListView(Sender) do
     begin
      if GetItemAt(CursorPos.X,CursorPos.Y)=nil then
        Index:=-1
      else
        Index := GetItemAt(CursorPos.X,CursorPos.Y).Index;

      for i:=0 to List.Count-1 do
      begin
        if Index >-1 then
          SItems:=Items.Insert(Index)
        else
          SItems:=Items.Add;
        SItems.Assign(TlistItem(List[i])); //Reconstruis les items à leur nouvel emplacement
      end;
    end;
  finally
    List.Free; //Liberer les Objets du contenu dans le TObjectList
  end;
end;


{--------------------- FONCTIONNEMENT DE L'INTERFACE --------------------------}

procedure InitializeMemos(const Mem1, Mem2: TListItems);
var
  i: Integer;
begin
  Mem1.Clear;
  Mem2.Clear;
  for i := 0 to 9 do
  begin
    Mem1.Add.Caption:=Format('ListView1.Items[%d]', [i]);
    Mem1.Item[i].SubItems.Add(Format('Col 1 [%d]',[i]));
    Mem1.Item[i].SubItems.Add(Format('Col 2 [%d]',[i]));
    Mem2.Add.Caption:=Format('ListView2.Items[%d]', [i]);
    Mem2.Item[i].SubItems.Add(Format('Col 1 [%d]',[i]));
    Mem2.Item[i].SubItems.Add(Format('Col 2 [%d]',[i]));
  end;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  InitializeMemos(ListView1.Items, ListView2.Items);
end;

procedure TfrmMain.btnInitializeClick(Sender: TObject);
begin
  InitializeMemos(ListView1.Items, ListView2.Items);
end;

procedure TfrmMain.btnClearLV1Click(Sender: TObject);
begin
  ListView1.Clear;
end;

procedure TfrmMain.btnClearLV2Click(Sender: TObject);
begin
  ListView2.Clear;
end;



end.

Télécharger le zip

22 février 2008 13:55:40 :

Ajout du source

22 février 2008 18:37:42 :

Correction des fautes ;-)

23 février 2008 22:10:16 :

Correction d’un oublie Modification du code en fonction des conseils de Delphiprog

23 février 2008 22:12:45 :

Correction d’un oublie Modification du code en fonction des conseils de Delphiprog

24 février 2008 18:02:09 :

Ajout d'une copie d'écran