Delphi

КОМПЬЮТЕРНЫЕ КУРСЫ "ПОИСК"

[Главная страница] [Delphi] [Контакты]

Механизм перетаскивания в VCL

Несмотря на то, что перетаскивание является простым механизмом взаимодействия в рамках интерфейса пользователя, реализовать этот механизм в приложении не так просто, как может показаться на первый взгляд.

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

1. Начать операцию перетаскивания.
2. Проверить, какой элемент вовлечен в эту операцию, и принять или отклонить перетаскиваемый элемент.
3. Завершить операцию перетаскивания.

Перетаскивание может быть начато автоматически, если свойству DragMode элемента управления присвоить значение dmAutomatic. Как правило, автоматическое начало операции перетаскивания не вызывает проблем. Однако иногда могут возникать сложности, связанные с использованием элемента управления, поскольку в этом случае имеет место автоматическое изменение указателя мыши.

Начать и остановить операцию перетаскивания можно и вручную, используя для этого методы BeginDrag и EndDrag.

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

drag

В окне списка Select Control Type содержится список классов, из которых можно создать соответствующие экземпляры. В окне списка Available types содержатся дополнительные классы, которые нужно перетащить в Select Control Type, чтобы создать соответствующий экземпляр.

Установите для  списка Select Control Type имя TypeList, а его свойству DragMode присвойте значение dmAutomatic, чтобы операция перетаскивания начиналась автоматически. Кроме того, добавьте в окно списка компоненты TLabel, TEdit и TButton, используя редактор String List Editor.

После присваивания свойству DragMode значения dmAutomatic вы должны написать код, который будет принимать или отклонять перетаскиваемый элемент. Для этого можно воспользоваться обработчиком события OnDragOver. Поскольку мы перетаскиваем элементы из окна списка TypeList на форму, этот код должен быть помещен в обработчик события OnDragOver формы.

procedure TForm1.FormDragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin

end;

В обработчике события OnDragOver можно воспользоваться параметром Source, чтобы посмотреть, какой элемент управления начал операцию перетаскивания. Параметр Accept позволяет управлять операцией перетаскивания. Если мы хотим принимать элементы из элемента управления Source, то должны просто присвоить параметру Accept значение True. Если операцию перетаскивания начнет неподдерживаемый элемент управления, мы можем присвоить этому параметру значение False, чтобы форма не принимала перетаскиваемый элемент. В нашем случае потребуется также узнать, выбрал ли пользователь что-нибудь в окне списка TypeList.

procedure TForm1.FormDragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  Accept := (Source = TypeList) and (TypeList.ItemIndex <> -1);
end;

Создание экземпляров элементов управлений

Для завершения операции перетаскивания (по сути, чтобы принять перетаскиваемый элемент), необходимо написать обработчик для события OnDragDrop. Событие OnDragDrop возникает только в том случае, если перетаскиваемый элемент был принят в обработчике события OnDragOver. Обработчик события OnDragDrop должен содержать код для создания экземпляра класса, выбранного в окне списка TypeList.

Для написания этого кода лучше всего воспользоваться блоком проверки условия if-then. В нем можно сначала узнать, какой класс был выбран, а затем создать экземпляр этого класса. На самом деле этот вариант не является оптимальным, потому что при каждом добавлении нового класса в список вы должны будете написать дополнительный код для создания экземпляра нового класса, как показано в листинге ниже.

procedure TForm1.FormDragDrop(Sender, Source: TObject; X, Y: Integer);
var
  newLabel: TLabel;
  newButton: TButton;
  newEdit: TEdit;
  sel: string;
begin
  sel := TypeList.Items[TypeList.ItemIndex];
  if sel = 'TLabel' then
    newLabel := TLabel.Create(Self)
  else if sel = 'TEdit' then
    newEdit := TEdit.Create(Self)
  else
    newButton := TButton.Create(Self);
end;

Использование полиморфизма

Еще один вариант (лучший, хоть и не оптимальный) динамического создания различных элементов управления предусматривает использование полиморфизма. Во фрагменте кода, представленном в листинге ниже, для создания уникальных имен элементов управления применяется свойство FControlCount главной формы.

