Tree gadget drag and drop (uses EasyVENT).

Share your advanced PureBasic knowledge/code with the community.
srod
PureBasic Expert
PureBasic Expert
Posts: 10589
Joined: Wed Oct 29, 2003 4:35 pm
Location: Beyond the pale...

Tree gadget drag and drop (uses EasyVENT).

Post by srod »

Code updated For 5.20+
**Bug fixed: 2nd September 2006.

Hi,

EasyVENT's internal drag and drop routines avoid the use of ImageLists because of certain known problems with ListIcon gadgets on certain machines (typically those with a bunch of Visual Basic runtime ocx's).

However, whilst EasyVENT's internal routines allow dragging to and from any gadget, only text can be dragged at present.

This demo shows how to make use of EasyVENT to assist in using the Windows ImageDrag functions for tree gadgets. This of course means you can drag images etc.

Thanks to kiffi who kindly offered his work for the basis of this example.

Code: Select all

;EasyVENT demonstration program - ImageList drag and drop 1.
;By Kiffi and srod.
;*********************************************************************************
;DEMONSTRATES THE FOLLOWING EVENTS:
;  #OnMouseDown, #OnMouseOver, #OnMouseUp
;*********************************************************************************
;
;EasyVENT's internal drag and drop routines avoid the use of ImageLists because of
;certain known problems with ListIcon gadgets on certain machines.
;However, whilst EasyVENT's internal routines allow dragging to and from any gadget,
;only text can be dragged at present.

;This demo shows how to make use of EasyVENT to assist in using the Windows ImageDrag functions
;for tree gadgets. This of course means you can drag images etc.

;*********************************************************************************



XIncludeFile "EasyVENT.pbi" 

#myWindow = 0 
#TG = 1 

Declare.l DragItem(*sender.PB_Sender) 
Declare.l DropItem(*sender.PB_Sender) 
Declare.l DragOver(*sender.PB_Sender) 

Define Event.l, i 

Global DragItem.l 
Global hDragIml.l 

