DragDropTx() for text-based gadgets (Windows)

Share your advanced PureBasic knowledge/code with the community.
User avatar
TI-994A
Addict
Addict
Posts: 2740
Joined: Sat Feb 19, 2011 3:47 am
Location: Singapore
Contact:

DragDropTx() for text-based gadgets (Windows)

Post by TI-994A »

Following a recent question here, I've noticed that PureBasic's drag & drop library does not natively support the StringGadget() or the TextGadget() fully. So, I decided to create a function to emulate this feature for those gadgets.

It supports any gadget that support the SetGadgetText() and GetGadgetText() functions, but it works only within the same application, and is Windows-only.

The entire drag & drop function is encapsulated into a single procedure, and could be easily plugged into any application, and simply called in the main events loop.

Tested with v5.21 x86 on WinXP and v5.22 x64 on Win7:

Code: Select all

;=================================================
;
;                 DragDropTx()
;
;             drag & drop emulator
;
;                     by
; 
;            TI-994A - 18th May 2014
;
;       developed in PureBasic 5.22 (x64)
;           on Windows 7 Home Premium
;       and tested in PureBasic 5.21 (x86)
;            on Windows XP Pro (SP3)
;
;      supports any gadget that support the
;  SetGadgetText() & GetGadgetText() functions    
;               (Windows only)                 
;
;         free to use, improve, share...
;
;=================================================
;***  DOES NOT SUPPORT GADGET NUMBER ZERO (0)  *** 
;=================================================