var
  Form1: TForm1;
  FControlCount: Integer = 0;

implementation

{$R *.dfm}

procedure TMainForm.FormDragDrop(Sender, Source: TObject; X, Y: Integer);
var
  newControl: TControl;
  sel: string;
begin
  sel := TypeList.Items[TypeList.ItemIndex];
  if sel = 'TLabel' then
    newControl := TLabel.Create(Self)
  else if sel = 'TEdit' then
    newControl := TEdit.Create(Self)
  else
    newControl := TButton.Create(Self);

  Inc(FControlCount);
  newControl.Name := newControl.ClassName + IntToStr(FControlCount);

  newControl.Parent := Self;
  newControl.Top := Y;
  newControl.Left := X;
end;

Ссылки на классы

Оптимальный вариант создания экземпляров предусматривает применение ссылок на классы. Ссылки на классы позволяют работать непосредственно с классами, а не с их экземплярами. Ссылки на классы применяются в приложениях VCL Forms практически повсеместно. Например, метод CreateForm класса TApplication использует ссылки на классы для создания экземпляров форм, построенных на этапе проектирования:

procedure CreateForm(FormClass: TFormClass; var Reference);

Для того чтобы сослаться на определенный класс в приложении, этот класс потребуется зарегистрировать. Регистрация классов производится автоматически, когда на этапе проектирования создастся экземпляр класса, однако их можно регистрировать и вручную с помощью процедуры RegisterClasses. В нашем случае мы должны вызвать процедуру RegisterClasses, поскольку нам нужно использовать классы, экземпляры которых не были созданы в окне Designer Surface (Окно конструктора). Поместите вызов процедуры RegisterClasses в обработчик события OnCreate.

procedure TForm1.FormCreate(Sender: TObject);
begin
  RegisterClasses([TLabel, TEdit, TButton, TMemo, TCheckBox, TRadioButton,
                  TListBox, TComboBox, TPanel]);
end;

Теперь, когда все необходимые классы зарегистрированы, мы должны получить класс из имени класса. Это можно сделать с помощью функции GetClass, объявленной в модуле Classes. Так как функция GetClass возвращает TPersistentClass, ее результат потребуется привести к типу TControlClass. TControlClass позволяет ссылаться на любой компонент, порожденный от TContrоl.

var
  selClass: TControlClass;
  selItem: string;
begin
  selItem := TypeList.Items[TypeList.ItemIndex];
  selClass := TControlClass(GetClass(selItem));
end;

После получения класса необходимо будет создать его экземпляр и определить свойства нового элемента управления. Больше всего хлопот доставит свойство Name, поскольку имя элемента управления должно быть уникальным. Чтобы получить уникальное имя, подобное генерируемому Designer Surface, потребуется подсчитать, сколько экземпляров определенного класса существует на форме. Этот код лучше всего поместить в отдельную функцию:

function TMainForm.GetControlCount(AClass: TControlClass): Integer;
var
  i: Integer;
begin
  Result := 0;
  for i := 0 to Pred(ControlCount) do
    if Controls[i] is AClass then Inc(Result);
end;

В листинге ниже представлен полный код обработчика события OnDragDrop.

  private
    { Private declarations }
    function GetControlCount(AClass: TControlClass): Integer;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  RegisterClasses([TLabel, TEdit, TButton, TMemo, TCheckBox, TRadioButton,
                  TListBox, TComboBox, TPanel]);
end;

procedure TForm1.FormDragDrop(Sender, Source: TObject; X, Y: Integer);
var
  newControl: TControl;
  selClass: TControlClass;
  ctlName: string;
  selItem: string;
begin
  selItem := TypeList.Items[TypeList.ItemIndex];
  selClass := TControlClass(GetClass(selItem));

  newControl := selClass.Create(Self);
  newControl.Parent := Self;

  ctlName := newControl.ClassName + IntToStr(GetControlCount(selClass));
  Delete(ctlName, 1, 1); {Удаляем "Т"}

  newControl.Name := ctlName;
  newControl.Top := Y;
  newControl.Left := X;
end;

procedure TForm1.FormDragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  Accept := (Source = TypeList) and (TypeList.ItemIndex <> -1);
end;

