Drag'n'Drop on a window

Share your advanced PureBasic knowledge/code with the community.
BackupUser
PureBasic Guru
PureBasic Guru
Posts: 16777133
Joined: Tue Apr 22, 2003 7:42 pm

Drag'n'Drop on a window

Post 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
BackupUser
PureBasic Guru
PureBasic Guru
Posts: 16777133
Joined: Tue Apr 22, 2003 7:42 pm

Post 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
BackupUser
PureBasic Guru
PureBasic Guru
Posts: 16777133
Joined: Tue Apr 22, 2003 7:42 pm

Post 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
BackupUser
PureBasic Guru
PureBasic Guru
Posts: 16777133
Joined: Tue Apr 22, 2003 7:42 pm

Post 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
BackupUser
PureBasic Guru
PureBasic Guru
Posts: 16777133
Joined: Tue Apr 22, 2003 7:42 pm

Post 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
BackupUser
PureBasic Guru
PureBasic Guru
Posts: 16777133
Joined: Tue Apr 22, 2003 7:42 pm

Post 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
User avatar
Flype
Addict
Addict
Posts: 1542
Joined: Tue Jul 22, 2003 5:02 pm
Location: In a long distant galaxy

Post by Flype »

it works well on win2k / xp
No programming language is perfect. There is not even a single best language.
There are only languages well suited or perhaps poorly suited for particular purposes. Herbert Mayer
LarsG
Enthusiast
Enthusiast
Posts: 713
Joined: Mon Jun 02, 2003 1:06 pm
Location: Norway
Contact:

Post 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
 

AMD Athlon XP2400, 512 MB RAM, Hercules 3D Prophet 9600 256MB RAM, WinXP
PIII 800MHz, 320 MB RAM, Nvidia Riva Tnt 2 Mach 64 (32MB), WinXP + Linux
17" iMac, 1.8 GHz G5, 512 MB DDR-RAM, 80 GB HD, 64 MB Geforce FX 5200, SuperDrive, OSX
User avatar
eddy
Addict
Addict
Posts: 1479
Joined: Mon May 26, 2003 3:07 pm
Location: Nantes

Post by eddy »

This code doesn't work with webgadget.
I see a shorcut icon instead of drag icon. :roll:
Imagewin10 x64 5.72 | IDE | PB plugin | Tools | Sprite | JSON | visual tool
User avatar
eddy
Addict
Addict
Posts: 1479
Joined: Mon May 26, 2003 3:07 pm
Location: Nantes

Post by eddy »

I've found the solution -> disabled webgadget
Imagewin10 x64 5.72 | IDE | PB plugin | Tools | Sprite | JSON | visual tool
User avatar
blueznl
PureBasic Expert
PureBasic Expert
Posts: 6161
Joined: Sat May 17, 2003 11:31 am
Contact:

Post by blueznl »

:-)
( PB6.00 LTS Win11 x64 Asrock AB350 Pro4 Ryzen 5 3600 32GB GTX1060 6GB)
( The path to enlightenment and the PureBasic Survival Guide right here... )
Post Reply