FreeBasic

Данный пример я адаптировал с другого языка. В нем показывается как можно осуществить перетаскивание пунктов из TreeView в ListView. Адаптировался с использованием библиотеки window9.

Автор: LJ (был дополнительно обновлен участником blbltheworm)
Адаптация кода на freebasic: Станислав Будинов

' English forum: http://www.purebasic.fr/english/viewtopic.php?t=7022&highlight=
' Author: LJ (updated for PB4.00 by blbltheworm)
' Adapted On Freebasic: Stanislav Budinov

#INCLUDE "window9.bi"
Declare Sub DropProcedure(Button As Integer, Item As Integer)
Const Drag_LeftMouse  = 1,Drag_RightMouse = 2 ,Tree = 1,Listview=2
Dim Shared As Integer DropProc, DragDropMode
Dim Shared As HWND hWndTV
Dim Shared As HBITMAP hDragIml
Dim Shared As HTREEITEM DragItem
Function DragDropCallback(hWindow As HWND, Message As UINT, wParam As WPARAM, lParam As LPARAM) As Integer
    Dim As Integer DoDrag, DropX, DropY, hItem, hItem2, dItem
    Select Case Message
        Case WM_NOTIFY
            Dim As NMHDR Ptr lp = Cast(NMHDR Ptr,lParam)
            If lp->code = TVN_BEGINDRAG And (DragDropMode And Drag_LeftMouse) Then
                DoDrag =True
            Endif
            If lp->code = TVN_BEGINRDRAG And (DragDropMode And Drag_RightMouse)Then
                DoDrag = True
            Endif
            If DoDrag <>0 Then
                Dim pnmtv As NMTREEVIEW Ptr = Cast(NMTREEVIEW Ptr,lParam)
                DragItem = pnmtv->itemNew.hItem
                hDragIml = Cast(HBITMAP,SendMessage(hWndTV, TVM_CREATEDRAGIMAGE, 0, Cast(LPARAM,DragItem)))
                SendMessage(hWndTV, TVM_SELECTITEM, TVGN_CARET, Null)
                ImageList_BeginDrag(Cast(HIMAGELIST,hDragIml), 0, 0, 0)
                ImageList_DragEnter(GetParent(hWndTV), 0, 0)
                ImageList_DragShowNolock(True)
                ImageList_DragLeave(hWndTV)
                ShowCursor(False)
                SetCapture(GetParent(hWndTV))
                SendMessage(hWndTV, TVM_SELECTITEM, TVGN_CARET, Cast(LPARAM,DragItem))
            Endif
        Case WM_MOUSEMOVE
            If hDragIml <>0 Then
                DropX = Loword(lParam)
                DropY = Hiword(lParam)
                ImageList_DragMove(DropX, DropY+20)
                'ImageList_DragShowNolock(True)
            Endif
        Case WM_LBUTTONUP
            If hDragIml<>0 And (DragDropMode And Drag_LeftMouse) Then
                ImageList_EndDrag()
                ReleaseCapture()
                ShowCursor(True)
                ImageList_Destroy(Cast(HIMAGELIST,hDragIml))
                hDragIml = False
                dItem = 0
                hItem = SendMessage(hWndTV, TVM_GETNEXTITEM, TVGN_ROOT, 0)
                While hItem <> DragItem
                    hItem2 = SendMessage(hWndTV, TVM_GETNEXTITEM, TVGN_CHILD, hItem)
                    Do
                        If hItem2 = Null Then
                            hItem2 = SendMessage(hWndTV, TVM_GETNEXTITEM, TVGN_NEXT, hItem)
                        Endif
                        If hItem2 = Null Then
                            hItem = SendMessage(hWndTV, TVM_GETNEXTITEM, TVGN_PARENT, hItem)
                        Endif
                    Loop Until hItem2 <> Null
                    hItem = hItem2
                    dItem += 1
                Wend
                DropProcedure(Drag_LeftMouse, dItem)
            Endif
        Case WM_RBUTTONUP
            If hDragIml<>0 And (DragDropMode And Drag_RightMouse) Then
                ImageList_EndDrag()
                ReleaseCapture()
                ShowCursor(True)
                ImageList_Destroy(Cast(HIMAGELIST,hDragIml))
                hDragIml = False
                dItem = 0
                hItem = SendMessage(hWndTV, TVM_GETNEXTITEM, TVGN_ROOT, 0)
                While hItem <> DragItem
                    hItem2 = SendMessage(hWndTV, TVM_GETNEXTITEM, TVGN_CHILD, hItem)
                    Do
                        If hItem2 = Null Then
                            hItem2 = SendMessage(hWndTV, TVM_GETNEXTITEM, TVGN_NEXT, hItem)
                        Endif
                        If hItem2 = Null Then
                            hItem = SendMessage(hWndTV, TVM_GETNEXTITEM, TVGN_PARENT, hItem)
                        Endif
                    Loop Until hItem2 <> Null
                    hItem = hItem2
                    dItem += 1
                Wend
                DropProcedure(Drag_RightMouse, Cast(Integer,DragItem))
            Endif
    End Select
    Return 0
End Function

Function EnableDragDrop(TVGadget As Integer, DragMode As Integer) As Integer
    Dim As Integer Style
    Dim As HIMAGELIST hIml
    hWndTV = GadgetID(TVGadget)
    DragDropMode = DragMode
    Style = GetWindowLong(hWndTV, GWL_STYLE)
    Style = Style And (Not TVS_DISABLEDRAGDROP)
    SetWindowLong(hWndTV, GWL_STYLE, Style)
    If SendMessage(hWndTV, TVM_GETIMAGELIST, TVSIL_NORMAL, 0) = Null  Then
        hIml = ImageList_Create(16,16,ILC_COLOR8,0,999)
        SendMessage(hWndTV, TVM_SETIMAGELIST, TVSIL_NORMAL, Cast(LPARAM,hIml))
    Endif
    SetWindowCallback(Cast(Integer,@DragDropCallback()))
    Return True
End Function

Sub DropProcedure(Button As Integer, Item As Integer)
    If Button = Drag_LeftMouse Then
        If IsMouseOver(GadgetID(Listview)) Then
            Beep
            AddListViewItem(Listview,"Item"+Str(Item),0,100,0)
        Endif
    Endif
End Sub

CenterWindow(OpenWindow("Drag'n Drop", 0, 0, 340, 300))
Dim As HBITMAP hbmp = Extract_Icon( "Shell32.DLL", 3 )'
Dim As HBITMAP hbmp1 = Extract_Icon( "Shell32.DLL", 45 )'
TreeViewGadget(Tree,10,10,140,230, TVS_HASLINES Or TVS_HASBUTTONS Or TVS_LINESATROOT,WS_EX_CLIENTEDGE,32)
Var Pos_=AddTreeViewItem(Tree,"1",hbmp,hbmp1,Cast(Integer,TVI_FIRST))
AddTreeViewItem(Tree,"1-1",hbmp,hbmp1,Cast(Integer,TVI_FIRST),Pos_)
Pos_=AddTreeViewItem(Tree,"2",hbmp,hbmp1,Pos_)
AddTreeViewItem(Tree,"2-1",hbmp,hbmp1,Cast(Integer,TVI_FIRST),Pos_)
Var LLIISS=ListViewGadget(Listview,200,10,100,230,,,,32)
AddListViewColumn(Listview, "1 Column",0,1,100)
EnableDragDrop(Tree, Drag_LeftMouse Or Drag_RightMouse)
Do:Loop Until WaitEvent=eventclose