Drag'n'Drop

[Xaby]

Kann mir jemand helfen?

Im Codearchive hab ich mir folgenden Code angeschaut:

Drag & Drop example with ListIconGadget
; By Timo 'fr34k' Harter
Tutorial.

Auch einige der anderen Drag'n'Drop Codes.
Ebenso das Datei-Drag'n'Droppen in ein Gadget.

Nun meine Frage:

Was muss ich machen, wenn ich ein ListviewGadget (oder was auch immer) habe, und daraus etwas ziehen möchte, was ich zum Beispiel in einem anderen Programm, meinetwegen wieder ein Programm mit ListviewGadget ... benutzen möchte.

Ich möchte eine Art Dateianzeiger machen.
So wie man es vom Arbeitsplatz her kennt.

Man kann so viele Arbeitsplätze öffnen, wie man möchte, und Dateien unter einander verschieben.

Mir würde es schon reichen, wenn ich eine Datei in mein Gadget ziehe, dass diese als Item angezeigt wird:

Da habe ich diesen Code gefunden und mit dem oben genannten gemischt.

Code: Alles auswählen

; French forum: http://www.serveurperso.com/~cederavic/forum/viewtopic.php?t=239
; Author: Le Soldat Inconnu (updated for PB 4.00 by Andre)
; Date: 29. August 2003
; OS: Windows
; Demo: No


; Drag'n'Drop into a ListIcon

Global IsDraging, DragImageList, SourceGadget, SourceItem, TargetGadget, TargetItem 
 
Declare WindowCallback(Window, message, wParam, lParam) 
 

