mirrors/doublecmd
2
0
Fork 0
mirror of https://github.com/doublecmd/doublecmd.git synced 2026-06-21 09:58:13 +00:00
Code Issues Projects Releases Packages Wiki Activity

ADD: External drag&drop in QT.

Browse source
This commit is contained in:
cobines 2009-04-30 23:00:21 +00:00
commit 9e3ce770f5
5 changed files with 1561 additions and 1087 deletions
Download patch file Download diff file Expand all files Collapse all files

7
src/doublecmd.lpi
View file

@ -59,7 +59,7 @@
<PackageName Value="viewerpackage"/>
</Item5>
</RequiredPackages>
<Units Count="48">
<Units Count="49">
<Unit0>
<Filename Value="doublecmd.lpr"/>
<IsPartOfProject Value="True"/>
@ -383,6 +383,11 @@
<IsPartOfProject Value="True"/>
<UnitName Value="uKeyboard"/>
</Unit47>
<Unit48>
<Filename Value="platform\udragdropqt.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="uDragDropQt"/>
</Unit48>
</Units>
</ProjectOptions>
<CompilerOptions>

1372
src/platform/uClipboard.pas
View file

File diff suppressed because it is too large Load diff

791
src/platform/udragdropex.pas
View file

@ -1,392 +1,399 @@
{
Double Commander
-------------------------------------------------------------------------
Interface unit for Drag&Drop to external applications.
Copyright (C) 2009 Koblov Alexander (Alexx2000@mail.ru)
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
}
unit uDragDropEx;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Controls;
type
TDropEffect = (DropNoEffect, DropCopyEffect, DropMoveEffect, DropLinkEffect, DropAskEffect);
TDragDropStatus = (DragDropAborted, DragDropSuccessful, DragDropError);
{ Source events }
{ Dragging has started }
TDragBeginEvent = function:Boolean of object;
{ Drag destination has requested data }
TRequestDataEvent = function(
// This is the same as given to DoDragDrop.
const FileNamesList: TStringList;
// MIME-type format in which target requested data, e.g. text/plain.
MimeType: string;
// Effect chosen by target (may not be final).
DropEffect: TDropEffect):string of object;
{ Dragging has ended }
TDragEndEvent = function:Boolean of object;
{ Target events }
{ Mouse entered into the control when dragging something }
TDragEnterEvent = function(
// Proposed drop effect by the source (can be changed by the target to inform the source).
var DropEffect: TDropEffect;
// Screen coordinates of mouse cursor.
ScreenPoint: TPoint):Boolean of object;
{ Mouse moved inside the control when dragging something }
TDragOverEvent = function(
// Proposed drop effect by the source (can be changed by the target to inform the source).
var DropEffect: TDropEffect;
// Screen coordinates of mouse cursor.
ScreenPoint: TPoint):Boolean of object;
{ Mouse button has been lifted causing a drop event }
TDropEvent = function(
// List of filenames given by the source.
const FileNamesList: TStringList;
// Drop effect chosen by the source.
DropEffect: TDropEffect;
// Screen coordinates of mouse cursor.
ScreenPoint: TPoint):Boolean of object;
{ Mouse has left the control when dragging something }
TDragLeaveEvent = function:Boolean of object;
{ Base class for external source }
TDragDropSource = class
public
constructor Create(SourceControl: TWinControl); virtual;
destructor Destroy; virtual;
function RegisterEvents(DragBeginEvent : uDragDropEx.TDragBeginEvent;
RequestDataEvent: uDragDropEx.TRequestDataEvent;
DragEndEvent : uDragDropEx.TDragEndEvent): Boolean; virtual;
procedure UnregisterEvents; virtual;
function DoDragDrop(const FileNamesList: TStringList;
MouseButton: TMouseButton; // button that initiated dragging
ScreenStartPoint: TPoint // mouse position in screen coords
): Boolean; virtual;
function GetLastStatus: TDragDropStatus;
function GetFileNamesList: TStringList;
function GetDragBeginEvent : TDragBeginEvent;
function GetRequestDataEvent: TRequestDataEvent;
function GetDragEndEvent : TDragEndEvent;
private
FDragDropControl: TWinControl;
FDragBeginEvent : TDragBeginEvent;
FRequestDataEvent : TRequestDataEvent;
FDragEndEvent : TDragEndEvent;
protected
function GetControl: TWinControl;
FLastStatus: TDragDropStatus;
FFileNamesList: TStringList;
end;
{ Base class for external target }
TDragDropTarget = class
public
constructor Create(TargetControl: TWinControl); virtual;
destructor Destroy; virtual;
function RegisterEvents(DragEnterEvent: uDragDropEx.TDragEnterEvent;
DragOverEvent : uDragDropEx.TDragOverEvent;
DropEvent : uDragDropEx.TDropEvent;
DragLeaveEvent: uDragDropEx.TDragLeaveEvent): Boolean; virtual;
procedure UnregisterEvents; virtual;
function GetDragEnterEvent: TDragEnterEvent;
function GetDragOverEvent : TDragOverEvent;
function GetDropEvent : TDropEvent;
function GetDragLeaveEvent: TDragLeaveEvent;
private
FDragDropControl: TWinControl;
FDragEnterEvent: TDragEnterEvent;
FDragOverEvent : TDragOverEvent;
FDropEvent : TDropEvent;
FDragLeaveEvent: TDragLeaveEvent;
protected
function GetControl: TWinControl;
end;
{ These functions return system-appropriate DragDrop... object. }
function CreateDragDropSource(Control: TWinControl): TDragDropSource;
function CreateDragDropTarget(Control: TWinControl): TDragDropTarget;
{ Returns True if external dragging is supported based
on operating system and LCLWidgetType (compile-time) }
function IsExternalDraggingSupported: Boolean;
{ Analyzes keyboard modifier keys (Shift, Ctrl, etc.) and mouse button nr
and returns the appropriate drop effect. }
function GetDropEffectByKeyAndMouse(ShiftState: TShiftState;
MouseButton: TMouseButton): TDropEffect;
var
{ If set to True, then dragging is being transformed: internal to external or vice-versa. }
TransformDragging : Boolean = False;
{ If set to True, then transforming from external back to internal dragging is enabled. }
AllowTransformToInternal : Boolean = True;
implementation
{$IF DEFINED(MSWINDOWS)}
uses
uOleDragDrop;
{$ELSEIF DEFINED(LCLGTK) or DEFINED(LCLGTK2)}
uses
uDragDropGtk;
{$ENDIF}
{ ---------- TDragDropSource ---------- }
constructor TDragDropSource.Create(SourceControl: TWinControl);
begin
FDragDropControl := SourceControl;
FDragBeginEvent := nil;
FRequestDataEvent := nil;
FDragEndEvent := nil;
FFileNamesList := TStringList.Create;
FLastStatus := DragDropSuccessful;
end;
destructor TDragDropSource.Destroy;
begin
if FDragDropControl.HandleAllocated then
UnregisterEvents;
FDragDropControl := nil;
if Assigned(FFileNamesList) then
FreeAndNil(FFileNamesList);
end;
function TDragDropSource.GetControl:TWinControl;
begin
Result := FDragDropControl;
end;
function TDragDropSource.GetFileNamesList: TStringList;
begin
Result := FFileNamesList;
end;
function TDragDropSource.GetLastStatus: TDragDropStatus;
begin
Result := FLastStatus;
end;
function TDragDropSource.GetDragBeginEvent: TDragBeginEvent;
begin
Result := FDragBeginEvent;
end;
function TDragDropSource.GetRequestDataEvent: TRequestDataEvent;
begin
Result := FRequestDataEvent;
end;
function TDragDropSource.GetDragEndEvent: TDragEndEvent;
begin
Result := FDragEndEvent;
end;
function TDragDropSource.RegisterEvents(DragBeginEvent : uDragDropEx.TDragBeginEvent;
RequestDataEvent: uDragDropEx.TRequestDataEvent;
DragEndEvent : uDragDropEx.TDragEndEvent): Boolean;
begin
FDragBeginEvent := DragBeginEvent;
FRequestDataEvent := RequestDataEvent;
FDragEndEvent := DragEndEvent;
Result := False;
end;
procedure TDragDropSource.UnregisterEvents;
begin
FDragBeginEvent := nil;
FRequestDataEvent := nil;
FDragEndEvent := nil;
end;
function TDragDropSource.DoDragDrop(const FileNamesList: TStringList;
MouseButton: TMouseButton;
ScreenStartPoint: TPoint): Boolean;
begin
FLastStatus := DragDropError;
Result := False;
end;
{ ---------- TDragDropTarget ---------- }
constructor TDragDropTarget.Create(TargetControl: TWinControl);
begin
FDragDropControl := TargetControl;
FDragEnterEvent := nil;
FDragOverEvent := nil;
FDropEvent := nil;
FDragLeaveEvent := nil;
end;
destructor TDragDropTarget.Destroy;
begin
if FDragDropControl.HandleAllocated then
UnregisterEvents;
FDragDropControl := nil;
end;
function TDragDropTarget.GetControl:TWinControl;
begin
Result := FDragDropControl;
end;
function TDragDropTarget.GetDragEnterEvent: TDragEnterEvent;
begin
Result := FDragEnterEvent;
end;
function TDragDropTarget.GetDragOverEvent: TDragOverEvent;
begin
Result := FDragOverEvent;
end;
function TDragDropTarget.GetDropEvent: TDropEvent;
begin
Result := FDropEvent;
end;
function TDragDropTarget.GetDragLeaveEvent: TDragLeaveEvent;
begin
Result := FDragLeaveEvent;
end;
function TDragDropTarget.RegisterEvents(DragEnterEvent: uDragDropEx.TDragEnterEvent;
DragOverEvent : uDragDropEx.TDragOverEvent;
DropEvent : uDragDropEx.TDropEvent;
DragLeaveEvent: uDragDropEx.TDragLeaveEvent): Boolean;
begin
FDragEnterEvent := DragEnterEvent;
FDragOverEvent := DragOverEvent;
FDropEvent := DropEvent;
FDragLeaveEvent := DragLeaveEvent;
Result := False;
end;
procedure TDragDropTarget.UnregisterEvents;
begin
FDragEnterEvent := nil;
FDragOverEvent := nil;
FDropEvent := nil;
FDragLeaveEvent := nil;
end;
{ --------------------------------------------------------------------------- }
function IsExternalDraggingSupported: Boolean;
begin
{$IF DEFINED(MSWINDOWS)}
Result := True;
{$ELSEIF DEFINED(LCLGTK) OR DEFINED(LCLGTK2)}
Result := True;
{$ELSEIF DEFINED(LCLQT)}
Result := False; // TODO: Implement in QT
{$ELSE}
Result := False;
{$ENDIF}
end;
function CreateDragDropSource(Control: TWinControl): TDragDropSource;
begin
{$IF DEFINED(MSWINDOWS)}
Result := TDragDropSourceWindows.Create(Control);
{$ELSEIF DEFINED(LCLGTK) or DEFINED(LCLGTK2)}
Result := TDragDropSourceGTK.Create(Control);
{$ELSE}
Result := TDragDropSource.Create(Control); // Dummy
{$ENDIF}
end;
function CreateDragDropTarget(Control: TWinControl): TDragDropTarget;
begin
{$IF DEFINED(MSWINDOWS)}
Result := TDragDropTargetWindows.Create(Control);
{$ELSEIF DEFINED(LCLGTK) or DEFINED(LCLGTK2)}
Result := TDragDropTargetGTK.Create(Control);
{$ELSE}
Result := TDragDropTarget.Create(Control); // Dummy
{$ENDIF}
end;
function GetDropEffectByKeyAndMouse(ShiftState: TShiftState;
MouseButton: TMouseButton): TDropEffect;
begin
case MouseButton of
mbLeft:
begin
if ShiftState = [] then
Result := DropCopyEffect // default to Copy when no keys pressed
else if ShiftState = [ssShift] then
Result := DropMoveEffect
else if ShiftState = [ssCtrl] then
Result := DropCopyEffect
else if ShiftState = [ssCtrl, ssShift] then
Result := DropLinkEffect
else
Result := DropNoEffect; // some other key combination pressed
end;
mbMiddle:
Result := DropAskEffect;
mbRight:
Result := DropAskEffect;
end;
end;
end.
{
Double Commander
-------------------------------------------------------------------------
Interface unit for Drag&Drop to external applications.
Copyright (C) 2009 Koblov Alexander (Alexx2000@mail.ru)
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
}
unit uDragDropEx;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Controls;
type
TDropEffect = (DropNoEffect, DropCopyEffect, DropMoveEffect, DropLinkEffect, DropAskEffect);
TDragDropStatus = (DragDropAborted, DragDropSuccessful, DragDropError);
{ Source events }
{ Dragging has started }
TDragBeginEvent = function:Boolean of object;
{ Drag destination has requested data }
TRequestDataEvent = function(
// This is the same as given to DoDragDrop.
const FileNamesList: TStringList;
// MIME-type format in which target requested data, e.g. text/plain.
MimeType: string;
// Effect chosen by target (may not be final).
DropEffect: TDropEffect):string of object;
{ Dragging has ended }
TDragEndEvent = function:Boolean of object;
{ Target events }
{ Mouse entered into the control when dragging something }
TDragEnterEvent = function(
// Proposed drop effect by the source (can be changed by the target to inform the source).
var DropEffect: TDropEffect;
// Screen coordinates of mouse cursor.
ScreenPoint: TPoint):Boolean of object;
{ Mouse moved inside the control when dragging something }
TDragOverEvent = function(
// Proposed drop effect by the source (can be changed by the target to inform the source).
var DropEffect: TDropEffect;
// Screen coordinates of mouse cursor.
ScreenPoint: TPoint):Boolean of object;
{ Mouse button has been lifted causing a drop event }
TDropEvent = function(
// List of filenames given by the source.
const FileNamesList: TStringList;
// Drop effect chosen by the source.
DropEffect: TDropEffect;
// Screen coordinates of mouse cursor.
ScreenPoint: TPoint):Boolean of object;
{ Mouse has left the control when dragging something }
TDragLeaveEvent = function:Boolean of object;
{ Base class for external source }
TDragDropSource = class
public
constructor Create(SourceControl: TWinControl); virtual;
destructor Destroy; virtual;
function RegisterEvents(DragBeginEvent : uDragDropEx.TDragBeginEvent;
RequestDataEvent: uDragDropEx.TRequestDataEvent;
DragEndEvent : uDragDropEx.TDragEndEvent): Boolean; virtual;
procedure UnregisterEvents; virtual;
function DoDragDrop(const FileNamesList: TStringList;
MouseButton: TMouseButton; // button that initiated dragging
ScreenStartPoint: TPoint // mouse position in screen coords
): Boolean; virtual;
function GetLastStatus: TDragDropStatus;
function GetFileNamesList: TStringList;
function GetDragBeginEvent : TDragBeginEvent;
function GetRequestDataEvent: TRequestDataEvent;
function GetDragEndEvent : TDragEndEvent;
private
FDragDropControl: TWinControl;
FDragBeginEvent : TDragBeginEvent;
FRequestDataEvent : TRequestDataEvent;
FDragEndEvent : TDragEndEvent;
protected
function GetControl: TWinControl;
FLastStatus: TDragDropStatus;
FFileNamesList: TStringList;
end;
{ Base class for external target }
TDragDropTarget = class
public
constructor Create(TargetControl: TWinControl); virtual;
destructor Destroy; virtual;
function RegisterEvents(DragEnterEvent: uDragDropEx.TDragEnterEvent;
DragOverEvent : uDragDropEx.TDragOverEvent;
DropEvent : uDragDropEx.TDropEvent;
DragLeaveEvent: uDragDropEx.TDragLeaveEvent): Boolean; virtual;
procedure UnregisterEvents; virtual;
function GetDragEnterEvent: TDragEnterEvent;
function GetDragOverEvent : TDragOverEvent;
function GetDropEvent : TDropEvent;
function GetDragLeaveEvent: TDragLeaveEvent;
private
FDragDropControl: TWinControl;
FDragEnterEvent: TDragEnterEvent;
FDragOverEvent : TDragOverEvent;
FDropEvent : TDropEvent;
FDragLeaveEvent: TDragLeaveEvent;
protected
function GetControl: TWinControl;
end;
{ These functions return system-appropriate DragDrop... object. }
function CreateDragDropSource(Control: TWinControl): TDragDropSource;
function CreateDragDropTarget(Control: TWinControl): TDragDropTarget;
{ Returns True if external dragging is supported based
on operating system and LCLWidgetType (compile-time) }
function IsExternalDraggingSupported: Boolean;
{ Analyzes keyboard modifier keys (Shift, Ctrl, etc.) and mouse button nr
and returns the appropriate drop effect. }
function GetDropEffectByKeyAndMouse(ShiftState: TShiftState;
MouseButton: TMouseButton): TDropEffect;
var
{ If set to True, then dragging is being transformed: internal to external or vice-versa. }
TransformDragging : Boolean = False;
{ If set to True, then transforming from external back to internal dragging is enabled. }
AllowTransformToInternal : Boolean = True;
implementation
{$IF DEFINED(MSWINDOWS)}
uses
uOleDragDrop;
{$ELSEIF DEFINED(LCLGTK) or DEFINED(LCLGTK2)}
uses
uDragDropGtk;
{$ELSEIF DEFINED(LCLQT)}
uses
uDragDropQt;
{$ENDIF}
{ ---------- TDragDropSource ---------- }
constructor TDragDropSource.Create(SourceControl: TWinControl);
begin
FDragDropControl := SourceControl;
FDragBeginEvent := nil;
FRequestDataEvent := nil;
FDragEndEvent := nil;
FFileNamesList := TStringList.Create;
FLastStatus := DragDropSuccessful;
end;
destructor TDragDropSource.Destroy;
begin
if FDragDropControl.HandleAllocated then
UnregisterEvents;
FDragDropControl := nil;
if Assigned(FFileNamesList) then
FreeAndNil(FFileNamesList);
end;
function TDragDropSource.GetControl:TWinControl;
begin
Result := FDragDropControl;
end;
function TDragDropSource.GetFileNamesList: TStringList;
begin
Result := FFileNamesList;
end;
function TDragDropSource.GetLastStatus: TDragDropStatus;
begin
Result := FLastStatus;
end;
function TDragDropSource.GetDragBeginEvent: TDragBeginEvent;
begin
Result := FDragBeginEvent;
end;
function TDragDropSource.GetRequestDataEvent: TRequestDataEvent;
begin
Result := FRequestDataEvent;
end;
function TDragDropSource.GetDragEndEvent: TDragEndEvent;
begin
Result := FDragEndEvent;
end;
function TDragDropSource.RegisterEvents(DragBeginEvent : uDragDropEx.TDragBeginEvent;
RequestDataEvent: uDragDropEx.TRequestDataEvent;
DragEndEvent : uDragDropEx.TDragEndEvent): Boolean;
begin
FDragBeginEvent := DragBeginEvent;
FRequestDataEvent := RequestDataEvent;
FDragEndEvent := DragEndEvent;
Result := False;
end;
procedure TDragDropSource.UnregisterEvents;
begin
FDragBeginEvent := nil;
FRequestDataEvent := nil;
FDragEndEvent := nil;
end;
function TDragDropSource.DoDragDrop(const FileNamesList: TStringList;
MouseButton: TMouseButton;
ScreenStartPoint: TPoint): Boolean;
begin
FLastStatus := DragDropError;
Result := False;
end;
{ ---------- TDragDropTarget ---------- }
constructor TDragDropTarget.Create(TargetControl: TWinControl);
begin
FDragDropControl := TargetControl;
FDragEnterEvent := nil;
FDragOverEvent := nil;
FDropEvent := nil;
FDragLeaveEvent := nil;
end;
destructor TDragDropTarget.Destroy;
begin
if FDragDropControl.HandleAllocated then
UnregisterEvents;
FDragDropControl := nil;
end;
function TDragDropTarget.GetControl:TWinControl;
begin
Result := FDragDropControl;
end;
function TDragDropTarget.GetDragEnterEvent: TDragEnterEvent;
begin
Result := FDragEnterEvent;
end;
function TDragDropTarget.GetDragOverEvent: TDragOverEvent;
begin
Result := FDragOverEvent;
end;
function TDragDropTarget.GetDropEvent: TDropEvent;
begin
Result := FDropEvent;
end;
function TDragDropTarget.GetDragLeaveEvent: TDragLeaveEvent;
begin
Result := FDragLeaveEvent;
end;
function TDragDropTarget.RegisterEvents(DragEnterEvent: uDragDropEx.TDragEnterEvent;
DragOverEvent : uDragDropEx.TDragOverEvent;
DropEvent : uDragDropEx.TDropEvent;
DragLeaveEvent: uDragDropEx.TDragLeaveEvent): Boolean;
begin
FDragEnterEvent := DragEnterEvent;
FDragOverEvent := DragOverEvent;
FDropEvent := DropEvent;
FDragLeaveEvent := DragLeaveEvent;
Result := False;
end;
procedure TDragDropTarget.UnregisterEvents;
begin
FDragEnterEvent := nil;
FDragOverEvent := nil;
FDropEvent := nil;
FDragLeaveEvent := nil;
end;
{ --------------------------------------------------------------------------- }
function IsExternalDraggingSupported: Boolean;
begin
{$IF DEFINED(MSWINDOWS)}
Result := True;
{$ELSEIF DEFINED(LCLGTK) OR DEFINED(LCLGTK2)}
Result := True;
{$ELSEIF DEFINED(LCLQT)}
Result := True;
{$ELSE}
Result := False;
{$ENDIF}
end;
function CreateDragDropSource(Control: TWinControl): TDragDropSource;
begin
{$IF DEFINED(MSWINDOWS)}
Result := TDragDropSourceWindows.Create(Control);
{$ELSEIF DEFINED(LCLGTK) or DEFINED(LCLGTK2)}
Result := TDragDropSourceGTK.Create(Control);
{$ELSEIF DEFINED(LCLQT)}
Result := TDragDropSourceQT.Create(Control);
{$ELSE}
Result := TDragDropSource.Create(Control); // Dummy
{$ENDIF}
end;
function CreateDragDropTarget(Control: TWinControl): TDragDropTarget;
begin
{$IF DEFINED(MSWINDOWS)}
Result := TDragDropTargetWindows.Create(Control);
{$ELSEIF DEFINED(LCLGTK) or DEFINED(LCLGTK2)}
Result := TDragDropTargetGTK.Create(Control);
{$ELSEIF DEFINED(LCLQT)}
Result := TDragDropTargetQT.Create(Control);
{$ELSE}
Result := TDragDropTarget.Create(Control); // Dummy
{$ENDIF}
end;
function GetDropEffectByKeyAndMouse(ShiftState: TShiftState;
MouseButton: TMouseButton): TDropEffect;
begin
case MouseButton of
mbLeft:
begin
if ShiftState = [] then
Result := DropCopyEffect // default to Copy when no keys pressed
else if ShiftState = [ssShift] then
Result := DropMoveEffect
else if ShiftState = [ssCtrl] then
Result := DropCopyEffect
else if ShiftState = [ssCtrl, ssShift] then
Result := DropLinkEffect
else
Result := DropNoEffect; // some other key combination pressed
end;
mbMiddle:
Result := DropAskEffect;
mbRight:
Result := DropAskEffect;
end;
end;
end.