function TForm1.GetControlCount(AClass: TControlClass): Integer;
var
  i: Integer;
begin
  Result := 0;
  for i := 0 to Pred(ControlCount) do
    if Controls[i] is AClass then
      Inc(Result);
end;

end.

Перетаскивание между компонентами TListBox

Теперь необходимо позаботиться о том, чтобы пользователь мог перетаскивать элементы из списка Available Types (Доступные типы) в окно списка TypeList. Окно списка AvailableList должно использоваться только в качестве контейнера для классов, которые могут быть добавлены в окно списка TypeList.

Поскольку мы должны сделать так, чтобы пользователь мог перетаскивать элементы из окна списка AvailableList в окно списка TypeList, необходимо присвоить свойству DragMode окна списка AvailableList значение dmAutomatic. Затем следует написать обработчик события OnDragOver окна списка TypeList, который будет принимать элементы, перетаскиваемые из списка AvailableList.

procedure TForm1.AvailableListDragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  Accept := (Source = AvailableList);
end;

Перетаскивая элемент в окно списка, его можно добавить в конец списка, вызвав для этого метод Add свойства Items. Если же вы захотите оформить эту операцию более профессионально, то тогда нужно вставить перетаскиваемый элемент по месту указателя мыши. Для этого потребуется вызвать метод ItemAtPos окна списка, чтобы определить индекс под указателем мыши и передать его методу Insert свойства Items.

procedure TForm1.TypeListDragDrop(Sender, Source: TObject; X, Y: Integer);
var
  itemPos: Integer;
begin
  if AvailableList.ItemIndex = -1 then Exit;
  itemPos := TypeList.ItemAtPos(Point(X, Y), False);
  with AvailableList do
  begin
    TypeList.Items.Insert(itemPos, Items[ItemIndex]);
    Items.Delete(ItemIndex);
  end;
end;

Теперь, когда перетаскивание между двумя окнами списка реализовано, пользователь сможет самостоятельно создать все доступные классы, если сначала перетащит их в окно списка TypeList, а затем на форму.

Исходный код здесь. Выполнен на Delphi XE.

Методы BeginDrag и EndDrag

Методы BeginDrag и EndDrag могут использоваться для начала и завершения процесса перетаскивания элемента управления, если свойству DragMode элемента управления будет присвоено значение dmManual. Мы будем использовать методы BeginDrag и EndDrag для того, чтобы пользователь мог перемещать элементы управления на форме. Во-первых, создайте новый проект приложения VCL Forms и добавьте на форму несколько элементов управления.

drag2

Наилучшим местом для вызова метода BeginDrag является обработчик события OnMouseDown. При вызове этого метода вы должны передать параметру Immediate булевское значение. Этот параметр определяет, когда начнется операция перетаскивания: непосредственно во время перемещения указателя мыши или после того, как указатель переместится на небольшое расстояние. Чтобы начать операцию перетаскивания непосредственно во время перемещения указателя мыши, передайте значение True, в противном случае передайте значение False.

procedure TForml.ControlMouseDown(Sender: TObject; Button: TMouseButton;
   Shift: TShiftState; X, Y: Integer); 
begin
  TWinControl(Sender).BeginDrag(True); 
end;

Параметр Sender отвечает за приведение к типу TWinControl, чтобы можно было назначить обработчик события множеству элементов управления.

Теперь все что нам нужно сделать — это принять перетаскиваемый элемент управления в обработчике OnDragOver формы и завершить операцию перетаскивания в событии OnDragDrop, вызвав для этого метод EndDrag. Метод EndDrag также принимает булевский параметр. Если вы действительно хотите перетащить элемент управления, передайте значение True. Если вы передадите значение False, операция перетаскивания будет отменена.

procedure ControlMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
    procedure FormDragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure FormDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TForm1 }

procedure TForm1.ControlMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  TWinControl(Sender).BeginDrag(True);
end;

procedure TForm1.FormDragDrop(Sender, Source: TObject; X, Y: Integer);
begin
  with TWinControl(Source) do
  begin
    Left := X;
    Top := Y;
    EndDrag(True);  { Перетаскиваемый элемент управления }
  end;
end;

