На этом шаге мы продолжим изучение некоторых событий и методов класса TControl. Полный перечень свойств, методов и событий приведен на шаге 16.

    Для библиотеки VCL фирмой Borland реализована собственная версия интерфейса Drag&Drop ("перетащить и оставить"). Передавать и принимать можно любые управляющие элементы Delphi внутри формы (кроме самой формы). Он реализован без использования соответствующих функций API Windows - их нужно применять при организации общения с другими задачами путем перетаскивания.

    Нажав левую кнопку мыши над элементом управления, мы можем "перетащить" его на любой другой элемент. С точки зрения программиста это означает, что в моменты перетаскивания и отпускания клавиши генерируются определенные события, которыми передается вся необходимая информация: указатель на перетаскиваемый объект, текущие координаты курсора и др. Получателем событий является тот элемент, на котором в данный момент находится курсор. Обработчик такого события должен сообщить системе, принимает ли данный элемент управления "посылку" или нет. При отпускании кнопки над принимающим элементом управления генерируется еще одно или два события, в зависимости от готовности приемника.

    Способ работы с этим интерфейсом в VCL определяется свойством:

   property DragMode: TDragMode; 
   TDragMode = (dmManual, dmAutomatic) ;.      

    Для автоматического включения механизмов, имеющихся в VCL, необходимо, чтобы свойство компонента DragMode было установлено в dmAutomatic. Это означает, что на всех стадиях перетаскивания нужные функции вызываются без участия программиста. Его задача состоит только в том, чтобы определить методы-обработчики соответствующих событий. В режиме dmManual (принимаемом по умолчанию) все необходимые вызовы функций нужно делать самому.

    Рассмотрим подробнее формат обработчиков трех основных событий интерфейса Drag&Drop.

    Во время перетаскивания при перемещении курсора мыши с перетаскиваемым элементом над другим элементом управления, а также при отпускании кнопки, для последнего возникает событие:

   property OnDragOver: TDragOverEvent; 
   TDragOverEvent = procedure (Sender, Source: TObject; X, Y: Integer;   
                        State: TDragState; var Accept: Boolean) 
of object; 

    Параметры события:

• Sender - элемент, над которым находится курсор;
• Source - перетаскиваемый элемент;
• X, Y - координаты курсора (в системе координат клиентской области Sender);
• State - одно из трех состояний (TDragState = (dsDragEnter, dsDragLeave, dsDragMove);):
  • dsDragEnter - курсор мыши появился над элементом;
  • dsDragMove - курсор мыши переместился над элементом;
  • dsDragLeave - курсор мыши ушел с элемента или была отпущена кнопка.

    Обработчик этого события должен возвратить решение, примет ли данный элемент объект Source или нет, в булевой переменной Accept. Если обработчик этого события отсутствует, то элемент управления не может работать приемником, то есть на него нельзя "перетащить" компонент.

    Во время перетаскивания над элементом управления он может изменить вид курсора, сигнализируя о готовности приема. Предназначенный для этого случая курсор описывается свойством:

   property DragCursor: TCursor;   . 

    Если компонент не является приемником Drag&Drop, или обработчик события OnDragOver отсутствует или возвращает False, то появляется другой курсор (по умолчанию crNoDrop).

    Событие:

   property OnDragDrop: TDragDropEvent; 
   TDragDropEvent = procedure (Sender, Source: TObject;    
                         X, Y: Integer) of object; 

возникает во время перетаскивания при отпускании левой кнопки мыши над элементом, готовым к приему. Параметры его имеют тот же смысл, что и в предыдущем случае.

    В приведенном примере можно перетащить одну из геометрических фигур в форме (компонент TShape, вкладка Additional) на статический текст Label1. Для этого в Label1 описано два метода:

• Label1DragOver сигнализирует о готовности принять только компоненты класса TShape, a
• Label1DragDrop вычисляет площадь фигуры в квадратных сантиметрах в зависимости от ее вида (эллипс, прямоугольник, прямоугольник с закругленными углами).

Рис.1. Внешний вид приложения

unit Un_D_D;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Shape1: TShape; //Эллипс.
    Shape2: TShape; //Прямоугольник.
    Shape3: TShape; //Прямоугольник с закругленными углами.
    procedure Label1DragOver(Sender, Source: TObject; X, Y: Integer;
                             State: TDragState; var Accept: Boolean);
    procedure Label1DragDrop(Sender, Source: TObject; X, Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Label1DragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
    Accept:=Source is TShape; //Прием компонентов типа TShape.
end;

procedure TForm1.Label1DragDrop(Sender, Source: TObject; 
                                          X, Y: Integer);
var
   f:single;
   i:Integer;
begin
   with Source as 
TShape do 
   //Компоненты типа TShape.
   begin
     i:=Width;
     if i>Height then i:=Height;
     //Вычисление площади в зависимости от фигуры.
     case Shape of
       stRectangle: f := Width*Height;
       stSquare:    f := i*i;
       stCircle:    f := Pi*i*i/4;
       stEllipse:   f := Pi*Width*Height/4;
       stRoundRect, stRoundSquare:
           begin
             if Shape=stRoundRect then f := Width*Height
             else f :=i*i;
             i := (i-Pen.Width+1) div 4;
             f := f-(4-Pi)*i*i;
           end;
     end;
   end;
   //Пересчет значения площади в квадратные сантиметры.
   f :=f/Sqr(Form1.PixelsPerInch/2.54);
   //Форматный вывод вычисленного значения.
   Label1.Caption := FloatToStrF(f,ffFixed,5,2)+ ' кв.см';
end;

end.

    Текст этого примера можно взять здесь.

    При завершении перетаскивания, вне зависимости от готовности приемника всегда возникает еще одно событие:

   property OnEndDrag: TEndDragEvent; 
   TEndDragEvent = procedure (Sender, Source: TObject;    
                         X, Y: Integer) of object; 

    Имеется также связанное с перетаскиванием событие OnStartDrag, которое позволяет произвести какие-то операции в начале перетаскивания. Это событие полезно при автоматическом начале перетаскивания, когда иным способом этот момент нельзя зафиксировать.

    Для управления перетаскиванием вручную (в режиме dmManual) есть следующие возможности. Начало перетаскивания происходит при вызове метода:

   procedure BeginDrag(Immediate: Boolean);     . 

    Программист должен связать вызов этого метода с каким-либо событием в системе (если свойство DragMode установлено в dmAutomatic, BeginDrag вызывается функцией окна при нажатии левой кнопки мыши). Параметр Immediate определяет, когда именно возникает состояние перетаскивания: в случае True - немедленно, в случае False - после смещения мыши с нажатой левой кнопкой на 5 точек по любой из осей. Последний вариант дает возможность использовать нажатие левой кнопки и для перетаскивания, и для регистрации щелчков на элементе управления (скажем, на кнопке). В режиме dmAutomatic такой возможности нет.

    Метод:

   procedure DragDrop(DragObject: TObject; X, У: Integer); dynamic; 

вызывает обработчик события OnDragDrop, а производит все завершающие действия метод:

   procedure EndDrag(Drop: Boolean);    . 

    Метод:

   function Dragging: Boolean; 

возвращает True, если данный элемент в настоящий момент перетаскивается.

    На следующем шаге мы рассмотрим свойства и методы, используемые для организации помощи.

Предыдущий шаг Содержание Следующий шаг