Drag'n drop entre 2 contrôles de même nature

Télécharger le projet
Commenter

Description

Démonstration du Tirer/Lâcher (drag and drop) entre :
-> 2 composants TList
-> au sein d'un même composant TList

Ce code inclut aussi une fonction de recherche de chaîne selon un masque défini par l'utilisateur, en utilisant les caractères jokers ? et *. Ce code n'est pas de moi et je ne me souviens plus de son auteur.

Source / Exemple : 


//
//   Auteur        : Delphiprog
//   E-mail        :
//   Internet      : http://www.delphiprog.fr.fm
//   Date création : 29/08/2002
//   Date révision : 13/03/2003
{
}
//   Objet         :
{       - Démo de recherche de chaînes dans d'autres chaînes
          à l'aide d'un masque. Le code de recherche de chaînes selon un modèle
          (pattern) n'est pas de moi.
        - utilisation du drag'n drop entre deux composants TListBox et
          dans une même TListBox, dans un sens comme dans l'autre.
}
//   Remarques     :
{
}
unit UDragDropDemoForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls;

type
  TDragDropDemoForm = class(TForm)
    btnVerifyMatching: TButton;
    lbxChoix: TListBox;
    Edit1: TEdit;
    chbxCasse: TCheckBox;
    Label1: TLabel;
    Label2: TLabel;
    lbxSelectionne: TListBox;
    Label3: TLabel;
    StatusBar1: TStatusBar;
    Label4: TLabel;
    procedure btnVerifyMatchingClick(Sender: TObject);
    procedure lbxSelectionneDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure lbxSelectionneDragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure lbxSelectionneStartDrag(Sender: TObject;
      var DragObject: TDragObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;

var
  DragDropDemoForm: TDragDropDemoForm;
  //Position de départ d'une opération de Drag'n drop
  StartPos,
  //index de l'élément de destination du drag'n drop
  EndPos: integer; 

implementation

{$R *.DFM}

ResourceString
  sStringsFound = '%d chaîne(s) trouvée(s)';

{-----------------------------------------------------------------------------
  Procedure: MatchStrings
  Author:    ???
  Date:      16-janv.-2003
  Arguments: source, pattern: string
  Result:    Boolean
  Objet : Rechercher dans source si le modéle pattern transmis
          correspond.
-----------------------------------------------------------------------------}

function MatchStrings(source, pattern: string): Boolean;
var
  pSource: array[0..255] of Char;
  pPattern: array[0..255] of Char;

  function MatchPattern(element, pattern: PChar): Boolean;

    function IsPatternWild(pattern: PChar): Boolean;
    begin
      Result := StrScan(pattern, '*') <> nil;
      if not Result then
        Result := StrScan(pattern, '?') <> nil;
    end;

  begin
    if 0 = StrComp(pattern, '*') then
      Result := True
    else
      if (element^ = Chr(0)) and (pattern^ <> Chr(0)) then
        Result := False
      else
        if element^ = Chr(0) then
          Result := True
        else
        begin
          case pattern^ of
            '*':
              if MatchPattern(element, @pattern[1]) then
                Result := True
              else
                Result := MatchPattern(@element[1], pattern);
            '?': Result := MatchPattern(@element[1], @pattern[1]);
          else
            if element^ = pattern^ then
              Result := MatchPattern(@element[1], @pattern[1])
            else
              Result := False;
          end;
        end;
  end;
begin
  StrPCopy(pSource, source);
  StrPCopy(pPattern, pattern);
  Result := MatchPattern(pSource, pPattern);
end;

procedure TDragDropDemoForm.btnVerifyMatchingClick(Sender: TObject);
var
  i: integer;
begin
  with LbxChoix do
    //Parcourir la liste
    for i := 0 to Items.Count - 1 do
    begin
      //Déselectionner chaque élément
      Selected[i] := False;
      //S'il faut vérifier la casse des caractères...
      if chbxCasse.Checked then
      begin
        //...transmettre les chaines tel quel
        if MatchStrings(Items[i], Edit1.Text) then
          Selected[i] := True;
      end
      else
        //...ou effectuer la comparaison sur les majuscules
        if MatchStrings(UpperCase(Items[i]), UpperCase(Edit1.Text)) then
          Selected[i] := True;
    end;
  Label2.Caption := Format(sStringsFound, [lbxChoix.SelCount]);
end;

procedure TDragDropDemoForm.lbxSelectionneDragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  //Accepter l'opération SSI le contrôle de départ est un TListBox
 Accept := (Source is TListBox) and (TListBox(Source).ItemIndex <> -1);
end;

procedure TDragDropDemoForm.lbxSelectionneDragDrop(Sender, Source: TObject; X, Y: Integer);
var
  { utilisé pour ItemAtPos pour connaître l'indice de l'élément
    sur lequel on va lâcher un élément }
  APoint: TPoint; 
begin
  APoint.X := X;
  APoint.y := Y;
  //Si l'élément tiré est issu d'une autre listbox...
  if Sender <> Source then
  begin
    //Insérer l'élément à la position courante
    with TListBox(Sender) do
      Items.Insert(ItemAtPos(APoint, True),
        TListBox(Source).Items[TListBox(Source).ItemIndex]);
    //et le supprimer de la ListBox d'origine
    with TListBox(Source) do
      Items.Delete(ItemIndex);
  end
  else
    //Un élément va être relâché sur la même ListBox
    with TListBox(Source) do
    begin
      //Calcul de l'indice de l'élément de destination
      EndPos := ItemAtPos(APoint, True);
      //Déplacer l'élément de son ancienne position à la nouvelle
      Items.Move(StartPos, EndPos);
    end;
end;

procedure TDragDropDemoForm.lbxSelectionneStartDrag(Sender: TObject;
  var DragObject: TDragObject);
begin
  { Déterminer la position de départ de
    l'opération de tirer/Lâcher }
  StartPos := TListBox(Sender).ItemIndex;
end;

end.

Conclusion :


Ce code n'implémente le Tirer/Lâcher que d'un seul élément à la fois.
Delphi 4 et +.
Utilisable avec l'édition personnelle de Delphi.
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (cs_Delphiprog)