Drag and Drop

A grafikus operációs rendszerek hasznos szolgáltatása a Drag&Drop, azaz vonszolási technika. Grafikus elemeinket megfoghatjuk, mozgathatjuk, és egy olyan objektum felé helyezve, mely képes a vonszolt elemet fogadni, elengedhetjük, aminek következtében az elem az új objektumban fog megjelenni. Ez a technika Delphi-ben is könnyen megvalósítható.

Legyen kis alkalmazásunkban elsőként két listadoboz, melyekből egy-egy elemet megfoghatunk és a másikba egérrel áttehetjük. Második részben egy listadobozból egy sztrigrácsba helyezhessünk át elemeket úgy, hogy az elengedés helye a cellát is jelölje ki. A harmadik részben beviteli mező tartalmát helyezhessük át az elsőből a másodikba. A beállításhoz az objektumok onMouseDown, onDragOver és onDragDrop eseménykezelőinek megírása szükséges.

A program futtatási képe, amikor már az elemeket, illetve az elemek egy részét már áthelyeztük a fogadó objektumba:

A program listája:

unit UDrag;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, 

Graphics, Controls, Forms, Dialogs, StdCtrls, Grids;

type
  TfmDrag = class(TForm)
    lbDrag: TLabel;
    btKilepes: TButton;
    ldA: TListBox;
    ldB: TListBox;
    ldC: TListBox;
    sgRacs: TStringGrid;
    edA: TEdit;
    edB: TEdit;
procedure btKilepesClick(Sender: TObject);
procedure ldAMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
procedure ldBMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
procedure ldADragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
procedure ldBDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
procedure ldADragDrop(Sender, Source: TObject; X, Y: Integer);
procedure ldBDragDrop(Sender, Source: TObject; X, Y: Integer);
procedure ldCMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
procedure sgRacsDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
procedure sgRacsDragDrop(Sender, Source: TObject; X, Y: Integer);
procedure edAMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
procedure edBDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
procedure edBDragDrop(Sender, Source: TObject; X, Y: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;

var
  fmDrag: TfmDrag;

implementation

{$R *.dfm}

procedure TfmDrag.btKilepesClick(Sender: TObject);
begin
  Close;
end;

procedure TfmDrag.ldAMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  ldA.BeginDrag(False);
  ldB.ItemIndex:= -1;
  ldC.ItemIndex:= -1;
end;

procedure TfmDrag.ldBMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  ldB.BeginDrag(False);
  ldA.ItemIndex:= -1;
  ldC.ItemIndex:= -1;
end;

procedure TfmDrag.ldADragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  Accept:= True;
end;

procedure TfmDrag.ldBDragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  Accept:= True;
end;

procedure TfmDrag.ldADragDrop(Sender, Source: TObject; X, Y: Integer);
begin
With ldB Do
Begin
If ItemIndex=-1 Then Exit;
    ldA.Items.Add(Items[ItemIndex]);
    Items.Delete(ItemIndex);
End;
end;

procedure TfmDrag.ldBDragDrop(Sender, Source: TObject; X, Y: Integer);
begin
With ldA Do
Begin
If ItemIndex=-1 Then Exit;
    ldB.Items.Add(Items[ItemIndex]);
    Items.Delete(ItemIndex);
End;
end;

procedure TfmDrag.ldCMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  ldC.BeginDrag(True);
  ldA.ItemIndex:= -1;
  ldB.ItemIndex:= -1;
end;

procedure TfmDrag.sgRacsDragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  Accept:= True;
end;

procedure TfmDrag.sgRacsDragDrop(Sender, Source: TObject; X, Y: Integer);
Var ACol, ARow: Integer;
begin
With ldC Do With sgRacs Do
Begin
If ItemIndex=-1 Then Exit;
    ACol:= X Div ColWidths[0];
    ARow:= Y Div RowHeights[0];
If ACol*ARow>0 Then
Begin
      Col:= ACol; Row:= ARow;
      Cells[Col,Row]:= Items[ItemIndex];
      Items.Delete(ItemIndex);
End;
End;
end;

procedure TfmDrag.edAMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  edA.BeginDrag(True);
end;

procedure TfmDrag.edBDragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  Accept:= True;
end;

procedure TfmDrag.edBDragDrop(Sender, Source: TObject; X, Y: Integer);
begin
  edB.Text:= edA.Text;
  edA.Text:= '';
end;

end.