procedure TForm1.FormDragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  Accept := True; { Принимаем все }
end;

end.

Использование и создание сообщений

В операционной системе Windows сообщения используются для уведомления приложения о происходящих событиях. Операционная система генерирует сообщение каждый раз, когда что-то происходит (например, когда пользователь щелкает на кнопке Start (Пуск), вводит что-нибудь с клавиатуры или перемещает окно), и посылает сообщение соответствующему окну.

Сообщения несут в себе дополнительную информацию, наиболее важной из которой является дескриптор окна, идентификатор сообщения и два параметра сообщения. При возникновении сообщение заносится в запись TMsg, после чего передается соответствующему приложению. Запись TMsg объявлена в модуле Windows и показана в листинге ниже.

tagMSG = packed record
    hwnd: HWND;
    message: UINT;
    WParam: WPARAM;
    lParam: LPARAM;
    time: DWORD;
    pt: TPoint;
end;
TMsg = tagMSG;

Поле hwnd хранит дескриптор окна, которому посылается сообщение. В среде Windows дескриптор окна представляет собой 32-разрядное целочисленное значение, уникально идентифицирующее окно. Кроме этого, в Windows все элементы управления (такие как кнопки, окна редактирования и окна списка) являются окнами и имеют собственные уникальные значения дескрипторов.

Поле сообщения является целочисленным значением, идентифицирующим сообщение. Для каждого сообщения Windows в модуле Messages предусмотрена константа, имя которой описывает данное действие. Все константы сообщений Windows начинаются с WM_.

Некоторые стандартные сообщения Windows
WM_MOVE         =  $0003; { Окно было перемещено }
WM_ENABLE       =  $000A; { Изменение состояния окна }
WM_PAINT        =  $000F; { Перерисовка клиентской области окна )
WM_CLOSE        =  $0010; { Закрытие окна }
KM_KEYDOWN      =  $0100; { Нажатие клавиши }
WM_LBUTTONDOWN  =  $0201; { Щелчок левой кнопкой мыши }

Поле wParam и lParam тесно связаны с сообщением, переданным в поле сообщения. Оба эти значения применяются для последующего определения сообщения. Значения полей time и pt используются редко. Поле time хранит время, когда возникло событие, а поле pt содержит координаты X и Y указателя мыши, в которых он находился во время возникновения события.

Библиотека VCL не только инкапсулирует в события большинство стандартных сообщений, таких как OnClick и OnMouseDown, но и предоставляет возможность управлять остальными сообщениями. Чтобы обработать сообщение, не инкапсулированное в событии VCL, потребуется написать метод сообщения.

Для создания метода сообщения нужно написать метод, принимающий один параметр-переменную TMessage (или похожую запись, связанную с сообщением), и пометить этот метод с помощью директивы message, ставя вслед за ней константу, идентифицирующую обработанное сообщение. В приложениях VCL Forms при работе с сообщениями служит запись TMessage, а не ТMsg.

Обработка сообщений

Теперь давайте попробуем обработать сообщение WM_MOVE, которое посылается окну после того, как оно было перемещено. Метод, отвечающий за обработку сообщения WM_MOVE, будет выглядеть примерно так, как показано ниже:

procedure MyMoveHandler(var Message: TMessage); message WM_MOVE;

В листинге ниже содержится весь метод сообщения, который просто отображает верхнюю (Тор) и левую (Left) координаты главной формы при ее перемещении.

type
  TForm1 = class(TForm)
  private
    { Private declarations }
  public
    { Public declarations }
    procedure WMMove(var Message: TMessage); message WM_MOVE;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TForm1 }

procedure TForm1.WMMove(var Message: TMessage);
begin
  Caption := Format('Top: %d - Left: %d', [Top, left]);
end;

d1-3

Различие между событиями VCL и непосредственной обработкой сообщений состоит в том, что мы должны передавать сообщение обработчику сообщения предка, а в отношении некоторых сообщений уведомлять операционную систему об их обработке. В документации по каждому сообщению всегда указывается, какие результаты нужно возвращать после его обработки.

procedure TForm1.WMMove(var Message: TMessage);
begin
  Caption := Format('Top: %d - Left: %d', [Top, left]);
  inherited; { Передаем сообщение обработчику сообщения предка }
