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

=== Пример Drag and Drop между двумя DBGrid ===
Данный пример компонента и демонстрационный проект показывают простой путь осуществления операции "drag and drop" (перетащи и брось) между двумя полями различных табличных сеток.
Запустите Delphi 3 (с незначительными изменениями данный код может работать и в Delphi 1-2).
Активизируйте File|New|Unit. Скопируйте приведенный ниже модуль MyDBGrid во вновь созданный модуль. Сделайте File|Save As. Сохраните модуль как MyDBGrid.pas.
Выберите пункт меню Component|Install Component. Переключитесь на страницу Info New Package. Поместите MyDBGrid.pas в поле редактирования "Unit file name" (имя файла модуля). Назовите модуль MyPackage.dpk. Ответьте Yes на вопрос Delphi 3 о необходимости сборки и установки пакета. Нажмите OK на сообщение Delphi 3 о необходимости включения VCL30.DPL. После этого пакет будет собран и установлен. Теперь компонент TMyDBGrid будет отображен в Палитре Компонентов в группе "Samples". Закройте редактор пакетов и сохраните пакет.
Выберите пункт меню File|New Application. Щелкните правой кнопкой мыши на форме (Form1) и выберите View As Text. Скопируйте приведенный ниже исходный код формы GridU1 в Form1. Щелкните правой кнопкой мыши на форме и выберите View As Form. Убедитесь в активности ваших таблиц. Скопируйте расположенный ниже модуль GridU1 в ваш модуль Unit1.
Выберите пункт меню File|Save Project As. Сохраните модуль как GridU1.pas. Сохраните проект как GridProj.dpr.
Теперь запустите проект и наслаждайтесь функцией Drag and Drop между двумя табличными сетками.
// Модуль 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
Source: Взято с http://delphiworld.narod.ru
ID: 03072
Category:Базы данных
Category:DBGrid