Пример Drag and Drop между двумя DBGRID

Code:

// Модуль MyDBGrid

unit MyDBGrid;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,

Dialogs, Grids, DBGrids;

type

TMyDBGrid = class(TDBGrid)

private

   { Private declarations }

   FOnMouseDown: TMouseEvent;

protected

   { Protected declarations }

   procedure MouseDown(Button: TMouseButton; Shift: TShiftState;

     X, Y: Integer); override;

published

   { Published declarations }

   property Row;

   property OnMouseDown read FOnMouseDown write FOnMouseDown;

end;

procedure Register;

implementation

procedure TMyDBGrid.MouseDown(Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

begin

if Assigned(FOnMouseDown) then

   FOnMouseDown(Self, Button, Shift, X, Y);

inherited MouseDown(Button, Shift, X, Y);

end;

procedure Register;

begin

RegisterComponents('Samples', [TMyDBGrid]);

end;

end.

// Модуль GridU1

unit GridU1;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,

Dialogs, Db, DBTables, Grids, DBGrids, MyDBGrid, StdCtrls;

type

TForm1 = class(TForm)

   MyDBGrid1: TMyDBGrid;

   Table1: TTable;

   DataSource1: TDataSource;

   Table2: TTable;

   DataSource2: TDataSource;

   MyDBGrid2: TMyDBGrid;

   procedure MyDBGrid1MouseDown(Sender: TObject;

     Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

   procedure MyDBGrid1DragOver(Sender, Source: TObject;

     X, Y: Integer; State: TDragState; var Accept: Boolean);

   procedure MyDBGrid1DragDrop(Sender, Source: TObject;

     X, Y: Integer);

private

   { Private declarations }

public

   { Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

var

SGC: TGridCoord;

procedure TForm1.MyDBGrid1MouseDown(Sender: TObject;

Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

var

DG: TMyDBGrid;

begin

DG := Sender as TMyDBGrid;

SGC := DG.MouseCoord(X, Y);

if (SGC.X > 0) and (SGC.Y > 0) then

   (Sender as TMyDBGrid).BeginDrag(False);

end;

procedure TForm1.MyDBGrid1DragOver(Sender, Source: TObject;

X, Y: Integer; State: TDragState; var Accept: Boolean);

var

GC: TGridCoord;

begin

GC := (Sender as TMyDBGrid).MouseCoord(X, Y);

Accept := Source is TMyDBGrid and (GC.X > 0) and (GC.Y > 0);

end;

procedure TForm1.MyDBGrid1DragDrop(Sender, Source: TObject;

X, Y: Integer);

var

DG: TMyDBGrid;

GC: TGridCoord;

CurRow: Integer;

begin

DG := Sender as TMyDBGrid;

GC := DG.MouseCoord(X, Y);

with DG.DataSource.DataSet do

begin

   with (Source as TMyDBGrid).DataSource.DataSet do

     Caption := 'Вы перетащили "' + Fields[SGC.X - 1].AsString + '"';

   DisableControls;

   CurRow := DG.Row;

   MoveBy(GC.Y - CurRow);

   Caption := Caption + ' в "' + Fields[GC.X - 1].AsString + '"';

   MoveBy(CurRow - GC.Y);

   EnableControls;

end;

end;

end.

Code:

// Форма GridU1

object Form1: TForm1

Left = 200

   Top = 108

   Width = 544

   Height = 437

   Caption = 'Form1'

   Font.Charset = DEFAULT_CHARSET

   Font.Color = clWindowText

   Font.Height = -11

   Font.Name = 'MS Sans Serif'

   Font.Style = []

   PixelsPerInch = 96

   TextHeight = 13

   object MyDBGrid1: TMyDBGrid

   Left = 8

     Top = 8

     Width = 521

     Height = 193

     DataSource = DataSource1

     Row = 1

     TabOrder = 0

     TitleFont.Charset = DEFAULT_CHARSET

     TitleFont.Color = clWindowText

     TitleFont.Height = -11

     TitleFont.Name = 'MS Sans Serif'

     TitleFont.Style = []

     OnDragDrop = MyDBGrid1DragDrop

     OnDragOver = MyDBGrid1DragOver

     OnMouseDown = MyDBGrid1MouseDown

end

object MyDBGrid2: TMyDBGrid

   Left = 7

     Top = 208

     Width = 521

     Height = 193

     DataSource = DataSource2

     Row = 1

     TabOrder = 1

     TitleFont.Charset = DEFAULT_CHARSET

     TitleFont.Color = clWindowText

     TitleFont.Height = -11

     TitleFont.Name = 'MS Sans Serif'

     TitleFont.Style = []

     OnDragDrop = MyDBGrid1DragDrop

     OnDragOver = MyDBGrid1DragOver

     OnMouseDown = MyDBGrid1MouseDown

end

object Table1: TTable

   Active = True

     DatabaseName = 'DBDEMOS'

     TableName = 'ORDERS'

     Left = 104

     Top = 48

end

object DataSource1: TDataSource

   DataSet = Table1

     Left = 136

     Top = 48

end

object Table2: TTable

   Active = True

     DatabaseName = 'DBDEMOS'

     TableName = 'CUSTOMER'

     Left = 104

     Top = 240

end

object DataSource2: TDataSource

   DataSet = Table2

     Left = 136

     Top = 240

end

end