end;

Как было сказано ранее, поля lParam и wParam содержат дополнительную информацию о сообщении. В сообщении WM_MOVE поле lParam хранит координаты X и Y окна. Младшее слово значения поля lParam определяет координату X, а старшее слово определяет координату Y.

procedure TForm1.WMMove(var Message: TMessage);
begin
  Caption := Format('X: %d - Y: %d', [Message.LParamLo, Message.LParamHi]);
  inherited; { Передаем сообщение обработчику сообщения предка }
end;

Еще лучший способ обработки сообщения состоит в использовании записи, которая в большей степени связана с сообщением, нежели обобщенная запись TMessage. Модуль Messages содержит большую коллекцию таких записей. Ниже показана запись, связанная с сообщением WM_MOVE:

TWMMove = packed record
Msg: Cardinal;
Unused: Integer;
case Integer of
  0: (
    XPos: Smallint; YPos: Smallint);
  1: (
    Pos: TSmallPoint; Result: Longint);
end;

Желательно всегда использовать именно эти записи, поскольку они позволяют существенно упростить код.

type
  TForm1 = class(TForm)
  private
    { Private declarations }
  public
    { Public declarations }
    procedure WMMove(var Message: TWMMove); message WM_MOVE;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TForm1 }

procedure TForm1.WMMove(var Message: TWMMove);
begin
  Caption := Format('X: %d - Y: %d', [Message.XPos, Message.YPos]);
  inherited; { Передаем сообщение обработчику сообщения предка }
end;

Теперь, когда известно, как используются сообщения, можно сделать что-нибудь более интересное. Например, мы можем создать "эластичные" окна, которые будут вести себя подобно главному окну и окну списка воспроизведения Winamp и других программ для воспроизведения мультимедиа-данных. Для начала добавьте в проект еще одну форму и присоедините ее к главной форме в обработчике сообщения WM_MOVE, как показано в листинге ниже.

type
  TForm1 = class(TForm)
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure WMMove(var Message: TWMMove); message WM_MOVE;
  end;

var
  Form1: TForm1;

implementation

uses Unit2;

{$R *.dfm}

{ TForm1 }

procedure TForm1.FormShow(Sender: TObject);
begin
  Form2.Show;
end;

procedure TForm1.WMMove(var Message: TWMMove);
begin
  { Мы должны проверить, существует ли форма Form2, так как сообщение
    WM_MOVE для главной формы будет сгенерировано прежде, чем будет
    создана форма Form2 }
  if Assigned(Form2) then
  begin
    Form2.Top := Top + Height;
    Form2.Left := Left;
  end;

  inherited;
end;

Ранее был описан способ перемещения формы, не имеющей строки заголовка. В том примере использовались три различных обработчика события и булевская переменная, которая была необходима для определения, когда нужно перемещать форму. Хотя приведенный код и не был сложным, он содержал достаточно много строк. Эту же задачу можно решить гораздо проще за счет перехвата сообщения WM_NCHITTEST и реакции на него.

Сообщение WM_NCHITTEST посылается окну при нажатии или отпускании кнопки мыши или же при перемещении указателя мыши. Возвращаемое значение этого сообщения указывает на место, в котором находится указатель мыши: клиентская область, строка заголовка, меню или любая другая область окна. Результат сообщения также определяет то, что операционная система будет делать с окном. Следовательно, единственное, что потребуется сделать — это заставить Windows "поверить" в то, что указатель мыши всегда находится над строкой заголовка. Для этого необходимо вернуть константу HTCAPTION в результате.

type
  TForm1 = class(TForm)
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure WMMove(var Message: TWMMove); message WM_MOVE;
    procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
  end;

var
  Form1: TForm1;

implementation

uses Unit2;

{$R *.dfm}

{ TForm1 }

procedure TForm1.FormShow(Sender: TObject);
begin
  Form2.Show;
end;

procedure TForm1.WMMove(var Message: TWMMove);
begin
  { Мы должны проверить, существует ли форма Form2, так как сообщение
    WM_MOVE для главной формы будет сгенерировано прежде, чем будет
    создана форма Form2 }
  if Assigned(Form2) then
  begin
    Form2.Top := Top + Height;
    Form2.Left := Left;
  end;

  inherited;
