Page 1 of 1

Drag'n'Drop on a window

Posted: Wed Jan 02, 2002 12:47 pm
by BackupUser
Code updated for 5.20+

Restored from previous forum. Originally posted by fred.

Code: Select all

; Original source code by James L.Boyd

Procedure DropFiles()
  ProcedureReturn EventwParam()
EndProcedure

Procedure GetNumDropFiles(*dropFiles)
  ProcedureReturn DragQueryFile_(*dropFiles, $FFFFFFFF, temp$, 0)
EndProcedure

Procedure.s GetDropFile(*dropFiles, index)
  bufferNeeded = DragQueryFile_(*dropFiles, index, 0, 0)
  buffer$ = Space(bufferNeeded)
  DragQueryFile_(*dropFiles, index, buffer$, bufferNeeded + 1)
  ProcedureReturn buffer$
EndProcedure

Procedure FreeDropFiles(*dropFiles)
  DragFinish_(*dropFiles)
EndProcedure

If OpenWindow (0, 100, 100, 300, 100, "Drag'n'drop files",
               #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  TextGadget(0, 10, 10, 280, 30,
             "Drag && drop files from file explorer into this window...")
  DragAcceptFiles_(WindowID(0), 1)
  Repeat
    Select WaitWindowEvent()
      Case #WM_DROPFILES
        *dropped = DropFiles()
        num = DragQueryFile_(*dropped, $FFFFFFFF, temp$, 0)
        f$ = ""
        For files = 0 To num - 1
          f$ + GetDropFile(*dropped, files) + Chr(13)
        Next
        MessageRequester("Drag'n'drop files", Str(num) + " file (s) dropped:" + 
                                              Chr(13) + Chr(13) + f$ + Chr(13))
        FreeDropFiles(*dropped)
        
      Case #PB_Event_CloseWindow
        Quit = 1
    EndSelect
  Until Quit = 1
EndIf
Fred - AlphaSND

Posted: Thu Jan 03, 2002 9:08 am
by BackupUser
Restored from previous forum. Originally posted by Fangbeast.

he Fred, that routine is pretty spiffy. Now i'm trying to think of evil ways to use it :):):)

Fangles

Posted: Sat Aug 31, 2002 6:53 pm
by BackupUser
Restored from previous forum. Originally posted by ebs.

Fred,

Is it possible to allow drag & drop only on a specific control, instead of an entire window? I would like to have two ListIconGadgets in a window and drag & drop files onto (and maybe between) both of them. Is there a way to tell onto which gadget a file has been dropped?

Regards,
Eric Schuyler

Posted: Sat Aug 31, 2002 8:03 pm
by BackupUser
Restored from previous forum. Originally posted by MrVainSCL.

Hi Fred
I know the code snip you posted... Still wonder that you posted the source with Procedures() inside the code... Because PB donbt like this when try to compile... Only works, if you put the Procedures() to the beginning of the source :wink: But i am sure you know this...


PIII450, 256MB Ram, 6GB HD, RivaTNT, DirectX8.1, SB AWE64, Win2000 + all Updates...

greetz
MrVainSCL! aka Thorsten

Posted: Sat Aug 31, 2002 9:37 pm
by BackupUser
Restored from previous forum. Originally posted by ebs.

Nothing like asking a question and working out the answer yourself! There may be a better way, but this works for me:

Code: Select all

; return gadget number where file(s) dropped
Procedure.l GetDropGadget() 
  GetCursorPos_(@DropPoint.POINT)
  hWnd.l = WindowFromPoint_(DropPoint\x, DropPoint\y)
  For gadget.l = 1 To #MaxGadget
    If GadgetID(gadget) = hWnd
      DropGadget.l = gadget
      gadget = #MaxGadget
    EndIf
  Next
  ProcedureReturn DropGadget
