**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
I'll add a more complex example later.