Announcement

Collapse
No announcement yet.

TREEVIEW Drag&Drop

Collapse
X
Collapse
 
  • Page of 2
  • Filter
  • Time
  • Show
Clear All
new posts
Previous 1 2 template Next
  • #1

    TREEVIEW Drag&Drop

    Has anyone successfully implemented drag & drop functionality in the Treeview control? I've looked at related postings by Jules, Semen and others but the only thing happening is that my head is getting sore from banging it against my monitor!



    TIA
    Harry


    Tags: None
  • #2
    Harry,

    Yes I've just done it, and you're right, it's head-banging stuff

    If you can wait a little, I'll try and put a demo together. Is there
    any particular aspect of it that's causing you a problem ?

    Paul


    ------------------
    http://www.zippety.net
    mailto[email protected][email protected]</A>
    Zippety Software, Home of the Lynx Project Explorer
    http://www.zippety.net
    My e-mail

    Comment

    • #3
      Thanks for the response Paul. I havn't gotten very far yet but some of the problems are:
      the drag image is just a blurry box- using the createdragimage macro
      can't seem to find the correct starting point for the drag image
      also not correctly reading the drop co-ordinates

      In other words, most things are giving me a problem.

      Thanks again, I will eagerly await you next post.....

      Harry

      Comment

      • #4
        Harry,

        I'll put the demo project up on my website, but probably not till the weekend, due to work in progress.
        In the meantime, here are the fragments I think you need to see. Because you've been wrestling with
        this, I'll assume that many of the items involved are fairly familiar already. This has all been lifted
        from a recent project -
        Code:
        1. Initialisation
   --------------
   
  static uHotSpot  as POINTAPI
  local  uIconInfo as ICONINFO
       
  'Create the drag image list, and the drag cursor icon...
  hCursors = ImageList_Create( 32, 32, %ILC_COLOR4 or %ILC_MASK, 1, 1 )
  hCursor  = LoadCursor( %NULL, byval %IDC_ARROW )
  ImageList_AddIcon hCursors, hCursor
  GetIconInfo hCursor, uIconInfo

  'Record these in a static variable...
  uHotSpot.x = uIconInfo.hotSpot
  uHotSpot.y = uIconInfo.yHotSpot

  'Release unwanted bitmaps...
  if uIconInfo.hbmMask  <> %NULL then DeleteObject uIconInfo.hbmMask
  if uIconInfo.hbmColor <> %NULL then DeleteObject uIconInfo.hbmColor

2. Detecting drag start
   --------------------
  
  (WM_NOTIFY...)
  
  select case wParam
  ...
    case %ID_TREE
      local pNMTV as NM_TREEVIEW ptr
      
      pNMTV = lParam
      select case @pNMTV.hdr.code

        case %TVN_BEGINDRAG

          'We cannot drag the root node...
          if @pNMTV.ItemNew.hItem <> TreeView_GetRoot( hTree ) then

            'This call creates a drag image from the tree item, and returns the
            'handle of an image list containing it as item 0. Note that at this
            'stage, the image is based solely on the tree item (it doesn't contain
            'the arrow cursor yet)...
            hDragList = TreeView_CreateDragImage( hTree, @pNMTV.ItemNew.hItem )

            'Remove the existing selection...
            TreeView_SelectItem hTree, %NULL  

            'Record the level this item is at...
            m = TreeView_GetIndent( hTree )
            n = TVW_GetLevel( hTree, @pNMTV.ItemNew.hItem )

            'Get RECT for *entire line* occupied by dragged item. This is relative 
            'to treeview origin (proven)...
            TreeView_GetItemRect hTree, @pNMTV.ItemNew.hItem, uRect, %FALSE

            '@pNMTV.ptDrag is measured relative to the tree (proven)...
            ImageList_BeginDrag hDragList, _
                                0, _
                                @pNMTV.ptDrag.x - uRect.nLeft - m * n, _
                                @pNMTV.ptDrag.y - uRect.nTop
            
            'If you comment this call out, the drag image on't have an arrow in it...
            ImageList_SetDragCursorImage hCursors, _
                                         0, _
                                         @pNMTV.ptDrag.x - uRect.nLeft - xuHotSpot.x - m * n, _
                                         @pNMTV.ptDrag.y - uRect.nTop  - xuHotSpot.y
            
            'We're off...
            ImageList_DragEnter hTree, @pNMTV.ptDrag.x, @pNMTV.ptDrag.y

            'Capture the mouse & hide the normal cursor...
            SetCapture hWnd
            ShowCursor %FALSE
            hDragItem = @pNMTV.ItemNew.hItem

          end if
          ...
          
3. Looking to drop
   ---------------
  
  (WM_MOUSEMOVE)
  
  local uTV_HIT_INFO as TV_HITTESTINFO
  
  'If dragging, move the drag cursor...
  if hDragList <> %NULL then

    'See where we are...
    uPoint.x = LOWRD( lParam )                              'these are relative to <hWnd>
    uPoint.y = HIWRD( lParam )

    'Convert to tree co-ordinates...
    MapWindowPoints hWnd, hTree, byval varptr(uPoint), 1

    'Load the hit test structure...
    uTV_HIT_INFO.pt.x = uPoint.x                            'these are relative to <hTree>
    uTV_HIT_INFO.pt.y = uPoint.y

    'If over a valid drop target, hilight it...
    TreeView_HitTest hTree, uTV_HIT_INFO
    
    'If the result is a different item to hilight...
    if uTV_HIT_INFO.hItem <> TreeView_GetDropHilight( hTree ) then

      'Clear the drag image...
      ImageList_DragLeave hTree

      'Unlight the old item, hilight the new one...
      TreeView_SelectDropTarget hTree, %NULL
      TreeView_SelectDropTarget hTree, uTV_HIT_INFO.hItem

      'Show the drag image...
      ImageList_DragEnter hTree, uPoint.x, uPoint.y

    else
      ImageList_DragMove uPoint.x, uPoint.y
    end if

  end if

4. Dropping
   --------
  
  (WM_LBUTTONUP)
  
  'If dragging, drop the object in its new location...
  if hDragList <> %NULL then

    local hDropItem as long

    'Stop the dragging process...
    ImageList_DragLeave hTree
    ImageList_EndDrag
    ImageList_Destroy hDragList
    hDragList = %NULL
    ReleaseCapture
    ShowCursor %TRUE

    'We only continue if the mouse is within the tree...
    GetClientRect hTree, uRect
    GetCursorPos uPoint
    ScreenToClient hTree, uPoint
    if PtInRect( uRect, uPoint.x, uPoint.y ) then             'inside the tree

      'Determine which item was last hilighted...
      hDropItem = TreeView_GetDropHilight( hTree )

      'Unselect the drop hilight item...
      TreeView_SelectDropTarget hTree, %NULL

      if hDropItem <> %NULL then

        'drag source = hDragItem
        'drop target = hDropItem

        if hDropItem <> hDragItem then

          'If we try to drop onto one of the dragged item's children, we'll
          'get a GPF...
          if TVW_IsChildOf( hTree, hDropItem, hDragItem ) then   
            beep
          else
            TVW_MoveItem hTree, hDragItem, hDropItem, 1
          end if

        else
          beep
        end if

      end if

    end if

    'Update the treeview display...
    InvalidateRect hTree, byval %NULL, %TRUE
    ...
        Hope this is useful.

        Cheers -

        Paul



        ------------------
        http://www.zippety.net
        mailto[email protected][email protected]</A>
        Zippety Software, Home of the Lynx Project Explorer
        http://www.zippety.net
        My e-mail

        Comment

        • #5
          Hi Harry,

          I have the sample project ready, but cannot release it publicly just yet. Some of the key
          elements were adapted from instructional books, and I need to get confirmation from the
          publishers that my work doesn't infringe copyright. I don't believe it does at all, but
          I'd rather be sure.

          I suspect you may be hanging on this, so if you want to send me an e-mail, we can talk
          some more about what you need.

          Best Regards,

          Paul


          ------------------
          http://www.zippety.net
          mailto[email protected][email protected]</A>
          Zippety Software, Home of the Lynx Project Explorer
          http://www.zippety.net
          My e-mail

          Comment

          • #6
            Treeview drag and drop

            Over ten years ago, a program that created a treeview and allowed drag and drop was posted below and a final version put on the web in 2002 at:

            http://www.zippety.net/download.htm
            (click on "TreeView Drag & Drop Demo")

            This works very nicely. It is written as a standalone SDK program whereas there would be some cases where it would be more useful if it could be called as a SUB or FUNCTION from another program. Unfortunately, in my hands all attempts fail, principally as far as I can tell as a result of different message handling in the callback loop created by the SDK dunction CreateWindow in the original example and the DIALOG NEW / DIALOG SHOW MODAL functions. The following code shows the original code for the main loop and callback and the replacement. These won't compile directly (as the .inc files and resources also need to be loaded from the website) but the code itself should show you what I mean.

            The modified code replaces the passed lparam, wmsg etc. variables with the CB.LPARAM, CB.MSG etc. equivalents, and replaces %WM_CREATE with %WM_INITDIALOG (as the fomer is not sent in a dialog). However, most of the callback still fails including drag and drop.

            Is there any general advice about converting windows to dialogs and are there any obvious further modifications to the dialog code that would make it work?

            Thanks

            Peter

            Original main loop code:

            Code:
            FUNCTION WINMAIN ( BYVAL hInstance     AS LONG, _
                   BYVAL hPrevInstance AS LONG, _
                   BYVAL lpCmdLine     AS ASCIIZ PTR, _
                   BYVAL iCmdShow      AS LONG ) AS LONG

  'This is all standard SDK stuff ; create a dialog and display it

  LOCAL uCC     AS INIT_COMMON_CONTROLSEX
  LOCAL uClass  AS WndClassEx
  LOCAL msg     AS tagMsg

  LOCAL zTitle  AS ASCIIZ * 30
  LOCAL zClass  AS ASCIIZ * 30
  LOCAL hDialog AS DWORD

  'Initialise...
  zTitle               = $TITLE
  zClass               = $CLASS

  'Register main window class...
  uClass.cbSize        = SIZEOF(uClass)
  uClass.style         = 0
  uClass.lpfnwndproc   = CODEPTR(wndproc)
  uClass.cbClsExtra    = 0
  uClass.cbWndExtra    = 0
  uClass.hInstance     = hInstance
  uClass.hIcon         = %NULL
  uClass.hCursor       = %NULL
  uClass.hbrBackground = %COLOR_BTNFACE + 1
  uClass.lpszMenuName  = %NULL
  uClass.lpszCLASSNAME = VARPTR(zClass)
  RegisterClassEx uClass

  'Initialise the common controls module...
  uCC.dwSize           = SIZEOF(uCC)
  uCC.dwICC            = %ICC_TREEVIEW_CLASSES
  IF InitCommonControlsEx(uCC) = 0 THEN
    InitCommonControls                                          'Win95A
  END IF

  'Create the dialog...
  hDialog = CreateWindow( zClass, _                                          'window class name
                          zTitle, _                                          'window caption
                          %WS_CLIPCHILDREN OR %WS_CAPTION OR %WS_SYSMENU OR %WS_THICKFRAME OR %WS_MINIMIZEBOX OR %WS_MAXIMIZEBOX, _
                          300, _                                             'initial x position
                          200, _                                             'initial y position
                          300, _                                             'initial x size
                          300, _                                             'initial y size
                          %HWND_DESKTOP, _                                   'parent window handle
                          %NULL, _                                           'window menu handle
                          hInstance, _                                       'program instance handle
                          BYVAL %NULL )                                      'creation parameters

  'Show it...
  ShowWindow hDialog, iCmdShow
  UpdateWindow hDialog

  'Process messages...
  WHILE GetMessage( msg, %NULL, 0, 0 )
    TranslateMessage msg
    DispatchMessage msg
  WEND

END FUNCTION

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

FUNCTION wndproc ( BYVAL hWnd AS DWORD, BYVAL wmsg AS LONG, _
                   BYVAL wParam AS DWORD, BYVAL lParam AS LONG ) AS LONG

  STATIC xhTree       AS DWORD
  STATIC xhDragList   AS DWORD
  STATIC xhCursors    AS DWORD
  STATIC xhDragItem   AS DWORD
  STATIC xuHotSpot    AS POINTAPI

  LOCAL  pNMTV        AS NM_TREEVIEW PTR
  LOCAL  uIconInfo    AS ICONINFO
  LOCAL  uPoint       AS POINTAPI
  LOCAL  uTV_HIT_INFO AS TV_HITTESTINFO
  LOCAL  uRect        AS RECT
  LOCAL  hList        AS DWORD
  LOCAL  hCursor      AS DWORD
  LOCAL  hDropItem    AS DWORD
  LOCAL  mIndent      AS LONG                                'per-item indent (pixels)
  LOCAL  mLevel       AS LONG                                'item indentation level
  LOCAL  mResult      AS LONG

  SELECT CASE wmsg

    CASE %WM_CREATE

      'Create the treeview and set up its image list...
      GetClientRect hWnd, uRect

      xhTree = CreateTree( GetModuleHandle( BYVAL %NULL ), hWnd, uRect )
      IF xhTree = %NULL THEN

        MSGBOX "Couldn't create tree !", , $TITLE
        SendMessage hWnd, %WM_CLOSE, 0, 0

      ELSE

        'Assign a control ID to the tree...
        SetWindowlong xhTree, %GWL_ID, %ID_TREE

        'Add some dummy data to the tree...
        PopulateTree xhTree

        'Create the drag image list, and the drag cursor icon...
        xhCursors = ImageList_Create( 32, 32, %ILC_COLOR4 OR %ILC_MASK, 1, 1 )
        hCursor   = LoadCursor( %NULL, BYVAL %IDC_ARROW )
        ImageList_AddIcon xhCursors, hCursor
        GetIconInfo hCursor, uIconInfo

        'Record these in a static variable...
        xuHotSpot.x = uIconInfo.xHotSpot
        xuHotSpot.y = uIconInfo.yHotSpot

        'Clean up unwanted bitmaps...
        DeleteObject uIconInfo.hbmMask
        DeleteObject uIconInfo.hbmColor

      END IF

    CASE %WM_SIZE
MSGBOX STR$(WPARAM)
      'Have the tree fill the dialog at all times...
      SELECT CASE wParam

        CASE %SIZE_MINIMIZED
          'do nothing

        CASE %SIZE_RESTORED, %SIZE_MAXIMIZED
          MoveWindow xhTree, 0, 0, LOWRD(lParam), HIWRD(lParam), %TRUE

      END SELECT

    CASE %WM_NOTIFY

      'Respond to tree notifications...
      IF wParam = %ID_TREE THEN

        pNMTV = lParam
        SELECT CASE @pNMTV.hdr.code

          CASE %TVN_ITEMEXPANDED                                'tree item expanded/collapsed

            'Set the item's image according to its new expanded or collapsed status...
            TVW_SetImage xhTree, @pNMTV.ItemNew.hItem, @pNMTV.ItemNew.state AND %TVIS_EXPANDED

            'Refresh the whole window...
            InvalidateRect hWnd, BYVAL %NULL, %TRUE
            UpdateWindow hWnd

          CASE %TVN_BEGINDRAG

            'We only allow certain tree items to be dragged...
            IF TVW_IsDragSource( xhTree, @pNMTV.ItemNew.hItem ) THEN

              'This call creates a drag image from the tree item, and returns the
              'handle of an image list containing it as item 0. Note that at this
              'stage, the image is based solely on the tree item (it doesn't contain
              'the arrow cursor yet)...
              xhDragList = TreeView_CreateDragImage( xhTree, @pNMTV.ItemNew.hItem )

              'Remove the existing selection...
              TreeView_SelectItem xhTree, %NULL

              'Record the level this item is at...
              mIndent = TreeView_GetIndent( xhTree )
              mLevel  = TVW_GetLevel( xhTree, @pNMTV.ItemNew.hItem )

              'Get RECT for *entire line* occupied by dragged item. This is relative
              'to treeview origin (proven)...
              TreeView_GetItemRect xhTree, @pNMTV.ItemNew.hItem, uRect, %FALSE

              '@pNMTV.ptDrag is measured relative to the tree (proven)...
              ImageList_BeginDrag xhDragList, _
                                  0, _
                                  @pNMTV.ptDrag.x - uRect.nLeft - mIndent * mLevel, _
                                  @pNMTV.ptDrag.y - uRect.nTop

              'Without this line, the drag image won't contain an arrow...
              ImageList_SetDragCursorImage xhCursors, _
                                      0, _
                                      @pNMTV.ptDrag.x - uRect.nLeft - xuHotSpot.x - mIndent * mLevel, _
                                      @pNMTV.ptDrag.y - uRect.nTop  - xuHotSpot.y

              'We're off...
              ImageList_DragEnter xhTree, @pNMTV.ptDrag.x, @pNMTV.ptDrag.y

              'Capture the mouse & hide the normal cursor...
              SetCapture hWnd
              ShowCursor %FALSE
              xhDragItem = @pNMTV.ItemNew.hItem

            END IF

        END SELECT

      END IF

    CASE %WM_MOUSEMOVE

      'If dragging, move the drag cursor...
      IF xhDragList <> %NULL THEN

        'See where we are...
        uPoint.x = LOWRD( lParam )                              'these are relative to <hWnd>
        uPoint.y = HIWRD( lParam )

        'Convert to tree co-ordinates...
        MapWindowPoints hWnd, xhTree, BYVAL VARPTR(uPoint), 1

        'Load the hit test structure...
        uTV_HIT_INFO.pt.x = uPoint.x                            'these are relative to <xhTree>
        uTV_HIT_INFO.pt.y = uPoint.y

        'If over a valid drop target, hilight it...
        TreeView_HitTest xhTree, uTV_HIT_INFO

        IF TVW_IsDropTarget( xhTree, uTV_HIT_INFO.hItem ) AND (uTV_HIT_INFO.hItem <> TreeView_GetDropHilight( xhTree )) THEN

          'Clear the drag image...
          ImageList_DragLeave xhTree

          'Unlight the old item, hilight the new one...
          TreeView_SelectDropTarget xhTree, %NULL
          TreeView_SelectDropTarget xhTree, uTV_HIT_INFO.hItem

          'Show the drag image...
          ImageList_DragEnter xhTree, uPoint.x, uPoint.y

        ELSE
          ImageList_DragMove uPoint.x, uPoint.y
        END IF

        'Check if we need to auto-scroll...
        'removed (see notes)

      END IF

    CASE %WM_LBUTTONUP

      'If dragging, drop the object in its new location...
      IF xhDragList <> %NULL THEN

        'Stop the dragging process...
        ImageList_DragLeave xhTree
        ImageList_EndDrag
        ImageList_Destroy xhDragList
        xhDragList = %NULL
        ReleaseCapture
        ShowCursor %TRUE

        'We only continue if the mouse is within the tree...
        GetClientRect xhTree, uRect
        GetCursorPos uPoint
        ScreenToClient xhTree, uPoint
        IF PtInRect( uRect, uPoint.x, uPoint.y ) THEN             'inside the tree

          'Determine which item was last hilighted...
          hDropItem = TreeView_GetDropHilight( xhTree )

          'Unselect the drop hilight item...
          TreeView_SelectDropTarget xhTree, %NULL

          IF hDropItem <> %NULL THEN

            'drag source = xhDragItem
            'drop target = hDropItem

            IF hDropItem <> xhDragItem THEN

              'Disallow drops onto own children (actually, not possible in this demo)...
              IF TVW_IsChildOf( xhTree, hDropItem, xhDragItem ) THEN
                BEEP
              ELSE
                'The final aim of the drag & drop operation...
                TVW_MoveItem xhTree, xhDragItem, hDropItem
              END IF

            ELSE
              'Disallow drops onto self
              BEEP
            END IF

          END IF

        END IF

        'Update the treeview display...
        InvalidateRect xhTree, BYVAL %NULL, %TRUE

      END IF

    CASE %WM_TIMER
      'removed (see notes)

    CASE %WM_CLOSE
      hList = TreeView_GetImageList( xhTree, %TVSIL_NORMAL )
      IF hList     THEN ImageList_Destroy hList
      IF xhCursors THEN ImageList_Destroy xhCursors           'suspect unnecessary

    CASE %WM_DESTROY
      PostQuitMessage 0
      mResult = 0
      GOTO Bye_wndproc

  END SELECT

  'If we get to here, the message wasn't handled, or needs completing by the default handler...
  mResult = DefWindowProc( hWnd, wmsg, wParam, lParam )

Bye_wndproc:
  FUNCTION = mResult
  EXIT FUNCTION