end;

procedure TForm1.WMNCHitTest(var Message: TWMNCHitTest);
begin
  inherited;
  if Message.Result = HTCLIENT then
    Message.Result := HTCAPTION;
end;

Создание специальных сообщений

Чтобы создать специальное сообщение, которое будет использоваться в приложении, потребуется определить целочисленную константу в диапазоне от WM_USER + $7FFF.

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

const
  MM_CHANGECOLOR = WM_USER + 1;

type
  TForm1 = class(TForm)
  private
    { Private declarations }
  public
    { Public declarations }
  end;

После того как вы создадите специальное сообщение, напишите метод сообщения, который отвечает за его обработку. Поскольку это специальное сообщение, вы можете делать с ним все что угодно. Вы можете, например, обрабатывать значение поля сообщения wParam как значение цвета и использовать сообщение MM_CHANGECOLOR для изменения цвета формы, как показано в листинге ниже.

type
  TForm1 = class(TForm)
  private
    { Private declarations }
  public
    { Public declarations }
    procedure MMChangeColor(var Message: TMessage); message MM_CHANGECOLOR;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TForm1 }

procedure TForm1.MMChangeColor(var Message: TMessage);
begin
  Color := Message.WParam;
end;

Последнее, что нужно сделать — это послать сообщение форме. Среда Delphi предлагает три способа отправки сообщения. Кроме метода VCL-библиотеки Perform можно использовать также функции Windows API SendMessage и PostMessage.

Функция SendMessage применяется, когда сообщение необходимо обработать как можно быстрее. Если вы используете функцию SendMessage, то она не вернет результат до тех пор, пока сообщение не будет обработано.

Функция PostMessage служит для отправки сообщения, не требующего срочной обработки. Сообщение, посланное с помощью функции PostMessage, помещается в очередь сообщении окна и будет обработано позднее.

Наиболее простым способом отправки сообщения в приложении VCL Forms состоит в вызове метода Perform. Метод Perform следует использовать в том случае, если вы точно знаете, какой элемент управления отвечает за обработку сообщения.

Ниже показано, как послать сообщение MM_CHANGECOLOR главной форме, и как дать ей команду, чтобы она изменила свой цвет на белый:

procedure TForm1.Button1Click(Sender: TObject);
begin
  Form1.Perform(MM_CHANGECOLOR, clWhite, 0);
end;

Если для отправки сообщений вы захотите использовать API-функции SendMessage и PostMessage, то в качестве первого параметра необходимо передать дескриптор искомого окна. Дескриптор окна главной формы определяется с помощью свойства Handle:

SendMessage(Handle, MM_CHANGECOLOR, clWhite, 0);

Система отправки сообщений обладает достаточной гибкостью и позволяет использовать свои специальные сообщения каким угодно образом. Например, сообщения можно использовать даже для добавления текста из текстового поля в окно списка. Для этой цели необходимо привести компоненты к целочисленному типу, после чего отправить их вместе с сообщением в качестве полей wParam и lParam.

unit Unit1;

interface

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

const
  MM_ADDTOLIST = WM_USER + 2;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    ListBox1: TListBox;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure MMAddToList(var Message: TMessage); message MM_ADDTOLIST;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
begin
  SendMessage(Handle, MM_ADDTOLIST, Integer(ListBox1), Integer(Edit1));
end;

procedure TForm1.MMAddToList(var Message: TMessage);
var
  edit: TEdit;
begin
  edit := TEdit(Message.LParam);
  TListBox(Message.WParam).Items.Add(edit.Text);
end;

end.

Перетаскивание из проводника Windows

Возможность принимать элементы, перетаскиваемые из проводника Windows, является одним из требований, предъявляемых нынешними пользователями. Дело в том, что для открытия файла пользователю порой быстрее и удобнее использовать проводник, чем диалоговое окно Open.

Первое, что потребуется сделать для того, чтобы принимать элементы из Проводника — это зарегистрировать окно, принимающее перетаскиваемые элементы. Для этого необходимо вызвать API-функцию DragAcceptFiles. С этой функцией связаны два параметра; дескриптор окна, принимающего перетаскиваемые элементы, и булевский параметр, который определяет, будет ли окно принимать перетаскиваемые элементы.

