Drag-n-Drop with image

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...

Drag-n-Drop with image

Post by srod »

**EDIT : code altered to remove massive flickering when dragging due to change of focus.

Hi,

ages ago (when the drag-drop lib was first added to PB), I hacked up a demo which showed one way of displaying an image whilst dragging some text. Now that I finally get around to making use of that code, I find that it does not work very well (since it attempts to draw atop windows containing controls etc. which is a very 'dodgy' thing to attempt!)

Here is a better (and simpler) method which uses a layered window (Win 2000 onwards) as the basis for the drag image. It seems to work a lot better than my first attempt, though admittedly I haven't tested a great deal as yet (that will change when I integrate this into the application I am working on) :

Code: Select all

Declare.i DragCallBack(Action)

;A couple of global fields for use when dragging our image window.
  Structure _drag
    winDrag.i
    width.i
    height.i
  EndStructure

  Global gDrag._drag


If OpenWindow(0,0,0,480,400,"Drag with image!",#PB_Window_ScreenCentered|#PB_Window_SystemMenu) 
  ListIconGadget(0,20,20,200,300,"Drag from", 195, #PB_ListIcon_FullRowSelect) 
  ListIconGadget(1,250,20,200,300,"Drag to", 195, #PB_ListIcon_FullRowSelect) 

  For i = 0 To 99
    AddGadgetItem(0, -1, "Row "+Str(i)) 
    AddGadgetItem(1, -1, "Row "+Str(i)) 
  Next
  EnableGadgetDrop(1,#PB_Drop_Text, #PB_Drag_Copy) 

  Repeat 
    eventID = WaitWindowEvent() 
    Select eventID 
      Case #PB_Event_GadgetDrop 
        If EventGadget() =1
          AddGadgetItem(EventGadget(), GetGadgetState(EventGadget()), EventDropText()) 
        EndIf
      Case #PB_Event_Gadget 
        If EventType() = #PB_EventType_DragStart  And EventGadget()=0
          dragrow = GetGadgetState(EventGadget()) 
          dragtxt.s = GetGadgetItemText(EventGadget(), dragrow) 
          draggadget = EventGadget() 
          ;Create drag image window.
            If StartDrawing(WindowOutput(0))
              DrawingFont(GetGadgetFont(draggadget))
              gDrag\width = TextWidth(dragtxt)
              gDrag\height = TextHeight(dragtxt)
              StopDrawing()
              imageID = CreateImage(#PB_Any, gDrag\width, gDrag\height)
             If imageID
                If StartDrawing(ImageOutput(imageID))
                  Box(0, 0, gDrag\width, gDrag\height, #White)
                  DrawingFont(GetGadgetFont(draggadget))
                  DrawingMode(#PB_2DDrawing_Transparent)
                  DrawText(0,0,dragtxt,#Black)
                  StopDrawing()
                  hBrush = CreatePatternBrush_(ImageID(imageID))
                  If hBrush
                    gDrag\winDrag = OpenWindow(#PB_Any, 0, 0, 0, 0, "", #PB_Window_BorderLess|#PB_Window_NoGadgets, WindowID(0))
                    If gDrag\winDrag 
                      hWnd = WindowID(gDrag\winDrag)
                      SetWindowLong_(hWnd, #GWL_EXSTYLE, GetWindowLong_(hWnd, #GWL_EXSTYLE) | #WS_EX_LAYERED) 
                      SetLayeredWindowAttributes_(hWnd, #White, 180, #LWA_COLORKEY|#LWA_ALPHA) 
                      ;We enable drops (mimicking our intended drop type) on this window so that the drag cursor behaves itself!
                        EnableWindowDrop(gDrag\winDrag, #PB_Drop_Text, #PB_Drag_Copy) 
                      SetClassLongPtr_(hWnd, #GCL_HBRBACKGROUND, hBrush)
                      ;Instigate the drag.
                        SetDragCallback(@DragCallBack())
                        SetFocus_(GadgetID(0))
                        DragText(dragtxt, #PB_Drag_Copy) 
                      ;Now tidy up.
                        CloseWindow(gDrag\winDrag)
                    EndIf
                    DeleteObject_(hBrush)
                  EndIf
                EndIf
                FreeImage(imageID)
              EndIf
          EndIf
        EndIf 
  EndSelect 
  Until eventID = #PB_Event_CloseWindow 
EndIf


Procedure.i DragCallBack(Action)
  Protected pt.point, rc.RECT, top
  GetCursorPos_(pt)
  GetWindowRect_(GadgetID(1), rc)
  If PtInRect_(rc, pt\x + pt\y<<32)
    ResizeWindow(gDrag\winDrag, pt\x, pt\y, gDrag\width, gDrag\height)
  Else
    ResizeWindow(gDrag\winDrag, 0, 0, 0, 0)
  EndIf
  ProcedureReturn 1
EndProcedure
This code is a bit rough and ready and will undoubtedly need some tarting up before it can be used within a serious app.

:)
Last edited by srod on Sat Jun 19, 2010 7:52 pm, edited 1 time in total.
I may look like a mule, but I'm not a complete ass.
User avatar
netmaestro
PureBasic Bullfrog
PureBasic Bullfrog
Posts: 8433
Joined: Wed Jul 06, 2005 5:42 am
Location: Fort Nelson, BC, Canada

Re: Drag-n-Drop with image

Post by netmaestro »

Firstly, let me say good job. Secondly, it's kind of rough. The reason is the layered window and #LWA_COLORKEY. This unfortunately plays hell with the antialias on your text when it's shown against a selected item. I was able to clean it up by using a slightly different approach:

Code: Select all

Declare.i DragCallBack(Action)

;A couple of global fields for use when dragging our image window.
Structure _drag
  winDrag.i
  isHidden.i
  wdfont.i
  wdwidth.i
  wdheight.i
  wdimage.i
  wdig.i
  text.s
EndStructure

Global gDrag._drag

If OpenWindow(0,0,0,480,400,"Drag with image!",#PB_Window_ScreenCentered|#PB_Window_SystemMenu) 
  ListIconGadget(0,20,20,200,300,"Drag from", 195, #PB_ListIcon_FullRowSelect) 
  ListIconGadget(1,250,20,200,300,"Drag to", 195, #PB_ListIcon_FullRowSelect) 
  
  For i = 0 To 99
    AddGadgetItem(0, -1, "Row "+Str(i)) 
    AddGadgetItem(1, -1, "Row "+Str(i)) 
  Next
  EnableGadgetDrop(1,#PB_Drop_Text, #PB_Drag_Copy) 
  
  Repeat 
    eventID = WaitWindowEvent() 
    Select eventID 
      Case #PB_Event_GadgetDrop 
        If EventGadget() = 1
          AddGadgetItem(EventGadget(), GetGadgetState(EventGadget()), EventDropText()) 
        EndIf
      Case #PB_Event_Gadget 
        If EventType() = #PB_EventType_DragStart  And EventGadget()=0
          dragrow = GetGadgetState(EventGadget()) 
          dragtxt.s = GetGadgetItemText(EventGadget(), dragrow) 
          draggadget = EventGadget() 
          ;Create drag image window.
          StartDrawing(WindowOutput(0))
            DrawingFont(GetGadgetFont(draggadget))
            width = TextWidth(dragtxt) : height = TextHeight(dragtxt)
          StopDrawing()
          oldgadgetlist = UseGadgetList(0)
          With gDrag
            \winDrag  = OpenWindow(#PB_Any, 0, 0, width, height, "", #PB_Window_BorderLess|#PB_Window_Invisible)
            \isHidden = #True
            \wdwidth  = width
            \wdheight = height
            \wdfont   = GetGadgetFont(draggadget)
            \wdimage  = CreateImage(#PB_Any, width,height,24)
            \text     = dragtxt
         EndWith
         
          UseGadgetList( WindowID(gDrag\winDrag))
          gDrag\wdig = ImageGadget(#PB_Any,0,0,width,height,0)
          UseGadgetList(oldgadgetlist)
         
          ;We enable drops (mimicking our intended drop type) on this window so that the drag cursor behaves itself!
          EnableWindowDrop(gDrag\winDrag, #PB_Drop_Text, #PB_Drag_Copy) 
          SetClassLongPtr_(hWnd, #GCL_HBRBACKGROUND, hBrush)
          ;Instigate the drag.
          SetDragCallback(@DragCallBack())
          DragText(dragtxt, #PB_Drag_Copy) 
          ;Now tidy up.
          CloseWindow(gDrag\winDrag)
          FreeImage(gDrag\wdimage)
        EndIf 
        
    EndSelect 
  Until eventID = #PB_Event_CloseWindow 
EndIf


Procedure.i DragCallBack(Action)
  Protected pt.point, rc.RECT, top
  GetCursorPos_(pt)
  GetWindowRect_(GadgetID(1), rc)
  If PtInRect_(rc, pt\x + pt\y<<32)
    If gDrag\isHidden
      HideWindow(gDrag\winDrag, 0)
      gDrag\isHidden=#False
    EndIf
    target = WindowFromPoint_(pt\x|(pt\y<<32))
    hdcin = GetDC_(target)
    hdcout = StartDrawing(ImageOutput(gDrag\wdimage))
      mappedpt.POINT = pt
      ScreenToClient_(target, mappedpt)
      BitBlt_(hdcout,0,0,gDrag\wdwidth,gDrag\wdheight,hdcin,mappedpt\x+1,mappedpt\y,#SRCCOPY)
      ReleaseDC_(target,hdcin)
      DrawingFont(gDrag\wdfont)
      DrawingMode(#PB_2DDrawing_Transparent )
      DrawText(0,0,gDrag\text, #Black)
    StopDrawing()
    SetGadgetState(gDrag\wdig, ImageID(gDrag\wdimage))
    ResizeWindow(gDrag\winDrag, pt\x+1, pt\y, #PB_Ignore, #PB_Ignore)
  Else
    If gDrag\isHidden = #False
      HideWindow(gDrag\winDrag, 1)
      gDrag\isHidden=#True
    EndIf
  EndIf
  ProcedureReturn 1
EndProcedure
Ideally, what I'd like to see is the text rendered white-on-nonwhite and black-on-white in two tones. I made some tries with UpdateLayeredWindow, but eventually concluded that gdi is not geared for 32bit depths and it just can't handle the task. I'm sure the goal could be accomplished by tapping into gdi+, but that seems a bit like overkill for such a simple implementation. I'm still mulling over a couple of simpler approaches though, I'll post if something occurs (and works).
BERESHEIT
srod
PureBasic Expert
PureBasic Expert
Posts: 10589
Joined: Wed Oct 29, 2003 4:35 pm
Location: Beyond the pale...

Re: Drag-n-Drop with image

Post by srod »

Interesting. I never noticed the anti-aliasing problem! :) It is obvious now that I think about it of course and I see how you've gotten around it, - very nicely done there.

This problem can be lessened, to some extent, by setting an alpha transparency value as well. I have done this with my above code and also fixed the massive flicker due to switching focus etc. by removing the HideWindow() function. You should do this with your code as well.

An interesting approach netty for sure. It certainly fixes the anti-alias problem, but there is a rather obtrusive flicker behind the drag text here when I drag the image over a selected item.

Personally, I can live with the anti-alias and, as luck would have it, it will not be such a problem in my application anyhow. :) Then again, in my app I can draw the drag text directly to the control upon which we are dropping anyhow (bypassing the layered window completely) and that will kill the anti-alias problem dead! :)
I may look like a mule, but I'm not a complete ass.
ozzie
Enthusiast
Enthusiast
Posts: 429
Joined: Sun Apr 06, 2008 12:54 pm
Location: Brisbane, Qld, Australia
Contact:

Re: Drag-n-Drop with image

Post by ozzie »

I know this topic was posted years ago, but it's exactly what I've been looking for and it works well (with just a minor tweak). Many thanks!
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5353
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: Drag-n-Drop with image

Post by Kwai chang caine »

Yes, never too late for the thanking
Thanks at this two great MASTERS for this sharing 8)
ImageThe happiness is a road...
Not a destination
Post Reply