EndProcedure
(#MaxGadget is a constant equal to the highest gadget number)


Instead of setting the entire window to accept dropped files, I only allow specific gadgets to accept them:

Code: Select all

; only certain gadgets can accept dropped files
DragAcceptFiles_(GadgetID(#StringGadget1), #TRUE)   
DragAcceptFiles_(GadgetID(#StringGadget2), #TRUE)   

You call GetDropGadget() in the #WM_DROPFILES event processing:

Code: Select all

If EventID = #WM_DROPFILES
  hDrop = EventwParam()
  ; get drop gadget number
  DropGadget.l = GetDropGadget()
  ; get dropped filename
  AllocateMemory(3, 256, 0)
  DragQueryFile_(hDrop, 0, MemoryID(), 256)
  File.s = PeekS(MemoryID())
  FreeMemory(3)
  DragFinish_(hDrop)
  ; display filename in gadget
  SetGadgetText(DropGadget, File)
EndIf

Originally posted by ebs

Fred,

Is it possible to allow drag & drop only on a specific control, instead of an entire window? I would like to have two ListIconGadgets in a window and drag & drop files onto (and maybe between) both of them. Is there a way to tell onto which gadget a file has been dropped?

Regards,
Eric Schuyler

Posted: Mon Sep 02, 2002 7:23 am
by BackupUser
Restored from previous forum. Originally posted by horst.

> ; only certain gadgets can accept dropped files
> DragAcceptFiles_(GadgetID(#StringGadget1), #TRUE)

This does not work if the StringGadget is inside a Frame3DGadget (Win98).
The file cannot be dropped (cursor symbol "forbidden")

Is there any trick or work-around?



Horst

Posted: Fri Jul 25, 2003 9:41 pm
by Flype
it works well on win2k / xp

Posted: Tue Mar 30, 2004 12:07 pm
by LarsG
Just cleaned and reposted in code tags..
[edit] edited to include a drop on a gadget example as well [/edit]

Code: Select all

; Original source code by James L.Boyd;
; Cleaned and reposted be LarsG

Procedure.l DropFiles()
  ProcedureReturn EventwParam()
EndProcedure

Procedure GetNumDropFiles(*dropFiles)
  ProcedureReturn DragQueryFile_(*dropFiles, $FFFFFFFF, temp$, 0)
EndProcedure

Procedure.s GetDropFile(*dropFiles, index)
  bufferNeeded = DragQueryFile_(*dropFiles, index, 0, 0)
  For a = 1 To bufferNeeded: buffer$ + " ": Next ; Short by one character!
  DragQueryFile_(*dropFiles, index, buffer$, bufferNeeded+1)
  ProcedureReturn buffer$
EndProcedure

Procedure FreeDropFiles(*dropFiles)
   DragFinish_(*dropFiles)
EndProcedure


If OpenWindow(0, 200, 200, 300, 100, #PB_Window_SystemMenu, "Drag 'n' drop")
  DragAcceptFiles_(WindowID(), 1)
  Repeat
    Select WaitWindowEvent()
      Case #WM_DROPFILES
           *dropped = DropFiles()
           num.l = GetNumDropFiles(*dropped)
           f$ = ""
           For files = 0 To num - 1
             f$ + GetDropFile(*dropped, files) + Chr (13)
           Next
           MessageRequester("Drag 'n' Drop", Str (num) + " file (s) dropped:" + Chr (13) + Chr (13) + f$)
           FreeDropFiles(*dropped)
      Case #PB_EventCloseWindow
            Quit = 1
    EndSelect
  Until Quit = 1
EndIf

End

drop on a gadget:

Code: Select all

;- Window Constants
;
Enumeration
  #Window_0
EndEnumeration

;- Gadget Constants
;
Enumeration
  #Listview_0
EndEnumeration


Procedure.l DropFiles()
  ProcedureReturn EventwParam()
EndProcedure

Procedure GetNumDropFiles(*dropFiles)
  ProcedureReturn DragQueryFile_(*dropFiles, $FFFFFFFF, temp$, 0)
EndProcedure

Procedure.s GetDropFile(*dropFiles, index)
  bufferNeeded = DragQueryFile_(*dropFiles, index, 0, 0)
  For a = 1 To bufferNeeded: buffer$ + " ": Next ; Short by one character!
  DragQueryFile_(*dropFiles, index, buffer$, bufferNeeded+1)
  ProcedureReturn buffer$
EndProcedure

Procedure FreeDropFiles(*dropFiles)
   DragFinish_(*dropFiles)
EndProcedure


; main loop
If OpenWindow(#Window_0, 216, 0, 490, 202,  #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_TitleBar , "New window ( 0 )")
  If CreateGadgetList(WindowID())
    ListViewGadget(#Listview_0, 80, 60, 400, 130)
  EndIf
  
  DragAcceptFiles_(GadgetID(#Listview_0), #TRUE)

  Repeat
    Select WaitWindowEvent()
      Case #WM_DROPFILES
           *dropped = DropFiles()
           num.l = GetNumDropFiles(*dropped)
           ClearGadgetItemList(#Listview_0)
           For files = 0 To num - 1
             AddGadgetItem(#Listview_0, -1, GetDropFile(*dropped, files))
           Next
           FreeDropFiles(*dropped)
      Case #PB_EventCloseWindow
            Quit = 1
    EndSelect
  Until Quit = 1

EndIf

End
 

Posted: Wed Mar 31, 2004 4:16 am
by eddy
This code doesn't work with webgadget.
I see a shorcut icon instead of drag icon. :roll:

Posted: Wed Mar 31, 2004 4:34 am
by eddy
I've found the solution -> disabled webgadget

Posted: Wed Mar 31, 2004 9:09 am
by blueznl
:-)