END FUNCTION
            Attempted replacment:
            Code:
            FUNCTION PBMAIN() AS LONG

'   Replacement dialog  statement for CreateWindow (the dialog sizes are in units rather than pixels but this shouldn't make any difference) 

  DIALOG NEW 0, "TreeView Drag & Drop", 300, 200, 300, 300, %WS_CLIPCHILDREN OR %WS_CAPTION OR %WS_SYSMENU OR %WS_THICKFRAME OR %WS_MINIMIZEBOX OR %WS_MAXIMIZEBOX, 0 TO hWnd

  DIALOG SHOW MODAL hWnd, CALL Treeview_callback TO a

END FUNCTION


'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

CALLBACK FUNCTION treeview_callback

  STATIC hWnd         AS LONG    'Added as a static variable that takes on the value of CB.HNDL

  STATIC xhTree       AS DWORD
  STATIC xhDragList   AS DWORD
  STATIC xhCursors    AS DWORD
  STATIC xhDragItem   AS DWORD
  STATIC xuHotSpot    AS POINTAPI

  LOCAL  pNMTV        AS NM_TREEVIEW PTR
  LOCAL  uIconInfo    AS ICONINFO
  LOCAL  uPoint       AS POINTAPI
  LOCAL  uTV_HIT_INFO AS TV_HITTESTINFO
  LOCAL  uRect        AS RECT
  LOCAL  hList        AS DWORD
  LOCAL  hCursor      AS DWORD
  LOCAL  hDropItem    AS DWORD
  LOCAL  mIndent      AS LONG                                'per-item indent (pixels)
  LOCAL  mLevel       AS LONG                                'item indentation level
  LOCAL  mResult      AS LONG

  SELECT CASE CB.MSG

    CASE %WM_INITDIALOG 'Changed from %WM_CREATE

        hWnd = CB.HNDL

      'Create the treeview and set up its image list...
      GetClientRect hWnd, uRect

      xhTree = CreateTree(GetModuleHandle(BYVAL %NULL), hWnd, uRect)

      IF xhTree = %NULL THEN

        MSGBOX "Couldn't create tree !", , "TreeView Drag & Drop"
        SendMessage hWnd, %WM_CLOSE, 0, 0

      ELSE

        'Assign a control ID to the tree...
        SetWindowlong xhTree, %GWL_ID, %ID_TREE

        CALL PopulateTree(xhTree)

        'Create the drag image list, and the drag cursor icon...
        xhCursors = ImageList_Create( 32, 32, %ILC_COLOR4 OR %ILC_MASK, 1, 1 )
        hCursor   = LoadCursor( %NULL, BYVAL %IDC_ARROW )
        ImageList_AddIcon xhCursors, hCursor
        GetIconInfo hCursor, uIconInfo

        'Record these in a static variable...
        xuHotSpot.x = uIconInfo.xHotSpot
        xuHotSpot.y = uIconInfo.yHotSpot

        'Clean up unwanted bitmaps...
        DeleteObject uIconInfo.hbmMask
        DeleteObject uIconInfo.hbmColor

      END IF

    CASE %WM_SIZE

      'Have the tree fill the dialog at all times...
      SELECT CASE CB.WPARAM

        CASE %SIZE_MINIMIZED
          'do nothing

        CASE %SIZE_RESTORED, %SIZE_MAXIMIZED
          MoveWindow xhTree, 0, 0, LOWRD(CB.LPARAM), HIWRD(CB.LPARAM), %TRUE

      END SELECT

    CASE %WM_NOTIFY

      'Respond to tree notifications...
      IF CB.WPARAM = %ID_TREE THEN

        pNMTV = CB.LPARAM

        SELECT CASE @pNMTV.hdr.code

          CASE %TVN_ITEMEXPANDED                                'tree item expanded/collapsed

            'Set the item's image according to its new expanded or collapsed status...
            TVW_SetImage xhTree, @pNMTV.ItemNew.hItem, @pNMTV.ItemNew.state AND %TVIS_EXPANDED

            'Refresh the whole window...
            InvalidateRect hWnd, BYVAL %NULL, %TRUE
            UpdateWindow hWnd

          CASE %TVN_BEGINDRAG

            'We only allow certain tree items to be dragged...
            IF TVW_IsDragSource( xhTree, @pNMTV.ItemNew.hItem ) THEN

              'This call creates a drag image from the tree item, and returns the
              'handle of an image list containing it as item 0. Note that at this
              'stage, the image is based solely on the tree item (it doesn't contain
              'the arrow cursor yet)...
              xhDragList = TreeView_CreateDragImage( xhTree, @pNMTV.ItemNew.hItem )

              'Remove the existing selection...
              TreeView_SelectItem xhTree, %NULL

              'Record the level this item is at...
              mIndent = TreeView_GetIndent( xhTree )
              mLevel  = TVW_GetLevel( xhTree, @pNMTV.ItemNew.hItem )

              'Get RECT for *entire line* occupied by dragged item. This is relative
              'to treeview origin (proven)...
              TreeView_GetItemRect xhTree, @pNMTV.ItemNew.hItem, uRect, %FALSE

              '@pNMTV.ptDrag is measured relative to the tree (proven)...
              ImageList_BeginDrag xhDragList, _
                                  0, _
                                  @pNMTV.ptDrag.x - uRect.nLeft - mIndent * mLevel, _
                                  @pNMTV.ptDrag.y - uRect.nTop

              'Without this line, the drag image won't contain an arrow...
              ImageList_SetDragCursorImage xhCursors, _
                                      0, _
                                      @pNMTV.ptDrag.x - uRect.nLeft - xuHotSpot.x - mIndent * mLevel, _
                                      @pNMTV.ptDrag.y - uRect.nTop  - xuHotSpot.y

              'We're off...
              ImageList_DragEnter xhTree, @pNMTV.ptDrag.x, @pNMTV.ptDrag.y

              'Capture the mouse & hide the normal cursor...
              SetCapture hWnd
              ShowCursor %FALSE
              xhDragItem = @pNMTV.ItemNew.hItem

            END IF

        END SELECT

      END IF

    CASE %WM_MOUSEMOVE

      'If dragging, move the drag cursor...
      IF xhDragList <> %NULL THEN

        'See where we are...
        uPoint.x = LOWRD(CB.LPARAM )                              'these are relative to <hWnd>
        uPoint.y = HIWRD(CB.LPARAM )

        'Convert to tree co-ordinates...
        MapWindowPoints hWnd, xhTree, BYVAL VARPTR(uPoint), 1

        'Load the hit test structure...
        uTV_HIT_INFO.pt.x = uPoint.x                            'these are relative to <xhTree>
        uTV_HIT_INFO.pt.y = uPoint.y

        'If over a valid drop target, hilight it...
        TreeView_HitTest xhTree, uTV_HIT_INFO

        IF TVW_IsDropTarget( xhTree, uTV_HIT_INFO.hItem ) AND (uTV_HIT_INFO.hItem <> TreeView_GetDropHilight( xhTree )) THEN

          'Clear the drag image...
          ImageList_DragLeave xhTree

          'Unlight the old item, hilight the new one...
          TreeView_SelectDropTarget xhTree, %NULL
          TreeView_SelectDropTarget xhTree, uTV_HIT_INFO.hItem

          'Show the drag image...
          ImageList_DragEnter xhTree, uPoint.x, uPoint.y

        ELSE
          ImageList_DragMove uPoint.x, uPoint.y
        END IF

        'Check if we need to auto-scroll...
        'removed (see notes)

      END IF

    CASE %WM_LBUTTONUP

      'If dragging, drop the object in its new location...
      IF xhDragList <> %NULL THEN

        'Stop the dragging process...
        ImageList_DragLeave xhTree
        ImageList_EndDrag
        ImageList_Destroy xhDragList
        xhDragList = %NULL
        ReleaseCapture
        ShowCursor %TRUE

        'We only continue if the mouse is within the tree...
        GetClientRect xhTree, uRect
        GetCursorPos uPoint
        ScreenToClient xhTree, uPoint
        IF PtInRect_TV( uRect, uPoint.x, uPoint.y ) THEN             'inside the tree

          'Determine which item was last hilighted...
          hDropItem = TreeView_GetDropHilight( xhTree )

          'Unselect the drop hilight item...
          TreeView_SelectDropTarget xhTree, %NULL

          IF hDropItem <> %NULL THEN

            'drag source = xhDragItem
            'drop target = hDropItem

            IF hDropItem <> xhDragItem THEN

              'Disallow drops onto own children (actually, not possible in this demo)...
              IF TVW_IsChildOf( xhTree, hDropItem, xhDragItem ) THEN
                BEEP
              ELSE
                'The final aim of the drag & drop operation...
                TVW_MoveItem xhTree, xhDragItem, hDropItem
              END IF

            ELSE
              'Disallow drops onto self
              BEEP
            END IF

          END IF

        END IF

        'Update the treeview display...
        InvalidateRect xhTree, BYVAL %NULL, %TRUE

      END IF

    CASE %WM_TIMER
      'removed (see notes)

    CASE %WM_CLOSE
      hList = TreeView_GetImageList( xhTree, %TVSIL_NORMAL )
      IF hList     THEN ImageList_Destroy hList
      IF xhCursors THEN ImageList_Destroy xhCursors           'suspect unnecessary

    CASE %WM_DESTROY
      PostQuitMessage 0
      mResult = -1
      GOTO Bye_wndproc

  END SELECT

  'If we get to here, the message wasn't handled, or needs completing by the default handler...
  mResult = DefWindowProc(hWnd, CB.MSG, CB.WPARAM, CB.LPARAM )

Bye_wndproc:
  FUNCTION = mResult
  EXIT FUNCTION

END FUNCTION
            Last edited by Peter Simmonds; 22 Jul 2012, 05:26 AM.

            Comment

            • #7
              Hi Peter, you might increase the size of your "review panel" by providing compileable code!

              Comment

              • #8
                Compilable examples

                Hi Chris

                You're right, here is the complete code that compiles and runs. They're a bit messy because I've combined the main loop file with two .INC files for various equates and Subs. I've also attached the resource file needed for the images.

                Hope you can see the difference between the two versions, basically the dialog version draws the tree, but it is subsequently largely non-functional.


                Original version, scroll down to WINMAIN for main loop and callback code. - This is now the correect program!!
                Code:
                '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'
' Purpose : TreeView drag & drop demo
'
' Author  : Paul Noble, http://www.zippety.net, [email protected]
'
' Date    : 29 Aug 2002
'
' Remarks : Please refer to the README.TXT which accompanies this distribution, for
'           important information relating to this project.
'
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

#COMPILE  EXE
#DIM      ALL

' Main source code file:  D:\PB\dragdrop\dragdrop.bas
' Resulting include file: D:\PB\dragdrop\WINCLEAN.INC
'
' Created by inClean v1.25, 08-29-2002, 11:53:43
' Press Help-button for some useful information and tips.
'
'  31239 lines of include file data read and compared against
'    973 lines of code in 1.30 seconds.
'

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'
'
' Main include file for TreeView drag & drop demo
'
'
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
$TITLE           = "TreeView Drag & Drop"
$CLASS           = "TDD_Demo"

'Control IDs...
%ID_TREE         = 500

'Tree bitmaps...
%IDB_BOOK_C      = 100
%IDB_BOOK_O      = 101
%IDB_FOLDER_C    = 102
%IDB_FOLDER_O    = 103
%IDB_DOCUMENT    = 104

'Tree ordinals...
%IDO_BOOK_C      = 0
%IDO_BOOK_O      = 1
%IDO_FOLDER_C    = 2
%IDO_FOLDER_O    = 3
%IDO_DOCUMENT    = 4

'Max length of treeview text, including terminating null
%TV_ITEM_CHARS   = 100

'Tree scrolling...
%SCROLL_UP       = 0
%SCROLL_DOWN     = 1
%SCROLL_OFF      = 0
%SCROLL_SLOWLY   = 1
%SCROLL_QUICKLY  = 2

'Tree scroll timer...
%IDT_SCROLL      = 200

#RESOURCE ".\dragdrop.pbr"

'For convenience, we use 2 globals to keep track of treeview automatic scrolling
GLOBAL gyScrollTimerActive AS LONG
GLOBAL gmScrollDirection   AS LONG     '-----------------------------------------------------------------
' Equates:  73
'-----------------------------------------------------------------
%WINAPI                                         = 1
%TRUE                                           = 1
%FALSE                                          = 0
%NULL                                           = 0
%SB_VERT                                        = 1
%SIF_RANGE                                      = &H0001
%GWL_ID                                         = -12
%WM_CREATE                                      = &H1
%WM_DESTROY                                     = &H2
%WM_SIZE                                        = &H5
%WM_CLOSE                                       = &H10
%WM_NOTIFY                                      = &H4E
%WM_TIMER                                       = &H113
%WM_VSCROLL                                     = &H115
%WM_MOUSEMOVE                                   = &H200
%WM_LBUTTONUP                                   = &H202
%SIZE_RESTORED                                  = 0
%SIZE_MINIMIZED                                 = 1
%SIZE_MAXIMIZED                                 = 2
%WS_CHILD                                       = &H40000000
%WS_VISIBLE                                     = &H10000000
%WS_CLIPCHILDREN                                = &H02000000
%WS_CAPTION                                     = &H00C00000  ' WS_BORDER OR WS_DLGFRAME
%WS_VSCROLL                                     = &H00200000
%WS_SYSMENU                                     = &H00080000
%WS_THICKFRAME                                  = &H00040000
%WS_MINIMIZEBOX                                 = &H00020000
%WS_MAXIMIZEBOX                                 = &H00010000
%WS_EX_CLIENTEDGE                               = &H00000200
%HWND_DESKTOP                                   = 0
%SM_CYHSCROLL                                   = 3
%COLOR_BTNFACE                                  = 15
%IDC_ARROW                                      = 32512&
%ICC_TREEVIEW_CLASSES                           = &H00000002 ' treeview, tooltips
%TV_FIRST                                       = &H1100      ' TreeView messages
%TVN_FIRST                                      = 0-400       ' treeview
%ILC_MASK                                       = &H0001
%ILC_COLOR4                                     = &H0004
%ILC_COLOR16                                    = &H0010
%TVS_HASBUTTONS                                 = &H00000001
%TVS_HASLINES                                   = &H00000002
%TVS_SHOWSELALWAYS                              = &H00000020
%TVIF_TEXT                                      = &H0001
%TVIF_IMAGE                                     = &H0002
%TVIF_HANDLE                                    = &H0010
%TVIF_SELECTEDIMAGE                             = &H0020
%TVIS_EXPANDED                                  = &H0020
%TVI_ROOT                                       = &HFFFF0000???
%TVI_FIRST                                      = &HFFFF0001???
%TVI_LAST                                       = &HFFFF0002???
%TVM_INSERTITEM                                 = %TV_FIRST + 0
%TVM_DELETEITEM                                 = %TV_FIRST + 1
%TVM_EXPAND                                     = %TV_FIRST + 2
%TVE_COLLAPSE                                   = &H00000001
%TVE_EXPAND                                     = &H00000002
%TVM_GETITEMRECT                                = %TV_FIRST + 4
%TVM_GETINDENT                                  = %TV_FIRST + 6
%TVM_GETIMAGELIST                               = %TV_FIRST + 8
%TVSIL_NORMAL                                   = 0
%TVM_SETIMAGELIST                               = %TV_FIRST + 9
%TVM_GETNEXTITEM                                = %TV_FIRST + 10
%TVGN_ROOT                                      = &H0000
%TVGN_PARENT                                    = &H0003
%TVGN_CHILD                                     = &H0004
%TVGN_DROPHILITE                                = &H0008
%TVGN_CARET                                     = &H0009
%TVM_SELECTITEM                                 = %TV_FIRST + 11
%TVM_GETITEM                                    = %TV_FIRST + 12
%TVM_SETITEM                                    = %TV_FIRST + 13
%TVM_HITTEST                                    = %TV_FIRST + 17
%TVM_CREATEDRAGIMAGE                            = %TV_FIRST + 18
%TVN_ITEMEXPANDED                               = %TVN_FIRST - 6
%TVN_BEGINDRAG                                  = %TVN_FIRST - 7

'-----------------------------------------------------------------
' TYPE and UNION structures:  14
'-----------------------------------------------------------------
TYPE RECT
  nLeft AS LONG
  nTop AS LONG
  nRight AS LONG
  nBottom AS LONG
END TYPE

TYPE POINTAPI
  x AS LONG
  y AS LONG
END TYPE

TYPE tagMSG
  hwnd AS DWORD
  message AS DWORD
  wParam AS LONG
  lParam AS LONG
  time AS DWORD
  pt AS POINTAPI
END TYPE

TYPE WNDCLASSEX
    cbSize AS DWORD
    style AS DWORD
    lpfnWndProc AS LONG
    cbClsExtra AS LONG
    cbWndExtra AS LONG
    hInstance AS DWORD
    hIcon AS DWORD
    hCursor AS DWORD
    hbrBackground AS DWORD
    lpszMenuName AS ASCIIZ PTR
    lpszClassName AS ASCIIZ PTR
    hIconSm AS DWORD
END TYPE

TYPE ICONINFO
  fIcon AS LONG
  xHotspot AS DWORD
  yHotspot AS DWORD
  hbmMask AS LONG
  hbmColor AS LONG
END TYPE

TYPE NMHDR
  hwndFrom AS DWORD
  idfrom AS DWORD
  CODE AS LONG    ' used for messages, so needs to be LONG, not DWORD...
END TYPE

TYPE SCROLLINFO
    cbSize AS DWORD
    fMask AS DWORD
    nMin AS LONG
    nMax AS LONG
    nPage AS DWORD
    nPos AS LONG
    nTrackPos AS LONG
END TYPE

TYPE INIT_COMMON_CONTROLSEX
    dwSize AS DWORD   ' size of this structure
    dwICC  AS DWORD   ' flags indicating which classes to be initialized
END TYPE

TYPE TV_ITEM
    mask           AS DWORD
    hItem          AS DWORD
    STATE          AS DWORD
    stateMask      AS DWORD
    pszText        AS ASCIIZ PTR
    cchTextMax     AS LONG
    iImage         AS LONG
    iSelectedImage AS LONG
    cChildren      AS LONG
    lParam         AS LONG
END TYPE

TYPE TVITEMEX
    mask           AS DWORD
    hItem          AS DWORD
    STATE          AS DWORD
    stateMask      AS DWORD
    pszText        AS ASCIIZ PTR
    cchTextMax     AS LONG
    iImage         AS LONG
    iSelectedImage AS LONG
    cChildren      AS LONG
    lParam         AS LONG
    iIntegral      AS LONG
END TYPE

UNION TV_ITEM_UNION
    itemex AS TVITEMEX
    item   AS TV_ITEM
END UNION

TYPE TV_INSERTSTRUCT
    hParent      AS DWORD
    hInsertAfter AS DWORD
    item         AS TV_ITEM_UNION
END TYPE

TYPE TV_HITTESTINFO
    pt AS POINTAPI
    flags AS DWORD
    hItem AS DWORD
END TYPE

TYPE NM_TREEVIEW
    hdr     AS NMHDR
    action  AS DWORD
    itemOld AS TV_ITEM
    itemNew AS TV_ITEM
    ptDrag  AS POINTAPI
END TYPE

'-----------------------------------------------------------------
' Declared Functions:  40
'-----------------------------------------------------------------
DECLARE FUNCTION CreateWindowEx LIB "USER32.DLL" ALIAS "CreateWindowExA" (BYVAL dwExStyle AS DWORD, lpClassName AS ASCIIZ, lpWindowName AS ASCIIZ, BYVAL dwStyle AS DWORD, BYVAL x AS LONG, BYVAL y AS LONG, _
    BYVAL nWidth AS LONG, BYVAL nHeight AS LONG, BYVAL hWndParent AS DWORD, BYVAL hMenu AS DWORD, BYVAL hInstance AS DWORD, lpParam AS ANY) AS DWORD