21
src/platform/udragdropgtk.pas
View file

@ -322,22 +322,10 @@ begin
case TTargetId(info) of
tidTextUriList:
for i := 0 to DragDropSource.GetFileNamesList.Count-1 do
begin
dataString := dataString
+ fileScheme + '//' { don't put hostname }
+ URIEncode(DragDropSource.GetFileNamesList[i])
+ LineEnding;
end;
dataString := FormatUriList(DragDropSource.GetFileNamesList);
tidTextPlain:
for i := 0 to DragDropSource.GetFileNamesList.Count-1 do
begin
dataString := dataString
+ fileScheme + '//' { don't put hostname }
+ DragDropSource.GetFileNamesList[i]
+ LineEnding;
end;
dataString := FormatTextPlain(DragDropSource.GetFileNamesList);
end;
@ -424,7 +412,7 @@ function OnDataReceived(widget: PGtkWidget; context: PGdkDragContext; x, y: gint
var
DragDropTarget: TDragDropTargetGTK;
DropEffect: TDropEffect;
FileNamesList: TStringList;
FileNamesList: TStringList = nil;
CursorPosition: TPoint;
uriList: string;
begin
@ -465,7 +453,8 @@ begin
Result := DragDropTarget.GetDropEvent()(FileNamesList, DropEffect, CursorPosition);
finally
FreeAndNil(FileNamesList);
if Assigned(FileNamesList) then
FreeAndNil(FileNamesList);
end;
end;

457
src/platform/udragdropqt.pas Normal file
View file

@ -0,0 +1,457 @@
{
Drag&Drop operations for QT.
}
unit uDragDropQt;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Controls, uDragDropEx,
qt4, qtwidgets;
type
TDragDropSourceQT = class(TDragDropSource)
function RegisterEvents(DragBeginEvent : uDragDropEx.TDragBeginEvent;
RequestDataEvent: uDragDropEx.TRequestDataEvent;
DragEndEvent : uDragDropEx.TDragEndEvent): Boolean; override;
function DoDragDrop(const FileNamesList: TStringList;
MouseButton: TMouseButton;
ScreenStartPoint: TPoint): Boolean; override;
private
function GetWidget: QWidgetH;
end;
TDragDropTargetQT = class(TDragDropTarget)
public
constructor Create(TargetControl: TWinControl); override;
function RegisterEvents(DragEnterEvent: uDragDropEx.TDragEnterEvent;
DragOverEvent : uDragDropEx.TDragOverEvent;
DropEvent : uDragDropEx.TDropEvent;
DragLeaveEvent: uDragDropEx.TDragLeaveEvent): Boolean; override;
procedure UnregisterEvents; override;
private
FEventHook : QObject_hookH;
function EventFilter(Sender: QObjectH; Event: QEventH): Boolean; cdecl; // called by QT
function GetWidget: QWidgetH;
function HasSupportedFormat(DropEvent: QDropEventH): Boolean;
function OnDragEnter(DragEnterEvent: QDragEnterEventH): Boolean;
function OnDragOver(DragMoveEvent: QDragMoveEventH): Boolean;
function OnDrop(DropEvent: QDropEventH): Boolean;
function OnDragLeave(DragLeaveEvent: QDragLeaveEventH): Boolean;
end;
function QtActionToDropEffect(Action: QtDropAction): TDropEffect;
function DropEffectToQtAction(DropEffect: TDropEffect): QtDropAction;
function QtDropEventPointToLCLPoint(const PDropEventPoint: PQtPoint): TPoint;
implementation
uses
uClipboard, LCLIntf;
const
uriListMimeW : WideString = uriListMime;
textPlainMimeW : WideString = textPlainMime;
function GetWidgetFromLCLControl(AWinControl: TWinControl): QWidgetH; inline;
begin
// Custom controls (TQtCustomControl) are created by LCL as
// QAbstractScrollArea with a viewport (and two scrollbars).
// We want the viewport to be the source/target of drag&drop, so we use
// GetContainerWidget which returns the viewport widget for custom controls
// and regular widget handle for others.
Result := TQtWidget(AWinControl.Handle).GetContainerWidget;
end;
{ ---------- TDragDropSourceQT ---------- }
function TDragDropSourceQT.RegisterEvents(DragBeginEvent : uDragDropEx.TDragBeginEvent;
RequestDataEvent: uDragDropEx.TRequestDataEvent;
DragEndEvent : uDragDropEx.TDragEndEvent): Boolean;
begin
inherited;
// RequestDataEvent is not handled in QT.
Result := True;
end;
function TDragDropSourceQT.DoDragDrop(const FileNamesList: TStringList;
MouseButton: TMouseButton;
ScreenStartPoint: TPoint): Boolean;
procedure SetMimeDataInFormat(MimeData: QMimeDataH;
MimeType: WideString;
DataString: AnsiString);
var
ByteArray: QByteArrayH;
begin
ByteArray := QByteArray_create(PAnsiChar(DataString));
try
QMimeData_setData(MimeData, @MimeType, ByteArray);
finally
QByteArray_destroy(ByteArray);
end;
end;
var
DragObject: QDragH = nil;
MimeData: QMimeDataH = nil;
begin
Result := False;
// Simulate drag-begin event.
if Assigned(GetDragBeginEvent) then
begin
Result := GetDragBeginEvent()();
if Result = False then Exit;
end;
DragObject := QDrag_create(GetWidget); // deleted automatically by QT
try
MimeData := QMimeData_create;
QDrag_setMimeData(DragObject, MimeData); // MimeData owned by DragObject after this
SetMimeDataInFormat(MimeData, uriListMimeW, FormatUriList(FileNamesList));
SetMimeDataInFormat(MimeData, textPlainMimeW, FormatTextPlain(FileNamesList));
except
QDrag_destroy(DragObject);
end;
// Start drag&drop operation (default to Copy action).
QDrag_exec(DragObject, QtCopyAction or QtLinkAction or QtMoveAction, qtCopyAction);
// Simulate drag-end event.
if Assigned(GetDragEndEvent) then
begin
if Result = True then
Result := GetDragEndEvent()()
else
GetDragEndEvent()()
end;
end;
function TDragDropSourceQT.GetWidget: QWidgetH;
begin
Result := GetWidgetFromLCLControl(GetControl);
end;
{ ---------- TDragDropTargetQT ---------- }
constructor TDragDropTargetQT.Create(TargetControl: TWinControl);
begin
inherited;
FEventHook := nil;
end;
function TDragDropTargetQT.RegisterEvents(DragEnterEvent: uDragDropEx.TDragEnterEvent;
DragOverEvent : uDragDropEx.TDragOverEvent;
DropEvent : uDragDropEx.TDropEvent;
DragLeaveEvent: uDragDropEx.TDragLeaveEvent): Boolean;
var
Method: TMethod;
begin
inherited;
QWidget_setAcceptDrops(GetWidget, True);
if Assigned(FEventHook) then
QObject_hook_destroy(FEventHook);
// Tap into target widget's events.
FEventHook := QObject_hook_create(GetWidget);
TEventFilterMethod(Method) := @EventFilter;
QObject_hook_hook_events(FEventHook, Method);
Result := True;
end;
procedure TDragDropTargetQT.UnregisterEvents;
begin
QWidget_setAcceptDrops(GetWidget, False);
if Assigned(FEventHook) then
begin
QObject_hook_destroy(FEventHook);
FEventHook := nil;
end;
inherited;
end;
function TDragDropTargetQT.GetWidget: QWidgetH;
begin
Result := GetWidgetFromLCLControl(GetControl);
end;
function TDragDropTargetQT.HasSupportedFormat(DropEvent: QDropEventH): Boolean;
var
MimeData: QMimeDataH;
begin
MimeData := QDropEvent_mimeData(DropEvent);
if Assigned(MimeData) then
begin
if QMimeData_hasFormat(mimedata, @urilistmimew) or
QMimeData_hasFormat(mimedata, @textPlainMimeW)
then
Exit(True);
end;
Result := False;
end;
function TDragDropTargetQT.EventFilter(Sender: QObjectH; Event: QEventH): Boolean; cdecl;
begin
Result := False; // False means the event is not filtered out.
case QEvent_type(Event) of
QEventDragEnter:
begin
QEvent_accept(Event);
OnDragEnter(QDragEnterEventH(Event));
end;
QEventDragMove:
begin
QEvent_accept(Event);
OnDragOver(QDragMoveEventH(Event));
end;
QEventDrop:
begin
QEvent_accept(Event);
OnDrop(QDropEventH(Event));
end;
QEventDragLeave:
begin
QEvent_accept(Event);
OnDragLeave(QDragLeaveEventH(Event));
end;
// QEventDragResponse - used internally by QT
end;
end;
function TDragDropTargetQT.OnDragEnter(DragEnterEvent: QDragEnterEventH): Boolean;
var
CursorPosition: TPoint;
DropEffect: TDropEffect;
DropEvent: QDropEventH;
QtAction: QtDropAction;
begin
// QDragEnterEvent inherits from QDragMoveEvent, which inherits from QDropEvent.
DropEvent := QDropEventH(DragEnterEvent);
if not HasSupportedFormat(DropEvent) then
begin
QDropEvent_setDropAction(DropEvent, QtIgnoreAction);
Result := False;
end
else if Assigned(GetDragEnterEvent) then
begin
DropEffect := QtActionToDropEffect(QDropEvent_proposedAction(DropEvent));
CursorPosition := QtDropEventPointToLCLPoint(QDropEvent_pos(DropEvent));
CursorPosition := GetControl.ClientToScreen(CursorPosition);
Result := GetDragEnterEvent()(DropEffect, CursorPosition);
if Result then
QtAction := DropEffectToQtAction(DropEffect)
else
QtAction := QtIgnoreAction;
QDropEvent_setDropAction(DropEvent, QtAction);
end
else
begin
QDropEvent_acceptProposedAction(DropEvent);
Result := True;
end;
end;
function TDragDropTargetQT.OnDragOver(DragMoveEvent: QDragMoveEventH): Boolean;
var
CursorPosition: TPoint;
DropEffect: TDropEffect;
DropEvent: QDropEventH;
QtAction: QtDropAction;
begin
// QDragMoveEvent inherits from QDropEvent.
DropEvent := QDropEventH(DragMoveEvent);
if not HasSupportedFormat(DropEvent) then
begin
QDropEvent_setDropAction(DropEvent, QtIgnoreAction);
Result := False;
end
else if Assigned(GetDragOverEvent) then
begin
DropEffect := QtActionToDropEffect(QDropEvent_proposedAction(DropEvent));
CursorPosition := QtDropEventPointToLCLPoint(QDropEvent_pos(DropEvent));
CursorPosition := GetControl.ClientToScreen(CursorPosition);
Result := GetDragOverEvent()(DropEffect, CursorPosition);
if Result then
QtAction := DropEffectToQtAction(DropEffect)
else
QtAction := QtIgnoreAction;
QDropEvent_setDropAction(DropEvent, QtAction);
end
else
begin
QDropEvent_acceptProposedAction(DropEvent);
Result := True;
end;
end;
function TDragDropTargetQT.OnDrop(DropEvent: QDropEventH): Boolean;
function GetMimeDataInFormat(MimeData: QMimeDataH; MimeType: WideString): AnsiString;
var
ByteArray: QByteArrayH;
Size: Integer;
Data: PAnsiChar;
begin
if QMimeData_hasFormat(MimeData, @MimeType) then
begin
ByteArray := QByteArray_create();
try
QMimeData_data(MimeData, ByteArray, @MimeType);
Size := QByteArray_size(ByteArray);
Data := QByteArray_data(ByteArray);
if (Size > 0) and Assigned(Data) then
SetString(Result, Data, Size);
finally
QByteArray_destroy(ByteArray);
end;
end
else
Result := '';
end;
var
DropAction: QtDropAction;
DropEffect: TDropEffect;
CursorPosition: TPoint;
uriList: String;
FileNamesList: TStringList = nil;
MimeData: QMimeDataH;
begin
Result := False;
// QDropEvent_possibleActions() returns all actions allowed by the source.
// QDropEvent_proposedAction() is the action proposed by the source.
DropAction := QDropEvent_dropAction(DropEvent); // action to be performed by the target
DropEffect := QtActionToDropEffect(DropAction);
CursorPosition := QtDropEventPointToLCLPoint(QDropEvent_pos(dropEvent));
CursorPosition := GetControl.ClientToScreen(CursorPosition);
QDropEvent_setDropAction(DropEvent, QtIgnoreAction); // default to ignoring the drop
MimeData := QDropEvent_mimeData(DropEvent);
if Assigned(GetDropEvent) and Assigned(MimeData) then
begin
if QMimeData_hasFormat(MimeData, @uriListMimeW) then
uriList := URIDecode(Trim(GetMimeDataInFormat(MimeData, uriListMimeW)))
else if QMimeData_hasFormat(MimeData, @textPlainMimeW) then
// try decoding, as text/plain may also be percent-encoded
uriList := URIDecode(Trim(GetMimeDataInFormat(MimeData, textPlainMimeW)))
else
Exit; // reject the drop
try
FileNamesList := ExtractFilenames(uriList);
if Assigned(FileNamesList) and (FileNamesList.Count > 0) then
Result := GetDropEvent()(FileNamesList, DropEffect, CursorPosition);
finally
if Assigned(FileNamesList) then
FreeAndNil(FileNamesList);
end;
QDropEvent_setDropAction(DropEvent, DropAction); // accept the drop
end;
end;
function TDragDropTargetQT.OnDragLeave(DragLeaveEvent: QDragLeaveEventH): Boolean;
begin
if Assigned(GetDragLeaveEvent) then
Result := GetDragLeaveEvent()()
else
Result := True;
end;
{ ---------------------------------------------------------------------------- }
function QtActionToDropEffect(Action: QtDropAction): TDropEffect;
begin
case Action of
QtCopyAction: Result := DropCopyEffect;
QtMoveAction: Result := DropMoveEffect;
QtTargetMoveAction: Result := DropMoveEffect;
QtLinkAction: Result := DropLinkEffect;
else Result := DropNoEffect;
end;
end;
function DropEffectToQtAction(DropEffect: TDropEffect): QtDropAction;
begin
case DropEffect of
DropCopyEffect: Result := QtCopyAction;
DropMoveEffect: Result := QtMoveAction;
DropLinkEffect: Result := QtLinkAction;
else Result := QtIgnoreAction;
end;
end;
function QtDropEventPointToLCLPoint(const PDropEventPoint: PQtPoint): TPoint;
begin
if Assigned(PDropEventPoint) then
begin
if (PDropEventPoint^.x <> 0) or (PDropEventPoint^.y <> 0) then
begin
Result.X := PDropEventPoint^.x;
Result.Y := PDropEventPoint^.y;
Exit;
end;
end;
GetCursorPos(Result);
end;
end.