procedure DragAcceptFiles(Wnd: HWND; Accept: BOOL);

Фактически мы должны вызвать функцию DragAcceptFiles два раза. Во-первых, мы должны вызвать ее в обработчике события OnCreate, чтобы зарегистрировать главную форму как целевой пункт перетаскивания, а затем вызвать ее в обработчиках событий OnDestroy или OnClose, чтобы больше не принимать перетаскиваемые элементы. Чтобы использовать функцию DragAcceptFiles, добавьте модуль ShellAPI в список uses.

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  DragAcceptFiles(Handle, True);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  DragAcceptFiles(Handle, False);
end;

end.

После того как окно будет зарегистрировано с помощью функции DragAcceptFiles, оно сможет приступить к обработке сообщения WM_DROPFILES. Чтобы принять файлы, перетаскиваемые из проводника, необходимо обработать сообщение WM_DROPFILES.

type
  TForm1 = class(TForm)
  public
    procedure WMDropFiles(var Message: TWMDropFiles); message WM_DROPFILES;
  end;

procedure TForm1.WMDropFiles(var Message: TWMDropFiles);
begin

end;

Внутри обработчика события WM_DROPFILES потребуется выполнить следующие действия;

  1. Определить, сколько файлов перетаскивалось на форму.
  2. Извлечь имена всех перетаскиваемых файлов.
  3. Завершить процесс перетаскивания, вызвав метод DragFinish.

Для определения количества перетаскиваемых файлов следует вызвать функцию DragQueryFile:

function DragQueryFile(
    Drop: HDROP;
    FileIndex: UINT;
    FileName: PChar;
    cb: UINT
): UINT;

Параметр Drop идентифицирует структуру, содержащую имена файлов, перетаскиваемых на форму. Значение параметра Drop всегда определяется в поле Drop сообщения WM_DROPFILES. Параметр FileIndex задает индекс файла для запроса имени файла. Если значение параметра FileIndex будет определено в диапазоне между 0 и количеством перетаскиваемых файлов, то функция DragQueryFile запишет имя файла в буфер, указанный в параметре FileName.

Если значение параметра FileIndex равно $FFFFFFFF, функция DragQueryFile вернет общее количество перетаскиваемых файлов. При определении количества перетаскиваемых файлов вы можете передать значение nil в качестве буфера FileName, как показано в листинге ниже.

procedure TForm1.WMDropFiles(var Message: TWMDropFiles);
var
  dropCount: Integer;
begin
  dropCount := DragQueryFile(Message.Drop, $FFFFFFFF, nil, 0);
  try

  finally
    DragFinish(Message.Drop);
  end;
end;

После определения количества перетаскиваемых файлов потребуется написать цикл для чтения имен всех перетаскиваемых файлов и создания буфера, размер которого будет достаточным, чтобы в нем можно было хранить длинные имена файлов. Проще всего создать буфер для имени файла можно путем объявления массива символов. Поскольку в Windows XP с установленной второй версией пакета обновлений (SP2) разрешено использовать файлы, имена которых могут содержать до 2048 символов, вы должны объявить массив, который будет принимать такое большое количество символов плюс один завершающий нулевой символ.

В листинге ниже представлен полный код обработчика события WM_DROPFILES, который добавляет имена перетаскиваемых файлов в компонент TListBox.

procedure TForm1.WMDropFiles(var Message: TWMDropFiles);
var
  dropCount: Integer;
  nameBuffer: array[0..2048] of Char;
  i: Integer;
begin
  dropCount := DragQueryFile(Message.Drop, $FFFFFFFF, nil, 0);
  try
    for i := 0 to Pred(dropCount) do
    begin
      { Обрабатываем имя файла }
      DragQueryFile(Message.Drop, i, nameBuffer, SizeOf(nameBuffer));
      ListBox1.Items.Add(String(nameBuffer));
    end; // Конец цикла for
  finally
    DragFinish(Message.Drop);
  end; // Конец блока try..finally
end;

Компонент TPageControl

