[Lazarus] GTK2: Drag files to other applications (to the file manager, Thunar, Nautilus, etc)

classic Classic list List threaded Threaded
43 messages Options
123
Reply | Threaded
Open this post in threaded view
|

[Lazarus] GTK2: Drag files to other applications (to the file manager, Thunar, Nautilus, etc)

Bernd K.
Hello,

I am trying to get drag and drop to work but I am not an expert with
all this low level GTK2 api. In the end I want to be able to drag
files from my application to the file manager. My application is
displaying a list of items (that represent files) in the scrollbox (I
have essentially emulated a custom drawn listview for my needs from
scratch) and then the user should be able to drag from the scrollbox
to the file manager or to the desktop and this other application shold
then behave as if files were dropped.

For this purpose I have started a new empty project to play with the
gtk2 API (and maybe later do the same also for windows once I have
worked out how this goes). This is what I have so far (and it is NOT
working):


unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
  StdCtrls;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    ScrollBox1: TScrollBox;
    procedure FormCreate(Sender: TObject);
    procedure SetupDragDrop;
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation
uses
  glib2, gtk2, gdk2;
{$R *.lfm}

{ TForm1 }

procedure drag_begin(para1: TGtkSignalFuncProc); cdecl;
begin
  writeln('drag_begin');
end;

procedure drag_end(para1: TGtkSignalFuncProc); cdecl;
begin
  writeln('drag_end');
end;

procedure drag_data_get(para1: TGtkSignalFuncProc); cdecl;
begin
  writeln('drag_data_get');
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  SetupDragDrop;
end;

procedure TForm1.SetupDragDrop;
var
  Widget: PGtkWidget;
  TargetEntry: TGtkTargetEntry;
begin
  // is it ok to assume that the handle is the PGtkWidget?

  // none of them seem to work :-(
  //Widget := PGtkWidget(Form1.Handle);
  //Widget := PGtkWidget(Button1.Handle);
  Widget := PGtkWidget(ScrollBox1.Handle);

  with TargetEntry do begin
    target := 'what do i have to put here for dragging files?';
    info := 0; // <-- what is this?
    flags := 0; // <-- maybe the wrong flags?
  end;

  // is this correct?
  gtk_drag_source_set(Widget, GDK_BUTTON1_MASK, @TargetEntry, 1,
GDK_ACTION_COPY);

  // or is the way I connect the signals wrong?
  g_signal_connect(Widget, 'drag-begin', @drag_begin, nil);
  g_signal_connect(Widget, 'drag-end', @drag_end, nil);
  g_signal_connect(Widget, 'drag-data-get', @drag_end, nil);

  // what else is missing? None of my callbacks will ever be called :-(
end;

end.

