Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Пример Drag and Drop между двумя DBGrid

Данный пример компонента и демонстрационный проект показывают простой путь осуществления операции "drag and drop" (перетащи и брось) между двумя полями различных табличных сеток.

  1. Запустите Delphi 3 (с незначительными изменениями данный код может работать и в Delphi 1-2).

  2. Активизируйте File|New|Unit. Скопируйте приведенный ниже модуль MyDBGrid во вновь созданный модуль. Сделайте File|Save As. Сохраните модуль как MyDBGrid.pas.

  3. Выберите пункт меню Component|Install Component. Переключитесь на страницу Info New Package. Поместите MyDBGrid.pas в поле редактирования "Unit file name" (имя файла модуля). Назовите модуль MyPackage.dpk. Ответьте Yes на вопрос Delphi 3 о необходимости сборки и установки пакета. Нажмите OK на сообщение Delphi 3 о необходимости включения VCL30.DPL. После этого пакет будет собран и установлен. Теперь компонент TMyDBGrid будет отображен в Палитре Компонентов в группе "Samples". Закройте редактор пакетов и сохраните пакет.

  4. Выберите пункт меню File|New Application. Щелкните правой кнопкой мыши на форме (Form1) и выберите View As Text. Скопируйте приведенный ниже исходный код формы GridU1 в Form1. Щелкните правой кнопкой мыши на форме и выберите View As Form. Убедитесь в активности ваших таблиц. Скопируйте расположенный ниже модуль GridU1 в ваш модуль Unit1.

  5. Выберите пункт меню File|Save Project As. Сохраните модуль как GridU1.pas. Сохраните проект как GridProj.dpr.

  6. Теперь запустите проект и наслаждайтесь функцией 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

Проект Delphi World © Выпуск 2002 - 2024
Автор проекта: USU Software
Вы можете выкупить этот проект.