You are not logged in. You can browse in the PowerBASIC Community, but you must click Login (top right) before you can post. If this is your first visit, check out the FAQ or Sign Up.
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!
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.....
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
...
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.
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
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
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
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.
...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.
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
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:
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.
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
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.
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, 12:32 PM.
Reason: See post #21 for details about changes
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.
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.
Comment