DECLARE FUNCTION DefWindowProc LIB "USER32.DLL" ALIAS "DefWindowProcA" (BYVAL hWnd AS DWORD, BYVAL uMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
DECLARE FUNCTION DeleteObject LIB "GDI32.DLL" ALIAS "DeleteObject" (BYVAL hObject AS DWORD) AS LONG
DECLARE FUNCTION DispatchMessage LIB "USER32.DLL" ALIAS "DispatchMessageA" (lpMsg AS tagMSG) AS LONG
DECLARE FUNCTION GetClientRect LIB "USER32.DLL" ALIAS "GetClientRect" (BYVAL hwnd AS DWORD, lpRect AS RECT) AS LONG
DECLARE FUNCTION GetCursorPos LIB "USER32.DLL" ALIAS "GetCursorPos" (lpPoint AS POINTAPI) AS LONG
DECLARE FUNCTION GetIconInfo LIB "USER32.DLL" ALIAS "GetIconInfo" (BYVAL hIcon AS DWORD, piconinfo AS ICONINFO) AS LONG
DECLARE FUNCTION GetMessage LIB "USER32.DLL" ALIAS "GetMessageA" (lpMsg AS tagMSG, BYVAL hWnd AS DWORD, BYVAL uMsgFilterMin AS DWORD, BYVAL uMsgFilterMax AS DWORD) AS LONG
DECLARE FUNCTION GetModuleHandle LIB "KERNEL32.DLL" ALIAS "GetModuleHandleA" (lpModuleName AS ASCIIZ) AS DWORD
DECLARE FUNCTION GetScrollInfo LIB "USER32.DLL" ALIAS "GetScrollInfo" (BYVAL hWnd AS DWORD, BYVAL n AS LONG, lpScrollInfo AS SCROLLINFO) AS LONG
DECLARE FUNCTION GetSystemMetrics LIB "USER32.DLL" ALIAS "GetSystemMetrics" (BYVAL nIndex AS LONG) AS LONG
DECLARE FUNCTION ImageList_AddMasked LIB "COMCTL32.DLL" _
    ALIAS "ImageList_AddMasked" (BYVAL himl AS DWORD, _
    BYVAL hbmImage AS DWORD, BYVAL crMask AS DWORD) AS LONG
DECLARE FUNCTION ImageList_BeginDrag LIB "COMCTL32.DLL" _
    ALIAS "ImageList_BeginDrag" (BYVAL himlTrack AS DWORD, _
    BYVAL iTrack AS LONG, BYVAL dxHotSpot AS LONG, BYVAL dyHotSpot AS LONG) _
    AS LONG
DECLARE FUNCTION ImageList_Create LIB "COMCTL32.DLL" ALIAS "ImageList_Create" _
    (BYVAL cx AS LONG, BYVAL cy AS LONG, BYVAL flags AS DWORD, _
    BYVAL cInitial AS LONG, BYVAL cGrow AS LONG) AS DWORD
DECLARE FUNCTION ImageList_Destroy LIB "COMCTL32.DLL" _
    ALIAS "ImageList_Destroy" (BYVAL himl AS DWORD) AS LONG
DECLARE FUNCTION ImageList_DragEnter LIB "COMCTL32.DLL" _
    ALIAS "ImageList_DragEnter" (BYVAL hWndLock AS DWORD, BYVAL x AS LONG, _
    BYVAL y AS LONG) AS LONG
DECLARE FUNCTION ImageList_DragLeave LIB "COMCTL32.DLL" _
    ALIAS "ImageList_DragLeave" (BYVAL hWndLock AS DWORD) AS LONG
DECLARE FUNCTION ImageList_DragMove LIB "COMCTL32.DLL" _
    ALIAS "ImageList_DragMove" (BYVAL x AS LONG, BYVAL y AS LONG) AS LONG
DECLARE FUNCTION ImageList_DragShowNolock LIB "COMCTL32.DLL" _
    ALIAS "ImageList_DragShowNolock" (BYVAL fShow AS LONG) AS LONG
DECLARE FUNCTION ImageList_ReplaceIcon LIB "COMCTL32.DLL" _
    ALIAS "ImageList_ReplaceIcon" (BYVAL himl AS DWORD, BYVAL i AS LONG, _
    BYVAL hIcon AS DWORD) AS LONG
DECLARE FUNCTION ImageList_SetDragCursorImage LIB "COMCTL32.DLL" _
    ALIAS "ImageList_SetDragCursorImage" (BYVAL himlDrag AS DWORD, _
    BYVAL iDrag AS LONG, BYVAL dxHotSpot AS LONG, BYVAL dyHotSpot AS LONG) _
    AS LONG
DECLARE FUNCTION InitCommonControlsEx LIB "COMCTL32.DLL" ALIAS "InitCommonControlsEx" (icc AS INIT_COMMON_CONTROLSEX) AS LONG
DECLARE FUNCTION InvalidateRect LIB "USER32.DLL" ALIAS "InvalidateRect" (BYVAL hWnd AS DWORD, lpRect AS RECT, BYVAL bErase AS LONG) AS LONG
DECLARE FUNCTION KillTimer LIB "USER32.DLL" ALIAS "KillTimer" (BYVAL hWnd AS DWORD, BYVAL nIDEvent AS LONG) AS LONG
DECLARE FUNCTION LoadBitmap LIB "USER32.DLL" ALIAS "LoadBitmapA" (BYVAL hInstance AS DWORD, lpBitmapName AS ASCIIZ) AS DWORD
DECLARE FUNCTION LoadCursor LIB "USER32.DLL" ALIAS "LoadCursorA" (BYVAL hInstance AS DWORD, lpCursorName AS ASCIIZ) AS DWORD
DECLARE FUNCTION MapWindowPoints LIB "USER32.DLL" ALIAS "MapWindowPoints" (BYVAL hWndFrom AS DWORD, BYVAL hWndTo AS DWORD, lppt AS ANY, BYVAL cPoints AS LONG) AS LONG
DECLARE FUNCTION MoveWindow LIB "USER32.DLL" ALIAS "MoveWindow" (BYVAL hWnd AS DWORD, BYVAL x AS LONG, BYVAL y AS LONG, BYVAL nWidth AS LONG, BYVAL nHeight AS LONG, BYVAL bRepaint AS LONG) AS LONG
DECLARE FUNCTION PtInRect LIB "USER32.DLL" ALIAS "PtInRect" (lpRect AS RECT, BYVAL ptx AS LONG, BYVAL pty AS LONG) AS LONG
DECLARE FUNCTION RegisterClassEx LIB "USER32.DLL" ALIAS "RegisterClassExA" (pcWndClassEx AS WNDCLASSEX) AS WORD
DECLARE FUNCTION ReleaseCapture LIB "USER32.DLL" ALIAS "ReleaseCapture" () AS LONG
DECLARE FUNCTION ScreenToClient LIB "USER32.DLL" ALIAS "ScreenToClient" (BYVAL hWnd AS DWORD, lpPoint AS POINTAPI) AS LONG
DECLARE FUNCTION SendMessage LIB "USER32.DLL" ALIAS "SendMessageA" (BYVAL hWnd AS DWORD, BYVAL dwMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
DECLARE FUNCTION SetCapture LIB "USER32.DLL" ALIAS "SetCapture" (BYVAL hWnd AS DWORD) AS LONG
DECLARE FUNCTION SetTimer LIB "USER32.DLL" ALIAS "SetTimer" (BYVAL hWnd AS DWORD, BYVAL nIDEvent AS LONG, BYVAL uElapse AS DWORD, BYVAL lpTimerFunc AS LONG) AS LONG
DECLARE FUNCTION SetWindowLong LIB "USER32.DLL" ALIAS "SetWindowLongA" (BYVAL hWnd AS DWORD, BYVAL nIndex AS LONG, BYVAL lNewLong AS LONG) AS LONG
DECLARE FUNCTION ShowCursor LIB "USER32.DLL" ALIAS "ShowCursor" (BYVAL bShow AS LONG) AS LONG
DECLARE FUNCTION ShowWindow LIB "USER32.DLL" ALIAS "ShowWindow" (BYVAL hWnd AS DWORD, BYVAL nCmdShow AS LONG) AS LONG
DECLARE FUNCTION TranslateMessage LIB "USER32.DLL" ALIAS "TranslateMessage" (lpMsg AS tagMSG) AS LONG
DECLARE FUNCTION UpdateWindow LIB "USER32.DLL" ALIAS "UpdateWindow" (BYVAL hWnd AS DWORD) AS LONG

'-----------------------------------------------------------------
' Declared Subs:  3
'-----------------------------------------------------------------
DECLARE SUB ImageList_EndDrag LIB "COMCTL32.DLL" ALIAS "ImageList_EndDrag" ()
DECLARE SUB InitCommonControls LIB "COMCTL32.DLL" ALIAS "InitCommonControls" ()
DECLARE SUB PostQuitMessage LIB "USER32.DLL" ALIAS "PostQuitMessage" (BYVAL nExitCode AS LONG)

'-----------------------------------------------------------------
' Functions:  20  (begins with declarations)
'-----------------------------------------------------------------
DECLARE FUNCTION CreateWindow (lpClassName AS ASCIIZ, lpWindowName AS ASCIIZ, BYVAL dwStyle AS DWORD, BYVAL xx AS LONG, BYVAL yy AS LONG, BYVAL nWidth AS LONG, _
                                 BYVAL nHeight AS LONG, BYVAL hwndParent AS DWORD, BYVAL hMenu AS DWORD, BYVAL hInstance AS DWORD, BYVAL lpParam AS DWORD) AS LONG
DECLARE FUNCTION ImageList_AddIcon (BYVAL hIml AS DWORD, hIcon AS DWORD) AS LONG
DECLARE FUNCTION TreeView_InsertItem (BYVAL hWnd AS LONG, lpis AS TV_INSERTSTRUCT) _
           AS DWORD
DECLARE FUNCTION TreeView_DeleteItem (BYVAL hWnd AS DWORD, BYVAL hitem AS DWORD) _
           AS LONG
DECLARE FUNCTION TreeView_Expand (BYVAL hWnd AS DWORD, BYVAL hitem AS LONG, _
           BYVAL code AS DWORD) AS LONG
DECLARE FUNCTION TreeView_GetItemRect (BYVAL hWnd AS DWORD, BYVAL hItem AS DWORD, _
           prc AS RECT, BYVAL code AS LONG) AS LONG
DECLARE FUNCTION TreeView_GetIndent (BYVAL hWnd AS DWORD) AS DWORD
DECLARE FUNCTION TreeView_GetImageList (BYVAL hWnd AS DWORD, BYVAL iImage AS LONG) _
           AS DWORD
DECLARE FUNCTION TreeView_SetImageList (BYVAL hWnd AS DWORD, BYVAL himl AS DWORD, _
           BYVAL iImage AS LONG) AS DWORD
DECLARE FUNCTION TreeView_GetNextItem (BYVAL hWnd AS DWORD, BYVAL hitem AS DWORD, _
           BYVAL code AS DWORD) AS DWORD
DECLARE FUNCTION TreeView_GetParent (BYVAL hwnd AS DWORD, BYVAL hitem AS DWORD) _
           AS DWORD
DECLARE FUNCTION TreeView_GetDropHilight (BYVAL hwnd AS DWORD) AS DWORD
DECLARE FUNCTION TreeView_GetRoot (BYVAL hwnd AS DWORD) AS DWORD
DECLARE FUNCTION TreeView_Select (BYVAL hwnd AS DWORD, BYVAL hitem AS DWORD, _
           BYVAL code AS LONG) AS LONG
DECLARE FUNCTION TreeView_SelectItem (BYVAL hwnd AS DWORD, BYVAL hitem AS DWORD) _
           AS LONG
DECLARE FUNCTION TreeView_SelectDropTarget (BYVAL hwnd AS DWORD, _
           BYVAL hitem AS DWORD) AS LONG
DECLARE FUNCTION TreeView_GetItem (BYVAL hwnd AS DWORD, pitem AS TV_ITEM) AS LONG
DECLARE FUNCTION TreeView_SetItem (BYVAL hwnd AS DWORD, pitem AS TV_ITEM) AS LONG
DECLARE FUNCTION TreeView_HitTest (BYVAL hwnd AS DWORD, lpht AS TV_HITTESTINFO) _
           AS DWORD
DECLARE FUNCTION TreeView_CreateDragImage (BYVAL hwnd AS DWORD, BYVAL hitem AS DWORD) _
           AS DWORD
'- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
FUNCTION CreateWindow (lpClassName AS ASCIIZ, lpWindowName AS ASCIIZ, BYVAL dwStyle AS DWORD, BYVAL xx AS LONG, BYVAL yy AS LONG, BYVAL nWidth AS LONG, _
                         BYVAL nHeight AS LONG, BYVAL hwndParent AS DWORD, BYVAL hMenu AS DWORD, BYVAL hInstance AS DWORD, BYVAL lpParam AS DWORD) AS LONG
    FUNCTION = CreateWindowEx(0, lpClassName, lpWindowName, dwStyle, xx, yy, nWidth, nHeight, hWndParent, hMenu, hInstance, BYVAL lpParam)
END FUNCTION

FUNCTION ImageList_AddIcon (BYVAL hIml AS DWORD, hIcon AS DWORD) AS LONG
    FUNCTION = ImageList_ReplaceIcon(hIml, -1, hIcon)
END FUNCTION

FUNCTION TreeView_InsertItem (BYVAL hWnd AS LONG, lpis AS TV_INSERTSTRUCT) _
   AS DWORD
    FUNCTION = SendMessage(hWnd, %TVM_INSERTITEM, 0, VARPTR(lpis))
END FUNCTION

FUNCTION TreeView_DeleteItem (BYVAL hWnd AS DWORD, BYVAL hitem AS DWORD) _
   AS LONG
    FUNCTION = SendMessage(hWnd, %TVM_DELETEITEM, 0, hitem)
END FUNCTION

FUNCTION TreeView_Expand (BYVAL hWnd AS DWORD, BYVAL hitem AS LONG, _
   BYVAL code AS DWORD) AS LONG
    FUNCTION = SendMessage(hWnd, %TVM_EXPAND, CODE, hitem)
END FUNCTION

FUNCTION TreeView_GetItemRect (BYVAL hWnd AS DWORD, BYVAL hItem AS DWORD, _
   prc AS RECT, BYVAL code AS LONG) AS LONG
    prc.nLeft = hItem
    FUNCTION = SendMessage(hWnd, %TVM_GETITEMRECT, CODE, VARPTR(prc))
END FUNCTION

FUNCTION TreeView_GetIndent (BYVAL hWnd AS DWORD) AS DWORD
    FUNCTION = SendMessage(hWnd, %TVM_GETINDENT, 0, 0)
END FUNCTION

FUNCTION TreeView_GetImageList (BYVAL hWnd AS DWORD, BYVAL iImage AS LONG) _
   AS DWORD
    FUNCTION = SendMessage(hWnd, %TVM_GETIMAGELIST, iImage, 0)
END FUNCTION

FUNCTION TreeView_SetImageList (BYVAL hWnd AS DWORD, BYVAL himl AS DWORD, _
   BYVAL iImage AS LONG) AS DWORD
    FUNCTION = SendMessage(hWnd, %TVM_SETIMAGELIST, iImage, himl)
END FUNCTION

FUNCTION TreeView_GetNextItem (BYVAL hWnd AS DWORD, BYVAL hitem AS DWORD, _
   BYVAL code AS DWORD) AS DWORD
    FUNCTION = SendMessage(hWnd, %TVM_GETNEXTITEM, CODE, hitem)
END FUNCTION

FUNCTION TreeView_GetParent (BYVAL hwnd AS DWORD, BYVAL hitem AS DWORD) _
   AS DWORD
    FUNCTION = TreeView_GetNextItem(hwnd, hitem, %TVGN_PARENT)
END FUNCTION

FUNCTION TreeView_GetDropHilight (BYVAL hwnd AS DWORD) AS DWORD
    FUNCTION = TreeView_GetNextItem(hwnd, %NULL, %TVGN_DROPHILITE)
END FUNCTION

FUNCTION TreeView_GetRoot (BYVAL hwnd AS DWORD) AS DWORD
    FUNCTION = TreeView_GetNextItem(hwnd, %NULL, %TVGN_ROOT)
END FUNCTION

FUNCTION TreeView_Select (BYVAL hwnd AS DWORD, BYVAL hitem AS DWORD, _
   BYVAL code AS LONG) AS LONG
    FUNCTION = SendMessage(hwnd, %TVM_SELECTITEM, CODE, hitem)
END FUNCTION

FUNCTION TreeView_SelectItem (BYVAL hwnd AS DWORD, BYVAL hitem AS DWORD) _
   AS LONG
    FUNCTION = TreeView_Select(hwnd, hitem, %TVGN_CARET)
END FUNCTION

FUNCTION TreeView_SelectDropTarget (BYVAL hwnd AS DWORD, _
   BYVAL hitem AS DWORD) AS LONG
    FUNCTION = TreeView_Select(hwnd, hitem, %TVGN_DROPHILITE)
END FUNCTION

FUNCTION TreeView_GetItem (BYVAL hwnd AS DWORD, pitem AS TV_ITEM) AS LONG
    FUNCTION = SendMessage(hwnd, %TVM_GETITEM, 0, VARPTR(pitem))
END FUNCTION

FUNCTION TreeView_SetItem (BYVAL hwnd AS DWORD, pitem AS TV_ITEM) AS LONG
    FUNCTION = SendMessage(hwnd, %TVM_SETITEM, 0, VARPTR(pitem))
END FUNCTION

FUNCTION TreeView_HitTest (BYVAL hwnd AS DWORD, lpht AS TV_HITTESTINFO) _
   AS DWORD
    FUNCTION = SendMessage(hwnd, %TVM_HITTEST, 0, VARPTR(lpht))
END FUNCTION

FUNCTION TreeView_CreateDragImage (BYVAL hwnd AS DWORD, BYVAL hitem AS DWORD) _
   AS DWORD
    FUNCTION = SendMessage(hwnd, %TVM_CREATEDRAGIMAGE, 0, hitem)
END FUNCTION

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

FUNCTION WINMAIN ( BYVAL hInstance     AS LONG, _
                   BYVAL hPrevInstance AS LONG, _
                   BYVAL lpCmdLine     AS ASCIIZ PTR, _
                   BYVAL iCmdShow      AS LONG ) AS LONG

  'This is all standard SDK stuff ; create a dialog and display it

  LOCAL uCC     AS INIT_COMMON_CONTROLSEX
  LOCAL uClass  AS WndClassEx
  LOCAL msg     AS tagMsg

  LOCAL zTitle  AS ASCIIZ * 30
  LOCAL zClass  AS ASCIIZ * 30
  LOCAL hDialog AS DWORD

  'Initialise...
  zTitle               = $TITLE
  zClass               = $CLASS

  'Register main window class...
  uClass.cbSize        = SIZEOF(uClass)
  uClass.style         = 0
  uClass.lpfnwndproc   = CODEPTR(wndproc)
  uClass.cbClsExtra    = 0
  uClass.cbWndExtra    = 0
  uClass.hInstance     = hInstance
  uClass.hIcon         = %NULL
  uClass.hCursor       = %NULL
  uClass.hbrBackground = %COLOR_BTNFACE + 1
  uClass.lpszMenuName  = %NULL
  uClass.lpszCLASSNAME = VARPTR(zClass)
  RegisterClassEx uClass

  'Initialise the common controls module...
  uCC.dwSize           = SIZEOF(uCC)
  uCC.dwICC            = %ICC_TREEVIEW_CLASSES
  IF InitCommonControlsEx(uCC) = 0 THEN
    InitCommonControls                                          'Win95A
  END IF

  'Create the dialog...
  hDialog = CreateWindow( zClass, _                                          'window class name
                          zTitle, _                                          'window caption
                          %WS_CLIPCHILDREN OR %WS_CAPTION OR %WS_SYSMENU OR %WS_THICKFRAME OR %WS_MINIMIZEBOX OR %WS_MAXIMIZEBOX, _
                          300, _                                             'initial x position
                          200, _                                             'initial y position
                          300, _                                             'initial x size
                          300, _                                             'initial y size
                          %HWND_DESKTOP, _                                   'parent window handle
                          %NULL, _                                           'window menu handle
                          hInstance, _                                       'program instance handle
                          BYVAL %NULL )                                      'creation parameters

  'Show it...
  ShowWindow hDialog, iCmdShow
  UpdateWindow hDialog

  'Process messages...
  WHILE GetMessage( msg, %NULL, 0, 0 )
    TranslateMessage msg
    DispatchMessage msg
  WEND

END FUNCTION

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

FUNCTION wndproc ( BYVAL hWnd AS DWORD, BYVAL wmsg AS LONG, _
                   BYVAL wParam AS DWORD, BYVAL lParam AS LONG ) AS LONG

  STATIC xhTree       AS DWORD
  STATIC xhDragList   AS DWORD
  STATIC xhCursors    AS DWORD
  STATIC xhDragItem   AS DWORD
  STATIC xuHotSpot    AS POINTAPI

  LOCAL  pNMTV        AS NM_TREEVIEW PTR
  LOCAL  uIconInfo    AS ICONINFO
  LOCAL  uPoint       AS POINTAPI
  LOCAL  uTV_HIT_INFO AS TV_HITTESTINFO
  LOCAL  uRect        AS RECT
  LOCAL  hList        AS DWORD
  LOCAL  hCursor      AS DWORD
  LOCAL  hDropItem    AS DWORD
  LOCAL  mIndent      AS LONG                                'per-item indent (pixels)
  LOCAL  mLevel       AS LONG                                'item indentation level
  LOCAL  mResult      AS LONG

  SELECT CASE wmsg

    CASE %WM_CREATE

      'Create the treeview and set up its image list...
      GetClientRect hWnd, uRect

      xhTree = CreateTree( GetModuleHandle( BYVAL %NULL ), hWnd, uRect )
      IF xhTree = %NULL THEN

        MSGBOX "Couldn't create tree !", , $TITLE
        SendMessage hWnd, %WM_CLOSE, 0, 0

      ELSE

        'Assign a control ID to the tree...
        SetWindowlong xhTree, %GWL_ID, %ID_TREE

        'Add some dummy data to the tree...
        PopulateTree xhTree

        'Create the drag image list, and the drag cursor icon...
        xhCursors = ImageList_Create( 32, 32, %ILC_COLOR4 OR %ILC_MASK, 1, 1 )
        hCursor   = LoadCursor( %NULL, BYVAL %IDC_ARROW )
        ImageList_AddIcon xhCursors, hCursor
        GetIconInfo hCursor, uIconInfo

        'Record these in a static variable...
        xuHotSpot.x = uIconInfo.xHotSpot
        xuHotSpot.y = uIconInfo.yHotSpot

        'Clean up unwanted bitmaps...
        DeleteObject uIconInfo.hbmMask
        DeleteObject uIconInfo.hbmColor

      END IF

    CASE %WM_SIZE

      'Have the tree fill the dialog at all times...
      SELECT CASE wParam

        CASE %SIZE_MINIMIZED
          'do nothing

        CASE %SIZE_RESTORED, %SIZE_MAXIMIZED
          MoveWindow xhTree, 0, 0, LOWRD(lParam), HIWRD(lParam), %TRUE

      END SELECT

    CASE %WM_NOTIFY

      'Respond to tree notifications...
      IF wParam = %ID_TREE THEN

        pNMTV = lParam
        SELECT CASE @pNMTV.hdr.code

          CASE %TVN_ITEMEXPANDED                                'tree item expanded/collapsed

            'Set the item's image according to its new expanded or collapsed status...
            TVW_SetImage xhTree, @pNMTV.ItemNew.hItem, @pNMTV.ItemNew.state AND %TVIS_EXPANDED

            'Refresh the whole window...
            InvalidateRect hWnd, BYVAL %NULL, %TRUE
            UpdateWindow hWnd

          CASE %TVN_BEGINDRAG

            'We only allow certain tree items to be dragged...
            IF TVW_IsDragSource( xhTree, @pNMTV.ItemNew.hItem ) THEN

              'This call creates a drag image from the tree item, and returns the
              'handle of an image list containing it as item 0. Note that at this
              'stage, the image is based solely on the tree item (it doesn't contain
              'the arrow cursor yet)...
              xhDragList = TreeView_CreateDragImage( xhTree, @pNMTV.ItemNew.hItem )

              'Remove the existing selection...
              TreeView_SelectItem xhTree, %NULL

              'Record the level this item is at...
              mIndent = TreeView_GetIndent( xhTree )
              mLevel  = TVW_GetLevel( xhTree, @pNMTV.ItemNew.hItem )

              'Get RECT for *entire line* occupied by dragged item. This is relative
              'to treeview origin (proven)...
              TreeView_GetItemRect xhTree, @pNMTV.ItemNew.hItem, uRect, %FALSE

              '@pNMTV.ptDrag is measured relative to the tree (proven)...
              ImageList_BeginDrag xhDragList, _
                                  0, _
                                  @pNMTV.ptDrag.x - uRect.nLeft - mIndent * mLevel, _
                                  @pNMTV.ptDrag.y - uRect.nTop

              'Without this line, the drag image won't contain an arrow...
              ImageList_SetDragCursorImage xhCursors, _
                                      0, _
                                      @pNMTV.ptDrag.x - uRect.nLeft - xuHotSpot.x - mIndent * mLevel, _
                                      @pNMTV.ptDrag.y - uRect.nTop  - xuHotSpot.y

              'We're off...
              ImageList_DragEnter xhTree, @pNMTV.ptDrag.x, @pNMTV.ptDrag.y

              'Capture the mouse & hide the normal cursor...
              SetCapture hWnd
              ShowCursor %FALSE
              xhDragItem = @pNMTV.ItemNew.hItem

            END IF

        END SELECT

      END IF

    CASE %WM_MOUSEMOVE

      'If dragging, move the drag cursor...
      IF xhDragList <> %NULL THEN

        'See where we are...
        uPoint.x = LOWRD( lParam )                              'these are relative to <hWnd>
        uPoint.y = HIWRD( lParam )

        'Convert to tree co-ordinates...
        MapWindowPoints hWnd, xhTree, BYVAL VARPTR(uPoint), 1

        'Load the hit test structure...
        uTV_HIT_INFO.pt.x = uPoint.x                            'these are relative to <xhTree>
        uTV_HIT_INFO.pt.y = uPoint.y

        'If over a valid drop target, hilight it...
        TreeView_HitTest xhTree, uTV_HIT_INFO

        IF TVW_IsDropTarget( xhTree, uTV_HIT_INFO.hItem ) AND (uTV_HIT_INFO.hItem <> TreeView_GetDropHilight( xhTree )) THEN

          'Clear the drag image...
          ImageList_DragLeave xhTree

          'Unlight the old item, hilight the new one...
          TreeView_SelectDropTarget xhTree, %NULL
          TreeView_SelectDropTarget xhTree, uTV_HIT_INFO.hItem

          'Show the drag image...
          ImageList_DragEnter xhTree, uPoint.x, uPoint.y

        ELSE
          ImageList_DragMove uPoint.x, uPoint.y
        END IF

        'Check if we need to auto-scroll...
        'removed (see notes)

      END IF

    CASE %WM_LBUTTONUP

      'If dragging, drop the object in its new location...
      IF xhDragList <> %NULL THEN

        'Stop the dragging process...
        ImageList_DragLeave xhTree
        ImageList_EndDrag
        ImageList_Destroy xhDragList
        xhDragList = %NULL
        ReleaseCapture
        ShowCursor %TRUE

        'We only continue if the mouse is within the tree...
        GetClientRect xhTree, uRect
        GetCursorPos uPoint
        ScreenToClient xhTree, uPoint
        IF PtInRect( uRect, uPoint.x, uPoint.y ) THEN             'inside the tree

          'Determine which item was last hilighted...
          hDropItem = TreeView_GetDropHilight( xhTree )

          'Unselect the drop hilight item...
          TreeView_SelectDropTarget xhTree, %NULL

          IF hDropItem <> %NULL THEN

            'drag source = xhDragItem
            'drop target = hDropItem

            IF hDropItem <> xhDragItem THEN

              'Disallow drops onto own children (actually, not possible in this demo)...
              IF TVW_IsChildOf( xhTree, hDropItem, xhDragItem ) THEN
                BEEP
              ELSE
                'The final aim of the drag & drop operation...
                TVW_MoveItem xhTree, xhDragItem, hDropItem
              END IF

            ELSE
              'Disallow drops onto self
              BEEP
            END IF

          END IF

        END IF

        'Update the treeview display...
        InvalidateRect xhTree, BYVAL %NULL, %TRUE

      END IF

    CASE %WM_TIMER
      'removed (see notes)

    CASE %WM_CLOSE
      hList = TreeView_GetImageList( xhTree, %TVSIL_NORMAL )
      IF hList     THEN ImageList_Destroy hList
      IF xhCursors THEN ImageList_Destroy xhCursors           'suspect unnecessary

    CASE %WM_DESTROY
      PostQuitMessage 0
      mResult = 0
      GOTO Bye_wndproc

  END SELECT

  'If we get to here, the message wasn't handled, or needs completing by the default handler...
  mResult = DefWindowProc( hWnd, wmsg, wParam, lParam )

Bye_wndproc:
  FUNCTION = mResult
  EXIT FUNCTION

END FUNCTION


'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

SUB TVW_SetImage( BYVAL hTree AS DWORD, BYVAL hItem AS DWORD, BYVAL yExpanded AS LONG )

  LOCAL uItem          AS TV_ITEM
  LOCAL mImage         AS LONG
  LOCAL mNewImage      AS LONG

  'Find out what image is used by this item...
  uItem.hItem    = hItem                                                  'this is the item handle we want it for
  uItem.mask     = %TVIF_HANDLE OR %TVIF_IMAGE OR %TVIF_SELECTEDIMAGE     'vital to specify both images
  TreeView_GetItem hTree, uItem                                           'fetch it
  mImage         = uItem.iImage
  mNewImage      = -1                                                     'impossible value

  'Decide what (if anything) we need to change the image to...
  SELECT CASE mImage

    CASE %IDO_BOOK_C
      IF yExpanded <> 0 THEN
        IF TreeView_GetNextItem( hTree, hItem, %TVGN_CHILD ) <> %NULL THEN
          mNewImage = %IDO_BOOK_O
        END IF
      END IF

    CASE %IDO_BOOK_O
      IF yExpanded =  0 THEN mNewImage = %IDO_BOOK_C

    CASE %IDO_FOLDER_C
      IF yExpanded <> 0 THEN
        IF TreeView_GetNextItem( hTree, hItem, %TVGN_CHILD ) <> %NULL THEN
          mNewImage = %IDO_FOLDER_O
        END IF
      END IF

    CASE %IDO_FOLDER_O
      IF yExpanded =  0 THEN mNewImage = %IDO_FOLDER_C

  END SELECT

  'Is a change required ?
  IF mNewImage <> -1 THEN

    uItem.iImage = mNewImage
    uItem.iSelectedImage = mNewImage
    TreeView_SetItem hTree, uItem

  END IF

END SUB

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

SUB TVW_Expand( BYVAL hTree AS DWORD, BYVAL hItem AS DWORD, BYVAL yExpand AS LONG )

  'Purpose : Wrapper for the TreeView_Expand() macro, but adds the automatic adjustment
  '          of the image according to the new collapsed/expanded state
  '
  'Remarks : It turns out that if the *currently selected* item is expanded by code, no adjustment
  '          to its 'expanded' image takes place, so we do that here, if necessary
  '
  LOCAL uItem          AS TV_ITEM
  LOCAL mImage         AS LONG
  LOCAL mToggledImage  AS LONG

  'Perform the basic action...
  IF yExpand <> 0 THEN
    TreeView_Expand hTree, hItem, %TVE_EXPAND
  ELSE
    TreeView_Expand hTree, hItem, %TVE_COLLAPSE
  END IF

  'Update the item's images...
  TVW_SetImage hTree, hItem, yExpand

END SUB

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

FUNCTION CreateTree( BYVAL hInstance AS DWORD, BYVAL hParent AS DWORD, uRect AS RECT ) AS DWORD

  'Purpose : Creates the treeview control and sets up the image list
  '
  'Returns : Treeview handle
  '
  'Remarks : Does not create any items in the tree
  '
  LOCAL hBitmap  AS DWORD
  LOCAL hRoot    AS DWORD
  LOCAL hPItem   AS DWORD
  LOCAL hTree    AS DWORD
  LOCAL hImages  AS DWORD
  LOCAL mMaskRGB AS LONG

  'Create the treeview...
  hTree = CreateWindowEx( %WS_EX_CLIENTEDGE, _
                          "SysTreeView32", _
                          "", _                                 'window caption
                          %WS_CHILD OR _
                          %WS_VISIBLE OR _
                          %WS_VSCROLL OR _
                          %TVS_HASLINES OR _
                          %TVS_HASBUTTONS OR _
                          %TVS_SHOWSELALWAYS, _
                          uRect.nLeft, _
                          uRect.nTop, _
                          uRect.nRight - uRect.nLeft, _
                          uRect.nBottom - uRect.nTop, _
                          hParent, _
                          %NULL, _                              'window menu handle
                          hInstance, _
                          BYVAL %NULL)                          'creation parameters

  IF hTree THEN

    hImages = ImageList_Create( 16, 16, %ILC_COLOR16 OR %ILC_MASK, 6, 0 )
    TreeView_SetImageList hTree, hImages, %TVSIL_NORMAL

    'This is the mask colour we always use in our images...
    mMaskRGB = RGB(255,0,255)

    'Add bitmaps from the resource file to the image list

    'Item 0 (%IDO_BOOK_C)...
    hBitmap = LoadBitmap(hInstance, BYVAL %IDB_BOOK_C)
    ImageList_AddMasked hImages, hBitmap, mMaskRGB
    DeleteObject hBitmap

    'Item 1 (%IDO_BOOK_O)...
    hBitmap = LoadBitmap(hInstance, BYVAL %IDB_BOOK_O)
    ImageList_AddMasked hImages, hBitmap, mMaskRGB
    DeleteObject hBitmap

    'Item 2 (%IDO_FOLDER_C)...
    hBitmap = LoadBitmap(hInstance, BYVAL %IDB_FOLDER_C)
    ImageList_AddMasked hImages, hBitmap, mMaskRGB
    DeleteObject hBitmap

    'Item 3 (%IDO_FOLDER_O)...
    hBitmap = LoadBitmap(hInstance, BYVAL %IDB_FOLDER_O)
    ImageList_AddMasked hImages, hBitmap, mMaskRGB
    DeleteObject hBitmap

    'Item 4 (%IDO_DOCUMENT)...
    hBitmap = LoadBitmap(hInstance, BYVAL %IDB_DOCUMENT)
    ImageList_AddMasked hImages, hBitmap, mMaskRGB
    DeleteObject hBitmap

  END IF

  'We're done
  FUNCTION = hTree

END FUNCTION

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

SUB PopulateTree( BYVAL hTree AS DWORD )

  'Purpose : Adds dummy data to the tree
  '
  DIM   sLName()   AS STRING
  DIM   sFName()   AS STRING

  LOCAL uInsert    AS TV_INSERTSTRUCT
  LOCAL hRoot      AS DWORD
  LOCAL hFolder    AS DWORD
  LOCAL hFile      AS DWORD

  LOCAL zText      AS ASCIIZ * %TV_ITEM_CHARS
  LOCAL mFolder    AS LONG
  LOCAL mFile      AS LONG

  'Set up the insertion structure...
  uInsert.hInsertAfter             = %TVI_LAST
  uInsert.item.item.mask           = %TVIF_TEXT OR %TVIF_IMAGE OR %TVIF_SELECTEDIMAGE

  'Root node...
  zText                            = "Family Visits"
  uInsert.hParent                  = %TVI_ROOT
  uInsert.item.item.pszText        = VARPTR( zText )
  uInsert.item.item.iImage         = %IDO_BOOK_C
  uInsert.item.item.iSelectedImage = %IDO_BOOK_C
  uInsert.item.item.LPARAM         = %NULL
  hRoot                            = TreeView_InsertItem( hTree, uInsert )

  'Create some dummy data...
  REDIM sLName( 1 TO 5 )
  sLName(1) = "Smith"
  sLName(2) = "Jones"
  sLName(3) = "Clark"
  sLName(4) = "Green"
  sLName(5) = "Taylor"

  REDIM sFName( 1 TO 5 )
  sFName(1) = "John"
  sFName(2) = "Susan"
  sFName(3) = "Bridget"
  sFName(4) = "Alan"
  sFName(5) = "Carol"

  'Add some folders and files...
  FOR mFolder = 1 TO UBOUND( sLName )

    'Add folder...
    zText                            = sLName(mFolder) & " family"
    uInsert.hParent                  = hRoot
    uInsert.item.item.pszText        = VARPTR( zText )
    uInsert.item.item.iImage         = %IDO_FOLDER_C
    uInsert.item.item.iSelectedImage = %IDO_FOLDER_C
    uInsert.item.item.LPARAM         = %NULL
    hFolder                          = TreeView_InsertItem( hTree, uInsert )

    'Add files to this folder...
    FOR mFile = 1 TO UBOUND( sFName )

      zText                            = sFName(mFile) & " " & sLName(mFolder)
      uInsert.hParent                  = hFolder
      uInsert.item.item.pszText        = VARPTR( zText )
      uInsert.item.item.iImage         = %IDO_DOCUMENT
      uInsert.item.item.iSelectedImage = %IDO_DOCUMENT
      uInsert.item.item.LPARAM         = %NULL
      hFile                            = TreeView_InsertItem( hTree, uInsert )

    NEXT mFile

    'Expand say the first 2 folders...
    IF mFolder <= 2 THEN TVW_Expand hTree, hFolder, %TRUE

  NEXT mFolder

  'Expand the root node, so that all the first-level nodes are visible...
  TVW_Expand hTree, hRoot, %TRUE

Bye_BuildTree:
  ERASE sLName
  ERASE sFName
  EXIT SUB

END SUB

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

FUNCTION TVW_GetImage( BYVAL hTree AS DWORD, BYVAL hItem AS DWORD ) AS LONG

  'Purpose : Returns the ordinal of the item's bitmap ; if the item is not
  '          found, returns -1
  '
  LOCAL ti AS TV_ITEM

  ti.hItem = hItem                                              'set up the item structure
  ti.mask  = %TVIF_HANDLE OR %TVIF_IMAGE                        'these are the valid fields

  IF TreeView_GetItem( hTree, ti ) = 0 THEN                     'fetch info about the new item
    FUNCTION = -1
  ELSE
    FUNCTION = ti.iImage
  END IF

END FUNCTION

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

FUNCTION TVW_GetLevel( BYVAL hTree AS DWORD, BYVAL hItem AS DWORD ) AS LONG

  'Purpose : Returns the item's level. The root item is assumed to be at
  '          level = zero.
  '
  LOCAL hRoot  AS DWORD
  LOCAL mLevel AS LONG

  IF hItem <> %NULL THEN

    'Determine the root's handle...
    hRoot = TreeView_GetRoot( hTree )

    'Walk back up the tree, towards the root...
    WHILE hItem <> hRoot

      INCR mLevel
      hItem = TreeView_GetNextItem( hTree, hItem, %TVGN_PARENT )

    WEND

  END IF

  FUNCTION = mLevel

END FUNCTION

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

FUNCTION TVW_IsDragSource( BYVAL hTree AS DWORD, BYVAL hItem AS DWORD ) AS LONG

  'Purpose : Determines whether the specified tree item is allowed to be dragged
  '
  'Returns : 1 ... yes
  '          0 ... no
  '
  'Remarks : In this demo, we allow only 'people' to be dragged
  '
  SELECT CASE TVW_GetImage( hTree, hItem )

    CASE %IDO_DOCUMENT
      FUNCTION = 1

    CASE ELSE
      FUNCTION = 0

  END SELECT

END FUNCTION

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

FUNCTION TVW_IsDropTarget( BYVAL hTree AS DWORD, BYVAL hItemDest AS DWORD ) AS LONG

  'Returns : 0 or 1
  '
  ' The rules -
  '
  '   1. We can drop people onto a family or another person
  '   2. We cannot drop people onto the root
  '
  SELECT CASE TVW_GetImage( hTree, hItemDest )

    CASE %IDO_FOLDER_C, %IDO_FOLDER_O, %IDO_DOCUMENT
      FUNCTION = 1

    CASE ELSE
      FUNCTION = 0

  END SELECT

END FUNCTION

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

FUNCTION TVW_GetText( BYVAL hTree AS DWORD, BYVAL hItem AS DWORD ) AS STRING

  'Purpose : Returns the item's text ; if the item is not found, returns ""
  '
  LOCAL ti      AS TV_ITEM
  LOCAL zText   AS ASCIIZ * ( %TV_ITEM_CHARS + 1 )
  LOCAL s       AS STRING

  'Set up the item structure...
  ti.hItem      = hItem
  ti.mask       = %TVIF_TEXT
  zText         = SPACE$( %TV_ITEM_CHARS )
  ti.cchTextMax = %TV_ITEM_CHARS + 1
  ti.pszText    = VARPTR( zText )

  'Query the tree...
  IF TreeView_GetItem( hTree, ti ) = 0 THEN                     'call failed
    FUNCTION = ""
  ELSE
    s = zText
    FUNCTION = s
  END IF

END FUNCTION

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

FUNCTION TVW_IsChildOf( BYVAL hTree AS DWORD, BYVAL hItem AS DWORD, BYVAL hPossParent AS DWORD ) AS LONG

  'Purpose : Determines whether <hItem> is a child of <hItem2>
  '
  'Returns : 0 or 1
  '
  LOCAL mResult AS LONG
  LOCAL hRoot   AS DWORD

  IF hItem <> %NULL AND hPossParent <> %NULL THEN

    'Determine the root's handle...
    hRoot = TreeView_GetRoot( hTree )

    'Walk back up the tree, towards the root...
    WHILE hItem <> hRoot

      IF hItem = hPossParent THEN
        mResult = 1
        EXIT LOOP
      ELSE
        hItem = TreeView_GetNextItem( hTree, hItem, %TVGN_PARENT )
      END IF

    WEND

  END IF

  FUNCTION = mResult

END FUNCTION

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

FUNCTION TVW_HasChildren( BYVAL hTree AS DWORD, BYVAL hItem AS DWORD ) AS LONG

  'Purpose : Determines whether there are any child items under the specified
  '          item
  '
  'Returns : 1 ... yes there are
  '          2 ... no there aren't
  '
  IF TreeView_GetNextItem( hTree, hItem, %TVGN_CHILD ) = %NULL THEN
    FUNCTION = 0
  ELSE
    FUNCTION = 1
  END IF

END FUNCTION

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

FUNCTION TVW_MoveItem( BYVAL hTree AS DWORD, BYVAL hItemSource AS DWORD, BYVAL hItemDest AS DWORD ) AS DWORD

  'Purpose : Move a tree item following a successful drag & drop operation
  '
  'Returns : Handle of the newly-created item
  '
  'Remarks : In this demo, we only copy across the dragged item's image and text, but
  '          in general, you may want to also take across other attributes such as
  '          the item's LPARAM, expansion state, text bolding, etc
  '
  LOCAL uInsert       AS TV_INSERTSTRUCT

  LOCAL hSourceParent AS DWORD
  LOCAL hDestParent   AS DWORD
  LOCAL zText         AS ASCIIZ * %TV_ITEM_CHARS

  LOCAL hNewItem      AS DWORD


  'Start off the insertion structure...
  uInsert.item.item.mask           = %TVIF_TEXT OR %TVIF_IMAGE OR %TVIF_SELECTEDIMAGE
  zText                            = TVW_GetText( hTree, hItemSource )
  uInsert.item.item.pszText        = VARPTR( zText )
  uInsert.item.item.iImage         = TVW_GetImage ( hTree, hItemSource )
  uInsert.item.item.iSelectedImage = uInsert.item.item.iImage

  'Are we dropping onto a folder, or onto another person ?
  SELECT CASE TVW_GetImage( hTree, hItemDest )

    CASE %IDO_DOCUMENT

      'Insert the dragged person after the dropped-on person
      uInsert.hParent                  = TreeView_GetParent( hTree, hItemDest )
      uInsert.hInsertAfter             = hItemDest

    CASE %IDO_FOLDER_C, %IDO_FOLDER_O

      'Insert the dragged person as the first person under this folder
      uInsert.hParent                  = hItemDest
      uInsert.hInsertAfter             = %TVI_FIRST

    CASE ELSE
      BEEP : GOTO Bye_TVW_MoveItem

  END SELECT

  'Create the new item...
  hNewItem = TreeView_InsertItem( hTree, uInsert )

  'Did we succeed ?
  IF hNewItem THEN

    'Record these...
    hSourceParent = TreeView_GetParent( hTree, hItemSource )
    hDestParent   = TreeView_GetParent( hTree, hItemDest   )

    'Now it's safe to delete the source item...
    TreeView_DeleteItem hTree, hItemSource

    'Ensure the new item is visible and selected; we don't use TreeView_EnsureVisible(),
    'because that can leave an expanded parent's image in the wrong state...
    TVW_Expand hTree, hDestParent, 1
    TreeView_SelectItem hTree, hNewItem

    'If the source folder has been emptied, close it up...
    IF TVW_HasChildren( hTree, hSourceParent ) = 0 THEN
      TVW_Expand hTree, hSourceParent, 0
    END IF

  END IF

Bye_TVW_MoveItem:
  FUNCTION = hNewItem

END FUNCTION
                New version, scroll down to PBMAIN for start of main loop and callback.
                Code:
                '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'
' Purpose : TreeView drag & drop demo
'
' Author  : Paul Noble, http://www.zippety.net, [email protected]
'
' Date    : 29 Aug 2002
'
' Remarks : Please refer to the README.TXT which accompanies this distribution, for
'           important information relating to this project.
'
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

#COMPILE  EXE
#DIM      ALL

' Main source code file:  D:\PB\dragdrop\dragdrop.bas
' Resulting include file: D:\PB\dragdrop\WINCLEAN.INC
'
' Created by inClean v1.25, 08-29-2002, 11:53:43
' Press Help-button for some useful information and tips.
'
'  31239 lines of include file data read and compared against
'    973 lines of code in 1.30 seconds.
'

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'
'
' Main include file for TreeView drag & drop demo
'
'
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
$TITLE           = "TreeView Drag & Drop"
$CLASS           = "TDD_Demo"

'Control IDs...
%ID_TREE         = 500

'Tree bitmaps...
%IDB_BOOK_C      = 100
%IDB_BOOK_O      = 101
%IDB_FOLDER_C    = 102
%IDB_FOLDER_O    = 103
%IDB_DOCUMENT    = 104

'Tree ordinals...
%IDO_BOOK_C      = 0
%IDO_BOOK_O      = 1
%IDO_FOLDER_C    = 2
%IDO_FOLDER_O    = 3
%IDO_DOCUMENT    = 4

'Max length of treeview text, including terminating null
%TV_ITEM_CHARS   = 100

'Tree scrolling...
%SCROLL_UP       = 0
%SCROLL_DOWN     = 1
%SCROLL_OFF      = 0
%SCROLL_SLOWLY   = 1
%SCROLL_QUICKLY  = 2

'Tree scroll timer...
%IDT_SCROLL      = 200

#RESOURCE ".\dragdrop.pbr"

'For convenience, we use 2 globals to keep track of treeview automatic scrolling
GLOBAL gyScrollTimerActive AS LONG
GLOBAL gmScrollDirection   AS LONG     '-----------------------------------------------------------------
' Equates:  73
'-----------------------------------------------------------------
%WINAPI                                         = 1
%TRUE                                           = 1
%FALSE                                          = 0
%NULL                                           = 0
%SB_VERT                                        = 1
%SIF_RANGE                                      = &H0001
%GWL_ID                                         = -12
%WM_CREATE                                      = &H1
%WM_DESTROY                                     = &H2
%WM_SIZE                                        = &H5
%WM_CLOSE                                       = &H10
%WM_NOTIFY                                      = &H4E
%WM_TIMER                                       = &H113
%WM_VSCROLL                                     = &H115
%WM_MOUSEMOVE                                   = &H200
%WM_LBUTTONUP                                   = &H202
%SIZE_RESTORED                                  = 0
%SIZE_MINIMIZED                                 = 1
%SIZE_MAXIMIZED                                 = 2
%WS_CHILD                                       = &H40000000
%WS_VISIBLE                                     = &H10000000
%WS_CLIPCHILDREN                                = &H02000000
%WS_CAPTION                                     = &H00C00000  ' WS_BORDER OR WS_DLGFRAME
%WS_VSCROLL                                     = &H00200000
%WS_SYSMENU                                     = &H00080000
%WS_THICKFRAME                                  = &H00040000
%WS_MINIMIZEBOX                                 = &H00020000
%WS_MAXIMIZEBOX                                 = &H00010000
%WS_EX_CLIENTEDGE                               = &H00000200
%HWND_DESKTOP                                   = 0
%SM_CYHSCROLL                                   = 3
%COLOR_BTNFACE                                  = 15
%IDC_ARROW                                      = 32512&
%ICC_TREEVIEW_CLASSES                           = &H00000002 ' treeview, tooltips
%TV_FIRST                                       = &H1100      ' TreeView messages
%TVN_FIRST                                      = 0-400       ' treeview
%ILC_MASK                                       = &H0001
%ILC_COLOR4                                     = &H0004
%ILC_COLOR16                                    = &H0010
%TVS_HASBUTTONS                                 = &H00000001
%TVS_HASLINES                                   = &H00000002
%TVS_SHOWSELALWAYS                              = &H00000020
%TVIF_TEXT                                      = &H0001
%TVIF_IMAGE                                     = &H0002
%TVIF_HANDLE                                    = &H0010
%TVIF_SELECTEDIMAGE                             = &H0020
%TVIS_EXPANDED                                  = &H0020
%TVI_ROOT                                       = &HFFFF0000???
%TVI_FIRST                                      = &HFFFF0001???
%TVI_LAST                                       = &HFFFF0002???
%TVM_INSERTITEM                                 = %TV_FIRST + 0
%TVM_DELETEITEM                                 = %TV_FIRST + 1
%TVM_EXPAND                                     = %TV_FIRST + 2
%TVE_COLLAPSE                                   = &H00000001
%TVE_EXPAND                                     = &H00000002
%TVM_GETITEMRECT                                = %TV_FIRST + 4
%TVM_GETINDENT                                  = %TV_FIRST + 6
%TVM_GETIMAGELIST                               = %TV_FIRST + 8
%TVSIL_NORMAL                                   = 0
%TVM_SETIMAGELIST                               = %TV_FIRST + 9
%TVM_GETNEXTITEM                                = %TV_FIRST + 10
%TVGN_ROOT                                      = &H0000
%TVGN_PARENT                                    = &H0003
%TVGN_CHILD                                     = &H0004
%TVGN_DROPHILITE                                = &H0008
%TVGN_CARET                                     = &H0009
%TVM_SELECTITEM                                 = %TV_FIRST + 11
%TVM_GETITEM                                    = %TV_FIRST + 12
%TVM_SETITEM                                    = %TV_FIRST + 13
%TVM_HITTEST                                    = %TV_FIRST + 17
%TVM_CREATEDRAGIMAGE                            = %TV_FIRST + 18
%TVN_ITEMEXPANDED                               = %TVN_FIRST - 6
%TVN_BEGINDRAG                                  = %TVN_FIRST - 7

'-----------------------------------------------------------------
' TYPE and UNION structures:  14
'-----------------------------------------------------------------
TYPE RECT
  nLeft AS LONG
  nTop AS LONG
  nRight AS LONG
  nBottom AS LONG
END TYPE

TYPE POINTAPI
  x AS LONG
  y AS LONG
END TYPE

TYPE tagMSG
  hwnd AS DWORD
  message AS DWORD
  wParam AS LONG
  lParam AS LONG
  time AS DWORD
  pt AS POINTAPI
END TYPE

TYPE WNDCLASSEX
    cbSize AS DWORD
    style AS DWORD
    lpfnWndProc AS LONG
    cbClsExtra AS LONG
    cbWndExtra AS LONG
    hInstance AS DWORD
    hIcon AS DWORD
    hCursor AS DWORD
    hbrBackground AS DWORD
    lpszMenuName AS ASCIIZ PTR
    lpszClassName AS ASCIIZ PTR
    hIconSm AS DWORD
END TYPE

TYPE ICONINFO
  fIcon AS LONG
  xHotspot AS DWORD
  yHotspot AS DWORD
  hbmMask AS LONG
  hbmColor AS LONG
END TYPE

TYPE NMHDR
  hwndFrom AS DWORD
  idfrom AS DWORD
  CODE AS LONG    ' used for messages, so needs to be LONG, not DWORD...
END TYPE

TYPE SCROLLINFO
    cbSize AS DWORD
    fMask AS DWORD
    nMin AS LONG
    nMax AS LONG
    nPage AS DWORD
    nPos AS LONG
    nTrackPos AS LONG
END TYPE

TYPE INIT_COMMON_CONTROLSEX
    dwSize AS DWORD   ' size of this structure
    dwICC  AS DWORD   ' flags indicating which classes to be initialized
END TYPE

TYPE TV_ITEM
    mask           AS DWORD
    hItem          AS DWORD
    STATE          AS DWORD
    stateMask      AS DWORD
    pszText        AS ASCIIZ PTR
    cchTextMax     AS LONG
    iImage         AS LONG
    iSelectedImage AS LONG
    cChildren      AS LONG
    lParam         AS LONG
END TYPE

TYPE TVITEMEX
    mask           AS DWORD
    hItem          AS DWORD
    STATE          AS DWORD
    stateMask      AS DWORD
    pszText        AS ASCIIZ PTR
    cchTextMax     AS LONG
    iImage         AS LONG
    iSelectedImage AS LONG
    cChildren      AS LONG
    lParam         AS LONG
    iIntegral      AS LONG
END TYPE

UNION TV_ITEM_UNION
    itemex AS TVITEMEX
    item   AS TV_ITEM
END UNION

TYPE TV_INSERTSTRUCT
    hParent      AS DWORD
    hInsertAfter AS DWORD
    item         AS TV_ITEM_UNION
END TYPE

TYPE TV_HITTESTINFO
    pt AS POINTAPI
    flags AS DWORD
    hItem AS DWORD
END TYPE

TYPE NM_TREEVIEW
    hdr     AS NMHDR
    action  AS DWORD
    itemOld AS TV_ITEM
    itemNew AS TV_ITEM
    ptDrag  AS POINTAPI
END TYPE

'-----------------------------------------------------------------
' Declared Functions:  40
'-----------------------------------------------------------------
DECLARE FUNCTION CreateWindowEx LIB "USER32.DLL" ALIAS "CreateWindowExA" (BYVAL dwExStyle AS DWORD, lpClassName AS ASCIIZ, lpWindowName AS ASCIIZ, BYVAL dwStyle AS DWORD, BYVAL x AS LONG, BYVAL y AS LONG, _
    BYVAL nWidth AS LONG, BYVAL nHeight AS LONG, BYVAL hWndParent AS DWORD, BYVAL hMenu AS DWORD, BYVAL hInstance AS DWORD, lpParam AS ANY) AS DWORD
DECLARE FUNCTION DefWindowProc LIB "USER32.DLL" ALIAS "DefWindowProcA" (BYVAL hWnd AS DWORD, BYVAL uMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
DECLARE FUNCTION DeleteObject LIB "GDI32.DLL" ALIAS "DeleteObject" (BYVAL hObject AS DWORD) AS LONG
DECLARE FUNCTION DispatchMessage LIB "USER32.DLL" ALIAS "DispatchMessageA" (lpMsg AS tagMSG) AS LONG
DECLARE FUNCTION GetClientRect LIB "USER32.DLL" ALIAS "GetClientRect" (BYVAL hwnd AS DWORD, lpRect AS RECT) AS LONG
DECLARE FUNCTION GetCursorPos LIB "USER32.DLL" ALIAS "GetCursorPos" (lpPoint AS POINTAPI) AS LONG
DECLARE FUNCTION GetIconInfo LIB "USER32.DLL" ALIAS "GetIconInfo" (BYVAL hIcon AS DWORD, piconinfo AS ICONINFO) AS LONG
DECLARE FUNCTION GetMessage LIB "USER32.DLL" ALIAS "GetMessageA" (lpMsg AS tagMSG, BYVAL hWnd AS DWORD, BYVAL uMsgFilterMin AS DWORD, BYVAL uMsgFilterMax AS DWORD) AS LONG
DECLARE FUNCTION GetModuleHandle LIB "KERNEL32.DLL" ALIAS "GetModuleHandleA" (lpModuleName AS ASCIIZ) AS DWORD
DECLARE FUNCTION GetScrollInfo LIB "USER32.DLL" ALIAS "GetScrollInfo" (BYVAL hWnd AS DWORD, BYVAL n AS LONG, lpScrollInfo AS SCROLLINFO) AS LONG
DECLARE FUNCTION GetSystemMetrics LIB "USER32.DLL" ALIAS "GetSystemMetrics" (BYVAL nIndex AS LONG) AS LONG
DECLARE FUNCTION ImageList_AddMasked LIB "COMCTL32.DLL" _
    ALIAS "ImageList_AddMasked" (BYVAL himl AS DWORD, _
    BYVAL hbmImage AS DWORD, BYVAL crMask AS DWORD) AS LONG
DECLARE FUNCTION ImageList_BeginDrag LIB "COMCTL32.DLL" _
    ALIAS "ImageList_BeginDrag" (BYVAL himlTrack AS DWORD, _
    BYVAL iTrack AS LONG, BYVAL dxHotSpot AS LONG, BYVAL dyHotSpot AS LONG) _
    AS LONG
DECLARE FUNCTION ImageList_Create LIB "COMCTL32.DLL" ALIAS "ImageList_Create" _
    (BYVAL cx AS LONG, BYVAL cy AS LONG, BYVAL flags AS DWORD, _
    BYVAL cInitial AS LONG, BYVAL cGrow AS LONG) AS DWORD
DECLARE FUNCTION ImageList_Destroy LIB "COMCTL32.DLL" _
    ALIAS "ImageList_Destroy" (BYVAL himl AS DWORD) AS LONG
DECLARE FUNCTION ImageList_DragEnter LIB "COMCTL32.DLL" _
    ALIAS "ImageList_DragEnter" (BYVAL hWndLock AS DWORD, BYVAL x AS LONG, _
    BYVAL y AS LONG) AS LONG
DECLARE FUNCTION ImageList_DragLeave LIB "COMCTL32.DLL" _
    ALIAS "ImageList_DragLeave" (BYVAL hWndLock AS DWORD) AS LONG
DECLARE FUNCTION ImageList_DragMove LIB "COMCTL32.DLL" _
    ALIAS "ImageList_DragMove" (BYVAL x AS LONG, BYVAL y AS LONG) AS LONG
DECLARE FUNCTION ImageList_DragShowNolock LIB "COMCTL32.DLL" _
    ALIAS "ImageList_DragShowNolock" (BYVAL fShow AS LONG) AS LONG
DECLARE FUNCTION ImageList_ReplaceIcon LIB "COMCTL32.DLL" _
    ALIAS "ImageList_ReplaceIcon" (BYVAL himl AS DWORD, BYVAL i AS LONG, _
    BYVAL hIcon AS DWORD) AS LONG
DECLARE FUNCTION ImageList_SetDragCursorImage LIB "COMCTL32.DLL" _
    ALIAS "ImageList_SetDragCursorImage" (BYVAL himlDrag AS DWORD, _
    BYVAL iDrag AS LONG, BYVAL dxHotSpot AS LONG, BYVAL dyHotSpot AS LONG) _
    AS LONG
DECLARE FUNCTION InitCommonControlsEx LIB "COMCTL32.DLL" ALIAS "InitCommonControlsEx" (icc AS INIT_COMMON_CONTROLSEX) AS LONG
DECLARE FUNCTION InvalidateRect LIB "USER32.DLL" ALIAS "InvalidateRect" (BYVAL hWnd AS DWORD, lpRect AS RECT, BYVAL bErase AS LONG) AS LONG
DECLARE FUNCTION KillTimer LIB "USER32.DLL" ALIAS "KillTimer" (BYVAL hWnd AS DWORD, BYVAL nIDEvent AS LONG) AS LONG
DECLARE FUNCTION LoadBitmap LIB "USER32.DLL" ALIAS "LoadBitmapA" (BYVAL hInstance AS DWORD, lpBitmapName AS ASCIIZ) AS DWORD
DECLARE FUNCTION LoadCursor LIB "USER32.DLL" ALIAS "LoadCursorA" (BYVAL hInstance AS DWORD, lpCursorName AS ASCIIZ) AS DWORD
DECLARE FUNCTION MapWindowPoints LIB "USER32.DLL" ALIAS "MapWindowPoints" (BYVAL hWndFrom AS DWORD, BYVAL hWndTo AS DWORD, lppt AS ANY, BYVAL cPoints AS LONG) AS LONG
DECLARE FUNCTION MoveWindow LIB "USER32.DLL" ALIAS "MoveWindow" (BYVAL hWnd AS DWORD, BYVAL x AS LONG, BYVAL y AS LONG, BYVAL nWidth AS LONG, BYVAL nHeight AS LONG, BYVAL bRepaint AS LONG) AS LONG
DECLARE FUNCTION PtInRect LIB "USER32.DLL" ALIAS "PtInRect" (lpRect AS RECT, BYVAL ptx AS LONG, BYVAL pty AS LONG) AS LONG
DECLARE FUNCTION RegisterClassEx LIB "USER32.DLL" ALIAS "RegisterClassExA" (pcWndClassEx AS WNDCLASSEX) AS WORD
DECLARE FUNCTION ReleaseCapture LIB "USER32.DLL" ALIAS "ReleaseCapture" () AS LONG
DECLARE FUNCTION ScreenToClient LIB "USER32.DLL" ALIAS "ScreenToClient" (BYVAL hWnd AS DWORD, lpPoint AS POINTAPI) AS LONG
DECLARE FUNCTION SendMessage LIB "USER32.DLL" ALIAS "SendMessageA" (BYVAL hWnd AS DWORD, BYVAL dwMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
DECLARE FUNCTION SetCapture LIB "USER32.DLL" ALIAS "SetCapture" (BYVAL hWnd AS DWORD) AS LONG
DECLARE FUNCTION SetTimer LIB "USER32.DLL" ALIAS "SetTimer" (BYVAL hWnd AS DWORD, BYVAL nIDEvent AS LONG, BYVAL uElapse AS DWORD, BYVAL lpTimerFunc AS LONG) AS LONG
DECLARE FUNCTION SetWindowLong LIB "USER32.DLL" ALIAS "SetWindowLongA" (BYVAL hWnd AS DWORD, BYVAL nIndex AS LONG, BYVAL lNewLong AS LONG) AS LONG
DECLARE FUNCTION ShowCursor LIB "USER32.DLL" ALIAS "ShowCursor" (BYVAL bShow AS LONG) AS LONG
DECLARE FUNCTION ShowWindow LIB "USER32.DLL" ALIAS "ShowWindow" (BYVAL hWnd AS DWORD, BYVAL nCmdShow AS LONG) AS LONG
DECLARE FUNCTION TranslateMessage LIB "USER32.DLL" ALIAS "TranslateMessage" (lpMsg AS tagMSG) AS LONG
DECLARE FUNCTION UpdateWindow LIB "USER32.DLL" ALIAS "UpdateWindow" (BYVAL hWnd AS DWORD) AS LONG

'-----------------------------------------------------------------
' Declared Subs:  3
'-----------------------------------------------------------------
DECLARE SUB ImageList_EndDrag LIB "COMCTL32.DLL" ALIAS "ImageList_EndDrag" ()
DECLARE SUB InitCommonControls LIB "COMCTL32.DLL" ALIAS "InitCommonControls" ()
DECLARE SUB PostQuitMessage LIB "USER32.DLL" ALIAS "PostQuitMessage" (BYVAL nExitCode AS LONG)

'-----------------------------------------------------------------
' Functions:  20  (begins with declarations)
'-----------------------------------------------------------------
DECLARE FUNCTION CreateWindow (lpClassName AS ASCIIZ, lpWindowName AS ASCIIZ, BYVAL dwStyle AS DWORD, BYVAL xx AS LONG, BYVAL yy AS LONG, BYVAL nWidth AS LONG, _
                                 BYVAL nHeight AS LONG, BYVAL hwndParent AS DWORD, BYVAL hMenu AS DWORD, BYVAL hInstance AS DWORD, BYVAL lpParam AS DWORD) AS LONG
DECLARE FUNCTION ImageList_AddIcon (BYVAL hIml AS DWORD, hIcon AS DWORD) AS LONG
DECLARE FUNCTION TreeView_InsertItem (BYVAL hWnd AS LONG, lpis AS TV_INSERTSTRUCT) _
           AS DWORD
DECLARE FUNCTION TreeView_DeleteItem (BYVAL hWnd AS DWORD, BYVAL hitem AS DWORD) _
           AS LONG
DECLARE FUNCTION TreeView_Expand (BYVAL hWnd AS DWORD, BYVAL hitem AS LONG, _
           BYVAL code AS DWORD) AS LONG
DECLARE FUNCTION TreeView_GetItemRect (BYVAL hWnd AS DWORD, BYVAL hItem AS DWORD, _
           prc AS RECT, BYVAL code AS LONG) AS LONG
DECLARE FUNCTION TreeView_GetIndent (BYVAL hWnd AS DWORD) AS DWORD
DECLARE FUNCTION TreeView_GetImageList (BYVAL hWnd AS DWORD, BYVAL iImage AS LONG) _
           AS DWORD
DECLARE FUNCTION TreeView_SetImageList (BYVAL hWnd AS DWORD, BYVAL himl AS DWORD, _
           BYVAL iImage AS LONG) AS DWORD
DECLARE FUNCTION TreeView_GetNextItem (BYVAL hWnd AS DWORD, BYVAL hitem AS DWORD, _
           BYVAL code AS DWORD) AS DWORD
DECLARE FUNCTION TreeView_GetParent (BYVAL hwnd AS DWORD, BYVAL hitem AS DWORD) _
           AS DWORD
DECLARE FUNCTION TreeView_GetDropHilight (BYVAL hwnd AS DWORD) AS DWORD
DECLARE FUNCTION TreeView_GetRoot (BYVAL hwnd AS DWORD) AS DWORD
DECLARE FUNCTION TreeView_Select (BYVAL hwnd AS DWORD, BYVAL hitem AS DWORD, _
           BYVAL code AS LONG) AS LONG
DECLARE FUNCTION TreeView_SelectItem (BYVAL hwnd AS DWORD, BYVAL hitem AS DWORD) _
           AS LONG
DECLARE FUNCTION TreeView_SelectDropTarget (BYVAL hwnd AS DWORD, _
           BYVAL hitem AS DWORD) AS LONG
DECLARE FUNCTION TreeView_GetItem (BYVAL hwnd AS DWORD, pitem AS TV_ITEM) AS LONG
DECLARE FUNCTION TreeView_SetItem (BYVAL hwnd AS DWORD, pitem AS TV_ITEM) AS LONG
DECLARE FUNCTION TreeView_HitTest (BYVAL hwnd AS DWORD, lpht AS TV_HITTESTINFO) _
           AS DWORD
DECLARE FUNCTION TreeView_CreateDragImage (BYVAL hwnd AS DWORD, BYVAL hitem AS DWORD) _
           AS DWORD
'- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
FUNCTION CreateWindow (lpClassName AS ASCIIZ, lpWindowName AS ASCIIZ, BYVAL dwStyle AS DWORD, BYVAL xx AS LONG, BYVAL yy AS LONG, BYVAL nWidth AS LONG, _
                         BYVAL nHeight AS LONG, BYVAL hwndParent AS DWORD, BYVAL hMenu AS DWORD, BYVAL hInstance AS DWORD, BYVAL lpParam AS DWORD) AS LONG
    FUNCTION = CreateWindowEx(0, lpClassName, lpWindowName, dwStyle, xx, yy, nWidth, nHeight, hWndParent, hMenu, hInstance, BYVAL lpParam)
END FUNCTION

FUNCTION ImageList_AddIcon (BYVAL hIml AS DWORD, hIcon AS DWORD) AS LONG
    FUNCTION = ImageList_ReplaceIcon(hIml, -1, hIcon)
END FUNCTION

FUNCTION TreeView_InsertItem (BYVAL hWnd AS LONG, lpis AS TV_INSERTSTRUCT) _
   AS DWORD
    FUNCTION = SendMessage(hWnd, %TVM_INSERTITEM, 0, VARPTR(lpis))
END FUNCTION

FUNCTION TreeView_DeleteItem (BYVAL hWnd AS DWORD, BYVAL hitem AS DWORD) _
   AS LONG
    FUNCTION = SendMessage(hWnd, %TVM_DELETEITEM, 0, hitem)
END FUNCTION

FUNCTION TreeView_Expand (BYVAL hWnd AS DWORD, BYVAL hitem AS LONG, _
   BYVAL code AS DWORD) AS LONG
    FUNCTION = SendMessage(hWnd, %TVM_EXPAND, CODE, hitem)
END FUNCTION

FUNCTION TreeView_GetItemRect (BYVAL hWnd AS DWORD, BYVAL hItem AS DWORD, _
   prc AS RECT, BYVAL code AS LONG) AS LONG
    prc.nLeft = hItem
    FUNCTION = SendMessage(hWnd, %TVM_GETITEMRECT, CODE, VARPTR(prc))
END FUNCTION

FUNCTION TreeView_GetIndent (BYVAL hWnd AS DWORD) AS DWORD
    FUNCTION = SendMessage(hWnd, %TVM_GETINDENT, 0, 0)
END FUNCTION

FUNCTION TreeView_GetImageList (BYVAL hWnd AS DWORD, BYVAL iImage AS LONG) _
   AS DWORD
    FUNCTION = SendMessage(hWnd, %TVM_GETIMAGELIST, iImage, 0)
END FUNCTION

FUNCTION TreeView_SetImageList (BYVAL hWnd AS DWORD, BYVAL himl AS DWORD, _
   BYVAL iImage AS LONG) AS DWORD
    FUNCTION = SendMessage(hWnd, %TVM_SETIMAGELIST, iImage, himl)
END FUNCTION

FUNCTION TreeView_GetNextItem (BYVAL hWnd AS DWORD, BYVAL hitem AS DWORD, _
   BYVAL code AS DWORD) AS DWORD
    FUNCTION = SendMessage(hWnd, %TVM_GETNEXTITEM, CODE, hitem)
END FUNCTION

FUNCTION TreeView_GetParent (BYVAL hwnd AS DWORD, BYVAL hitem AS DWORD) _
   AS DWORD
    FUNCTION = TreeView_GetNextItem(hwnd, hitem, %TVGN_PARENT)
END FUNCTION

FUNCTION TreeView_GetDropHilight (BYVAL hwnd AS DWORD) AS DWORD
    FUNCTION = TreeView_GetNextItem(hwnd, %NULL, %TVGN_DROPHILITE)
END FUNCTION

FUNCTION TreeView_GetRoot (BYVAL hwnd AS DWORD) AS DWORD
    FUNCTION = TreeView_GetNextItem(hwnd, %NULL, %TVGN_ROOT)
END FUNCTION

FUNCTION TreeView_Select (BYVAL hwnd AS DWORD, BYVAL hitem AS DWORD, _
   BYVAL code AS LONG) AS LONG
    FUNCTION = SendMessage(hwnd, %TVM_SELECTITEM, CODE, hitem)
END FUNCTION

FUNCTION TreeView_SelectItem (BYVAL hwnd AS DWORD, BYVAL hitem AS DWORD) _
   AS LONG
    FUNCTION = TreeView_Select(hwnd, hitem, %TVGN_CARET)
END FUNCTION

FUNCTION TreeView_SelectDropTarget (BYVAL hwnd AS DWORD, _
   BYVAL hitem AS DWORD) AS LONG
    FUNCTION = TreeView_Select(hwnd, hitem, %TVGN_DROPHILITE)
END FUNCTION

FUNCTION TreeView_GetItem (BYVAL hwnd AS DWORD, pitem AS TV_ITEM) AS LONG
    FUNCTION = SendMessage(hwnd, %TVM_GETITEM, 0, VARPTR(pitem))
END FUNCTION

FUNCTION TreeView_SetItem (BYVAL hwnd AS DWORD, pitem AS TV_ITEM) AS LONG
    FUNCTION = SendMessage(hwnd, %TVM_SETITEM, 0, VARPTR(pitem))
END FUNCTION

FUNCTION TreeView_HitTest (BYVAL hwnd AS DWORD, lpht AS TV_HITTESTINFO) _
   AS DWORD
    FUNCTION = SendMessage(hwnd, %TVM_HITTEST, 0, VARPTR(lpht))
END FUNCTION

FUNCTION TreeView_CreateDragImage (BYVAL hwnd AS DWORD, BYVAL hitem AS DWORD) _
   AS DWORD
    FUNCTION = SendMessage(hwnd, %TVM_CREATEDRAGIMAGE, 0, hitem)
END FUNCTION

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

FUNCTION PBMAIN() AS LONG
  DIM hWnd AS LONG
  DIALOG NEW 0, "TreeView Drag & Drop", 200, 200, 300, 300, %WS_CLIPCHILDREN OR %WS_CAPTION OR %WS_SYSMENU OR %WS_THICKFRAME OR %WS_MINIMIZEBOX OR %WS_MAXIMIZEBOX, 0 TO hWnd

  DIALOG SHOW MODAL hWnd, CALL Treeview_callback

END FUNCTION


'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

CALLBACK FUNCTION treeview_callback

  STATIC hWnd         AS LONG    'Added as a static variable that takes on the value of CB.HNDL

  STATIC xhTree       AS DWORD
  STATIC xhDragList   AS DWORD
  STATIC xhCursors    AS DWORD
  STATIC xhDragItem   AS DWORD
  STATIC xuHotSpot    AS POINTAPI

  LOCAL  pNMTV        AS NM_TREEVIEW PTR
  LOCAL  uIconInfo    AS ICONINFO
  LOCAL  uPoint       AS POINTAPI
  LOCAL  uTV_HIT_INFO AS TV_HITTESTINFO
  LOCAL  uRect        AS RECT
  LOCAL  hList        AS DWORD
  LOCAL  hCursor      AS DWORD
  LOCAL  hDropItem    AS DWORD
  LOCAL  mIndent      AS LONG                                'per-item indent (pixels)
  LOCAL  mLevel       AS LONG                                'item indentation level
  LOCAL  mResult      AS LONG

  SELECT CASE CB.MSG

    CASE %WM_INITDIALOG 'Changed from %WM_CREATE

        hWnd = CB.HNDL

      'Create the treeview and set up its image list...
      GetClientRect hWnd, uRect

      xhTree = CreateTree(GetModuleHandle(BYVAL %NULL), hWnd, uRect)

      IF xhTree = %NULL THEN

        MSGBOX "Couldn't create tree !", , "TreeView Drag & Drop"
        SendMessage hWnd, %WM_CLOSE, 0, 0

      ELSE

        'Assign a control ID to the tree...
        SetWindowlong xhTree, %GWL_ID, %ID_TREE

        CALL PopulateTree(xhTree)

        'Create the drag image list, and the drag cursor icon...
        xhCursors = ImageList_Create( 32, 32, %ILC_COLOR4 OR %ILC_MASK, 1, 1 )
        hCursor   = LoadCursor( %NULL, BYVAL %IDC_ARROW )
        ImageList_AddIcon xhCursors, hCursor
        GetIconInfo hCursor, uIconInfo

        'Record these in a static variable...
        xuHotSpot.x = uIconInfo.xHotSpot
        xuHotSpot.y = uIconInfo.yHotSpot

        'Clean up unwanted bitmaps...
        DeleteObject uIconInfo.hbmMask
        DeleteObject uIconInfo.hbmColor

      END IF

    CASE %WM_SIZE

      'Have the tree fill the dialog at all times...
      SELECT CASE CB.WPARAM

        CASE %SIZE_MINIMIZED
          'do nothing

        CASE %SIZE_RESTORED, %SIZE_MAXIMIZED
          MoveWindow xhTree, 0, 0, LOWRD(CB.LPARAM), HIWRD(CB.LPARAM), %TRUE

      END SELECT

    CASE %WM_NOTIFY

      'Respond to tree notifications...
      IF CB.WPARAM = %ID_TREE THEN

        pNMTV = CB.LPARAM

        SELECT CASE @pNMTV.hdr.code

          CASE %TVN_ITEMEXPANDED                                'tree item expanded/collapsed

            'Set the item's image according to its new expanded or collapsed status...
            TVW_SetImage xhTree, @pNMTV.ItemNew.hItem, @pNMTV.ItemNew.state AND %TVIS_EXPANDED

            'Refresh the whole window...
            InvalidateRect hWnd, BYVAL %NULL, %TRUE
            UpdateWindow hWnd

          CASE %TVN_BEGINDRAG

            'We only allow certain tree items to be dragged...
            IF TVW_IsDragSource( xhTree, @pNMTV.ItemNew.hItem ) THEN

              'This call creates a drag image from the tree item, and returns the
              'handle of an image list containing it as item 0. Note that at this
              'stage, the image is based solely on the tree item (it doesn't contain
              'the arrow cursor yet)...
              xhDragList = TreeView_CreateDragImage( xhTree, @pNMTV.ItemNew.hItem )

              'Remove the existing selection...
              TreeView_SelectItem xhTree, %NULL

              'Record the level this item is at...
              mIndent = TreeView_GetIndent( xhTree )
              mLevel  = TVW_GetLevel( xhTree, @pNMTV.ItemNew.hItem )

              'Get RECT for *entire line* occupied by dragged item. This is relative
              'to treeview origin (proven)...
              TreeView_GetItemRect xhTree, @pNMTV.ItemNew.hItem, uRect, %FALSE

              '@pNMTV.ptDrag is measured relative to the tree (proven)...
              ImageList_BeginDrag xhDragList, _
                                  0, _
                                  @pNMTV.ptDrag.x - uRect.nLeft - mIndent * mLevel, _
                                  @pNMTV.ptDrag.y - uRect.nTop

              'Without this line, the drag image won't contain an arrow...
              ImageList_SetDragCursorImage xhCursors, _
                                      0, _
                                      @pNMTV.ptDrag.x - uRect.nLeft - xuHotSpot.x - mIndent * mLevel, _
                                      @pNMTV.ptDrag.y - uRect.nTop  - xuHotSpot.y

              'We're off...
              ImageList_DragEnter xhTree, @pNMTV.ptDrag.x, @pNMTV.ptDrag.y

              'Capture the mouse & hide the normal cursor...
              SetCapture hWnd
              ShowCursor %FALSE
              xhDragItem = @pNMTV.ItemNew.hItem

            END IF

        END SELECT

      END IF

    CASE %WM_MOUSEMOVE

      'If dragging, move the drag cursor...
      IF xhDragList <> %NULL THEN

        'See where we are...
        uPoint.x = LOWRD(CB.LPARAM )                              'these are relative to <hWnd>
        uPoint.y = HIWRD(CB.LPARAM )

        'Convert to tree co-ordinates...
        MapWindowPoints hWnd, xhTree, BYVAL VARPTR(uPoint), 1

        'Load the hit test structure...
        uTV_HIT_INFO.pt.x = uPoint.x                            'these are relative to <xhTree>
        uTV_HIT_INFO.pt.y = uPoint.y

        'If over a valid drop target, hilight it...
        TreeView_HitTest xhTree, uTV_HIT_INFO

        IF TVW_IsDropTarget( xhTree, uTV_HIT_INFO.hItem ) AND (uTV_HIT_INFO.hItem <> TreeView_GetDropHilight( xhTree )) THEN

          'Clear the drag image...
          ImageList_DragLeave xhTree

          'Unlight the old item, hilight the new one...
          TreeView_SelectDropTarget xhTree, %NULL
          TreeView_SelectDropTarget xhTree, uTV_HIT_INFO.hItem

          'Show the drag image...
          ImageList_DragEnter xhTree, uPoint.x, uPoint.y

        ELSE
          ImageList_DragMove uPoint.x, uPoint.y
        END IF

        'Check if we need to auto-scroll...
        'removed (see notes)

      END IF

    CASE %WM_LBUTTONUP

      'If dragging, drop the object in its new location...
      IF xhDragList <> %NULL THEN

        'Stop the dragging process...
        ImageList_DragLeave xhTree
        ImageList_EndDrag
        ImageList_Destroy xhDragList
        xhDragList = %NULL
        ReleaseCapture
        ShowCursor %TRUE

        'We only continue if the mouse is within the tree...
        GetClientRect xhTree, uRect
        GetCursorPos uPoint
        ScreenToClient xhTree, uPoint
        IF PtInRect( uRect, uPoint.x, uPoint.y ) THEN             'inside the tree

          'Determine which item was last hilighted...
          hDropItem = TreeView_GetDropHilight( xhTree )

          'Unselect the drop hilight item...
          TreeView_SelectDropTarget xhTree, %NULL

          IF hDropItem <> %NULL THEN

            'drag source = xhDragItem
            'drop target = hDropItem

            IF hDropItem <> xhDragItem THEN

              'Disallow drops onto own children (actually, not possible in this demo)...
              IF TVW_IsChildOf( xhTree, hDropItem, xhDragItem ) THEN
                BEEP
              ELSE
                'The final aim of the drag & drop operation...
                TVW_MoveItem xhTree, xhDragItem, hDropItem
              END IF

            ELSE
              'Disallow drops onto self
              BEEP
            END IF

          END IF

        END IF

        'Update the treeview display...
        InvalidateRect xhTree, BYVAL %NULL, %TRUE

      END IF

    CASE %WM_TIMER
      'removed (see notes)

    CASE %WM_CLOSE
      hList = TreeView_GetImageList( xhTree, %TVSIL_NORMAL )
      IF hList     THEN ImageList_Destroy hList
      IF xhCursors THEN ImageList_Destroy xhCursors           'suspect unnecessary

    CASE %WM_DESTROY
      PostQuitMessage 0
      mResult = -1
      GOTO Bye_wndproc

  END SELECT

  'If we get to here, the message wasn't handled, or needs completing by the default handler...
  mResult = DefWindowProc(hWnd, CB.MSG, CB.WPARAM, CB.LPARAM )

Bye_wndproc:
  FUNCTION = mResult
  EXIT FUNCTION

END FUNCTION


'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

SUB TVW_SetImage( BYVAL hTree AS DWORD, BYVAL hItem AS DWORD, BYVAL yExpanded AS LONG )

  LOCAL uItem          AS TV_ITEM
  LOCAL mImage         AS LONG
  LOCAL mNewImage      AS LONG

  'Find out what image is used by this item...
  uItem.hItem    = hItem                                                  'this is the item handle we want it for
  uItem.mask     = %TVIF_HANDLE OR %TVIF_IMAGE OR %TVIF_SELECTEDIMAGE     'vital to specify both images
  TreeView_GetItem hTree, uItem                                           'fetch it
  mImage         = uItem.iImage
  mNewImage      = -1                                                     'impossible value

  'Decide what (if anything) we need to change the image to...
  SELECT CASE mImage

    CASE %IDO_BOOK_C
      IF yExpanded <> 0 THEN
        IF TreeView_GetNextItem( hTree, hItem, %TVGN_CHILD ) <> %NULL THEN
          mNewImage = %IDO_BOOK_O
        END IF
      END IF

    CASE %IDO_BOOK_O
      IF yExpanded =  0 THEN mNewImage = %IDO_BOOK_C

    CASE %IDO_FOLDER_C
      IF yExpanded <> 0 THEN
        IF TreeView_GetNextItem( hTree, hItem, %TVGN_CHILD ) <> %NULL THEN
          mNewImage = %IDO_FOLDER_O
        END IF
      END IF

    CASE %IDO_FOLDER_O
      IF yExpanded =  0 THEN mNewImage = %IDO_FOLDER_C

  END SELECT

  'Is a change required ?
  IF mNewImage <> -1 THEN

    uItem.iImage = mNewImage
    uItem.iSelectedImage = mNewImage
    TreeView_SetItem hTree, uItem

  END IF

END SUB

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

SUB TVW_Expand( BYVAL hTree AS DWORD, BYVAL hItem AS DWORD, BYVAL yExpand AS LONG )

  'Purpose : Wrapper for the TreeView_Expand() macro, but adds the automatic adjustment
  '          of the image according to the new collapsed/expanded state
  '
  'Remarks : It turns out that if the *currently selected* item is expanded by code, no adjustment
  '          to its 'expanded' image takes place, so we do that here, if necessary
  '
  LOCAL uItem          AS TV_ITEM
  LOCAL mImage         AS LONG
  LOCAL mToggledImage  AS LONG

  'Perform the basic action...
  IF yExpand <> 0 THEN
    TreeView_Expand hTree, hItem, %TVE_EXPAND
  ELSE
    TreeView_Expand hTree, hItem, %TVE_COLLAPSE
  END IF

  'Update the item's images...
  TVW_SetImage hTree, hItem, yExpand

END SUB

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

FUNCTION CreateTree( BYVAL hInstance AS DWORD, BYVAL hParent AS DWORD, uRect AS RECT ) AS DWORD

  'Purpose : Creates the treeview control and sets up the image list
  '
  'Returns : Treeview handle
  '
  'Remarks : Does not create any items in the tree
  '
  LOCAL hBitmap  AS DWORD
  LOCAL hRoot    AS DWORD
  LOCAL hPItem   AS DWORD
  LOCAL hTree    AS DWORD
  LOCAL hImages  AS DWORD
  LOCAL mMaskRGB AS LONG

  'Create the treeview...
  hTree = CreateWindowEx( %WS_EX_CLIENTEDGE, _
                          "SysTreeView32", _
                          "", _                                 'window caption
                          %WS_CHILD OR _
                          %WS_VISIBLE OR _
                          %WS_VSCROLL OR _
                          %TVS_HASLINES OR _
                          %TVS_HASBUTTONS OR _
                          %TVS_SHOWSELALWAYS, _
                          uRect.nLeft, _
                          uRect.nTop, _
                          uRect.nRight - uRect.nLeft, _
                          uRect.nBottom - uRect.nTop, _
                          hParent, _
                          %NULL, _                              'window menu handle
                          hInstance, _
                          BYVAL %NULL)                          'creation parameters

  IF hTree THEN

    hImages = ImageList_Create( 16, 16, %ILC_COLOR16 OR %ILC_MASK, 6, 0 )
    TreeView_SetImageList hTree, hImages, %TVSIL_NORMAL

    'This is the mask colour we always use in our images...
    mMaskRGB = RGB(255,0,255)

    'Add bitmaps from the resource file to the image list

    'Item 0 (%IDO_BOOK_C)...
    hBitmap = LoadBitmap(hInstance, BYVAL %IDB_BOOK_C)
    ImageList_AddMasked hImages, hBitmap, mMaskRGB
    DeleteObject hBitmap

    'Item 1 (%IDO_BOOK_O)...
    hBitmap = LoadBitmap(hInstance, BYVAL %IDB_BOOK_O)
    ImageList_AddMasked hImages, hBitmap, mMaskRGB
    DeleteObject hBitmap

    'Item 2 (%IDO_FOLDER_C)...
    hBitmap = LoadBitmap(hInstance, BYVAL %IDB_FOLDER_C)
    ImageList_AddMasked hImages, hBitmap, mMaskRGB
    DeleteObject hBitmap

    'Item 3 (%IDO_FOLDER_O)...
    hBitmap = LoadBitmap(hInstance, BYVAL %IDB_FOLDER_O)
    ImageList_AddMasked hImages, hBitmap, mMaskRGB
    DeleteObject hBitmap

    'Item 4 (%IDO_DOCUMENT)...
    hBitmap = LoadBitmap(hInstance, BYVAL %IDB_DOCUMENT)
    ImageList_AddMasked hImages, hBitmap, mMaskRGB
    DeleteObject hBitmap

  END IF

  'We're done
  FUNCTION = hTree

END FUNCTION

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

SUB PopulateTree( BYVAL hTree AS DWORD )

  'Purpose : Adds dummy data to the tree
  '
  DIM   sLName()   AS STRING
  DIM   sFName()   AS STRING

  LOCAL uInsert    AS TV_INSERTSTRUCT
  LOCAL hRoot      AS DWORD
  LOCAL hFolder    AS DWORD
  LOCAL hFile      AS DWORD

  LOCAL zText      AS ASCIIZ * %TV_ITEM_CHARS
  LOCAL mFolder    AS LONG
  LOCAL mFile      AS LONG

  'Set up the insertion structure...
  uInsert.hInsertAfter             = %TVI_LAST
  uInsert.item.item.mask           = %TVIF_TEXT OR %TVIF_IMAGE OR %TVIF_SELECTEDIMAGE

  'Root node...
  zText                            = "Family Visits"
  uInsert.hParent                  = %TVI_ROOT
  uInsert.item.item.pszText        = VARPTR( zText )
  uInsert.item.item.iImage         = %IDO_BOOK_C
  uInsert.item.item.iSelectedImage = %IDO_BOOK_C
  uInsert.item.item.LPARAM         = %NULL
  hRoot                            = TreeView_InsertItem( hTree, uInsert )

  'Create some dummy data...
  REDIM sLName( 1 TO 5 )
  sLName(1) = "Smith"
  sLName(2) = "Jones"
  sLName(3) = "Clark"
  sLName(4) = "Green"
  sLName(5) = "Taylor"

  REDIM sFName( 1 TO 5 )
  sFName(1) = "John"
  sFName(2) = "Susan"
  sFName(3) = "Bridget"
  sFName(4) = "Alan"
  sFName(5) = "Carol"

  'Add some folders and files...
  FOR mFolder = 1 TO UBOUND( sLName )

    'Add folder...
    zText                            = sLName(mFolder) & " family"
    uInsert.hParent                  = hRoot
    uInsert.item.item.pszText        = VARPTR( zText )
    uInsert.item.item.iImage         = %IDO_FOLDER_C
    uInsert.item.item.iSelectedImage = %IDO_FOLDER_C
    uInsert.item.item.LPARAM         = %NULL
    hFolder                          = TreeView_InsertItem( hTree, uInsert )

    'Add files to this folder...
    FOR mFile = 1 TO UBOUND( sFName )

      zText                            = sFName(mFile) & " " & sLName(mFolder)
      uInsert.hParent                  = hFolder
      uInsert.item.item.pszText        = VARPTR( zText )
      uInsert.item.item.iImage         = %IDO_DOCUMENT
      uInsert.item.item.iSelectedImage = %IDO_DOCUMENT
      uInsert.item.item.LPARAM         = %NULL
      hFile                            = TreeView_InsertItem( hTree, uInsert )

    NEXT mFile

    'Expand say the first 2 folders...
    IF mFolder <= 2 THEN TVW_Expand hTree, hFolder, %TRUE

  NEXT mFolder

  'Expand the root node, so that all the first-level nodes are visible...
  TVW_Expand hTree, hRoot, %TRUE

Bye_BuildTree:
  ERASE sLName
  ERASE sFName
  EXIT SUB

END SUB

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

FUNCTION TVW_GetImage( BYVAL hTree AS DWORD, BYVAL hItem AS DWORD ) AS LONG

  'Purpose : Returns the ordinal of the item's bitmap ; if the item is not
  '          found, returns -1
  '
  LOCAL ti AS TV_ITEM

  ti.hItem = hItem                                              'set up the item structure
  ti.mask  = %TVIF_HANDLE OR %TVIF_IMAGE                        'these are the valid fields

  IF TreeView_GetItem( hTree, ti ) = 0 THEN                     'fetch info about the new item
    FUNCTION = -1
  ELSE
    FUNCTION = ti.iImage
  END IF

END FUNCTION

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

FUNCTION TVW_GetLevel( BYVAL hTree AS DWORD, BYVAL hItem AS DWORD ) AS LONG

  'Purpose : Returns the item's level. The root item is assumed to be at
  '          level = zero.
  '
  LOCAL hRoot  AS DWORD
  LOCAL mLevel AS LONG

  IF hItem <> %NULL THEN

    'Determine the root's handle...
    hRoot = TreeView_GetRoot( hTree )

    'Walk back up the tree, towards the root...
    WHILE hItem <> hRoot

      INCR mLevel
      hItem = TreeView_GetNextItem( hTree, hItem, %TVGN_PARENT )

    WEND

  END IF

  FUNCTION = mLevel

END FUNCTION

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

FUNCTION TVW_IsDragSource( BYVAL hTree AS DWORD, BYVAL hItem AS DWORD ) AS LONG

  'Purpose : Determines whether the specified tree item is allowed to be dragged
  '
  'Returns : 1 ... yes
  '          0 ... no
  '
  'Remarks : In this demo, we allow only 'people' to be dragged
  '
  SELECT CASE TVW_GetImage( hTree, hItem )

    CASE %IDO_DOCUMENT
      FUNCTION = 1

    CASE ELSE
      FUNCTION = 0

  END SELECT

END FUNCTION

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

FUNCTION TVW_IsDropTarget( BYVAL hTree AS DWORD, BYVAL hItemDest AS DWORD ) AS LONG

  'Returns : 0 or 1
  '
  ' The rules -
  '
  '   1. We can drop people onto a family or another person
  '   2. We cannot drop people onto the root
  '
  SELECT CASE TVW_GetImage( hTree, hItemDest )

    CASE %IDO_FOLDER_C, %IDO_FOLDER_O, %IDO_DOCUMENT
      FUNCTION = 1

    CASE ELSE
      FUNCTION = 0

  END SELECT

END FUNCTION

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

FUNCTION TVW_GetText( BYVAL hTree AS DWORD, BYVAL hItem AS DWORD ) AS STRING

  'Purpose : Returns the item's text ; if the item is not found, returns ""
  '
  LOCAL ti      AS TV_ITEM
  LOCAL zText   AS ASCIIZ * ( %TV_ITEM_CHARS + 1 )
  LOCAL s       AS STRING

  'Set up the item structure...
  ti.hItem      = hItem
  ti.mask       = %TVIF_TEXT
  zText         = SPACE$( %TV_ITEM_CHARS )
  ti.cchTextMax = %TV_ITEM_CHARS + 1
  ti.pszText    = VARPTR( zText )

  'Query the tree...
  IF TreeView_GetItem( hTree, ti ) = 0 THEN                     'call failed
    FUNCTION = ""
  ELSE
    s = zText
    FUNCTION = s
  END IF

END FUNCTION

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

FUNCTION TVW_IsChildOf( BYVAL hTree AS DWORD, BYVAL hItem AS DWORD, BYVAL hPossParent AS DWORD ) AS LONG

  'Purpose : Determines whether <hItem> is a child of <hItem2>
  '
  'Returns : 0 or 1
  '
  LOCAL mResult AS LONG
  LOCAL hRoot   AS DWORD

  IF hItem <> %NULL AND hPossParent <> %NULL THEN

    'Determine the root's handle...
    hRoot = TreeView_GetRoot( hTree )

    'Walk back up the tree, towards the root...
    WHILE hItem <> hRoot

      IF hItem = hPossParent THEN
        mResult = 1
        EXIT LOOP
      ELSE
        hItem = TreeView_GetNextItem( hTree, hItem, %TVGN_PARENT )
      END IF

    WEND

  END IF

  FUNCTION = mResult

END FUNCTION

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

FUNCTION TVW_HasChildren( BYVAL hTree AS DWORD, BYVAL hItem AS DWORD ) AS LONG

  'Purpose : Determines whether there are any child items under the specified
  '          item
  '
  'Returns : 1 ... yes there are
  '          2 ... no there aren't
  '
  IF TreeView_GetNextItem( hTree, hItem, %TVGN_CHILD ) = %NULL THEN
    FUNCTION = 0
  ELSE
    FUNCTION = 1
  END IF

END FUNCTION

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

FUNCTION TVW_MoveItem( BYVAL hTree AS DWORD, BYVAL hItemSource AS DWORD, BYVAL hItemDest AS DWORD ) AS DWORD

  'Purpose : Move a tree item following a successful drag & drop operation
  '
  'Returns : Handle of the newly-created item
  '
  'Remarks : In this demo, we only copy across the dragged item's image and text, but
  '          in general, you may want to also take across other attributes such as
  '          the item's LPARAM, expansion state, text bolding, etc
  '
  LOCAL uInsert       AS TV_INSERTSTRUCT

  LOCAL hSourceParent AS DWORD
  LOCAL hDestParent   AS DWORD
  LOCAL zText         AS ASCIIZ * %TV_ITEM_CHARS

  LOCAL hNewItem      AS DWORD


  'Start off the insertion structure...
  uInsert.item.item.mask           = %TVIF_TEXT OR %TVIF_IMAGE OR %TVIF_SELECTEDIMAGE
  zText                            = TVW_GetText( hTree, hItemSource )
  uInsert.item.item.pszText        = VARPTR( zText )
  uInsert.item.item.iImage         = TVW_GetImage ( hTree, hItemSource )
  uInsert.item.item.iSelectedImage = uInsert.item.item.iImage

  'Are we dropping onto a folder, or onto another person ?
  SELECT CASE TVW_GetImage( hTree, hItemDest )

    CASE %IDO_DOCUMENT

      'Insert the dragged person after the dropped-on person
      uInsert.hParent                  = TreeView_GetParent( hTree, hItemDest )
      uInsert.hInsertAfter             = hItemDest

    CASE %IDO_FOLDER_C, %IDO_FOLDER_O

      'Insert the dragged person as the first person under this folder
      uInsert.hParent                  = hItemDest
      uInsert.hInsertAfter             = %TVI_FIRST

    CASE ELSE
      BEEP : GOTO Bye_TVW_MoveItem

  END SELECT

  'Create the new item...
  hNewItem = TreeView_InsertItem( hTree, uInsert )

  'Did we succeed ?
  IF hNewItem THEN

    'Record these...
    hSourceParent = TreeView_GetParent( hTree, hItemSource )
    hDestParent   = TreeView_GetParent( hTree, hItemDest   )

    'Now it's safe to delete the source item...
    TreeView_DeleteItem hTree, hItemSource

    'Ensure the new item is visible and selected; we don't use TreeView_EnsureVisible(),
    'because that can leave an expanded parent's image in the wrong state...
    TVW_Expand hTree, hDestParent, 1
    TreeView_SelectItem hTree, hNewItem

    'If the source folder has been emptied, close it up...
    IF TVW_HasChildren( hTree, hSourceParent ) = 0 THEN
      TVW_Expand hTree, hSourceParent, 0
    END IF

  END IF

Bye_TVW_MoveItem:
  FUNCTION = hNewItem

END FUNCTION
                Attached Files
                Last edited by Peter Simmonds; 23 Jul 2012, 04:13 PM. Reason: Oops, wrong program added!

                Comment

                • #9
                  Hi Harry!
                  The first time I tried D&D in a TreeView was early in my PowerBASIC experience. Like you, I was daunted.

                  At the time, I decided a node version of cut and paste would be close enough to a D&D solution and is significantly simpler. That's what I use in my gbSnippets app.

                  I'd swear I posted the code, but after searching the forums this morning I don't see it. So, here's the compilable code example:


                  Code:
                  'Compilable Example:
'This example allows cut/copy/paste of child nodes only - implemented as a context menu
'It does not allows cut/copy/paste of parent nodes
'Although a normal menu bar could be used to accomplish these features,
'a context menu (right mouse click) is used in this example, using the
'%WM_ContextMenu and TrackPopupMenu API to display a TreeView popup menu.
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
%Unicode=1
#Include "Win32API.inc"
#Include "commctrl.inc"
Global hDlg As Dword, hContext As Dword, OrigTextBoxProc&
Global NodeCopy$, NodeUser&

%IDC_TreeView = 400
%ID_Cut = 500   : %ID_Copy = 502
%ID_PasteC = 503 : %ID_PasteS = 504 : %ID_Delete = 505

Function PBMain() As Long
   Dialog New Pixels, 0, "Test Code",300,300,200,200, %WS_OverlappedWindow To hDlg
   Local hItem As Dword, hTemp As Dword, hTemp2 As Dword, hTemp3 As Dword
   Dialog New Pixels, 0, "TreeView",200,200,155,250, %WS_SysMenu, 0 To hDlg
   Control Add TreeView, hDlg, %IDC_TreeView, "", 10,10,130,200
   TreeView Insert Item hDlg, %IDC_TreeView, 0, %TVI_Last, 0,0,"Root" To hItem
   TreeView Insert Item hDlg, %IDC_TreeView, hItem, %TVI_Last, 0,0,"Mother" To hTemp
   TreeView Insert Item hDlg, %IDC_TreeView, hTemp, %TVI_Last, 0,0,"Dan" To hTemp2
   TreeView Insert Item hDlg, %IDC_TreeView, hTemp, %TVI_Last, 0,0,"Bob" To hTemp3
   TreeView Set Expanded hDlg, %IDC_TreeView, hTemp, %True
   TreeView Insert Item hDlg, %IDC_TreeView, hTemp3, %TVI_Last, 0,0,"Foot" To hTemp2
   TreeView Insert Item hDlg, %IDC_TreeView, hTemp3, %TVI_Last, 0,0,"Arm" To hTemp2
   TreeView Set Expanded hDlg, %IDC_TreeView, hTemp3, %True
   TreeView Insert Item hDlg, %IDC_TreeView, hItem, %TVI_Last, 0,0,"Father" To hTemp
   TreeView Insert Item hDlg, %IDC_TreeView, hTemp, %TVI_Last, 0,0,"Helen" To hTemp2
   TreeView Insert Item hDlg, %IDC_TreeView, hTemp, %TVI_Last, 0,0,"Any" To hTemp3
   TreeView Set Expanded hDlg, %IDC_TreeView, hTemp, %True
   TreeView Insert Item hDlg, %IDC_TreeView, hTemp3, %TVI_Last, 0,0,"Leg" To hTemp2
   TreeView Insert Item hDlg, %IDC_TreeView, hTemp3, %TVI_Last, 0,0,"Finger" To hTemp2
   TreeView Set Expanded hDlg, %IDC_TreeView, hTemp3, %True
   TreeView Set Expanded hDlg, %IDC_TreeView, hItem, %True
   AddContextMenu
   Dialog Show Modal hDlg Call DlgProc
End Function

CallBack Function DlgProc() As Long
   Local x As Long, y As Long, iReturn As Long
   Select Case CB.Msg
      Case %WM_ContextMenu
         x = Lo(Integer,CB.lParam) : y = Hi(Integer, CB.lParam)
         iReturn = GetDlgCtrlID (CB.wParam)             'get control ID
         If iReturn = %IDC_TreeView Then
            'select the item under the mouse when a right-click is made
            Local TVht As TV_HitTestInfo
            TVht.pt.x = x
            TVht.pt.y = y
            MapWindowPoints(%HWND_Desktop, CB.wParam, ByVal VarPtr(Tvht.pt), 1)
            SendMessage(CB.wParam, %TVM_HITTEST, 0, ByVal VarPTR(TVht))
            TreeView Select hDlg, %IDC_TreeView, TVht.hItem
            TrackPopupMenu hContext, %TPM_LEFTALIGN, x, y, 0, hDlg, ByVal 0
         End If
      Case %WM_Command
         Select Case CB.Ctl
            Case %ID_Cut     : TreeCut
            Case %ID_Copy    : TreeCopy
            Case %ID_PasteC  : TreePasteAsChild
            Case %ID_PasteS  : TreePasteAsSibling
            Case %ID_Delete   : TreeDelete
         End Select
   End Select
End Function

Sub AddContextMenu
   Menu New Popup To hContext
   Menu Add String, hContext, "Cut",  %ID_Cut,  %MF_Enabled
   Menu Add String, hContext, "Copy",  %ID_Copy,  %MF_Enabled
   Menu Add String, hContext, "Paste As Child", %ID_PasteC, %MF_Enabled
   Menu Add String, hContext, "Paste As Sibling", %ID_PasteS, %MF_Enabled
   Menu Add String, hContext, "Delete", %ID_Delete, %MF_Enabled
End Sub

Sub TreeDelete
   Local hNode as Dword, iReturn&
   TreeView Get Select hDlg, %IDC_TreeView to hNode
   TreeView Get Child hDlg, %IDC_TreeView, hNode to iReturn&
   If iReturn&  Then
      'is parent
      Beep
   Else
      'is child
      TreeView Delete hDlg, %IDC_TreeView, hNode
   End If
End Sub

Sub TreeCut
   Local hNode as Dword, iReturn&
   TreeView Get Select hDlg, %IDC_TreeView to hNode
   TreeView Get Child hDlg, %IDC_TreeView, hNode to iReturn&
   If iReturn&  Then
      'is parent
      Beep
   Else
      'is child
      TreeView Get Text hDlg, %IDC_TreeView, hNode To NodeCopy$
      TreeView Get User hDlg, %IDC_TreeView, hNode To NodeUser&
      TreeView Delete hDlg, %IDC_TreeView, hNode
   End If
End Sub

Sub TreeCopy
   Local hNode as Dword, iReturn&
   TreeView Get Select hDlg, %IDC_TreeView to hNode
   TreeView Get Child hDlg, %IDC_TreeView, hNode to iReturn&
   If iReturn&  Then
      'is parent
      Beep
   Else
      'is child
      TreeView Get Text hDlg, %IDC_TreeView, hNode To NodeCopy$
      TreeView Get User hDlg, %IDC_TreeView, hNode To NodeUser&
   End If
End Sub

Sub TreePasteAsChild
   Local hNode as Dword, iReturn&
   TreeView Get Select hDlg, %IDC_TreeView to hNode
   TreeView Insert Item hDlg, %IDC_TreeView, hNode, %TVI_First, 0, 0, NodeCopy$ to hNode
   TreeView Set User hDlg, %IDC_TreeView, hNode, NodeUser&
End Sub

Sub TreePasteAsSibling
   Local hNode as Dword, iReturn&, hParent as Dword
   TreeView Get Select hDlg, %IDC_TreeView to hNode
   TreeView Get Parent hDlg, %IDC_TreeView, hNode To hParent
   TreeView Insert Item hDlg, %IDC_TreeView, hParent, hNode, 0, 0, NodeCopy$ to hNode
   TreeView Set User hDlg, %IDC_TreeView, hNode, NodeUser&
End Sub

'gbs_00263
                  Last edited by Gary Beene; 22 Jul 2012, 09:17 AM.

                  Comment

                  • #10
                    Gary

                    Thanks for that code, I had actually already made a DDT but had to resort to the old SDK program to get the drag and drop to work.

                    Any thoughts about why the callback doesn't work would be greatly appreciated. Although the callback in the modified dialog code is active for some functions (like %WM_INITDIALOG), most of the rest doesn't work. For example clicking on a node is supposed to change the icon as well as toggling the contents display but only the latter works (and that's because the click isn't caught by the callbck function to activate the relevant SUB).

                    There are one or two descitions on the Forum about differences in dialog and windows callback (90% compatible?) but I haven't able to find a definitive list of the differences and how a conversion might be attempted.

                    Peter

                    Comment

                    • #11
                      Hey Peter,
                      Re:
                      ...but had to resort to the old SDK program to get the drag and drop to work.
                      I know you said it that way just to egg me on! While I admire the extra capabilities/control SDK offers, I've been known to take the challenge to do in DDT what has been done in SDK.

                      Did Paul put his demo online over the weekend? I haven't checked. But it sounds like he has a solution in hand. I've been wanting to work out a solution for a while now, but just haven't gotten around to it.



                      Perhaps Paul will make us both happy today!

                      Comment

                      • #12
                        Whoops, I'm such an idiot.

                        I posted the wrong code into the previous posting. The first program is the original one from Paul that does`actually work, apologies for anyone who has tried them! This has now been corrected in the edited post above

                        Peter

                        Comment

                        • #13
                          Success (sort of)

                          Gary

                          I tried the other approach, calling the TreeView program as a child window from PBMAIN (with all its SDK code left intact) instead of trying to convert it to a dialog. That worked finally after following your instructions in your very useful tutorial page:

                          http://www.garybeene.com/code/index.htm

                          I had the iCmdShow variable set wrongly (t had to be set to %SW_Show). So I think I can now integrate all the other stuff into the Treeview window and expand the callback.

                          If anyone wants the workng code let me know

                          Peter

                          Comment

                          • #14
                            Yes, please post!

                            Comment

                            • #15
                              Hi, here the modification ot te main loop and callback:

                              Code:
                              FUNCTION PBMAIN() AS LONG

    DIM main_handle AS LONG
    DIM a AS LONG

  DIALOG NEW 0, "TreeView Drag & Drop", 200, 200, 300, 300, %WS_CLIPCHILDREN OR %WS_CAPTION OR %WS_SYSMENU OR %WS_THICKFRAME OR %WS_MINIMIZEBOX OR %WS_MAXIMIZEBOX, 0 TO main_handle

  DIALOG SHOW MODAL main_handle, CALL mainloop_callback TO a

END FUNCTION

CALLBACK FUNCTION mainloop_callback

    DIM a AS LONG

  SELECT CASE CB.MSG

    CASE %WM_INITDIALOG

        a = treeview_draw(CB.HNDL)

    END SELECT

END FUNCTION

FUNCTION treeview_draw (main_handle AS LONG) AS LONG

  'This is all standard SDK stuff ; create a dialog and display it
  LOCAL uCC     AS INIT_COMMON_CONTROLSEX
  LOCAL uClass  AS WndClassEx
  LOCAL msg     AS tagMsg
  LOCAL hInstance AS LONG
  LOCAL iCmdshow AS LONG

  LOCAL zTitle  AS ASCIIZ * 30
  LOCAL zClass  AS ASCIIZ * 30
  LOCAL hDialog AS DWORD
  LOCAL a AS DWORD

  'Initialise...
  zTitle               = $TITLE
  zClass               = $CLASS

  'Register main window class...
  uClass.cbSize        = SIZEOF(uClass)
  uClass.style         = 0
  uClass.lpfnwndproc   = CODEPTR(wndproc)
  uClass.cbClsExtra    = 0
  uClass.cbWndExtra    = 0
  uClass.hInstance     = hInstance
  uClass.hIcon         = %NULL
  uClass.hCursor       = LoadCursor(%NULL, BYVAL %IDC_ARROW)
  uClass.hbrBackground = %COLOR_BTNFACE + 1
  uClass.lpszMenuName  = %NULL
  uClass.lpszCLASSNAME = VARPTR(zClass)
  RegisterClassEx uClass

  'Initialise the common controls module...
  uCC.dwSize           = SIZEOF(uCC)
  uCC.dwICC            = %ICC_TREEVIEW_CLASSES
  IF InitCommonControlsEx(uCC) = 0 THEN
    InitCommonControls                                          'Win95A
  END IF

  'Create the dialog...
  hDialog = CreateWindow( zClass, _                                          'window class name
                          "Window 1", _                                          'window caption
                          %WS_CLIPCHILDREN OR %WS_CAPTION OR %WS_SYSMENU OR %WS_THICKFRAME OR %WS_MINIMIZEBOX OR %WS_MAXIMIZEBOX, _
                          300, _                                             'initial x position
                          200, _                                             'initial y position
                          300, _                                             'initial x size
                          300, _                                             'initial y size
                          main_handle, _                                     'parent window handle
                          %NULL, _                                           'window menu handle
                          hInstance, _                                       'program instance handle
                          BYVAL %NULL )                                      'creation parameters

  'Show it...
  iCmdShow = %SW_SHOW
  ShowWindow hDialog, iCmdShow
  UpdateWindow hDialog

  'Process messages...
'  WHILE GetMessage( msg, %NULL, 0, 0 )
'    TranslateMessage msg
'    DispatchMessage msg
'  WEND

END FUNCTION
                              Last edited by Peter Simmonds; 25 Jul 2012, 03:16 PM.

                              Comment

                              • #16
                                I'm interested in having a treeview that I can drag the elements around. Also need a checkbox next to the items.

                                I compiled the example above https://forum.powerbasic.com/forum/u...641#post618641

                                I can only select the entries and not able to drag them

                                Comment

                                • #17
                                  Steve,
                                  Do you need to move parent nodes as well? I've posted code that lets you cut/copy/paste child nodes - sort of the equivalent to drag/drop but works only for child nodes.

                                  Comment

                                  • #18
                                    Hi Gary,

                                    Yes I like your very small example.

                                    I do need to be able to move everything.

                                    Comment

                                    • #19
                                      Steve,
                                      Keeping with the cut and paste approach, I'd think you could modify the "WalkThroughNode" code below and keep track of the node text and levels, using those to make a copy (lines of text, corresponding to the removed lines) which you would then use to insert at a selected node.

                                      I'm short on time right now but I'll watch here to see if you have questions on how to use that approach.

                                      HTML Code:
                                      [code]'Compilable Example:
#Compiler PBWin 9, PBWin 10
#Compile Exe
#Dim All
%Unicode=1
#Include "Win32API.inc"
%IDC_TreeView     = 100
%IDC_Cut          = 200
%IDC_Copy         = 250
%IDC_PasteChild   = 300
%IDC_PasteSibling = 400
%IDC_PasteContent = 500
%IDC_Reset        = 600
Global hDlg As Dword, PasteContent$

Function PBMain() As Long
   Local BoxStyle As Long
   BoxStyle = %WS_Child Or %WS_Visible Or %ES_MultiLine Or %WS_VScroll Or %ES_AutoHScroll _
            Or %WS_HScroll Or %ES_AutoVScroll Or %ES_WantReturn Or %ES_NoHideSel Or %WS_TabStop
   Dialog Default Font "Tahoma", 12, 1
   Dialog New Pixels, 0, "TreeView",200,200,385,590, %WS_SysMenu, 0 To hDlg
   Control Add TextBox, hDlg, %IDC_PasteContent, "", 200,10,180,430, BoxStyle, %WS_Ex_ClientEdge
   Control Add Button, hDlg, %IDC_Reset,"Reset", 200,450,110,25
   Control Add Button, hDlg, %IDC_Copy,"Copy", 25,450,110,25
   Control Add Button, hDlg, %IDC_Cut,"Cut", 25,480,110,25
   Control Add Button, hDlg, %IDC_PasteSibling,"Paste_Sibling", 25,510,110,25
   Control Add Button, hDlg, %IDC_PasteChild,"Paste_Child", 25,540,110,25
   ResetTreeView
   Dialog Show Modal hDlg Call DlgProc
End Function

CallBack Function DlgProc() As Long
   Local hNode As Dword, temp$
   Select Case Cb.Msg
      Case %WM_Command
         Select Case Cb.Ctl
            Case %IDC_Reset
               ResetTreeView
            Case %IDC_Cut
               Treeview Get Select Cb.Hndl, %IDC_TreeView To hNode
               If hNode = 0 Then ? "No slection!" : Exit Function
               WalkThroughNode (hNode)
               Control Set Text hDlg, %IDC_PasteContent, PasteContent$
               Treeview Delete hDlg, %IDC_TreeView, hNode
            Case %IDC_Copy
               Treeview Get Select Cb.Hndl, %IDC_TreeView To hNode
               If hNode = 0 Then ? "No slection!" : Exit Function
               WalkThroughNode (hNode)
               Control Set Text hDlg, %IDC_PasteContent, PasteContent$
            Case %IDC_PasteSibling
               Clipboard Get Text To temp$
               If Len(temp$) = 0 Then ? "No selection!" : Exit Function
               PasteIntoTreeView 1
            Case %IDC_PasteChild
               Clipboard Get Text To temp$
               If Len(temp$) = 0 Then ? "No selection!" : Exit Function
               PasteIntoTreeView 0
         End Select
   End Select
End Function

Sub ResetTreeView
   Local hItem As Dword, hTemp As Dword, hTemp2 As Dword, hTemp3 As Dword
   Control Kill hDlg, %IDC_TreeView
   Control Add Treeview, hDlg, %IDC_TreeView, "", 10,10,180,430
   Treeview Insert Item hDlg, %IDC_TreeView, 0, %TVI_Last, 0,0,"Root" To hItem
   Treeview Insert Item hDlg, %IDC_TreeView, hItem, %TVI_Last, 0,0,"Mother" To hTemp
   Treeview Insert Item hDlg, %IDC_TreeView, hTemp, %TVI_Last, 0,0,"Dan" To hTemp2
   Treeview Insert Item hDlg, %IDC_TreeView, hTemp, %TVI_Last, 0,0,"Bob" To hTemp3
   Treeview Set Expanded hDlg, %IDC_TreeView, hTemp, %True
   Treeview Insert Item hDlg, %IDC_TreeView, hTemp3, %TVI_Last, 0,0,"Foot" To hTemp2
   Treeview Insert Item hDlg, %IDC_TreeView, hTemp3, %TVI_Last, 0,0,"Arm" To hTemp2
   Treeview Set Expanded hDlg, %IDC_TreeView, hTemp3, %True
   Treeview Insert Item hDlg, %IDC_TreeView, hItem, %TVI_Last, 0,0,"Father" To hTemp

   Treeview Insert Item hDlg, %IDC_TreeView, hTemp, %TVI_Last, 0,0,"Helen" To hTemp2
   Treeview Insert Item hDlg, %IDC_TreeView, hTemp2, %TVI_Last, 0,0,"Left" To hTemp3
   Treeview Insert Item hDlg, %IDC_TreeView, hTemp2, %TVI_Last, 0,0,"Right" To hTemp3
   Treeview Set Expanded hDlg, %IDC_TreeView, hTemp2, %True

   Treeview Insert Item hDlg, %IDC_TreeView, hTemp, %TVI_Last, 0,0,"Any" To hTemp3
   Treeview Set Expanded hDlg, %IDC_TreeView, hTemp, %True
   Treeview Insert Item hDlg, %IDC_TreeView, hTemp3, %TVI_Last, 0,0,"Leg" To hTemp2
   Treeview Insert Item hDlg, %IDC_TreeView, hTemp3, %TVI_Last, 0,0,"Finger" To hTemp2
   Treeview Set Expanded hDlg, %IDC_TreeView, hTemp3, %True
   Treeview Set Expanded hDlg, %IDC_TreeView, hItem, %True
End Sub

Function WalkThroughNode(ByVal hNode As Dword) As Dword
   'walks through (selects) children+subnodes of specified Node
   'returns last node
   'returns 0 if no children or subnodes
   Local iReturn As Dword, hStartNode As Dword, D As Long, tmp$
   hStartNode = hNode
   Treeview Get Text hDlg, %IDC_TreeView, hStartNode To PasteContent$
   PasteContent$ = "001 " + PasteContent$
   D = 1
   Do
      Function = hNode
      Treeview Get Child hDlg, %IDC_TreeView, hNode To iReturn                      'get child (1st choice)
      If iReturn = 0 Then Treeview Get Next hDlg, %IDC_TreeView, hNode To iReturn Else Incr D   'or sibling (2nd choice)
      If iReturn = 0 Then                                                        'no child or sibling
         Do                                                                      'get sibling of first parent with sibling
            Treeview Get Parent hDlg, %IDC_TreeView, hNode To hNode              'parent
            If hNode Then Decr D
            If hNode = hStartNode Then iReturn = 0 : Exit Loop                   'if reach starting node, stop
            Treeview Get Next hDlg, %IDC_TreeView, hNode To iReturn              'sibling child of parent
         Loop Until iReturn Or (hNode = 0)  'stop when find sibling of parent with sibling, or no more choices
      End If
      hNode = iReturn    'possible values: 0, zero (no parent/no sibling), <>0 (parent or sibling)
      'do something here-----------
      If hNode And D > 0 Then Treeview Get Text hDlg, %IDC_TreeView, hNode To tmp$ : PasteContent$ += $CrLf + Format$(D,"000") + " " + tmp$
      'If hNode and D > 0 Then TreeView Select hDlg, %IDC_TreeView, hNode : Sleep 300 'for demo only - selection/pause is optional
   Loop While hNode And D > 0
End Function

Function PasteIntoTreeView(Sibling As Long) As String   'PasteContent$ is a Global string variable
   Local record$, caption$, recordnext$, hItem, hTemp,h As Dword, i,DepthCurrent, DepthNext As Long
   ReDim hParent(100) As Dword, Parent(100) As String

   'determine parent of initial position
   Treeview Get Select hDlg, %IDC_TreeView To hItem
   If Sibling = 1 Then
      Treeview Get Parent hDlg, %IDC_TreeView, hItem To hParent(0)  'sibling
   Else
      hParent(0) = hItem                                            'child
   End If

   'build interior
   Treeview Get Select hDlg, %IDC_TreeView To hItem
   For i = 1 To ParseCount(Pastecontent,$CrLf)
      'Get info about Current and Next records
      record$      = Parse$(Pastecontent,$CrLf,i)
      depthcurrent = Val(record$)
      caption$     = Parse$(record$,$Spc,2)
      recordnext$  = Parse$(PasteContent,$CrLf,i+1)
      depthnext    = Val(recordnext$)
      'put current record into TreeView
      If DepthNext > DepthCurrent Then 'is parent node
         Treeview Insert Item hDlg, %IDC_TreeView, hParent(depthcurrent-1), %TVI_Last, 0,0,caption$ To hItem  'add parent
         hParent(DepthCurrent) = hItem  'save parent node value
      Else 'is child node
         Treeview Insert Item hDlg, %IDC_TreeView, hParent(depthcurrent-1), %TVI_Last, 0,0,caption$ To hTemp  'add child
      End If
      Treeview Set Expanded hDlg, %IDC_TreeView, hParent(depthcurrent-1), 1                                'expand parent
   Next i
End Function
[/code]
                                      Last edited by Gary Beene; 19 Jan 2020, 11:32 AM. Reason: See post #21 for details about changes

                                      Comment

                                      • #20
                                        Steve,
                                        Here's a better starting point. This shows how to make a text version of a TreeView, convert that to a TreeView, then get the text back out again. It's based on the code I posted above and it shows how to trace through a selected node, getting the level and text of the nodes.

                                        One option is that you extract the text corresponding to the node you want removed, then delete that node. Then, you insert that extracted text as nodes where you want the new content dropped.

                                        It should be a reasonably minimal solution as compared to some of the much earlier posts.

                                        See later post for code with indentations ...
                                        Last edited by Gary Beene; 18 Jan 2020, 11:51 AM.

                                        Comment

                                        Previous 1 2 template Next
                                        Working...
                                        X

                                        We process personal data about users of our site, through the use of cookies and other technologies, to deliver our services, and to analyze site activity. For additional details, refer to our Privacy Policy.

                                        By clicking "I AGREE" below, you agree to our Privacy Policy and our personal data processing and cookie practices as described therein. You also acknowledge that this forum may be hosted outside your country and you consent to the collection, storage, and processing of your data in the country where this forum is hosted.

                                        I Agree