;=================================================
;DragDropTx() encapsulated into a single procedure
;=================================================
Procedure DragDropTx(event)
  Static gNo, grabNo, h_gNo, stdCursor, dragCursor, dropCursor, grabText.s
  
  If Not stdCursor Or Not dragCursor
    stdCursor = LoadCursor_(0, #IDC_ARROW)
    dragCursor = LoadCursor_(0, #IDC_NO)
    dropCursor = LoadCursor_(0, #IDC_HAND)
  EndIf
  
  Macro hoveringGadget(gNo)
    GetCursorPos_(cursor.POINT)
    gNo = WindowFromPoint_(PeekQ(@cursor))
    gNo = GetDlgCtrlID_(gNo)  
    If Not IsGadget(gNo)
      gNo = 0
    EndIf
  EndMacro
  
  Select event
    Case #WM_MOUSEMOVE
      If grabNo 
        hoveringGadget(h_gNo)
        If h_gNo
          SetCursor_(dropCursor)
        Else
          SetCursor_(dragCursor)
        EndIf
      EndIf
    Case #WM_LBUTTONDOWN
      hoveringGadget(gNo)
      If gNo
        grabText = GetGadgetText(gNo)
        If Trim(grabText) <> ""
          grabNo = gNo
          SetCursor_(dropCursor)
        EndIf
      EndIf
    Case #WM_LBUTTONUP
      If grabNo
        hoveringGadget(gNo)
        If gNo And gNo <> grabNo
          If GetAsyncKeyState_(#VK_CONTROL) & 32768
            swapText.s = GetGadgetText(gNo)
            SetGadgetText(grabNo, swapText)
          EndIf
          SetGadgetText(gNo, grabText)
        EndIf
        SetCursor_(stdCursor)
        grabText = ""
        grabNo = 0
        gNo = 0
      EndIf
  EndSelect
EndProcedure


;=========
;demo code
;=========
instructions.s = "Just left click on any of the above gadgets, drag the mouse to another "
instructions + "gadget, and release it. The text from the first gadget will be copied into "
instructions + "the second gadget." + #CRLF$ + #CRLF$ + "When dragging, the mouse cursor "
instructions + "will change to a HAND icon whenever it hovers over another gadget. However "
instructions + "this drag and drop function will work only with gadgets that support the " 
instructions + "SetGadgetText() and GetGadgetText() functions." + #CRLF$  + #CRLF$ + "Pressing "
instructions + "the control key on the keyboard before releasing it onto the second gadget "
instructions + "will cause the texts from the two gadgets to be swapped." + #CRLF$ + #CRLF$
instructions + "Due to the function structure, gadget number zero (0) is not supported."

wFlags = #PB_Window_SystemMenu | #PB_Window_ScreenCentered
OpenWindow(0, #PB_Any, #PB_Any, 400, 600, "DragDropTx() - drag & drop emulator by TI-994A", wFlags)
TextGadget(0, 20, 390, 360, 190, instructions)
TextGadget(1, 10, 10, 220, 30, "This is a TextGadget()", #SS_NOTIFY | #PB_Text_Border)
TextGadget(2, 10, 150, 220, 30, "This is another TextGadget()", #SS_NOTIFY | #PB_Text_Border)
StringGadget(3, 170, 230, 220, 30, "Some text on another StringGadget().")
StringGadget(4, 170, 60, 220, 30, "Some text on a StringGadget().")
ButtonGadget(5, 10, 320, 380, 30, "Drag My Caption Too!")
FrameGadget(6, 10, 370, 380, 220, " Instructions ")
SetGadgetColor(0, #PB_Gadget_FrontColor, RGB(150, 0, 0))

Repeat
  event = WaitWindowEvent() 
  Select event
    Case #PB_Event_CloseWindow
      appQuit = 1
    Case #WM_LBUTTONDOWN, #WM_LBUTTONUP, #WM_MOUSEMOVE
      DragDropTx(event)
  EndSelect
Until appQuit = 1
As always, suggestions, feedback, and improvements are most welcome. Thank you. :D

EDIT (19th May, 2014): Added a second cursor to indicate dragging. Thanks to KCC!
Last edited by TI-994A on Mon May 19, 2014 10:27 am, edited 1 time in total.
Texas Instruments TI-99/4A Home Computer: the first home computer with a 16bit processor, crammed into an 8bit architecture. Great hardware - Poor design - Wonderful BASIC engine. And it could talk too! Please visit my YouTube Channel :D
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5494
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: DragDropTx() for text-based gadgets (Windows)

Post by Kwai chang caine »

It's surelly normal, but the special cursor "drag/drop" not appear during the drag, other that, it's works very well :D
Thanks for sharing 8)
ImageThe happiness is a road...
Not a destination
User avatar
TI-994A
Addict
Addict
Posts: 2740
Joined: Sat Feb 19, 2011 3:47 am
Location: Singapore
Contact:

Re: DragDropTx() for text-based gadgets (Windows)

Post by TI-994A »

Kwaï chang caïne wrote:...the special cursor "drag/drop" not appear during the drag...
Hi KCC. You're right; I seem to have missed that. I've updated the code to include a separate cursor to indicate the dragging event.

Thank you for your valuable feedback! :D
Texas Instruments TI-99/4A Home Computer: the first home computer with a 16bit processor, crammed into an 8bit architecture. Great hardware - Poor design - Wonderful BASIC engine. And it could talk too! Please visit my YouTube Channel :D
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5494
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: DragDropTx() for text-based gadgets (Windows)

Post by Kwai chang caine »

Thanks for your reactivity 8)
I have try your new code and have always a mouse "prohibits parking" pointer, when i drag between two gadget :|
Inside the gadget i have the hand cursor...
ImageThe happiness is a road...
Not a destination
IdeasVacuum
Always Here
Always Here
Posts: 6426
Joined: Fri Oct 23, 2009 2:33 am
Location: Wales, UK
Contact:

Re: DragDropTx() for text-based gadgets (Windows)

Post by IdeasVacuum »

If the app were to crash for any reason, the User might end-up with the wrong cursor. So, the reset/recover the default cursor family:

Code: Select all

SystemParametersInfo_(#SPI_SETCURSORS,0,#Null,#Null)
LoadCursor is en route to retirement, replaced by LoadImage.
IdeasVacuum
If it sounds simple, you have not grasped the complexity.
User avatar
TI-994A
Addict
Addict
Posts: 2740
Joined: Sat Feb 19, 2011 3:47 am
Location: Singapore
Contact:

Re: DragDropTx() for text-based gadgets (Windows)

Post by TI-994A »

Kwaï chang caïne wrote:...mouse "prohibits parking" pointer, when i drag between two gadget :|
Inside the gadget i have the hand cursor...
Yes; the prohibits parking cursor = not drop zone and the hand cursor = drop zone. But you can change them to any cursor of your choice; I've used Windows stock cursors for convenience. :)
Texas Instruments TI-99/4A Home Computer: the first home computer with a 16bit processor, crammed into an 8bit architecture. Great hardware - Poor design - Wonderful BASIC engine. And it could talk too! Please visit my YouTube Channel :D
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5494
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: DragDropTx() for text-based gadgets (Windows)

Post by Kwai chang caine »

Ok thanks, i have understand now :wink:
ImageThe happiness is a road...
Not a destination
User avatar
TI-994A
Addict
Addict
Posts: 2740
Joined: Sat Feb 19, 2011 3:47 am
Location: Singapore
Contact:

Re: DragDropTx() for text-based gadgets (Windows)

Post by TI-994A »

IdeasVacuum wrote:If the app were to crash for any reason, the User might end-up with the wrong cursor...
Hi IdeasVacuum. I believe that there's no risk of that here.

The SetCursor() API function has no bearing outside of application windows, and in fact does not even override the class cursors. If it is not constantly called during the WM_MOUSEMOVE or WM_SETCURSOR events, it will automatically revert to its default class cursor. To override the class cursor, the SetClassLong() function should be used, with the GCL_HCURSOR index; but even then, the setting is still not system-wide.

For a system-wide change, the SetSystemCursor() API function is needed, and only then should the system's SPI_SETCURSORS parameter be reset, to reload the default system cursors.

So, no risk of being stuck with the wrong cursor. :)
IdeasVacuum wrote:LoadCursor is en route to retirement, replaced by LoadImage.
You're right. As Microsoft puts it, this function has been superseded. But it has been superseded for well over a decade now, and they've still not deprecated it. It's much easier to use than the LoadImage() API function, so perhaps not much risk in using it for the time being. :wink:
Texas Instruments TI-99/4A Home Computer: the first home computer with a 16bit processor, crammed into an 8bit architecture. Great hardware - Poor design - Wonderful BASIC engine. And it could talk too! Please visit my YouTube Channel :D
Post Reply