Валентин Озеров - Советы по Delphi. Версия 1.4.3 от 1.1.2001

typeTMyDBGrid = class(TDBGrid)

private

{ Private declarations }

FOnMouseDown: TMouseEvent;

protected

{ Protected declarations }

procedureMouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;

published

{ Published declarations }

propertyRow;

propertyOnMouseDown readFOnMouseDown writeFOnMouseDown;

end;

procedure Register;

implementation

procedureTMyDBGrid.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

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

inheritedMouseDown(Button, Shift, X, Y);

end;

procedure Register;

begin

RegisterComponents('Samples', [TMyDBGrid]);

end;

end.

unitGridU1;

interface

usesWindows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Db, DBTables, Grids, DBGrids, MyDBGrid, StdCtrls;

typeTForm1 = class(TForm)

MyDBGrid1: TMyDBGrid;

Table1: TTable;

DataSource1: TDataSource;

Table2: TTable;

DataSource2: TDataSource;

MyDBGrid2: TMyDBGrid;

procedureMyDBGrid1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

procedureMyDBGrid1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; varAccept: Boolean);

procedureMyDBGrid1DragDrop(Sender, Source: TObject; X, Y: Integer);

private

{ Private declarations }

public

{ Public declarations }

end;

varForm1: TForm1;

implementation

{$R *.DFM}

varSGC : TGridCoord;

procedureTForm1.MyDBGrid1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

varDG : TMyDBGrid;

begin

DG := Sender asTMyDBGrid;

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

if(SGC.X > 0) and(SGC.Y > 0) then(Sender asTMyDBGrid).BeginDrag(False);

end;

procedureTForm1.MyDBGrid1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; varAccept: Boolean);

varGC : TGridCoord;

begin

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

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

end;

procedureTForm1.MyDBGrid1DragDrop(Sender, Source: TObject; X, Y: Integer);

var

DG : TMyDBGrid;

GC : TGridCoord;

CurRow : Integer;

begin

DG := Sender asTMyDBGrid;

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

withDG.DataSource.DataSet do begin

with(Source asTMyDBGrid).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.

objectForm1: 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

objectMyDBGrid1: TMyDBGrid

Left = 8

Top = 8

Width = 521

Height = 193

DataSource = DataSource1

Row = 1

TabOrder = 0

TitleFont.Charset = DEFAULT_CHARSET

TitleFont.Color = clWindowTextTitle

Font.Height = -11

TitleFont.Name = 'MS Sans Serif'

TitleFont.Style = []

OnDragDrop = MyDBGrid1DragDrop

OnDragOver = MyDBGrid1DragOver

OnMouseDown = MyDBGrid1MouseDown

end

objectMyDBGrid2: 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

objectTable1: TTableActive = True

DatabaseName = 'DBDEMOS'

TableName = 'ORDERS'

Left = 104

Top = 48

end

objectDataSource1: TDataSource

DataSet = Table1

Left = 136

Top = 48

end

objectTable2: TTable

Active = True

DatabaseName = 'DBDEMOS'

TableName = 'CUSTOMER'

Left = 104

Top = 240

end

objectDataSource2: TDataSource

DataSet = Table2

Left = 136

Top = 240

end