// Модуль 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.
// Форма 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
|