Its a simple empty application with just a button and a TScrollBox
(ideally I want to have the scrollbox as drag source, some GTK
tutorials use buttons in their examples as drag source so I assume at
least with the button it should work once I get it working at all?

Unfortunately the above code does not seem to do anything at all. None
of the callbacks are called, the cursor does not change when I attempt
to drag, I assume I am missing something esential. It would be nice if
someone could help me modify the above at least to the point where at
least *something* will happen and maybe also answer some of the
questions embedded in the code, maybe then I can figure out the rest
on my own.

Bernd

--
_______________________________________________
Lazarus mailing list
[hidden email]
http://lists.lazarus.freepascal.org/mailman/listinfo/lazarus
Reply | Threaded
Open this post in threaded view
|

Re: [Lazarus] GTK2: Drag files to other applications (to the file manager, Thunar, Nautilus, etc)

Bernd K.
I am making progress. The handle is indeed a PGTKWidget but there are
always multiple widgets nested inside each other, for example a
TButton is really a GTKLabel inside a GTKButton inside a GTKEventBox,
so I have to recursively go through all the child widgets and set up
drag&drop for them all.

Here is what I have now (for everybody who also wants to experiment with this):

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
  StdCtrls, ComCtrls;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    ScrollBox1: TScrollBox;
    StaticText1: TStaticText;
    TreeView1: TTreeView;
    procedure FormCreate(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation
{$ifdef LCLGTK2}
uses
  glib2, gtk2, gdk2;
{$endif}

{$R *.lfm}

{$ifdef LCLGTK2}
procedure GtkDragDataGet(GtkW: PGtkWidget;
                      Context: PGdkDragContext;
                      SelData: PGtkSelectionData;
                   TargetType: guint;
                         Time: guint;
                      Control: TWinControl); cdecl;
begin
  writeln('drag_data_get from ', Control.Name);
end;

procedure GtkDragBegin(GtkW: PGtkWidget;
                    Context: PGdkDragContext;
                    Control: TWinControl); cdecl;
begin
  writeln('drag_begin from ', Control.Name);
end;

procedure GtkRecursiveConnect(GtkW: PGtkWidget; Control: TWinControl); cdecl;
const
  FileDragTarget: TGtkTargetEntry = (target: 'text/uri-list'; flags:
0; info: 0;);
begin
  WriteLn('connecting: ', gtk_widget_get_name(GtkW));
  gtk_drag_source_set(GtkW, GDK_BUTTON1_MASK, @FileDragTarget, 1,
GDK_ACTION_COPY);
  g_signal_connect(GtkW, 'drag-data-get', TGCallback(@GtkDragDataGet), Control);
  g_signal_connect(GtkW, 'drag-begin', TGCallback(@GtkDragBegin), Control);

  // recurse through all child widgets
  if GTK_IS_CONTAINER(GtkW) then
    gtk_container_foreach(PGTKContainer(GtkW),
TGtkCallback(@GtkRecursiveConnect), Control);
end;

procedure GTkSetupDragDrop(AControl: TWinControl);
var
  GtkW: PGtkWidget;
begin
  writeln(LineEnding, 'now setting up: ', AControl.Name);
  GtkW := PGtkWidget(AControl.Handle);
  GtkRecursiveConnect(GtkW, AControl);
end;
{$endif}

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
  {$ifdef LCLGTK2}
  //SetupDragDrop(Form1);
  GTkSetupDragDrop(Button1);
  GTkSetupDragDrop(ScrollBox1);
  GTkSetupDragDrop(StaticText1);
  GTkSetupDragDrop(TreeView1);
  {$endif}
end;

end.

it prints the following to the console (and file manager and desktop
behave as if they would accept the file drop although it does not yet
send any data):

now setting up: Button1
connecting: GtkEventBox
connecting: GtkButton
connecting: GtkLabel

now setting up: ScrollBox1
connecting: GtkScrolledWindow
connecting: GtkLayout

now setting up: StaticText1
connecting: GtkFrame
connecting: GtkEventBox
connecting: GtkLabel

now setting up: TreeView1
connecting: LCLWinapiWidget
connecting: LCLWinapiClient
drag_begin from ScrollBox1
drag_begin from ScrollBox1
drag_data_get from ScrollBox1
drag_begin from StaticText1
drag_data_get from StaticText1
drag_begin from Button1
drag_data_get from Button1

The only thing that is not working is the TTreeView, it does not seem
to be based on any native GTK widget and will not behave like the
other widgets.

--
_______________________________________________
Lazarus mailing list
[hidden email]
http://lists.lazarus.freepascal.org/mailman/listinfo/lazarus
Reply | Threaded
Open this post in threaded view
|

Re: [Lazarus] GTK2: Drag files to other applications (to the file manager, Thunar, Nautilus, etc)

Bernd K.
I have made a working component. See attachment. Use it like this:

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
  DragSource := TFileDragSource.Create(Self);
  DragSource.Control := ScrollBox1;
  DragSource.OnDragBegin := @OnScrollboxDragBegin;;
  DragSource.OnDragEnd := @OnScrollboxDragEnd;;
  DragSource.OnGetData := @OnScrollboxGetData;;
end;

procedure TForm1.OnScrollboxDragBegin(Sender: TObject);
begin
  WriteLn('scrollbox drag begin');
end;

procedure TForm1.OnScrollboxDragEnd(Sender: TObject);
begin
  WriteLn('scrollbox drag end');
end;

procedure TForm1.OnScrollboxGetData(Sender: TObject; Data: TStringList);
begin
  WriteLn('scrollbox drag get data');
  Data.Append('file:///home/bernd/file_a');
  Data.Append('file:///home/bernd/file_b');
end;

Now the Scrollbox on my form will act as a drag source for dragging
files to other applications (In a real world application the OnGetData
handler could for example create these files and supply the file names
and the OnDragEnd could delete them again). Dragging them to the file
manager would copy the files, dragging them to an editor would make it
open them.

Now it wold be nice if one of the local windows API Gurus could extend
this code to also work in windows and maybe someone else make it work
in Qt and on the Mac also. And eventually this code should go directly
into the LCL (maybe after also adding the ability to drag arbitrary
mime types and not only filenames).

--
_______________________________________________
Lazarus mailing list
[hidden email]
http://lists.lazarus.freepascal.org/mailman/listinfo/lazarus

filedragsource.pas.tar.bz2 (3K) Download Attachment
Reply | Threaded
Open this post in threaded view
|

Re: [Lazarus] GTK2: Drag files to other applications (to the file manager, Thunar, Nautilus, etc)

Mattias Gaertner
On Mon, 20 Aug 2012 17:38:45 +0200
Bernd <[hidden email]> wrote:

> I have made a working component. See attachment. Use it like this:
>
> { TForm1 }
>
> procedure TForm1.FormCreate(Sender: TObject);
> begin
>   DragSource := TFileDragSource.Create(Self);
>   DragSource.Control := ScrollBox1;
>   DragSource.OnDragBegin := @OnScrollboxDragBegin;;
>   DragSource.OnDragEnd := @OnScrollboxDragEnd;;
>   DragSource.OnGetData := @OnScrollboxGetData;;
> end;
>
> procedure TForm1.OnScrollboxDragBegin(Sender: TObject);
> begin
>   WriteLn('scrollbox drag begin');
> end;
>
> procedure TForm1.OnScrollboxDragEnd(Sender: TObject);
> begin
>   WriteLn('scrollbox drag end');
> end;
>
> procedure TForm1.OnScrollboxGetData(Sender: TObject; Data: TStringList);
> begin
>   WriteLn('scrollbox drag get data');
>   Data.Append('file:///home/bernd/file_a');
>   Data.Append('file:///home/bernd/file_b');
> end;
>
> Now the Scrollbox on my form will act as a drag source for dragging
> files to other applications (In a real world application the OnGetData
> handler could for example create these files and supply the file names
> and the OnDragEnd could delete them again). Dragging them to the file
> manager would copy the files, dragging them to an editor would make it
> open them.

Nice. Thanks.
Should I add it to the examples or in a package of its own?

 
> Now it wold be nice if one of the local windows API Gurus could extend
> this code to also work in windows and maybe someone else make it work
> in Qt and on the Mac also. And eventually this code should go directly
> into the LCL (maybe after also adding the ability to drag arbitrary
> mime types and not only filenames).

Yes.

Mattias


--
_______________________________________________
Lazarus mailing list
[hidden email]
http://lists.lazarus.freepascal.org/mailman/listinfo/lazarus
Reply | Threaded
Open this post in threaded view
|

Re: [Lazarus] GTK2: Drag files to other applications (to the file manager, Thunar, Nautilus, etc)

Bernd K.
2012/8/20 Mattias Gaertner <[hidden email]>:

> Nice. Thanks.
> Should I add it to the examples or in a package of its own?

I think it should be made a package, make an icon for it and place it
on the components palette (I have never done this myself before but
since its a descendant of TComponent and has published properties for
the events (TNotifyEvent) like oher components it might not be too
much work.

Then people could immediately start using it without too much trouble
and submit patches until it is really complete (all widgetsets) and
then eventually once it is complete and well tested maybe its methods
and events could be integrated directly into TWinControl (maybe the
events would then need some different names to not be confused with
the internal drag&drop mechanism)

--
_______________________________________________
Lazarus mailing list
[hidden email]
http://lists.lazarus.freepascal.org/mailman/listinfo/lazarus
Reply | Threaded
Open this post in threaded view
|

Re: [Lazarus] GTK2: Drag files to other applications (to the file manager, Thunar, Nautilus, etc)

Hans-Peter Diettrich
In reply to this post by Bernd K.
Bernd schrieb:
> I am making progress. The handle is indeed a PGTKWidget but there are
> always multiple widgets nested inside each other, for example a
> TButton is really a GTKLabel inside a GTKButton inside a GTKEventBox,
> so I have to recursively go through all the child widgets and set up
> drag&drop for them all.

Please clarify what you *really* want to achieve. DragDrop of *files* is
very different from DragDrop of *components*.

Dragging *controls* worked for me off the shelf, on both Win32 and Gtk2
widgetsets.

Dragging *files* across applications is a matter of the platform,
requiring different procedures for *sending* and *receiving*. I don't
see how the widgetset is involved here, at least on Windows the related
messages (WM_DROPFILES) are sent to the control *Handle*. Similarly
sending files must be invoked by an event of a control, again fully
independent from the used widgetset. The code for actually sending files
depends on the platform, dunno whether there exists a common API already
in the FCL/LCL.

DoDi


--
_______________________________________________
Lazarus mailing list
[hidden email]
http://lists.lazarus.freepascal.org/mailman/listinfo/lazarus
Reply | Threaded
Open this post in threaded view
|

Re: [Lazarus] GTK2: Drag files to other applications (to the file manager, Thunar, Nautilus, etc)

Bernd K.
2012/8/20 Hans-Peter Diettrich <[hidden email]>:

> Bernd schrieb:
>
>> I am making progress. The handle is indeed a PGTKWidget but there are
>> always multiple widgets nested inside each other, for example a
>> TButton is really a GTKLabel inside a GTKButton inside a GTKEventBox,
>> so I have to recursively go through all the child widgets and set up
>> drag&drop for them all.
>
>
> Please clarify what you *really* want to achieve. DragDrop of *files* is
> very different from DragDrop of *components*.

I want to drag files, I *don't* want to drag the components
themselves. I don't want to interfere with or do anything docking
related.

I want to put the mouse cursor over one of my controls that represents
one or more files (for example the current selection of a list view
that represents files that either exist already somewhere in the file
system or can be extracted from a database on demand), press the mouse
button, drag it *outside* the application and drop it onto another
application (for example a file manager or the desktop) so that the
receiving application can then do what it usually does when files get
dropped onto it.

for this (at least on GTK2) I need to declare one of the GTK widgets
the "drag source" that will then fire various signals during the drag
operation. in GTK this is done with gtk_drag_source_set() and the
signals are connected with g_signal_connect() just like all the other
signals too.

My initial problem in Post #1 was that the LCL TButton.Handle actually
represents a GTKEventBox and only *inside* this as a child widget is
the actual GTKButton. This is why it did not work initially, I
registered the invisible GTKEventBox as drag source but could not
actually click it because I should have used the GTKButton instead
which is not directly exposed by the LCL. Similar with most other
controls too, they are all represented by more than one GTK widget.
Therefore I now made it simply recursively register and connect the
widget and *all* its contained sub-widgets, knowing that the one that
is actually exposed to the mouse and can fire drag-* signals must be
among them.

> Dragging *files* across applications is a matter of the platform, requiring
> different procedures for *sending* and *receiving*. I don't see how the
> widgetset is involved here,

The widgetset *is* the platform! (at least as far as file dragging is
concerned, no need to access any other API)

--
_______________________________________________
Lazarus mailing list
[hidden email]
http://lists.lazarus.freepascal.org/mailman/listinfo/lazarus
Reply | Threaded
Open this post in threaded view
|

Re: [Lazarus] GTK2: Drag files to other applications (to the file manager, Thunar, Nautilus, etc)

Hans-Peter Diettrich
Bernd schrieb:

> The widgetset *is* the platform! (at least as far as file dragging is
> concerned, no need to access any other API)

This is not correct, because dragging is not restricted to work only
between controls of the same widgetset.

I'd look behind the scene, and use the platform specific protocol
directly. The final implementation should end up in a cross-platform FPC
component, not in the LCL.

DoDi


--
_______________________________________________
Lazarus mailing list
[hidden email]
http://lists.lazarus.freepascal.org/mailman/listinfo/lazarus
Reply | Threaded
Open this post in threaded view
|

Re: [Lazarus] GTK2: Drag files to other applications (to the file manager, Thunar, Nautilus, etc)

Sven Barth

Am 21.08.2012 06:28 schrieb "Hans-Peter Diettrich" <[hidden email]>:
>
> Bernd schrieb:
>
>
>> The widgetset *is* the platform! (at least as far as file dragging is
>> concerned, no need to access any other API)
>
>
> This is not correct, because dragging is not restricted to work only between controls of the same widgetset.

And these widgetset specific APIs normally provide the capability to copy and paste to/from applications written in a different widgetset, because the widgetsets themselves do already use the underlying protocols.

Regards,
Sven


--
_______________________________________________
Lazarus mailing list
[hidden email]
http://lists.lazarus.freepascal.org/mailman/listinfo/lazarus
Reply | Threaded
Open this post in threaded view
|

Re: [Lazarus] GTK2: Drag files to other applications (to the file manager, Thunar, Nautilus, etc)

Bernd K.
In reply to this post by Hans-Peter Diettrich
2012/8/21 Hans-Peter Diettrich <[hidden email]>:
> Bernd schrieb:
>
>
>> The widgetset *is* the platform! (at least as far as file dragging is
>> concerned, no need to access any other API)
>
>
> This is not correct, because dragging is not restricted to work only between
> controls of the same widgetset.

I'm curious: what makes you believe that such popular and mature
toolkits like GTK2 (or Qt4) would not be able to use the correct
underlying platform protocols when implementing such elementary things
as copy/paste/drag/drop? According to the documentation GTK2 when run
on xorg will make use of XDND and when GTK2 is run on windows it will
use the appropriate windows api to provide this functionality. If you
were a GTK2 core developer wouldn't you have implemented it the same
way too? What makes you think they didn't? And I would be very
surprised if Qt would not have similar capabilities (without looking
into the Qt documentation I simply take it for granted that
inter-application drag/drop API also exists in Qt4 and that they of
course implemented it in such a way that it actually works).

--
_______________________________________________
Lazarus mailing list
[hidden email]
http://lists.lazarus.freepascal.org/mailman/listinfo/lazarus
Reply | Threaded
Open this post in threaded view
|

Re: [Lazarus] GTK2: Drag files to other applications (to the file manager, Thunar, Nautilus, etc)

Hans-Peter Diettrich
Bernd schrieb:

> I'm curious: what makes you believe that such popular and mature
> toolkits like GTK2 (or Qt4) would not be able to use the correct
> underlying platform protocols when implementing such elementary things
> as copy/paste/drag/drop?

They *have* to use the platform protocols, so why should dragging files
or other objects run through an widgetset instead of using the API directly?

Didn't you complain about the complex structure of even simple controls
in gtk2? Using the platform API doesn't require any widgetset specific
code, no need for adapations to new widgetsets.

DoDi


--
_______________________________________________
Lazarus mailing list
[hidden email]
http://lists.lazarus.freepascal.org/mailman/listinfo/lazarus
Reply | Threaded
Open this post in threaded view
|

Re: [Lazarus] GTK2: Drag files to other applications (to the file manager, Thunar, Nautilus, etc)

Graeme Geldenhuys
On 21 August 2012 12:41, Hans-Peter Diettrich <[hidden email]> wrote:
> They *have* to use the platform protocols, so why should dragging files or
> other objects run through an widgetset instead of using the API directly?

I have to admit that Bernd's implementation does seem strange - now
with multiple DND implementation between the LCL's TWinControl and his
TComponent descendant. But if it works, then great.

I also have so say, considering I have implemented x-platform DND in
fpGUI using platform API's directly, that using the platform API's
directly is a very complex task. The idea is that the GUI Toolkit
makes the DND task easier to use, and in a x-platform manner, so the
application developer doesn't need to add IFDEF statements in there
code or learn each platform's DND API. At least this is how it is done
in fpGUI Toolkit. XDND is used under X11 and OLE DND under Windows -
just like GTK2, Qt does. Good news is,  the application developer
doesn't need to worry about that at all. In the case of fpGUI, they
simply register their dragable data with a mime type, hook into some
TfpgWidget DND events, and fpGUI takes care of the rest.

--
Regards,
  - Graeme -


_______________________________________________
fpGUI - a cross-platform Free Pascal GUI toolkit
http://fpgui.sourceforge.net

--
_______________________________________________
Lazarus mailing list
[hidden email]
http://lists.lazarus.freepascal.org/mailman/listinfo/lazarus
Reply | Threaded
Open this post in threaded view
|

Re: [Lazarus] GTK2: Drag files to other applications (to the file manager, Thunar, Nautilus, etc)

Bernd K.
2012/8/21 Graeme Geldenhuys <[hidden email]>:
> On 21 August 2012 12:41, Hans-Peter Diettrich <[hidden email]> wrote:
>> They *have* to use the platform protocols, so why should dragging files or
>> other objects run through an widgetset instead of using the API directly?
>
> I have to admit that Bernd's implementation does seem strange - now
> with multiple DND implementation between the LCL's TWinControl and his
> TComponent descendant. But if it works, then great.

its not *between* the TWinControl and my component, my component is
just there as a wrapper around some internal state (which could also
be implemented in the TWinControl directly) and to add a few more
events (which could also be added to TWinControl) and around the
platform specific code between the ifdefs which could later be moved
into lcl/interfaces/gtk2/ once it is complete.

I just did it this way (with a separate component) because now it does
not require me to patch the LCL for my experiments.

Also I don't want to implement an *additional* DND mechanism, I just
wanted to have something that enables me to drag files to other
applications which was imposible before. Its not meant to replace LCL
internal DND mechanism, at least not yet in this incomplete state. At
the moment it should only exist as a separate optional component.

--
_______________________________________________
Lazarus mailing list
[hidden email]
http://lists.lazarus.freepascal.org/mailman/listinfo/lazarus
Reply | Threaded
Open this post in threaded view
|

Re: [Lazarus] GTK2: Drag files to other applications (to the file manager, Thunar, Nautilus, etc)

Bernd K.
In reply to this post by Hans-Peter Diettrich
2012/8/21 Hans-Peter Diettrich <[hidden email]>:

> They *have* to use the platform protocols, so why should dragging files or
> other objects run through an widgetset instead of using the API directly?

Because when using GTK2 for the GUI I usually do all GUI related
things through GTK and not by accessing the native platform directly
because thats the reason something like GTK exists in the first place.
Or do you paint your windows and buttons with X11 libs when you have
LCL and GTK2?

> Didn't you complain about the complex structure of even simple controls in
> gtk2?

No I did not complain. I said "I am not a GTK2 expert". This was not a
complaint.

> Using the platform API doesn't require any widgetset specific code, no
> need for adapations to new widgetsets.

It would require platform specific code instead. How is this better?

Its even worse because then with n different widgetsets being able to
run on m different platforms I would have n*m possible combinations of
two things that are messing around in the same realm (GUI) to step on
each other's feet and go wrong.

--
_______________________________________________
Lazarus mailing list
[hidden email]
http://lists.lazarus.freepascal.org/mailman/listinfo/lazarus
Reply | Threaded
Open this post in threaded view
|

Re: [Lazarus] GTK2: Drag files to other applications (to the file manager, Thunar, Nautilus, etc)

Bernd K.
In reply to this post by Bernd K.
Intermediate result of first experiments on windows. May the next
person who googles for this rare problem (everybody knows how to
receive files but only few people have ever implemented an IDataObject
 themselves and then posted the results) find this post in which it is
all condensed into only 200 lines of a readable programming language:

unit win32dragdrop;

{$mode objfpc}{$H+}

interface

procedure DoVeryComplicatedStuffThatIsNotWellDocumented;


implementation
uses
  Classes, Windows, ActiveX, shlobj;

const
  MyFileDragFormat: FORMATETC = (
    CfFormat : CF_HDROP;
    Ptd      : nil;
    dwAspect : DVASPECT_CONTENT;
    lindex   : -1;
    tymed    : TYMED_HGLOBAL;
  );

type

  { TDropSource }

  TDropSource = class(TInterfacedObject, IDropSource)
    function QueryContinueDrag(fEscapePressed: BOOL; grfKeyState:
DWORD): HResult; StdCall;
    function GiveFeedback(dwEffect: DWORD): HResult; StdCall;
  end;

  { TDataObject }

  TDataObject = class(TInterfacedObject, IDataObject)
    function GetData(const formatetcIn: FORMATETC; out medium:
STGMEDIUM): HRESULT; STDCALL;
    function GetDataHere(const pformatetc: FormatETC; out medium:
STGMEDIUM): HRESULT; STDCALL;
    function QueryGetData(const pformatetc: FORMATETC): HRESULT; STDCALL;
    function GetCanonicalFormatEtc(const pformatetcIn: FORMATETC; out
pformatetcOut: FORMATETC): HResult; STDCALl;
    function SetData(const pformatetc: FORMATETC; const medium:
STGMEDIUM; FRelease: BOOL): HRESULT; StdCall;
    function EnumFormatEtc(dwDirection: DWord; out enumformatetcpara:
IENUMFORMATETC): HRESULT; StdCall;
    function DAdvise(const formatetc: FORMATETC; advf: DWORD; const
AdvSink: IAdviseSink; out dwConnection: DWORD): HRESULT; StdCall;
    function DUnadvise(dwconnection: DWord): HRESULT; StdCall;
    function EnumDAdvise(out enumAdvise: IEnumStatData): HResult; StdCall;
  private
    function HaveThisFormat(const f: TFORMATETC): Boolean;
  end;

{$note SHCreateStdEnumFmtEtc() definition in shlobj is wrong, report this bug}
function SHCreateStdEnumFmtEtc(cfmt:UINT; afmt: PFORMATETC; var
ppenumFormatEtc:IEnumFORMATETC):HRESULT;StdCall;external 'shell32'
name 'SHCreateStdEnumFmtEtc';

procedure DoVeryComplicatedStuffThatIsNotWellDocumented;
var
  DataObject: IDataObject;
  DropSource: IDropSource;
  DWEffect: DWord;
begin
  DataObject := TDataObject.Create;
  DropSource := TDropSource.Create;
  DoDragDrop(DataObject, DropSource, DROPEFFECT_COPY, @DWEffect);
  WriteLn(DWEffect);
end;

{ TDataObject }


function TDataObject.GetData(const formatetcIn: FORMATETC; out medium:
STGMEDIUM): HRESULT; STDCALL;
var
  FileList: TStringList;
  FileName: String;
  sFileList: WideString;
  BufLen: PtrInt;
  hgDropFiles: THANDLE;
  pgDropFiles: PDROPFILES;

begin
  // This method may be called multiple times amd also even when no
  // drop happens at all because I am using CF_HDROP which means: files
  // exist in the file system and so windows thinks it is ok to access
  // the dragged data immediately after dragging has begun!

  if HaveThisFormat(formatetcIn) then begin

    // for this list we would normally ask the FileDragSource component
    // once its all completely implemented but for now I just quickly
    // make up a list of filenames myself.
    FileList := TStringList.Create;
    FileList.Append('c:\dummy.txt');
    FileList.Append('c:\dummy2.txt');

    // First we need a widestring #0 sepatated and #0#0 at the end.
    for FileName in FileList do begin
      sFileList += FileName + #0;
    end;
    sFileList += #0;
    FileList.Free;

    // now we need to allocate memory for the DROPFILES structure
    // we need room for that structure plus the above widestring
    BufLen := SizeOf(DROPFILES) + 2*Length(sFileList); //widestring!
    hgDropFiles := GlobalAlloc(GMEM_MOVEABLE or GMEM_DDESHARE or
GMEM_ZEROINIT, BufLen);

    // populate the DROPFILES structure,
    // it has the string of filenames appended directly at the end
    pgDropFiles := GlobalLock(hgDropFiles);
    pgDropFiles^.pFiles := SizeOf(DROPFILES); // offset of the file list
    pgDropFiles^.fWide := True; // contains widestring!
    Move(sFileList[1], pgDropFiles[1], 2*Length(sFileList)); // widestring!
    GlobalUnlock(hgDropFiles);

    // populate the STGMEDIUM structore;
    medium.Tymed := TYMED_HGLOBAL;
    medium.HGLOBAL := hgDropFiles;
    medium.PUnkForRelease := nil;

    Result := S_OK;
  end
  else
    Result := DV_E_FORMATETC;
end;

function TDataObject.GetDataHere(const pformatetc: FormatETC; out
medium: STGMEDIUM): HRESULT; STDCALL;
begin
end;

function TDataObject.QueryGetData(const pformatetc: FORMATETC):
HRESULT; STDCALL;
begin
  if HaveThisFormat(pformatetc) then
    Result := S_OK
  else
    Result := DV_E_FORMATETC;
end;

function TDataObject.GetCanonicalFormatEtc(const pformatetcIn:
FORMATETC; out pformatetcOut: FORMATETC): HResult; STDCALl;
begin
end;

function TDataObject.SetData(const pformatetc: FORMATETC; const
medium: STGMEDIUM; FRelease: BOOL): HRESULT; StdCall;
begin
end;

function TDataObject.EnumFormatEtc(dwDirection: DWord; out
enumformatetcpara: IENUMFORMATETC): HRESULT; StdCall;
var
  E: IEnumFORMATETC;
begin
  if dwDirection = DATADIR_GET then
    Result := SHCreateStdEnumFmtEtc(1, @MyFileDragFormat, enumformatetcpara)
  else
    Result := E_NOTIMPL;
end;

function TDataObject.DAdvise(const formatetc: FORMATETC; advf: DWORD;
const AdvSink: IAdviseSink; out dwConnection: DWORD): HRESULT;
StdCall;
begin
  Result := OLE_E_ADVISENOTSUPPORTED;
end;

function TDataObject.DUnadvise(dwconnection: DWord): HRESULT; StdCall;
begin
  Result := OLE_E_ADVISENOTSUPPORTED;
end;

function TDataObject.EnumDAdvise(out enumAdvise: IEnumStatData):
HResult; StdCall;
begin
  Result := OLE_E_ADVISENOTSUPPORTED;
end;

function TDataObject.HaveThisFormat(const f: TFORMATETC): Boolean;
begin
  if (f.tymed = MyFileDragFormat.tymed)
  and (f.CfFormat = MyFileDragFormat.CfFormat)
  and (f.dwAspect = MyFileDragFormat.dwAspect) then
    Result := True
  else
    Result := False;
end;

{ TDragSource }

function TDropSource.QueryContinueDrag(fEscapePressed: BOOL;
grfKeyState: DWORD): HResult; StdCall;
begin
  // if the Escape key has been pressed since the last call, cancel the drop
  if fEscapePressed = True then
    exit(DRAGDROP_S_CANCEL);

  // if the LeftMouse button has been released, then do the drop!
  if (grfKeyState and MK_LBUTTON) = 0 then
    exit(DRAGDROP_S_DROP);

  // continue with the drag-drop
  Result := S_OK;
end;

function TDropSource.GiveFeedback(dwEffect: DWORD): HResult; StdCall;
begin
  Result := DRAGDROP_S_USEDEFAULTCURSORS;
end;

initialization
  OleInitialize(nil);
finalization
  OleUninitialize();
end.

--
_______________________________________________
Lazarus mailing list
[hidden email]
http://lists.lazarus.freepascal.org/mailman/listinfo/lazarus
Reply | Threaded
Open this post in threaded view
|

Re: [Lazarus] GTK2: Drag files to other applications (to the file manager, Thunar, Nautilus, etc)

Hans-Peter Diettrich
In reply to this post by Bernd K.
Bernd schrieb:

> 2012/8/21 Graeme Geldenhuys <[hidden email]>:
>> On 21 August 2012 12:41, Hans-Peter Diettrich <[hidden email]> wrote:
>>> They *have* to use the platform protocols, so why should dragging files or
>>> other objects run through an widgetset instead of using the API directly?
>> I have to admit that Bernd's implementation does seem strange - now
>> with multiple DND implementation between the LCL's TWinControl and his
>> TComponent descendant. But if it works, then great.
>
> its not *between* the TWinControl and my component, my component is
> just there as a wrapper around some internal state (which could also
> be implemented in the TWinControl directly)

Your component should be a non-visual one, like a timer. Basing it on
TWinControl is the wrong way, it *introduces* all the widgetset
dependencies :-(

DoDi


--
_______________________________________________
Lazarus mailing list
[hidden email]
http://lists.lazarus.freepascal.org/mailman/listinfo/lazarus
Reply | Threaded
Open this post in threaded view
|

Re: [Lazarus] GTK2: Drag files to other applications (to the file manager, Thunar, Nautilus, etc)

Hans-Peter Diettrich
In reply to this post by Graeme Geldenhuys
Graeme Geldenhuys schrieb:

> On 21 August 2012 12:41, Hans-Peter Diettrich <[hidden email]> wrote:
>> They *have* to use the platform protocols, so why should dragging files or
>> other objects run through an widgetset instead of using the API directly?
>
> I have to admit that Bernd's implementation does seem strange - now
> with multiple DND implementation between the LCL's TWinControl and his
> TComponent descendant. But if it works, then great.
>
> I also have so say, considering I have implemented x-platform DND in
> fpGUI using platform API's directly, that using the platform API's
> directly is a very complex task.

What's complex in providing a list of filenames, in a TStrings object,
and let the RTL/FCL do the rest?

Sending other objects is different, because it's bound to platform
capabilities and cannot be covered by a simple API.

DoDi


--
_______________________________________________
Lazarus mailing list
[hidden email]
http://lists.lazarus.freepascal.org/mailman/listinfo/lazarus
Reply | Threaded
Open this post in threaded view
|

Re: [Lazarus] GTK2: Drag files to other applications (to the file manager, Thunar, Nautilus, etc)

Hans-Peter Diettrich
In reply to this post by Bernd K.
Bernd schrieb:

>> Using the platform API doesn't require any widgetset specific code, no
>> need for adapations to new widgetsets.
>
> It would require platform specific code instead. How is this better?

The implementation can become part of the RTL, where all platform
specific code is implemented.

DoDi


--
_______________________________________________
Lazarus mailing list
[hidden email]
http://lists.lazarus.freepascal.org/mailman/listinfo/lazarus
Reply | Threaded
Open this post in threaded view
|

Re: [Lazarus] GTK2: Drag files to other applications (to the file manager, Thunar, Nautilus, etc)

Graeme Geldenhuys
In reply to this post by Hans-Peter Diettrich
Hi,

On 22 August 2012 01:08, Hans-Peter Diettrich <[hidden email]> wrote:
>
> Sending other objects is different, because it's bound to platform
> capabilities and cannot be covered by a simple API.

Exactly my point. I didn't implement some half-assed DND in fpGUI.
Current LCL's DND support is totally useless. When I think DND, I
think any type of data, dragging inside my application as well as
outside my application (send and receive). Not to mention the fact
that XDND requires window handles to function etc, which a non-GUI
drag component wouldn't have.


--
Regards,
  - Graeme -


_______________________________________________
fpGUI - a cross-platform Free Pascal GUI toolkit
http://fpgui.sourceforge.net

--
_______________________________________________
Lazarus mailing list
[hidden email]
http://lists.lazarus.freepascal.org/mailman/listinfo/lazarus
Reply | Threaded
Open this post in threaded view
|

[Lazarus] WST - not working

Ian Godman
In reply to this post by Hans-Peter Diettrich
I have been trying to get a web services client to work with WST and
Lazarus.

The web-service is written in Java using CXF. Other client work with
this web-service without issue.

Tracing through the Lazarus code it appears that the XML is being
received and parsed but when trying to read the results the DOM object
is empty.

I have asked about this before and got a few replies from people saying
that WST worked for them, beginning to think they were lucky!

I am unable due to lack of Lazarus experience to go further which means
that unfortunately I will have to use a different language.

--
_______________________________________________
Lazarus mailing list
[hidden email]
http://lists.lazarus.freepascal.org/mailman/listinfo/lazarus
123