Блокировка Drag&Drop в Lazarus

Delphi , Программа и Интерфейс , Приложение своё

Блокировка Drag&Drop в Lazarus

При работе с Lazarus может возникнуть проблема, когда приложение позволяет пользователю перетаскивать файлы из Windows Explorer, но также позволяет перетаскивать файлы из самого приложения в себя же. Это может привести к нежелательным последствиям, таким как потеря данных или непредсказуемое поведение приложения. В этой статье мы рассмотрим, как блокировать перетаскивание файлов из Lazarus приложения в Lazarus приложение.

Контекст

В обсуждении на форуме Lazarus пользователь domasz столкнулся с проблемой, когда его приложение позволяло перетаскивать файлы из Windows Explorer, но также позволяло перетаскивать файлы из самого приложения в себя же. Он нашел компонент, который позволял перетаскивать файлы из Lazarus приложения в Windows Explorer, но не знал, как заблокировать перетаскивание из Lazarus в Lazarus.

Решения

1. Использование GetCapture

Одним из предложенных решений было использование функции GetCapture для определения приложения, которое выполняет перетаскивание. Затем в методе DragEnter можно было бы установить эффект перетаскивания в зависимости от того, является ли приложение-источник тем же самым, что и приложение-получатель.

Однако пользователь domasz обнаружил, что этот подход не работает, так как GetCapture возвращает значение 0 в методе FormDropFiles.

1. Использование IDataObject

Другим предложенным решением было использование IDataObject для хранения дополнительного маркера, указывающего на то, что перетаскивание происходит из приложения. Затем в методе DragEnter можно было бы запросить этот маркер и заблокировать перетаскивание, если оно происходит из того же самого приложения.

Однако пользователь domasz столкнулся с трудностями при попытке реализовать это решение, так как не knew, как получить доступ к IDataObject в методе FormDropFiles.

Реализация

Ниже приведен пример кода на Object Pascal, который блокирует перетаскивание файлов из Lazarus приложения в Lazarus приложение:

unit Main;

{$MODE Delphi}

interface

uses
  DragDrop, DropTarget, DragDropFile, LCLIntf, LCLType, LMessages, Messages,
  SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ComCtrls,
  ExtCtrls, DropSource, Types, Windows, JwaPsApi;

type
  TForm1 = class(TForm)
    DropDummy1: TDropDummy;
    DropFileSource1: TDropFileSource;
    DropFileTarget1: TDropFileTarget;
    ListView1: TListView;
    procedure DropFileSource1GetDragImage(Sender: TObject;
      const DragSourceHelper: IDragSourceHelper; var Handled: boolean);
    procedure DropFileTarget1Drop(Sender: TObject; ShiftState: TShiftState;
      Point: TPoint; var Effect: Integer);
    procedure DropFileTarget1Enter(Sender: TObject; ShiftState: TShiftState;
      APoint: TPoint; var Effect: Longint);
    procedure ListView1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    FIsDragSource: Boolean;
  public
    property IsDragSource: Boolean read FIsDragSource write FIsDragSource;
  end;

var
  Form1: TForm1;

implementation

uses  ActiveX, CommCtrl;

{$R *.lfm}

procedure TForm1.DropFileSource1GetDragImage(Sender: TObject;
  const DragSourceHelper: IDragSourceHelper; var Handled: boolean);
var
  Pt: TPoint;
begin
  GetCursorPos(Pt);
  Handled := Succeeded(DragSourceHelper.InitializeFromWindow(Listview1.Handle, Pt, TCustomDropSource(Sender) as IDataObject));
  FIsDragSource := True;
end;

procedure TForm1.DropFileTarget1Drop(Sender: TObject; ShiftState: TShiftState;
  Point: TPoint; var Effect: Integer);
var
  i: integer;
  Item: TListItem;
begin
  // called when the user drag and drop files onto your application.
  // Display mapped names if present.
  // Mapped names are usually only present when dragging from the recycle bin
  // (try it).
  if (DropFileTarget1.MappedNames.Count > 0) then
    Listview1.Columns[1].Width := 100
  else
    Listview1.Columns[1].Width := 0;
  // Copy the file names from the DropTarget component into the list view.
  for i := 0 to DropFileTarget1.Files.Count-1 do
  begin
    Item := ListView1.Items.Add;
    Item.Caption := DropFileTarget1.Files[i];
    // Display mapped names if present.
    if (DropFileTarget1.MappedNames.Count > i) then
      Item.SubItems.Add(DropFileTarget1.MappedNames[i]);
  end;
  // Reject "moved" files
  if (Effect = DROPEFFECT_MOVE) then
    Effect := DROPEFFECT_NONE;
  FIsDragSource := False;
end;

procedure TForm1.DropFileTarget1Enter(Sender: TObject; ShiftState: TShiftState;
  APoint: TPoint; var Effect: Longint);
begin
  if FIsDragSource then
    Effect := DROPEFFECT_NONE;
end;

procedure TForm1.ListView1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var i: integer;
begin
  // Wait for user to move mouse before we start the drag/drop.
  // Note:
  // Due to some internal mouse message juggling inside TListView we will not
  // get the MouseDown event until the mouse is either moved or the mouse button
  // is released.
  // Remember this when it appears that DragDetectPlus isn't working...
  if (ListView1.SelCount > 0) and (DragDetectPlus(TWinControl(Sender))) then
  begin
    // Delete anything from a previous drag.
    DropFileSource1.Files.Clear;
    // Fill DropSource1.Files with selected files from ListView1.
    for i := 0 to ListView1.Items.Count-1 do
      if (ListView1.Items.Item[i].Selected) then
        DropFileSource1.Files.Add(ListView1.Items.Item[i].Caption);
    // Start the drag operation.
    DropFileSource1.Execute;
  end;
end;

end.

В этом примере мы используем булевую переменную FIsDragSource для отслеживания того, является ли приложение-источник тем же самым, что и приложение-получатель. В методе DropFileSource1GetDragImage мы устанавливаем значение этой переменной в True, а в методе DropFileTarget1Drop мы устанавливаем ее в False. В методе DropFileTarget1Enter мы проверяем значение этой переменной и блокируем перетаскивание, если оно происходит из того же самого приложения.

Вывод

В этой статье мы рассмотрели проблему блокировки перетаскивания файлов из Lazarus приложения в Lazarus приложение и предложили решение, которое использует булевую переменную для отслеживания источника перетаскивания. Мы также предоставили пример кода на Object Pascal, который реализует это решение.

Создано по материалам из источника по ссылке.

В контексте обсуждения на форуме Lazarus пользователь domasz столкнулся с проблемой блокировки перетаскивания файлов из Lazarus приложения в само себя.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: Приложение своё ::