OpenWindow(#myWindow, 100, 100, 300, 400, "EasyVENT ImageList drag and drop 1.", #PB_Window_SystemMenu |#PB_Window_MinimizeGadget|#PB_Window_MaximizeGadget| #PB_Window_ScreenCentered) 

TreeGadget(#TG,10,10,280,280) 

Define myIcon = LoadImage(#PB_Any, "icon.ico") ; Please use your own icon! 

For i = 1 To 10 
  AddGadgetItem(#TG, -1, "TreeNode " + Str(i),ImageID(myIcon)) 
Next 

;Set event handlers. 
SetEventHandler(GadgetID(#TG), #OnMouseDown, @DragItem()) 
;NOTICE THE FOLLOWING HAVE TO BE DIRECTED TO THE MAIN WINDOW BECAUSE OF THE 'SetCapture()' etc.
SetEventHandler(WindowID(#myWindow), #OnMouseOver,  @DragOver()) 
SetEventHandler(WindowID(#myWindow), #OnMouseUp,   @DropItem()) 

Repeat 
  Event = WaitWindowEvent() 
Until Event = #PB_Event_CloseWindow 

End 

;********************************************************************************* 
;                                 EVENT HANDLERS 
;********************************************************************************* 

Procedure.l DragItem(*sender.PB_Sender) 
  Protected HTI.TV_HITTESTINFO
;First check that the cursor is over a label or its icon, not a checkbox etc.
  HTI\pt\x=*sender\mousex
  HTI\pt\y=*sender\mousey
  SendMessage_(GadgetID(#TG), #TVM_HITTEST, 0, HTI) 
  If hti\flags = #TVHT_ONITEMICON Or hti\flags=#TVHT_ONITEMLABEL
;Identify item to drag.
    DragItem = GadgetItemID(#TG,GetGadgetState(#TG)) 
; Create drag imagelist 
    hDragIml =  SendMessage_(*sender\hwnd, #TVM_CREATEDRAGIMAGE, 0, DragItem)
    If hDragIml
;Instigate drag.
      ImageList_BeginDrag_(hDragIml, 0, 0, 0) 
      ImageList_DragEnter_(GetParent_(*sender\hwnd), 0, 0) 
      ImageList_DragShowNolock_(#True) 
      ImageList_DragLeave_(*sender\hwnd) 
      ShowCursor_(#False) 
;IMPORTANT, THE FOLLOWING COMMAND WILL RESULT IN ALL FUTURE MOUSE EVENTS BEING DIRECTED TO
;THE MAIN WINDOW AND NOT THE TREE GADGET!
      SetCapture_(GetParent_(*sender\hwnd))
    Else 
      DragItem=0
    EndIf
  EndIf
  ProcedureReturn #PB_ProcessPureBasicEvents 
EndProcedure 


;The following is attached to the main window, NOT the Tree gadget.
Procedure.l DragOver(*sender.PB_Sender) 
  Protected pt.POINT
  If hDragIml
;Check if the mouse button is down.
;This is a 'fix' due to not using the proper Windows Drag image notification messages.
    If GetAsyncKeyState_(#VK_LBUTTON)&32768<>32768
      ImageList_EndDrag_() 
      ReleaseCapture_() 
      ShowCursor_(#True) 
      ImageList_Destroy_(hDragIml) 
      hDragIml = 0 : DragItem = 0 
      ProcedureReturn #PB_ProcessPureBasicEvents 
    EndIf

    GetCursorPos_(pt)
;The following command requires coordinates relative to the main window (not its client area).
    ImageList_DragMove_(pt\x-WindowX(#myWindow), pt\y-WindowY(#myWindow)) 
;***
  EndIf
  ProcedureReturn #PB_ProcessPureBasicEvents 
EndProcedure 


;The following is attached to the main window, NOT the Tree gadget.
Procedure.l DropItem(*sender.PB_Sender) 
  If hDragIml
    ImageList_EndDrag_() 
    ReleaseCapture_() 
    ShowCursor_(#True) 
    ImageList_Destroy_(hDragIml) 
 
;INSERT CODE FOR PROCESSING THE RESULTS OF THE DROP! 

    hDragIml = 0 : DragItem = 0 
  EndIf 
  ProcedureReturn #PB_ProcessPureBasicEvents 
EndProcedure
and then don't forget to destroy this image list at close of program.

I'll add a more complex example later.
I may look like a mule, but I'm not a complete ass.
clipper
User
User
Posts: 44
Joined: Fri Aug 29, 2003 7:47 am
Location: Germany

Post by clipper »

Here my PB4 solution to enable drag´n drop from a ListIconGadget to a TreeGadget.
It is the modified Drag and drop items 4 Example from the EasyVENT Package by srod (Thanks a lot srod)

Code: Select all

;EasyVENT demonstration program - Drag and drop items 5 (more complex example!)
;*********************************************************************************
;DEMONSTRATES THE FOLLOWING EVENTS:
;  #OnStartDragItem, #OnDragOver, #OnEndDragItem
;
;This demo shows how to drag items between 1 ListIcongadget and 1 Treegadget. This is usually very fiddly,
;but EasyVENT makes it somewhat easier!
;The Win API is used to highlight the target item beneath the cursor etc,
;Formerly Drag and drop items 4 edited by Clipper
;*********************************************************************************



;ESSENTIAL INCLUDE.
;*********************************************************************************
XIncludeFile "EasyVENT.pbi"
;*********************************************************************************

Declare.l DragOverWindow(*sender.PB_Sender)
Declare.l DragItem(*sender.PB_Sender)
Declare.l DropItem(*sender.PB_Sender)
Declare.l DragOver(*sender.PB_Sender)

Declare HighLightSelection(hWnd, state)

Define Event.l, i

Global gTargetitem ;Denotes which item we are dropping on.

OpenWindow(0, 100, 100, 360, 200, "EasyVENT drag and drop items demo 5.", #PB_Window_SystemMenu |#PB_Window_MinimizeGadget|#PB_Window_MaximizeGadget| #PB_Window_ScreenCentered)
  CreateGadgetList(WindowID(0))
  ListIconGadget(1,10,10,150,150,"Drag from",120) 
  TreeGadget(2,200,10,150,150)
    CreateImage(0,16,16)
    StartDrawing(ImageOutput(0))
      Box(0,0,16,16,RGB(255,255,255))
      Box(4,4,8,8,RGB(255,0,0))
    StopDrawing()

    For i = 1 To 10
      AddGadgetItem(1, -1, "Listgadgetitem " + Str(i),0)
      If i < 6
        AddGadgetItem(2, -1, "Treegadgetitem " + Str(i),ImageID(0))
      EndIf
    Next
    For i=1 To 5
       AddGadgetItem(2, 2, "Treegadgetsubitem " + Str(i),0,1)
    Next
  CheckBoxGadget(3, 200, 166, 150, 20, "Insert dropped Item as Child")
;Set event handlers.
  SetEventHandler(GadgetID(1), #OnDragItemStart, @DragItem())
  SetEventHandler(GadgetID(2), #OnDragItemOver,  @DragOver())
  SetEventHandler(GadgetID(2), #OnDragItemEnd,   @DropItem())
  SetEventHandler(WindowID(0), #OnDragItemOver,  @DragOverWindow())

SetActiveGadget(1)
Repeat
  Event = WaitWindowEvent()
Until Event = #PB_Event_CloseWindow
End


;*********************************************************************************
;                                 EVENT HANDLERS
;*********************************************************************************

;The following ensures that any highlighted item in the target control is removed
;whenever the cursor leaves the control.
Procedure.l DragOverWindow(*sender.PB_Sender)
;Remove any selection highlight already in place.
  HighLightSelection(GadgetID(2), 0)
ProcedureReturn #PB_ProcessPureBasicEvents
EndProcedure

;Here we simply return #PB_ProcessPureBasicEvents to enable the drag.
Procedure.l DragItem(*sender.PB_Sender)
  If GetActiveGadget()=1 And GetGadgetState(1)>=0
    *sender\text$=GetGadgetText(1)
  EndIf
ProcedureReturn #PB_ProcessPureBasicEvents
EndProcedure

;Since the following handles only one gadget, we need not check which control etc.
Procedure.l DropItem(*sender.PB_Sender)
;First remove any selection highlight already in place.
  HighLightSelection(*sender\hWnd, 0)
  lpis.TV_INSERTSTRUCT
  
    ; Set the openflag if you want to add the Item as a child node
  openflag.l=GetGadgetState(3) 

  If openflag 
    pitem.TV_ITEM
    pitem\mask = #TVIF_CHILDREN | #TVIF_HANDLE
    pitem\hItem = gTargetitem
    pitem\cChildren = 1
    SendMessage_(*sender\hWnd, #TVM_SETITEM, 0, @pitem)
    lpis\hParent = gTargetitem
    lpis\hInsertAfter = gTargetitem
  Else 
    lpis\hParent = SendMessage_(*sender\hWnd, #TVM_GETNEXTITEM, #TVGN_PARENT, gTargetitem)
    lpis\hInsertAfter = gTargetitem
  EndIf
  text.s=GetGadgetText(1)
  lpis\item\mask = #TVIF_TEXT | #TVIF_IMAGE | #TVIF_SELECTEDIMAGE 
  lpis\item\iImage = 1
  lpis\item\iSelectedImage =  1
  lpis\item\cchTextMax = Len(text)
  lpis\item\pszText = @text
  SendMessage_(*sender\hWnd, #TVM_INSERTITEM, 0, @lpis)
  RemoveGadgetItem(1,*sender\item) ;Remove item from ListIcon.
ProcedureReturn #PB_ProcessPureBasicEvents
EndProcedure

Procedure.l DragOver(*sender.PB_Sender)
  Protected hittestinfo.LV_HITTESTINFO
;First remove any selection highlight already in place.
  HighLightSelection(*sender\hWnd, 0)
;Find which item we are currently hovering over. We need an API call for this.
  hittestinfo\pt\x = *sender\mousex
  hittestinfo\pt\y = *sender\mousey
  gTargetitem = SendMessage_(*sender\hWnd, #TVM_HITTEST, 0, @hittestinfo)            
;Highlight the new item
  If gTargetitem<>-1
     HighLightSelection(*sender\hWnd, #TVIS_DROPHILITED)
  EndIf
  ProcedureReturn #PB_ProcessPureBasicEvents
EndProcedure

;*********************************************************************************
;                              END OF EVENT HANDLERS
;*********************************************************************************


;The following utility either highlights the target item or removes the highlight etc.
Procedure HighLightSelection(hWnd, state)
  Protected pitem.TV_ITEM
    pitem\mask = #TVIF_STATE
    pitem\hItem = gTargetitem
    pitem\state = state
    pitem\stateMask = #TVIS_DROPHILITED
    SendMessage_(hWnd, #TVM_SETITEM, 0, @pitem)
    RedrawWindow_(hWnd, 0, 0, #RDW_UPDATENOW)
EndProcedure
Last edited by clipper on Mon Sep 18, 2006 3:09 pm, edited 1 time in total.
srod
PureBasic Expert
PureBasic Expert
Posts: 10589
Joined: Wed Oct 29, 2003 4:35 pm
Location: Beyond the pale...

Post by srod »

Nice one clipper. :)

I've added this to the EasyVENT download (with your permission pending of course!)
I may look like a mule, but I'm not a complete ass.
User avatar
Fangbeast
PureBasic Protozoa
PureBasic Protozoa
Posts: 4791
Joined: Fri Apr 25, 2003 3:08 pm
Location: Not Sydney!!! (Bad water, no goats)

@srod Heeeeeelp!!

Post by Fangbeast »

I copied your code in your easyvent library to drag files from anywhere to a listicongadget and found a problem.

My form has an imagegadget as a background (jsut to look pretty) and then a listicongadget on top of that. The listicongadget will not accept any files this way.

If I turn off the imagegadget background, it works. Is there any way around this? ( I am planning multiple imagegadget backgrounds to give my 'drop window' a certains tyle)

Code: Select all

;============================================================================================================================
; Constants (Visual designer created)
;============================================================================================================================

Enumeration 1
  #Window_drop
EndEnumeration

#WindowIndex = #PB_Compiler_EnumerationValue

Enumeration 1
  #Gadget_drop_background
  #Gadget_drop_filelist
EndEnumeration

#GadgetIndex = #PB_Compiler_EnumerationValue

Enumeration 1
  #Image_drop_background
EndEnumeration

#ImageIndex = #PB_Compiler_EnumerationValue

CatchImage(#Image_drop_background, ?_OPT_drop_background)

DataSection
  _OPT_drop_background : IncludeBinary "Images\Grand Canyon.BMP"
EndDataSection

;============================================================================================================================
; Windows (Visual designer created)
;============================================================================================================================

Procedure.l Window_drop()
  If OpenWindow(#Window_drop,88,88,400,300,"Drag and Drop test",#PB_Window_SystemMenu|#PB_Window_ScreenCentered|#PB_Window_Invisible)
    If CreateGadgetList(WindowID(#Window_drop))
      ImageGadget(#Gadget_drop_background,0,0,400,300,ImageID(#Image_drop_background),#PB_Image_Border)
      ResizeGadget(#Gadget_drop_background,0,0,400,300)
      ResizeImage(#Image_drop_background,400,300)
      SetGadgetState(#Gadget_drop_background,ImageID(#Image_drop_background))
      ListIconGadget(#Gadget_drop_filelist,30,30,340,240,"File names",336,#PB_ListIcon_MultiSelect|#PB_ListIcon_FullRowSelect|#PB_ListIcon_AlwaysShowSelection)
      HideWindow(#Window_drop,0)
      ProcedureReturn WindowID(#Window_drop)
    EndIf
  EndIf
EndProcedure

;============================================================================================================================
; Myconstants
;============================================================================================================================

Define quitdrop

;============================================================================================================================
; Any included files needed
;============================================================================================================================

XIncludeFile "EasyVENT.pbi"

;============================================================================================================================
; Mydeclarations
;============================================================================================================================

Declare.l DragDrop(*sender.PB_Sender)
Declare.l SelectItem(*sender.PB_Sender)

;============================================================================================================================
; *sender\item holds the number of filenames dropped. *sender\wParam holds the windows handle of the underlying drop structure.
;============================================================================================================================

Procedure.l DragDrop(*sender.PB_Sender)
  Protected numfiles, i, buffer$
  numfiles = *sender\item
  For i = 0 To numfiles - 1 
    buffer$ = Space(DragQueryFile_(*sender\wParam, i, 0, 0) + 1) ; This will hold individual filenames. Get next filename.
    DragQueryFile_ (*sender\wParam, i, buffer$, Len(buffer$)) 
    AddGadgetItem(#Gadget_drop_filelist, -1, buffer$)            ; Now add filename to the ListIcon gadget.
  Next 
ProcedureReturn #PB_ProcessPureBasicEvents
EndProcedure

;============================================================================================================================
; 
;============================================================================================================================

Procedure.l SelectItem(*sender.PB_Sender)
  If *sender\state = #EVENT_DESELECT
    Debug "Deselecting: " + Str(*sender\item)
  Else                                                ; This means that *sender\state = #EVENT_SELECT
    Debug "Selecting: " + Str(*sender\item)
  EndIf
ProcedureReturn #PB_ProcessPureBasicEvents
EndProcedure

;============================================================================================================================
; 
;============================================================================================================================

If Window_drop()

  quitdrop = 0

  SetEventHandler(GadgetID(#Gadget_drop_filelist), #OnDragDrop,     @DragDrop())
  SetEventHandler(GadgetID(#Gadget_drop_filelist), #OnItemSelected, @SelectItem())

  Repeat

    Select WaitWindowEvent()
      Case #PB_Event_CloseWindow
        If EventWindow() = #Window_drop
          quitdrop = 1
        EndIf
;       Case #PB_Event_Gadget
;         Select EventGadget()
;           Case #Gadget_drop_filelist
;             Select EventType()
;               Case #PB_EventType_LeftDoubleClick
;               Case #PB_EventType_RightDoubleClick
;               Case #PB_EventType_RightClick
;               Default
;             EndSelect
;         EndSelect
    EndSelect
  Until quitdrop
  CloseWindow(#Window_drop)
EndIf
End

srod
PureBasic Expert
PureBasic Expert
Posts: 10589
Joined: Wed Oct 29, 2003 4:35 pm
Location: Beyond the pale...

Post by srod »

The image gadget is swallowing all of the mouse messages.
At the end of the day Windows decides which control is the target of the drop and the way EasyVENT is set up, mouse messages from static controls will always be intercepted.

The solution is easy however. You've 3 options.
  • Make the listicon a child of the image gadget.
  • target the image gadget with the drop and then test whether the cursor is within the bounds of the listicon.
  • disable the image gadget with

    Code: Select all

    DisableGadget(#Gadget_drop_background,1)
    
The 3rd option is by far the better one!
I may look like a mule, but I'm not a complete ass.
User avatar
Fangbeast
PureBasic Protozoa
PureBasic Protozoa
Posts: 4791
Joined: Fri Apr 25, 2003 3:08 pm
Location: Not Sydney!!! (Bad water, no goats)

Thank you!

Post by Fangbeast »

/me dances around the room. It would never have occurred to me, not having the relevant brain cells (Stolen by pupil last year) and not knowing the api.

Thank you, works like a cracker and still looks good. Now I can extend my picture store program and make it better.

Woohoo!!
srod
PureBasic Expert
PureBasic Expert
Posts: 10589
Joined: Wed Oct 29, 2003 4:35 pm
Location: Beyond the pale...

Post by srod »

:lol:
I may look like a mule, but I'm not a complete ass.
Post Reply