Procedure.l Triage(Liste.l, Colonne.l, File.s) 
  
  File = "#\" + LCase(File) 
  Path.s = GetPathPart(Left(File, Len(File) - 1)) 
  Debug "Path = " + Path 
  ExistPath.s = "" 
  Index = 1 
  Depart = 0 
  NbElement = CountGadgetItems(Liste) - 1 
  Fin = NbElement 
  Debug Depart 
  Debug Fin  

  Repeat 
    Partie1.s = StringField(Path, Index, "\") 
    Debug "Partie1 = " + Partie1 
    If Partie1 <> "" 
      Test_Ok = 0 
      For n = Depart To Fin 
        File2.s = LCase("#\" + GetGadgetItemText(Liste, n, Colonne)) 
        Debug "File2 = " + File2 
        Partie2.s = StringField(GetPathPart(File2), Index, "\") 
        Debug "Partie2 = " + Partie2 + "   (index="+ Str(Index) + ")" 
        If Test_Ok = 0 And Partie1 = Partie2 
          Test_Ok = 1 
          Depart2 = n 
        EndIf 
        If Partie1 = Partie2 
          Fin2 = n 
        EndIf 
      Next 
      Debug "Depart2 = " + Str(Depart2) 
      Debug "Fin2 = " + Str(Fin2) 
      Depart = Depart2 
      Fin = Fin2 
    EndIf 
    ExistPath2.s = ExistPath + Partie1 + "\" 
    If Partie1 <> "" And FindString(LCase("#\" + GetGadgetItemText(Liste, Depart, Colonne)), ExistPath2, 1) = 1 
      ExistPath = ExistPath2 
      Index + 1 
    EndIf 
  Until Partie1 = "" Or FindString(LCase("#\" + GetGadgetItemText(Liste, Depart, Colonne)), ExistPath2, 1) = 0 
  
  ; On affiche ici les résultats de la première partie de l'algo 
  Debug ">> Depart = " + Str(Depart) 
  Debug ">> Fin = " + Str(Fin) 
  Debug ">> ExistPath = " + ExistPath 
   
  Partie1.s = StringField(File, Index, "\") 
  Type1.s = Mid(File, Len(ExistPath + Partie1) + 1, 1) 
  Debug "Index = " + Str(Index) 
  Debug "Partie1 = " + Partie1 
  Debug File 
  Debug ExistPath + Partie1 
  Debug "Type1 = '" + Type1 + "'" 
  
  Depart = Depart - 1 
  Repeat 
    Depart + 1 
    File2.s = LCase("#\" + GetGadgetItemText(Liste, Depart, Colonne)) 
    Partie2.s = StringField(File2, Index, "\") 
    Longueur.l = Len(ExistPath + Partie2) 
    If Longueur < Len(File2) 
      Type2.s = Mid(File2, Longueur + 1, 1) 
    Else 
      Type2.s = Mid(File2, Longueur, 1) 
      If Type2 <> "\" : Type2 = "" : EndIf 
    EndIf 
    Debug "File2 = " + File2 
    Debug "Partie2 = " + Partie2 
    Debug "Type2 = '" + Type2 + "'" 
  Until (Type1 = Type2 And Partie1 <= Partie2) Or (Type1 = "\" And Type2 = "") Or Depart > Fin Or Depart > NbElement 
  
  Debug ">> Depart = " + Str(Depart) 
  Debug "--------------------" 
  
  ProcedureReturn Depart 
EndProcedure 



Procedure ListIconGadgetXP(GadgetID.l, x.l, y.l, tx.l, ty.l, Colonne.s, largeur.l, Options.l) 
  ListIconGadget(GadgetID, x, y, tx, ty, Colonne, largeur, Options) 
  #LVM_SETEXTENDEDLISTVIEWSTYLE = 4150 : #LVS_EX_SUBITEMIMAGES = 2 
  hImageListS.l = SHGetFileInfo_("c:\", 0, @InfosFile.SHFILEINFO, SizeOf(SHFILEINFO), #SHGFI_SYSICONINDEX | #SHGFI_SMALLICON) 
  ImageList_SetBkColor_(hImageListS, #CLR_NONE) 
  SendMessage_(GadgetID(GadgetID), #LVM_SETIMAGELIST, #LVSIL_SMALL, hImageListS) 
  SendMessage_(GadgetID(GadgetID), #LVM_SETEXTENDEDLISTVIEWSTYLE, #LVS_EX_SUBITEMIMAGES, #LVS_EX_SUBITEMIMAGES) 
EndProcedure 

Procedure AddGadgetItemXP(GadgetID.l, Pos.l, Texte.s, IconPath.s) 
  SHGetFileInfo_(IconPath, 0, @InfosFile.SHFILEINFO, SizeOf(SHFILEINFO), #SHGFI_SYSICONINDEX | #SHGFI_SMALLICON) 
  If Pos = -1 
    Pos = CountGadgetItems(GadgetID) + 1 
  EndIf 
  
;   Structure LVITEM 
;     mask.l 
;     iItem.l 
;     iSubitem.l 
;     state.l 
;     stateMask.l 
;     pszText.l 
;     cchTextMax.l 
;     iImage.l 
;     lParam.l 
;     iIndent.l 
;     iGroupId.l 
;     cColumns.l 
;     puColumns.l 
;   EndStructure 
  
  var.LVITEM 
  var\mask = #LVIF_IMAGE | #LVIF_TEXT 
  var\iSubItem = 0 
  var\iItem = Pos 
  var\pszText = @Texte 
  var\iImage = InfosFile\iIcon 
  SendMessage_(GadgetID(GadgetID), #LVM_INSERTITEM, 0, @var) 
EndProcedure 

Procedure Open_Window() 
  
  If OpenWindow(0, 0, 0, 500, 200, "Ajouter des fichiers par glisser déposer", #PB_Window_SystemMenu | #PB_Window_ScreenCentered) 
    DragAcceptFiles_(WindowID(0), #True) ; activez le glisser déposer 
    SetWindowPos_(WindowID(0), -1, 0, 0, 0, 0, #SWP_NOSIZE | #SWP_NOMOVE) ; fenêtre toujours au premier plan 
    If CreateGadgetList(WindowID(0)) 
      ListIconGadgetXP(1, 0, 0, 500, 200, "Fichiers", 495, 0) ; crée une listicongadget avec icônes systèmes 
    EndIf 
  EndIf 
EndProcedure 


Procedure DragAndDrop() 
  dropped.l = EventwParam() 
  num.l = DragQueryFile_(dropped, -1, "", 0) 
  For Index = 0 To num - 1 
    Size.l = DragQueryFile_(dropped, Index, 0, 0) 
    filename.s = Space(Size) 
    DragQueryFile_(dropped, Index, filename, Size + 1) 
    
    If FileSize(filename) = -2 
      If Right(filename, 1) <> "\" : filename = filename + "\" : EndIf 
    EndIf 

    Position = Triage(1, 0, filename) 
    AddGadgetItemXP(1, Position, filename, filename) 
    
  Next 
  DragFinish_(dropped) 
EndProcedure 

;- debut du programme 
Open_Window() 

 SetWindowCallback(@WindowCallback())

Repeat 
  Event = WaitWindowEvent() 
  
  If Event = #WM_DROPFILES : DragAndDrop() : EndIf 
  
Until Event = #PB_Event_CloseWindow 

End

Procedure WindowCallback(Window, message, wParam, lParam) 
  result = #PB_ProcessPureBasicEvents 
  
  If message = #WM_NOTIFY 

    *nmhdr.NMHDR = lParam 
   
    If *nmhdr\hwndFrom = GadgetID(1) ; ListIconGadget 
    
      If *nmhdr\code = #LVN_BEGINDRAG 
  
        If *nmhdr\hwndFrom = GadgetID(1) 
          SourceGadget = 1
          
        Else  ; must be #ListIcon2, as we have allready checked, that it is only one of the 2 
         
        EndIf 
        
        *nmv.NMLISTVIEW = lParam 
        SourceItem = *nmv\iItem         
        
        DragImageList = SendMessage_(GadgetID(SourceGadget), #LVM_CREATEDRAGIMAGE, SourceItem, @UpperLeft.POINT) 
        
        If DragImageList   
      
          If ImageList_BeginDrag_(DragImageList , 0, 0, 0) 
          
            ImageList_DragShowNolock_(#True) 
         
            SetCapture_(GetParent_(GadgetID(SourceGadget))) 
            
            ShowCursor_(#False) 
            
            IsDraging = #True 
            
            
          EndIf ; check for ImageList_BeginDrag_()        
          
        EndIf ; check for DragImageList 
        
      EndIf ; check for #LVN_BEGINDRAG 
      
    EndIf ; check for right gadget 

  ElseIf message = #WM_MOUSEMOVE And IsDraging 
    
    ExamineDesktops()
    ImageList_DragMove_(DesktopMouseX(), DesktopMouseY())   

    ImageList_DragShowNolock_(#False) 

    MouseX = lParam & $FFFF 
    MouseY = lParam >> 16 
       
    If TargetGadget <> -1  
     
      pitem.LV_ITEM 
      pitem\mask = #LVIF_STATE 
      pitem\iItem = TargetItem 
      
      pitem\state = 0 
      pitem\stateMask = #LVIS_DROPHILITED 
      
      SendMessage_(GadgetID(TargetGadget), #LVM_SETITEM, 0, @pitem) 

      RedrawWindow_(GadgetID(TargetGadget), 0, 0, #RDW_UPDATENOW) 
      
    EndIf 

    TargetGadgetID = ChildWindowFromPoint_(Window, MouseX, MouseY) 
    

    If TargetGadgetID = GadgetID(1) 
      TargetGadget = 1 
      
    Else 
      TargetGadget = -1 
    EndIf 
     
    If TargetGadget <> -1  
    
      hittestinfo.LV_HITTESTINFO 
      hittestinfo\pt\x = MouseX - GadgetX(TargetGadget) 
      hittestinfo\pt\y = MouseY - GadgetY(TargetGadget) 
      
      TargetItem = SendMessage_(GadgetID(TargetGadget), #LVM_HITTEST, 0, @hittestinfo)             
      
      pitem.LV_ITEM 
      pitem\mask = #LVIF_STATE 
      pitem\iItem = TargetItem 
      pitem\state = #LVIS_DROPHILITED 
      pitem\stateMask = #LVIS_DROPHILITED 
      
      SendMessage_(GadgetID(TargetGadget), #LVM_SETITEM, 0, @pitem)   
      RedrawWindow_(GadgetID(TargetGadget), 0, 0, #RDW_UPDATENOW) ; again a redraw 
      
    EndIf  
      
    ImageList_DragShowNolock_(#True)  
           
  ElseIf message = #WM_LBUTTONUP And IsDraging 

    ReleaseCapture_() 
    ImageList_EndDrag_() 
    ImageList_Destroy_(DragImageList) 
    ShowCursor_(#True) 
    IsDraging = #False  
    If TargetGadget <> -1 
      
      pitem.LV_ITEM 
      pitem\mask = #LVIF_STATE 
      pitem\iItem = TargetItem 
      pitem\state = 0 
      pitem\stateMask = #LVIS_DROPHILITED 
      
      SendMessage_(GadgetID(TargetGadget), #LVM_SETITEM, 0, @pitem) 
      RedrawWindow_(GadgetID(TargetGadget), 0, 0, #RDW_UPDATENOW) 
      
    EndIf    
    If TargetGadget <> -1 

      ItemText$ = GetGadgetItemText(SourceGadget, SourceItem, 0)       
      RemoveGadgetItem(SourceGadget, SourceItem)             
      AddGadgetItem(TargetGadget, TargetItem, ItemText$) 
      
    EndIf ; check TargetGadget  
    
  EndIf ; check Message 
  
  ProcedureReturn result 
EndProcedure  

Für ein bisschen drag'n'drop ist es aber sehr viel Code.

Gut, ein bisschen Code ist für das Icon-Aussehen verantwortlich, und es muss wohl das Bild beim Verschieben selbst gemalt werden.
Man könnte ja dann auch Bildchen ändern, je nach dem, wo man was hinzieht.

Für Buttons in Menüs hab ich auch mal nach Code gesucht, nix gefunden.
Wenn man zum Beispiel einen Button per Drag'n'Drop verschieben will.
Aber das muss man dann wohl etwas anders lösen.
Aber vielleicht geht es mit der gleichen Prozedur.

Am liebsten wäre mir ja sowas wie die Zwischenablage:

GetDragDropString()

Da sind dann alle markierten Dateien drin.

Und mit SetDragDropString()
kann man die Drag'n'Drop-Schleife initialisieren.

Vielleicht bräuchte man noch ein MouseOverItem(#GadgetID)
Ergebnis ist die Item-Position.

Ach manchmal macht es Spaß zu programmieren und dann gibt es wieder Momente, da sieht man den Wald nicht.

Vielen Dank, wenn ihr mir da mal einen Tipp geben könnt.

[duli]

Hallo

Ich habe mich auch mal versucht mit Drag und Drop und folgenden Code gefunden den ich gut fand. Aber da ich erst Anfänger bin konnte ich den Code noch nicht so richtig verstehen, aber vieleicht hilft er dir weiter.

gruss Duli

Code: Alles auswählen

; Converted by PBSourceConverter on 17.04.2007 / 22:50
; ------------------------------------------------------------------
;
;   Drag & Drop example with 
;   ExplorerListGadget and ExplorerTreeGadget
;
;   By Timo 'fr34k' Harter
;
; ------------------------------------------------------------------
;
; This example shows how to implement drag & drop between
; Explorer type gadgets in PureBasic. It is done very similar
; to the other drag & drop exmaples i wrote, so if you read them,
; you might find that this one uses basically all the same techniques.
;
; However, the explorer gadgets are a little more complicated than a
; basic ListIcon or TreeGadget, so this code is longer, but it
; should not be much more complicated than the others.
;
; As always, feel free to use any of the code/information given
; here in whichever way you want.
;
; ------------------------------------------------------------------

; These are the 3 Constants for the 3 needed objects: the main window and
; the two gadgets. If you modify this code to fit into your project,
; make sure you replace all occourances of these with your own constants.
; It should work with no problem with #PB_Any created onjects, you just
; have to replace all the constants with the variables then.
#Window       = 0
#ExplorerTree = 0
#ExplorerList = 1


; One note first for better understanding:
; The explorergadgets have like some of the other more
; complicated PB Gadgets an own invisible parent Window for their
; event procession. This is no problem, it just means, that you
; can't get their messages from the main WindowCallback, because
; they never end up there. You need to subclass that invisible
; parent window as described later to get these messages.

; Ok, here's the required global stuff. The callback variables
; are needed for the subclassing and explained below. IsDraging
; is #true when drag&drop is in progress and DragImageList stores
; the imagelist that contains the drag image.
; The other variables should be clear.

; You have to know though that 'SourceItem' and 'TargetItem' do contain
; the item index if the Gadget is an ExplorerListGadget and contain 
; an Item handle, when it is an ExplorerTreeGadget. This is because
; a treeview control internally only uses handles, and no index.

Global RealCallback_ExplorerList, RealCallback_ExplorerTree
Global IsDraging, SourceGadget, SourceItem, TargetGadget, TargetItem
Global DragImageList


; Ok, now about the subclassing. Each window and gadget in windows
; has a callback procedure that handles its messages. Subclassing
; just means that you replace that procedure with your own, and at the
; end of your procedure call the original one. This way, there can be
; a chain of subclasses, each procedure calling the next, and everybody
; can process the messages he needs.
; So the global values above are used to store the adress of the real
; callbacks of the invisible parent window of the gadgets.

; So here we have our replacement procedure for the ExplorerListGadget's
; parent window. We only need to catch one message here. The one that
; starts the draging, so this procedure is quite short.

Procedure Callback_ExplorerList(Window, Message, wParam, lParam)

  ; LVN_BEGINDRAG is the message inicating a d&d start. It is a #WM_NOTIFY
  ; message. So we get #WM_NOTIFY, and then there is a structure pointer
  ; in lParam, that contains the actual message data:
  
  If Message = #WM_NOTIFY
    *nmv.NMLISTVIEW = lParam
    
    If *nmv\hdr\code = #LVN_BEGINDRAG
      
      ; no target hilighted yet:
      TargetGadget = -1
      TargetItem   = -1    

      ; since this procedure subclasses only the one gadget, there is no
      ; need to ckeck for gadget type, as they can only come from this one.
      SourceGadget = #ExplorerList
      SourceItem   = GetGadgetState(#ExplorerList)
      
      ; This is a little check to make the ".." item undragable.
      ; you can ckeck for other types of items here, that you don't want to
      ; be draged. Just don't execute the following code then.
      If GetGadgetItemText(#ExplorerList, SourceItem, 0) <> ".."
        
        ; this message creates the drag image:        
        DragImageList = SendMessage_(GadgetID(#ExplorerList), #LVM_CREATEDRAGIMAGE, SourceItem, @UpperLeft.POINT)
        
        ; check for success:
        If DragImageList 
        
          ; ok, this starts the d&d operation
          If ImageList_BeginDrag_(DragImageList , 0, 0, 0)
            
            ; show the image
            ImageList_DragShowNolock_(#True)
            
            ; send all mouse messages to our main window (and thus main window callback)
            SetCapture_(WindowID(#Window))
            
            ; hide the normal cursor
            ShowCursor_(#False)

            ; indicate that d&d is in progress
            IsDraging = #True
            
          EndIf ; ImageList_BeginDrag_()
        
        EndIf ; check DragImageList
        
      EndIf ; check ".." item
    EndIf ; check #LVN_BEGINDRAG
  EndIf ; check #WM_NOTIFY

  ; Now we need to call the original procedure. This is really important,
  ; as otherwise the gadget won't work at all.
  ProcedureReturn CallWindowProc_(RealCallback_ExplorerList, Window, Message, wParam, lParam)
EndProcedure



; This is exactly the same for the ExplorerTreeGadget. The way of doing things is
; the same, just the structures and messages are a little different.

Procedure Callback_ExplorerTree(Window, Message, wParam, lParam)

  If Message = #WM_NOTIFY
    *nmtv.NMTREEVIEW = lParam 
    
    If *nmtv\hdr\code = #TVN_BEGINDRAG    

      TargetGadget = -1
      TargetItem   = -1    

      SourceGadget = #ExplorerTree
      
      ; The source item handle is stored in that structure:
      SourceItem   = *nmtv\itemNew\hItem
      
      ; note that this message functions a little different from the listicon one.
      ; have a look at MS documentation on LVM_CREATEDRAGIMAGE and TVM_CREATEDRAGIMAGES
      ; for the exact description.
      DragImageList = SendMessage_(GadgetID(#ExplorerTree), #TVM_CREATEDRAGIMAGE, 0, SourceItem)
      
      ; this part is exactly the same:
      If DragImageList 
        If ImageList_BeginDrag_(DragImageList , 0, 0, 0)

          ImageList_DragShowNolock_(#True)
          SetCapture_(WindowID(#Window))
          ShowCursor_(#False)

          IsDraging = #True
        EndIf    
      
      EndIf
           
    EndIf
  EndIf
  
  ; also call the real procedure:  
  ProcedureReturn CallWindowProc_(RealCallback_ExplorerTree, Window, Message, wParam, lParam)
EndProcedure

; Ok, the code to start the d&d operation is done. Now we need to implement
; the mouse moves, the target hilightning and the end of the operation.
; This is done in the main callback, because with "SetCapture_(WindowID(#Window))",
; we directed all mouse messages there.

; The next 2 procedures are just seperated, because this code needs to be called
; several times from the main callback.

; This procedure checks, which Gadget the mouse is currently over, and hilights
; the target. it also updates the TargetGadget and TargetItem variables.
; Note that MouseX and MouseY are client coordinates of the main window, not like
; WindowMouseY() and WindowMouseY() which include the window border.
; Note that while this procedure is called, the drag image must be hidden to aboid
; some ugly graphics.

Procedure HilightTarget(MouseX, MouseY)

  ; get the handle of the 'window' under the mouse:
  ; note that for explorer type gadgets, you get the handle of the invisible
  ; parent window here, so we have to compare this value to "GetParent_(GadgetID(#Gadget))"
  TargetID = ChildWindowFromPoint_(WindowID(#Window), MouseX, MouseY)
  
  ; because both gadgets can be both target or source (you can even drag within one gadget)
  ; so the code must always work for both gadgets:
  
  If TargetID = GetParent_(GadgetID(#ExplorerList))
    TargetGadget = #ExplorerList
    
    ; this checks, which item in the gadget the mouse is over:  
    lv_hittestinfo.LV_HITTESTINFO
    lv_hittestinfo\pt\x = MouseX - GadgetX(#ExplorerList)
    lv_hittestinfo\pt\y = MouseY - GadgetY(#ExplorerList)    
    
    ; note that the result here is an item index, that works with the PB gadget functions:
    TargetItem = SendMessage_(GadgetID(#ExplorerList), #LVM_HITTEST, 0, @lv_hittestinfo) 
    
    ; now we hilight the item:    
    lv_item.LV_ITEM
    lv_item\mask = #LVIF_STATE
    lv_item\iItem = TargetItem
    lv_item\state = #LVIS_DROPHILITED
    lv_item\stateMask = #LVIS_DROPHILITED    
    SendMessage_(GadgetID(#ExplorerList), #LVM_SETITEM, 0, @lv_item)  
    
    ; redraw the window
    RedrawWindow_(GadgetID(#ExplorerList), 0, 0, #RDW_UPDATENOW)      
    
    
  ; it is again the same for ExplorerTree, only with slightly different
  ; structures and messages:
  ElseIf TargetID = GetParent_(GadgetID(#ExplorerTree))
    TargetGadget = #ExplorerTree
    
    tv_hittestinfo.TV_HITTESTINFO
    tv_hittestinfo\pt\x = MouseX - GadgetX(#ExplorerTree)
    tv_hittestinfo\pt\y = MouseY - GadgetY(#ExplorerTree)    
    
    TargetItem = SendMessage_(GadgetID(#ExplorerTree), #TVM_HITTEST, 0, @tv_hittestinfo) 
    If TargetItem = 0
      TargetItem = -1
    EndIf
    
    tv_item.TV_ITEM
    tv_item\mask = #TVIF_STATE
    tv_item\hItem = TargetItem
    tv_item\state = #TVIS_DROPHILITED
    tv_item\stateMask = #TVIS_DROPHILITED    
    SendMessage_(GadgetID(#ExplorerTree), #TVM_SETITEM, 0, @tv_item)  
    
    RedrawWindow_(GadgetID(#ExplorerTree), 0, 0, #RDW_UPDATENOW)    
  
  ; if the mouse is not over any gadget, indicate that through the -1     
  Else
    TargetGadget = -1
    TargetItem = -1
  
  EndIf

EndProcedure


; This procedure unhilights the last hilighted gadgets, so a new one can
; be hilighted.

Procedure UnHilightTarget()

  If TargetGadget = #ExplorerList
           
    lv_item.LV_ITEM
    lv_item\mask = #LVIF_STATE
    lv_item\iItem = TargetItem
    lv_item\state = 0
    lv_item\stateMask = #LVIS_DROPHILITED
         
    SendMessage_(GadgetID(#ExplorerList), #LVM_SETITEM, 0, @lv_item)
    RedrawWindow_(GadgetID(#ExplorerList), 0, 0, #RDW_UPDATENOW)  
  
  ElseIf TargetGadget = #ExplorerTree

    tv_item.TV_ITEM
    tv_item\mask = #TVIF_STATE
    tv_item\hItem = TargetItem
    tv_item\state = 0
    tv_item\stateMask = #TVIS_DROPHILITED
    
    SendMessage_(GadgetID(#ExplorerTree), #TVM_SETITEM, 0, @tv_item)  
    RedrawWindow_(GadgetID(#ExplorerTree), 0, 0, #RDW_UPDATENOW)    
  
  EndIf

EndProcedure



; Finally there is the main window callback. This is a normal
; PB windowcallback, as you can see by the #PB_ProcessPureBasicEvents way

Procedure Callback_MainWindow(Window, Message, wParam, lParam)
  result = #PB_ProcessPureBasicEvents
    
  ; the following messages are only processed when draging is in progress
  If IsDraging
  
    ; the mouse is moved, so the image needs to be moved, and maybe a new
    ; target hilighted
    If Message = #WM_MOUSEMOVE
      
      ; this moves the drag image. Screen coordinates are needed here.
      ; for this we need screen coordinates
      GetCursorPos_(@MousePos.POINT)
      ImageList_DragMove_(MousePos\x, MousePos\y)
      
      ; now hide the image for the hilightning of the target
      ImageList_DragShowNolock_(#False)         
      
      ; unhilight any previously hilighted target, and hilight the new one
      UnHilightTarget()
      HilightTarget(WindowMouseX(#Window), WindowMouseY(#Window))
      
      ; show the drag image again.
      ImageList_DragShowNolock_(#True)
    
    
    ; mouse button up, so the d&d is finished.
    ElseIf Message = #WM_LBUTTONUP
      
      ; release the mouse message capturing
      ReleaseCapture_()
      
      ; end the d&d operation
      ImageList_EndDrag_()
      
      ; free the image list
      ImageList_Destroy_(DragImageList)      
      
      ; show the cursor again
      ShowCursor_(#True)
      
      ; indicate, that d&d is no longer in progress
      IsDraging = #False
      
      ; unhilight the target
      UnHilightTarget()
      
      ; That's it, the drag&drop is finished. Now we can work with what we know.
      ; The last call of the HilightTarget() procedure has allready set the
      ; TargetGadget and TargetItem values, so no more such checks are needed.
      
      ; I have inserted a message requester here to show the available information,
      ; and also to explain how to get it.
      
      Message$ = "Drag & Drop complete" + #CRLF$ + #CRLF$
      
      ; for d&d to start, there must be a valid source gadget and item, so there
      ; is no need to check for -1 here.
      
      If SourceGadget = #ExplorerList
        Message$ + "Source: ExplorerListGadget" + #CRLF$
        
        ; for ExplorerListGadget, to get the full item path, both these functions are needed.
        Message$ + "Item: " + GetGadgetText(#ExplorerList) + GetGadgetItemText(#ExplorerList, SourceItem, 0) + #CRLF$
        
        If GetGadgetItemState(#ExplorerList, SourceItem) & #PB_Explorer_Directory
          Message$ + "Type: Directory" + #CRLF$
        Else
          Message$ + "Type: File" + #CRLF$          
        EndIf        
      
      ElseIf SourceGadget = #ExplorerTree
        ; Here is a little issue. As said before, a treeview works with handles, also
        ; the ExplorerTreeGadget doesn't have 'individual' items like the list one, it
        ; only has one current one. Also, the d&d operation removes this current
        ; selection from the gadget.
        
        ; so what we do to get this info is to manually select the Source and the
        ; target item with SendMessage and it's handle, then get the information
        ; with GetGadgetText/State, and deselect the item again later:      
        SendMessage_(GadgetID(#ExplorerTree), #TVM_SELECTITEM, #TVGN_CARET, SourceItem)
        
        ; get the info:
        Message$ + "Source: ExplorerTreeGadget" + #CRLF$
        Message$ + "Item: " + GetGadgetText(#ExplorerTree) + #CRLF$
        If GetGadgetState(#ExplorerList) & #PB_Explorer_Directory
          Message$ + "Type: Directory" + #CRLF$
        Else
          Message$ + "Type: File" + #CRLF$          
        EndIf        
        
        ; delselect the item again:
        SendMessage_(GadgetID(#ExplorerTree), #TVM_SELECTITEM, #TVGN_CARET, 0)
              
      EndIf
            
      Message$ + #CRLF$
      
      If TargetGadget = -1
        Message$ + "Target: Item dropped not in the Explorer Gadgets." + #CRLF$
      
      ElseIf TargetGadget = #ExplorerList
        Message$ + "Source: ExplorerListGadget" + #CRLF$
        If TargetItem = -1
          Message$ + "Item: Item dropped in the empty Gadget area." + #CRLF$
        Else
          Message$ + "Item: " + GetGadgetText(#ExplorerList) + GetGadgetItemText(#ExplorerList, TargetItem, 0) + #CRLF$
          If GetGadgetItemState(#ExplorerList, TargetItem) & #PB_Explorer_Directory
            Message$ + "Type: Directory" + #CRLF$
          Else
            Message$ + "Type: File" + #CRLF$          
          EndIf                       
        EndIf
        
      ElseIf TargetGadget = #ExplorerTree
        Message$ + "Target: ExplorerTreeGadget" + #CRLF$
        If TargetItem = -1
          Message$ + "Item: Item dropped in the empty Gadget area." + #CRLF$
        Else                 
          ; same here: first select the target, get the info and unselect it.
          
          SendMessage_(GadgetID(#ExplorerTree), #TVM_SELECTITEM, #TVGN_CARET, TargetItem)
          Message$ + "Item: " + GetGadgetText(#ExplorerTree) + #CRLF$
          If GetGadgetState(#ExplorerList) & #PB_Explorer_Directory
            Message$ + "Type: Directory" + #CRLF$
          Else
            Message$ + "Type: File" + #CRLF$          
          EndIf  
          SendMessage_(GadgetID(#ExplorerTree), #TVM_SELECTITEM, #TVGN_CARET, 0)                                         
        EndIf
         
      EndIf
      
      ; That's it, now you have all the info you need. work with it ;)
      ; Let's just display our requester.
      
      ; One note though: If you do file operations in the displayed directorys,
      ; the ExplorerListGadget() will automatically refresh. However, the
      ; ExplorerTreeGadget() doesn't have that feature yet (PB v3.91).
      ; Just be aware of this.
      
      MessageRequester("Drag & Drop", Message$)
    
    EndIf  ; check Message
  
  EndIf  ; check IsDraging
  
  ProcedureReturn result  ; return result
EndProcedure



; That was all the hard part, now simply follows the GUI part:

If OpenWindow(#Window, 0, 0, 800, 600, "Drag & Drop with ExplorerGadgets", #PB_Window_SystemMenu|#PB_Window_Screencentered)
  If CreateGadgetList(WindowID(#Window))
    
    ExplorerTreeGadget(#ExplorerTree, 5, 5, 240, 590, "*.*", #PB_Explorer_AutoSort)
    ExplorerListGadget(#ExplorerList, 255, 5, 540, 590, "*.*", #PB_Explorer_AutoSort)
    
    ; these lines subclass the parent of the gadgets, and stores the old
    ; callback procedure address in our global variable.
    
    RealCallback_ExplorerList = SetWindowLong_(GetParent_(GadgetID(#ExplorerList)), #GWL_WNDPROC, @Callback_ExplorerList())
    RealCallback_ExplorerTree = SetWindowLong_(GetParent_(GadgetID(#ExplorerTree)), #GWL_WNDPROC, @Callback_ExplorerTree())
    
    ; for a treeview, drag&drop needs to be enabled first in order to work.
    ; this is very important.
    SetWindowLong_(GadgetID(#ExplorerTree), #GWL_STYLE, GetWindowLong_(GadgetID(#ExplorerTree), #GWL_STYLE) & ~#TVS_DISABLEDRAGDROP)
    
    ; finally set our main window callback:
    SetWindowCallback(@Callback_MainWindow())
    
    ; nothing to do in the event loop:
    Repeat
      Event = WaitWindowEvent()
    Until Event = #PB_Event_CloseWindow
    
  EndIf
EndIf

End


; ------------------------------------------------------------------
;
; Phhhhew! That was lots of text again, and probably lots of
; typing errors again :)
; I hope it was easy to understand, and is helpfull to you.
; For more questions, mail me at 'freak@betriebsdirektor.de', or
; ask on the forums at 'http://forums.purebasic.com'
; For more of these tutorials, browse my site at 
; 'http://freak.purearea.net/'
;
; Thanks for reading..
;
; Timo
;
; ------------------------------------------------------------------
; ExecutableFormat=Windows
; CursorPosition=293
; FirstLine=289
; DisableDebugger
; EOF

; IDE Options = PureBasic v4.02 (Windows - x86)
; CursorPosition = 312
; FirstLine = 285
; Folding = -

[Xaby]

Die Frage bleibt im Raum stehen:

Wie dropt man Daten wieder heraus von dem PB-Programm zu Windows?

Und wie zwischen Programmen?

[Tafkadasom2k5]

Wie man "Dateien" Droppt, kommt ganz auf das Programm man. Normalerweise übermittelt man beim Droppen immer den Dateinamen- damit arbeiten die Meisten Programme.

Die ganze Sache ist leider nicht ganz so einfach. Unter PowerBasic könnte ich dir schnell ein Beispiel posten, dann müsstest du einfach die Callback für Pure übersetzen. Aber dann ist die Crossplattform-Konformität nicht mehr gegeben- nur noch Windows.

Gr33tz
Tafkadasom2k5

[ts-soft]

Im engl. Forum einfach nach EasyVent suchen. Sind eine Menge Beispiele
enthalten. Ansonsten mal abwarten, ob PB dies in Zukunft nicht von Hause
aus unterstützt

[AND51]

@ TS'si: Das glaube ich eher nicht.


Also ich möchte ganz gerne mal das selber coden und mich nicht auf andere Libs stützen. Muss man aber immer alles im Callback machen? Geht das nicht auch so?

@ Tafkadasom2k5:
Bitte poste doch mal das Beispiel, wenn es nicht zu lang ist? Und: Da die meisten hier ja eh mit Windows arbeiten ist die fehlende Portierung sicherlich kein Beinbruch.

[Xaby]

EasyVent ist geil.

Das Splittergadget hat mich fasziniert. Es flackert nicht wie das eigentliche von PB.

Geil sind auch die MouseOver-Funktionen. Die man ja doch ab und an schon gern gehabt hätte.

Die Drag'n'Drop Sachen sehen auf den ersten Blick beeindruckend aus, sind aber immer das gleiche.

Ich habe ein Gadget und frage ab, ob meine Maus drüber ist.
Wenn ja, dann hole ich mir den Gadgettext und initialisiere die Drag'n'Drop Routinen.

Lustige Sache. Sicherlich eine nette Spielerei, wenn man damit Menüs oder Listen verschieben will.

Allerdings habe ich kein Beispiel gefunden, wo es um das Drag'n'Droppen außerhalb des Programms ging.

Und selbst innerhalb gab es einen fatalen Fehler.
Sobald man beim Drag'n'Droppen die zweite Maustaste benutzt, hackt das Programm und es lässt sich nur noch mit Gewalt schließen.

Da fällt mir ein, wie hat das Problem Gnozal bei seinem jaPBe gelöst?
Wenn man markierten Text hat, kann man den verschieben.

Sogar aus einem jaPB-Editor in einen anderen. Das wäre die Lösung.

Auch von einem Explorer zum jaPBe.

Sowas will ich auch können. Jemand auf Anhieb eine Ahnung?
Werd mir mal die beigefügten Units (Libs) anschauen, vielleicht gibt es ja wenigstens für das Text-drag'n'drop was.

[ts-soft]

@ TS'si: Das glaube ich eher nicht.

Wollen wir wetten?

Also ich möchte ganz gerne mal das selber coden und mich nicht auf andere Libs stützen. Muss man aber immer alles im Callback machen? Geht das nicht auch so?

Zur Zeit nicht

PS: EasyVent ist keine Lib, sondern ein Source

[Tafkadasom2k5]

Okay, das ist WinAPI-Live
Schönes Beispiel, da man damit ohne Weiteres alles eben schnell Hnadlen kann.
Es ist kopiert von einem aus nem PowerBasic-Forum, ich habe nur ein paar Sachen auskommentiert. Ich find diese Version ganz gut.

Wer Fragen zu bestimmten Stellen hat, kann sie mir gerne stellen. Ich habe jetzt eben nur rüberkopiert, und die Kommentare übernommen. Aber normalerweise verstehe ich, was da steht- nur wäre ich von Alleine da nie drauf gekommen

Vielleicht gucke ich mal, ob was 'noch' einfacheres möglich ist

Gr33tz
Tafkadasom2k5

Edit: Falls einem diese Varinate wirklich ne zu harte Nummer ist (was ich durchaus verstehen könnte ), dann wäre auch noch die Möglichkeit gegeben, per Copy/Paste das alles abwickeln zu lassen.

Code: Alles auswählen

#Compile Exe
 
Option Explicit
 
#Include "win32api.inc"
#INCLUDE "Commctrl.inc"

'Drag-Functions--------------------------------------------------------
Global WM_LISTVIEW_ENDDRAG As LONG
 
FUNCTION LISTVIEW_HandleDrag( ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long ) As Long
 
    LOCAL a               AS LONG
    LOCAL b               AS LONG
    LOCAL c               AS LONG
    LOCAL X               AS INTEGER
    LOCAL Y               AS INTEGER
    LOCAL PA              AS POINTAPI
    LOCAL pNMH            AS NMLISTVIEW Ptr
    LOCAL RItem           AS Rect
 
    STATIC hImageList   AS LONG
    STATIC hTempImgList AS LONG
    STATIC pPrevProc    AS LONG
    STATIC nStartId     AS LONG
    STATIC nEndId       AS LONG
 
    '// Hook is in place, handle messages..
    If pPrevProc Then Function = CallWindowProc( pPrevProc, hWnd, wMsg, wParam, lParam )
 
    Select Case wMsg
    Case %WM_NOTIFY
 
        If lParam = 0 Then Exit Select
        pNMH = lParam
 
        Select Case @pNMH.hdr.code
        Case %LVN_BEGINDRAG
 
            '// Prepare an unique windows message to communicate with the parent dialog.
            If WM_LISTVIEW_ENDDRAG = 0 Then WM_LISTVIEW_ENDDRAG = RegisterWindowMessage( "LISTVIEW_ENDDRAG" )
 
            '// Fetch the selected item id.
            nStartId = SendMessage( @pNMH.hdr.hWndFrom, %LVM_GETNEXTITEM, -1, MakLng( %LVNI_SELECTED, 0 ) )
            If nStartId < 0 Then Exit Select
 
            '// A temporary hook is used on the control.
            If pPrevProc = 0 Then
                pPrevProc = SetWindowLong( @pNMH.hdr.hWndFrom, %GWL_WNDPROC, CodePtr( LISTVIEW_HandleDrag ) )
            End If
 
            '// No imagelist present, let's create one for a brief moment.
            If SendMessage( @pNMH.hdr.hWndFrom, %LVM_GETIMAGELIST, %LVSIL_NORMAL, ByVal 0& ) = 0 Then
                hTempImgList = ImageList_Create( 0, 0, %ILC_COLORDDB, 0, 0 )
                SendMessage @pNMH.hdr.hWndFrom, %LVM_SETIMAGELIST, %LVSIL_NORMAL, ByVal hTempImgList
            End If
 
            '// Create a drag image.
            hImageList = SendMessage( @pNMH.hdr.hWndFrom, %LVM_CREATEDRAGIMAGE, nStartId, ByVal VarPtr( PA ) )
 
            '// Destroy an evt. temp imagelist.
            If hTempImgList Then
                SendMessage @pNMH.hdr.hWndFrom, %LVM_SETIMAGELIST, %LVSIL_NORMAL, ByVal 0&
                ImageList_Destroy hTempImgList
            End If
 
            '// Initiate dragging + make sure the image is positioned well.
            SendMessage @pNMH.hdr.hWndFrom, %LVM_GETITEMRECT, nStartId, ByVal VarPtr( RItem )
            ImageList_BeginDrag hImageList, 0, @pNMH.ptAction.x, ( RItem.nBottom - RItem.nTop ) / 2
 
            '// Route all mousemessages to this control.
            SetCapture @pNMH.hdr.hWndFrom
 
            Function = 1
 
        End Select
 
    Case %WM_MOUSEMOVE
      '// Relocate the image.
        'ImageList_DragLeave ByVal 0&
        ClientToScreen hWnd, PA
        PA.X = PA.X + LoWrd( lParam ): PA.Y = PA.Y + HiWrd( lParam )
        ImageList_DragMove PA.X, PA.Y
        ImageList_DragEnter ByVal 0&, PA.X, PA.Y
 
    Case %WM_LBUTTONUP
 
        '// User has released the mouse with abort.
        '// Where is the mouse located?
        ReleaseCapture
 
        '// What is the target id?
        '// A cumbersome method to determine the item below the mouse.
        nEndId = -1
        b = SendMessage( hWnd, %LVM_GETCOUNTPERPAGE, 0, ByVal 0& )
        c = SendMessage( hWnd, %LVM_GETTOPINDEX, 0, ByVal 0& )
 
        X = LoWrd( lParam ): Y = HiWrd( lParam )
        If X < 0 Or Y < 0 Then Exit Select
 
        For a = c To c + b - 1
            SendMessage hWnd, %LVM_GETITEMRECT, a, ByVal VarPtr( RItem )
            If X > RItem.nRight Or Y < RItem.nTop Then Exit For
            If Y >= RItem.nTop And Y < RItem.nBottom Then nEndId = a: Exit For
        Next a
 
        '// The start and end id are different, notify parent dialog.
        If nEndId >= 0 And nEndId <> nStartId Then
            PostMessage GetParent( hWnd ), WM_LISTVIEW_ENDDRAG, nStartId, nEndId
        End If
 
   Case %WM_CAPTURECHANGED
 
        '// Due releasecapture, the control get's notified about this change.
        '// A good moment to release the hook e.o.
        '// This release could be invoked by the user by clicking the right mouse during drag.
        '// This will abort the dragmode.
        ImageList_DragLeave ByVal 0&
        ImageList_EndDrag
 
        If hImageList Then ImageList_Destroy hImageList: hImageList = 0
        If pPrevProc Then SetWindowLong hWnd, %GWL_WNDPROC, pPrevProc: pPrevProc = 0
 
   End Select
 
END FUNCTION

'drag functions end----------------------------------------------------

'Example-----
CallBack Function DlgProc() As Long
 
    Dim a   As Long
    Dim T   As String
    Dim LVC As LV_COLUMN
    Dim lvi As LVITEM
    Dim pNMH As NMHDR Ptr
 
    Select Case CbMsg
    Case %WM_INITDIALOG
 
        Control Add "SysListView32", CbHndl, 100, "", 5, 9, 222, 200,  _
            %WS_CHILD Or %WS_VISIBLE Or %WS_TABSTOP Or %LVS_REPORT Or %LVS_SHAREIMAGELISTS, %WS_EX_CLIENTEDGE
 
        '// Add a column.
        T = "Drag LV items"
        LVC.mask      = %LVCF_FMT Or %LVCF_TEXT Or %LVCF_WIDTH
        LVC.pszText   = StrPtr( T )
        LVC.fmt       = %LVCFMT_LEFT
        LVC.cx        = 200
        LVC.iOrder    = 0
 
        SendDlgItemMessage CbHndl, 100, %LVM_INSERTCOLUMN, 0, ByVal VarPtr( LVC )
 
        For a = 1 To 10
 
            T = Format$( a ) & ", " & Format$( Rnd( 1, 10000 ) )
            lvi.mask        = %LVIF_TEXT
            lvi.pszText     = StrPtr( T )
            lvi.iItem       = SendDlgItemMessage( CbHndl, 100, %LVM_GETITEMCOUNT, 0, ByVal 0& )
            SendDlgItemMessage CbHndl, 100, %LVM_INSERTITEM, 0, VarPtr( lvi )
 
        Next a
 
    Case %WM_NOTIFY
 
        If CbLParam = 0 Then Exit Select
        pNMH = CbLParam
 
        Select Case @pNMH.idFrom
        Case 100
 
            Select Case @pNMH.code
            Case %LVN_BEGINDRAG
                If LISTVIEW_HandleDrag( CbHndl, CbMsg, CbWParam, CbLParam ) Then Function = 1: Exit Function
            End Select
 
        End Select
 
    Case WM_LISTVIEW_ENDDRAG
 
        MsgBox "Original id:" & Str$( CbWParam ) & ", Target id:" & Str$( CbLParam ), %MB_TASKMODAL, "Drag 'n drop from holland.."
 
    Case %WM_DESTROY
    End Select
 
End Function
 
Function WinMain ( ByVal hCurInstance  As Long, _
                   ByVal hPrevInstance As Long, _
                   BYVAL lpszCmdLine   AS Asciiz Ptr, _
                   ByVal nCmdShow      As Long ) As Long
 
    Dim a       As Long
    Dim hDlg    As Long
    Dim Result  As Long
 
    InitCommonControls
 
    Dialog New 0, "Drag listview items",,, 240, 240 _
        ,  %WS_OVERLAPPED _
        Or %WS_SYSMENU _
        Or %WS_MINIMIZEBOX _
        Or %WS_MAXIMIZEBOX _
        Or %WS_THICKFRAME _
        Or %WS_CLIPSIBLINGS _
        Or %WS_CLIPCHILDREN _
        To hDlg
 
    If hDlg = 0 Then Exit Function
 
    Dialog Show Modal hDlg Call DlgProc To Result
 
    Function = 1
 
End Function

[ts-soft]

@Tafkadasom2k5
Code-Beispiele in PowerBasic halte ich zumindest im Anfänger-Forum für
unnütz