Теперь давайте воспользуемся компонентом TPageControl (из категории Win32), чтобы усовершенствовать пример с перетаскиванием из предыдущего раздела и разрешить пользователю предварительно просматривать файлы с простым текстом, файлы расширенного текстового формата и файлы изображений.

Для этого потребуется выполнить следующие шаги:

  1. Удалить компонент TListBox, который использовался в предыдущем разделе.
  2. Добавить в окно Designer Surface компонент TPageControl (и присвоить ему имя PageControl).
  3. Добавить модуль ExtCtrls в список uses, поскольку нам понадобится компонент TImage.
  4. Создать процедуру OpenDroppedFile, которая будет загружать файлы с простым текстом, файлы расширенного текстового формата и файлы изображений, а также отображать их как вкладки в компоненте TPageControl.

Первое, что необходимо сделать в процедуре OpenDroppedFile — это определить тип файлов, поскольку мы должны создать экземпляр другого компонента для каждого типа: ТМеmо для файлов с простым текстом, TRichEdit для файлов с расширенным текстовым форматом и TImage для файлов изображений.

procedure TForm1.OpenDroppedFile(const AFileName: string);
var
  Extension: string;
  NewTab: TTabSheet;
  FileClass: TControlClass;
  NewControl: TControl;
begin
  Extension := LowerCase(ExtractFileExt(AFileName));
  // Проверяем расширение
  if Extension = '.txt' then
    FileClass := TMemo
  else if Extension = '.rtf' then
    FileClass := TRichEdit
  else if Extension = '.bmp' then
    FileClass := TImage
  else
    Exit; { Завершаем работу, если перетаскивается неподдерживаемый файл}

После определения типа файла необходимо создать вкладку для отображения содержимого файла. Чтобы создать новую вкладку, следует создать экземпляр класса TTabSheet и добавить его в компонент TPageControl, назначив компонент TPageControl свойству PageControl класса TTabSheet:

  // Создаем новую вкладку
  NewTab := TTabSheet.Create(PageControl);
  NewTab.PageControl := PageControl;
  NewTab.Caption := ExtractFileName(AFileName);

Мы создали экземпляр компонента, необходимый для загрузки перетаскиваемого файла. Чтобы отобразить компонент во вкладке TPageControl, сделайте компонент TTabSheet его родителем (Parent).

  // Создаем требуемый элемент управления
  NewControl := FileClass.Create(Self);
  NewControl.Parent := NewTab;
  NewControl.Align := alClient;

Наконец, потребуется открыть файл и активизировать новую вкладку, чтобы отобразить только что открытый файл. Поскольку компоненты ТМеmо и TRichEdit порождены от компонента TCustomMemo, воспользуемся особенностями полиморфизма, что позволит загружать файлы с простым текстом и файлы расширенного текстового формата с помощью одной строки кода.

  { Открываем файл }
  if FileClass = TImage then
    TImage(NewControl).Picture.LoadFromFile(AFileName)
  else
    TCustomMemo(NewControl).Lines.LoadFromFile(AFileName);
  { Активизировать вкладку }
  PageControl.ActivePage := PageControl.Pages[Pred(PageControl.PageCount)];
end;

Теперь, когда работа с процедурой OpenDroppedFile завершена, замените вызов Items.Add вызовом  процедуры OpenDroppedFile в обработчике события

    for i := 0 to Pred(dropCount) do
    begin
      { Обрабатываем имя файла }
      DragQueryFile(Message.Drop, i, nameBuffer, SizeOf(nameBuffer));
      OpenDroppedFile(String(nameBuffer));
    end; // Конец цикла for

Последнее, что необходимо сделать — это позволить пользователю закрывать все открытые файлы с помощью команды File - Close All (Файл - Закрыть все):

procedure TForm1.CloseAll1Click(Sender: TObject);
var
  i: Integer;
begin
  for i := Pred(PageControl.PageCount) downto 0 do
    PageControl.Pages[i].Free;
end;

После запуска приложения и перетаскивания на форму нескольких файлов процедура OpenDroppedFile откроет все поддерживаемые файлы и отобразит их в виде вкладок компонента TPageControl.

d1-4

Источник: Иван Хладни - Внутренний мир Borland Delphi 2006.