2010. december 28., kedd

An example of drag and drop between DBGrids


Problem/Question/Abstract:

This sample component and sample project demonstrates an easy way of enabling drag and drop of an arbitrary field in one data aware grid onto an arbitrary field in another data aware grid.

Answer:

An example of drag and drop between DBGrids - by Borland Developer Support Staff

Technical Information Database

TI1562D.txt - An example of drag and drop between DBGrids

Category   :General Programming
Platform   :All Windows
Product    :All32Bit,  

Description:
Title: An example of drag and drop between DBGrids

This sample component and sample project demonstrates an easy way of enabling drag and drop of an arbitrary field in one data aware grid onto an arbitrary field in another data aware grid.

Launch Delphi x.xx (the code will work in 1 and 2 as well with some minor changes).

Do a File|New|Unit. Take the MyDBGrid unit (below) and paste it in the newly created unit. Do a File|Save As. Save the unit as MyDBGrid.pas.

Do a Component|Install Component. Switch to the Info New Package tab. Put MyDBGrid.pas in the Unit file name box. Call the package MyPackage.dpk. Hit Yes when Delphi tells you that the package will be built and installed. Hit OK when Delphi tells you that VCLxx.DPL is needed. The package will now be rebuilt and installed. You will now find the TMyDBGrid component on your Samples tab on your component palette. Close the package editor and save the package.

Do a File|New Application. Right click on the form (Form1) and select View As Text. Take the GridU1 form source (below) and paste it in Form1. Right click on the form and select View As Form. This may take a few moments since it's opening up the tables for you. Take the GridU1 unit (below) and paste it in the unit (Unit1).

Do a File|Save Project As. Save the unit as GridU1.pas. Save the project as GridProj.dpr.

Now, run the project and enjoy the dragging and dropping of fields inbetween or with the two grids.


The MyDBGrid unit

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.

The GridU1 unit

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 := 'You dragged "' + Fields[SGC.X - 1].AsString + '"';
    DisableControls;
    CurRow := DG.Row;
    MoveBy(GC.Y - CurRow);
    Caption := Caption + ' to "' + Fields[GC.X - 1].AsString + '"';
    MoveBy(CurRow - GC.Y);
    EnableControls;
  end;
end;

end.

The GridU1 form

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

Nincsenek megjegyzések:

Megjegyzés küldése