Announcement
Collapse
No announcement yet.
TREEVIEW Drag&Drop
Collapse
X
-
Added:- Copy only
- Detects whether a selection has been made
- Detects empty clipboard.
Leave a comment:
-
Ok, Steve, give this is a try. It provides Cut, PasteAsSibling and PasteAsChild options.
When pasting, the pasted content becomes the last child under the parent.
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 ? "Clipboard Empty!" : Exit Function PasteIntoTreeView 1 Case %IDC_PasteChild Clipboard Get Text To temp$ If Len(temp$) = 0 Then ? "Clipboard Empty!" : 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:35 PM.
Leave a comment:
-
HTML Code:[code]'Compilable Example: #Compile Exe #Dim All %Unicode=1 #Include "Win32API.inc" %IDC_TreeView = 500 %IDC_TextBoxIn = 501 %IDC_TextBoxOut = 502 %IDC_ButtonBuild = 503 %IDC_ButtonGet = 504 Global hDlg As Dword Function PBMain() As Long Dialog New Pixels, 0, "TreeView",200,200,590,250, %WS_SysMenu, 0 To hDlg Control Add Button, hDlg, %IDC_ButtonBuild, "Build TreeView", 10,5,125,25 Control Add Button, hDlg, %IDC_ButtonGet, "Build Text From TreeView", 400,5,150,25 Control Add TextBox, hDlg, %IDC_TextBoxIn,"", 10,40,180,200, %ES_MultiLine Or %ES_WantReturn Control Add Treeview, hDlg, %IDC_TreeView,"", 200,40,190,200 Control Add TextBox, hDlg, %IDC_TextBoxOut,"", 400,40,180,200, %ES_MultiLine Or %ES_WantReturn Dialog Show Modal hDlg Call DlgProc End Function CallBack Function DlgProc() As Long Local temp$, hNode As Dword Select Case Cb.Msg Case %WM_InitDialog Control Set Text hDlg, %IDC_TextBoxIn, _ "City" + $CrLf + _ "...Dallas" + $CrLf + _ "...Chicago" + $CrLf + _ "...New York" + $CrLf + _ "State" + $CrLf + _ "...Texas" + $CrLf + _ "......Cowboys" + $CrLf + _ "......Cowgirls" + $CrLf + _ "...New York" + $CrLf + _ "Idaho" Case %WM_Command Select Case Cb.Ctl Case %IDC_ButtonBuild Control Get Text hDlg, %IDC_TextBoxIn To temp$ BuildTreeViewCode(temp$,1,1) Case %IDC_ButtonGet Treeview Get Select hDlg, %IDC_TreeView To hNode Control Set Text hDlg, %IDC_TextBoxOut, GetTreeViewContent(hNode) End Select End Select End Function Function BuildTreeViewCode(TVContent As String, ShowRoot As Long, ExpandAll As Long) As String Local record$, caption$, recordnext$, hItem, hTemp As Dword, i,DepthCurrent, DepthNext As Long ReDim hParent(100) As Dword, Parent(100) As String 'add root node if required If ShowRoot Then Treeview Insert Item hDlg, %IDC_TreeView, 0, %TVI_Last, 0, 0, "Root" To hParent(0) 'build interior For i = 1 To ParseCount(TVcontent,$CrLf) 'Get info about Current and Next records record$ = Parse$(TVcontent,$CrLf,i) depthcurrent = ParseCount(record$,"...") caption$ = LTrim$(record$,".") recordnext$ = Parse$(TVContent,$CrLf,i+1) depthnext = ParseCount(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 If ExpandAll Then Treeview Set Expanded hDlg, %IDC_TreeView, hParent(depthcurrent-1), 1 'expand parent End If Next i End Function Function GetTreeViewContent(hNode As Dword) As String Local iReturn As Dword, temp$,tmp$, D As Long 'Treeview Get Root hDlg, %IDC_TreeView To hNode Do 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 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) Treeview Get Text hDlg, %IDC_TreeView, hNode To tmp$ : temp$ = temp$ + $CrLf + Repeat$(D-1,"...") + tmp$ Loop While hNode Function = Trim$(temp$,$CrLf) End Function 'gbs_01259 'Date: 05-11-2013[/code]
Leave a comment:
-
bummer. i just now saw the indenting problem mentioned in the other thread. will try to fix.
Leave a comment:
-
Steve,
Here's a better starting point. This shows how to make a text version of a TreeView, convert that to a TreeView, then get the text back out again. It's based on the code I posted above and it shows how to trace through a selected node, getting the level and text of the nodes.
One option is that you extract the text corresponding to the node you want removed, then delete that node. Then, you insert that extracted text as nodes where you want the new content dropped.
It should be a reasonably minimal solution as compared to some of the much earlier posts.
See later post for code with indentations ...
Last edited by Gary Beene; 18 Jan 2020, 12:51 PM.
Leave a comment:
-
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]
Leave a comment:
-
Hi Gary,
Yes I like your very small example.
I do need to be able to move everything.
Leave a comment:
-
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.
Leave a comment:
-
I'm interested in having a treeview that I can drag the elements around. Also need a checkbox next to the items.
I compiled the example above https://forum.powerbasic.com/forum/u...641#post618641
I can only select the entries and not able to drag them
Leave a comment:
-
Hi, here the modification ot te main loop and callback:
Code:FUNCTION PBMAIN() AS LONG DIM main_handle AS LONG DIM a AS LONG DIALOG NEW 0, "TreeView Drag & Drop", 200, 200, 300, 300, %WS_CLIPCHILDREN OR %WS_CAPTION OR %WS_SYSMENU OR %WS_THICKFRAME OR %WS_MINIMIZEBOX OR %WS_MAXIMIZEBOX, 0 TO main_handle DIALOG SHOW MODAL main_handle, CALL mainloop_callback TO a END FUNCTION CALLBACK FUNCTION mainloop_callback DIM a AS LONG SELECT CASE CB.MSG CASE %WM_INITDIALOG a = treeview_draw(CB.HNDL) END SELECT END FUNCTION FUNCTION treeview_draw (main_handle AS LONG) AS LONG 'This is all standard SDK stuff ; create a dialog and display it LOCAL uCC AS INIT_COMMON_CONTROLSEX LOCAL uClass AS WndClassEx LOCAL msg AS tagMsg LOCAL hInstance AS LONG LOCAL iCmdshow AS LONG LOCAL zTitle AS ASCIIZ * 30 LOCAL zClass AS ASCIIZ * 30 LOCAL hDialog AS DWORD LOCAL a AS DWORD 'Initialise... zTitle = $TITLE zClass = $CLASS 'Register main window class... uClass.cbSize = SIZEOF(uClass) uClass.style = 0 uClass.lpfnwndproc = CODEPTR(wndproc) uClass.cbClsExtra = 0 uClass.cbWndExtra = 0 uClass.hInstance = hInstance uClass.hIcon = %NULL uClass.hCursor = LoadCursor(%NULL, BYVAL %IDC_ARROW) uClass.hbrBackground = %COLOR_BTNFACE + 1 uClass.lpszMenuName = %NULL uClass.lpszCLASSNAME = VARPTR(zClass) RegisterClassEx uClass 'Initialise the common controls module... uCC.dwSize = SIZEOF(uCC) uCC.dwICC = %ICC_TREEVIEW_CLASSES IF InitCommonControlsEx(uCC) = 0 THEN InitCommonControls 'Win95A END IF 'Create the dialog... hDialog = CreateWindow( zClass, _ 'window class name "Window 1", _ 'window caption %WS_CLIPCHILDREN OR %WS_CAPTION OR %WS_SYSMENU OR %WS_THICKFRAME OR %WS_MINIMIZEBOX OR %WS_MAXIMIZEBOX, _ 300, _ 'initial x position 200, _ 'initial y position 300, _ 'initial x size 300, _ 'initial y size main_handle, _ 'parent window handle %NULL, _ 'window menu handle hInstance, _ 'program instance handle BYVAL %NULL ) 'creation parameters 'Show it... iCmdShow = %SW_SHOW ShowWindow hDialog, iCmdShow UpdateWindow hDialog 'Process messages... ' WHILE GetMessage( msg, %NULL, 0, 0 ) ' TranslateMessage msg ' DispatchMessage msg ' WEND END FUNCTION
Last edited by Peter Simmonds; 25 Jul 2012, 04:16 PM.
Leave a comment:
-
Success (sort of)
Gary
I tried the other approach, calling the TreeView program as a child window from PBMAIN (with all its SDK code left intact) instead of trying to convert it to a dialog. That worked finally after following your instructions in your very useful tutorial page:
http://www.garybeene.com/code/index.htm
I had the iCmdShow variable set wrongly (t had to be set to %SW_Show). So I think I can now integrate all the other stuff into the Treeview window and expand the callback.
If anyone wants the workng code let me know
Peter
Leave a comment:
-
Whoops, I'm such an idiot.
I posted the wrong code into the previous posting. The first program is the original one from Paul that does`actually work, apologies for anyone who has tried them! This has now been corrected in the edited post above
Peter
Leave a comment:
-
Hey Peter,
Re:
...but had to resort to the old SDK program to get the drag and drop to work.
Did Paul put his demo online over the weekend? I haven't checked. But it sounds like he has a solution in hand. I've been wanting to work out a solution for a while now, but just haven't gotten around to it.
Perhaps Paul will make us both happy today!
Leave a comment:
-
Gary
Thanks for that code, I had actually already made a DDT but had to resort to the old SDK program to get the drag and drop to work.
Any thoughts about why the callback doesn't work would be greatly appreciated. Although the callback in the modified dialog code is active for some functions (like %WM_INITDIALOG), most of the rest doesn't work. For example clicking on a node is supposed to change the icon as well as toggling the contents display but only the latter works (and that's because the click isn't caught by the callbck function to activate the relevant SUB).
There are one or two descitions on the Forum about differences in dialog and windows callback (90% compatible?) but I haven't able to find a definitive list of the differences and how a conversion might be attempted.
Peter
Leave a comment:
-
Hi Harry!
The first time I tried D&D in a TreeView was early in my PowerBASIC experience. Like you, I was daunted.
At the time, I decided a node version of cut and paste would be close enough to a D&D solution and is significantly simpler. That's what I use in my gbSnippets app.
I'd swear I posted the code, but after searching the forums this morning I don't see it. So, here's the compilable code example:
Code:'Compilable Example: 'This example allows cut/copy/paste of child nodes only - implemented as a context menu 'It does not allows cut/copy/paste of parent nodes 'Although a normal menu bar could be used to accomplish these features, 'a context menu (right mouse click) is used in this example, using the '%WM_ContextMenu and TrackPopupMenu API to display a TreeView popup menu. #Compiler PBWin 9, PBWin 10 #Compile EXE #Dim All %Unicode=1 #Include "Win32API.inc" #Include "commctrl.inc" Global hDlg As Dword, hContext As Dword, OrigTextBoxProc& Global NodeCopy$, NodeUser& %IDC_TreeView = 400 %ID_Cut = 500 : %ID_Copy = 502 %ID_PasteC = 503 : %ID_PasteS = 504 : %ID_Delete = 505 Function PBMain() As Long Dialog New Pixels, 0, "Test Code",300,300,200,200, %WS_OverlappedWindow To hDlg Local hItem As Dword, hTemp As Dword, hTemp2 As Dword, hTemp3 As Dword Dialog New Pixels, 0, "TreeView",200,200,155,250, %WS_SysMenu, 0 To hDlg Control Add TreeView, hDlg, %IDC_TreeView, "", 10,10,130,200 TreeView Insert Item hDlg, %IDC_TreeView, 0, %TVI_Last, 0,0,"Root" To hItem TreeView Insert Item hDlg, %IDC_TreeView, hItem, %TVI_Last, 0,0,"Mother" To hTemp TreeView Insert Item hDlg, %IDC_TreeView, hTemp, %TVI_Last, 0,0,"Dan" To hTemp2 TreeView Insert Item hDlg, %IDC_TreeView, hTemp, %TVI_Last, 0,0,"Bob" To hTemp3 TreeView Set Expanded hDlg, %IDC_TreeView, hTemp, %True TreeView Insert Item hDlg, %IDC_TreeView, hTemp3, %TVI_Last, 0,0,"Foot" To hTemp2 TreeView Insert Item hDlg, %IDC_TreeView, hTemp3, %TVI_Last, 0,0,"Arm" To hTemp2 TreeView Set Expanded hDlg, %IDC_TreeView, hTemp3, %True TreeView Insert Item hDlg, %IDC_TreeView, hItem, %TVI_Last, 0,0,"Father" To hTemp TreeView Insert Item hDlg, %IDC_TreeView, hTemp, %TVI_Last, 0,0,"Helen" To hTemp2 TreeView Insert Item hDlg, %IDC_TreeView, hTemp, %TVI_Last, 0,0,"Any" To hTemp3 TreeView Set Expanded hDlg, %IDC_TreeView, hTemp, %True TreeView Insert Item hDlg, %IDC_TreeView, hTemp3, %TVI_Last, 0,0,"Leg" To hTemp2 TreeView Insert Item hDlg, %IDC_TreeView, hTemp3, %TVI_Last, 0,0,"Finger" To hTemp2 TreeView Set Expanded hDlg, %IDC_TreeView, hTemp3, %True TreeView Set Expanded hDlg, %IDC_TreeView, hItem, %True AddContextMenu Dialog Show Modal hDlg Call DlgProc End Function CallBack Function DlgProc() As Long Local x As Long, y As Long, iReturn As Long Select Case CB.Msg Case %WM_ContextMenu x = Lo(Integer,CB.lParam) : y = Hi(Integer, CB.lParam) iReturn = GetDlgCtrlID (CB.wParam) 'get control ID If iReturn = %IDC_TreeView Then 'select the item under the mouse when a right-click is made Local TVht As TV_HitTestInfo TVht.pt.x = x TVht.pt.y = y MapWindowPoints(%HWND_Desktop, CB.wParam, ByVal VarPtr(Tvht.pt), 1) SendMessage(CB.wParam, %TVM_HITTEST, 0, ByVal VarPTR(TVht)) TreeView Select hDlg, %IDC_TreeView, TVht.hItem TrackPopupMenu hContext, %TPM_LEFTALIGN, x, y, 0, hDlg, ByVal 0 End If Case %WM_Command Select Case CB.Ctl Case %ID_Cut : TreeCut Case %ID_Copy : TreeCopy Case %ID_PasteC : TreePasteAsChild Case %ID_PasteS : TreePasteAsSibling Case %ID_Delete : TreeDelete End Select End Select End Function Sub AddContextMenu Menu New Popup To hContext Menu Add String, hContext, "Cut", %ID_Cut, %MF_Enabled Menu Add String, hContext, "Copy", %ID_Copy, %MF_Enabled Menu Add String, hContext, "Paste As Child", %ID_PasteC, %MF_Enabled Menu Add String, hContext, "Paste As Sibling", %ID_PasteS, %MF_Enabled Menu Add String, hContext, "Delete", %ID_Delete, %MF_Enabled End Sub Sub TreeDelete Local hNode as Dword, iReturn& TreeView Get Select hDlg, %IDC_TreeView to hNode TreeView Get Child hDlg, %IDC_TreeView, hNode to iReturn& If iReturn& Then 'is parent Beep Else 'is child TreeView Delete hDlg, %IDC_TreeView, hNode End If End Sub Sub TreeCut Local hNode as Dword, iReturn& TreeView Get Select hDlg, %IDC_TreeView to hNode TreeView Get Child hDlg, %IDC_TreeView, hNode to iReturn& If iReturn& Then 'is parent Beep Else 'is child TreeView Get Text hDlg, %IDC_TreeView, hNode To NodeCopy$ TreeView Get User hDlg, %IDC_TreeView, hNode To NodeUser& TreeView Delete hDlg, %IDC_TreeView, hNode End If End Sub Sub TreeCopy Local hNode as Dword, iReturn& TreeView Get Select hDlg, %IDC_TreeView to hNode TreeView Get Child hDlg, %IDC_TreeView, hNode to iReturn& If iReturn& Then 'is parent Beep Else 'is child TreeView Get Text hDlg, %IDC_TreeView, hNode To NodeCopy$ TreeView Get User hDlg, %IDC_TreeView, hNode To NodeUser& End If End Sub Sub TreePasteAsChild Local hNode as Dword, iReturn& TreeView Get Select hDlg, %IDC_TreeView to hNode TreeView Insert Item hDlg, %IDC_TreeView, hNode, %TVI_First, 0, 0, NodeCopy$ to hNode TreeView Set User hDlg, %IDC_TreeView, hNode, NodeUser& End Sub Sub TreePasteAsSibling Local hNode as Dword, iReturn&, hParent as Dword TreeView Get Select hDlg, %IDC_TreeView to hNode TreeView Get Parent hDlg, %IDC_TreeView, hNode To hParent TreeView Insert Item hDlg, %IDC_TreeView, hParent, hNode, 0, 0, NodeCopy$ to hNode TreeView Set User hDlg, %IDC_TreeView, hNode, NodeUser& End Sub 'gbs_00263
Last edited by Gary Beene; 22 Jul 2012, 10:17 AM.
Leave a comment:
-
Compilable examples
Hi Chris
You're right, here is the complete code that compiles and runs. They're a bit messy because I've combined the main loop file with two .INC files for various equates and Subs. I've also attached the resource file needed for the images.
Hope you can see the difference between the two versions, basically the dialog version draws the tree, but it is subsequently largely non-functional.
Original version, scroll down to WINMAIN for main loop and callback code. - This is now the correect program!!
Code:'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' ' Purpose : TreeView drag & drop demo ' ' Author : Paul Noble, http://www.zippety.net, [email protected] ' ' Date : 29 Aug 2002 ' ' Remarks : Please refer to the README.TXT which accompanies this distribution, for ' important information relating to this project. ' '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ #COMPILE EXE #DIM ALL ' Main source code file: D:\PB\dragdrop\dragdrop.bas ' Resulting include file: D:\PB\dragdrop\WINCLEAN.INC ' ' Created by inClean v1.25, 08-29-2002, 11:53:43 ' Press Help-button for some useful information and tips. ' ' 31239 lines of include file data read and compared against ' 973 lines of code in 1.30 seconds. ' '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' ' ' Main include file for TreeView drag & drop demo ' ' '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ $TITLE = "TreeView Drag & Drop" $CLASS = "TDD_Demo" 'Control IDs... %ID_TREE = 500 'Tree bitmaps... %IDB_BOOK_C = 100 %IDB_BOOK_O = 101 %IDB_FOLDER_C = 102 %IDB_FOLDER_O = 103 %IDB_DOCUMENT = 104 'Tree ordinals... %IDO_BOOK_C = 0 %IDO_BOOK_O = 1 %IDO_FOLDER_C = 2 %IDO_FOLDER_O = 3 %IDO_DOCUMENT = 4 'Max length of treeview text, including terminating null %TV_ITEM_CHARS = 100 'Tree scrolling... %SCROLL_UP = 0 %SCROLL_DOWN = 1 %SCROLL_OFF = 0 %SCROLL_SLOWLY = 1 %SCROLL_QUICKLY = 2 'Tree scroll timer... %IDT_SCROLL = 200 #RESOURCE ".\dragdrop.pbr" 'For convenience, we use 2 globals to keep track of treeview automatic scrolling GLOBAL gyScrollTimerActive AS LONG GLOBAL gmScrollDirection AS LONG '----------------------------------------------------------------- ' Equates: 73 '----------------------------------------------------------------- %WINAPI = 1 %TRUE = 1 %FALSE = 0 %NULL = 0 %SB_VERT = 1 %SIF_RANGE = &H0001 %GWL_ID = -12 %WM_CREATE = &H1 %WM_DESTROY = &H2 %WM_SIZE = &H5 %WM_CLOSE = &H10 %WM_NOTIFY = &H4E %WM_TIMER = &H113 %WM_VSCROLL = &H115 %WM_MOUSEMOVE = &H200 %WM_LBUTTONUP = &H202 %SIZE_RESTORED = 0 %SIZE_MINIMIZED = 1 %SIZE_MAXIMIZED = 2 %WS_CHILD = &H40000000 %WS_VISIBLE = &H10000000 %WS_CLIPCHILDREN = &H02000000 %WS_CAPTION = &H00C00000 ' WS_BORDER OR WS_DLGFRAME %WS_VSCROLL = &H00200000 %WS_SYSMENU = &H00080000 %WS_THICKFRAME = &H00040000 %WS_MINIMIZEBOX = &H00020000 %WS_MAXIMIZEBOX = &H00010000 %WS_EX_CLIENTEDGE = &H00000200 %HWND_DESKTOP = 0 %SM_CYHSCROLL = 3 %COLOR_BTNFACE = 15 %IDC_ARROW = 32512& %ICC_TREEVIEW_CLASSES = &H00000002 ' treeview, tooltips %TV_FIRST = &H1100 ' TreeView messages %TVN_FIRST = 0-400 ' treeview %ILC_MASK = &H0001 %ILC_COLOR4 = &H0004 %ILC_COLOR16 = &H0010 %TVS_HASBUTTONS = &H00000001 %TVS_HASLINES = &H00000002 %TVS_SHOWSELALWAYS = &H00000020 %TVIF_TEXT = &H0001 %TVIF_IMAGE = &H0002 %TVIF_HANDLE = &H0010 %TVIF_SELECTEDIMAGE = &H0020 %TVIS_EXPANDED = &H0020 %TVI_ROOT = &HFFFF0000??? %TVI_FIRST = &HFFFF0001??? %TVI_LAST = &HFFFF0002??? %TVM_INSERTITEM = %TV_FIRST + 0 %TVM_DELETEITEM = %TV_FIRST + 1 %TVM_EXPAND = %TV_FIRST + 2 %TVE_COLLAPSE = &H00000001 %TVE_EXPAND = &H00000002 %TVM_GETITEMRECT = %TV_FIRST + 4 %TVM_GETINDENT = %TV_FIRST + 6 %TVM_GETIMAGELIST = %TV_FIRST + 8 %TVSIL_NORMAL = 0 %TVM_SETIMAGELIST = %TV_FIRST + 9 %TVM_GETNEXTITEM = %TV_FIRST + 10 %TVGN_ROOT = &H0000 %TVGN_PARENT = &H0003 %TVGN_CHILD = &H0004 %TVGN_DROPHILITE = &H0008 %TVGN_CARET = &H0009 %TVM_SELECTITEM = %TV_FIRST + 11 %TVM_GETITEM = %TV_FIRST + 12 %TVM_SETITEM = %TV_FIRST + 13 %TVM_HITTEST = %TV_FIRST + 17 %TVM_CREATEDRAGIMAGE = %TV_FIRST + 18 %TVN_ITEMEXPANDED = %TVN_FIRST - 6 %TVN_BEGINDRAG = %TVN_FIRST - 7 '----------------------------------------------------------------- ' TYPE and UNION structures: 14 '----------------------------------------------------------------- TYPE RECT nLeft AS LONG nTop AS LONG nRight AS LONG nBottom AS LONG END TYPE TYPE POINTAPI x AS LONG y AS LONG END TYPE TYPE tagMSG hwnd AS DWORD message AS DWORD wParam AS LONG lParam AS LONG time AS DWORD pt AS POINTAPI END TYPE TYPE WNDCLASSEX cbSize AS DWORD style AS DWORD lpfnWndProc AS LONG cbClsExtra AS LONG cbWndExtra AS LONG hInstance AS DWORD hIcon AS DWORD hCursor AS DWORD hbrBackground AS DWORD lpszMenuName AS ASCIIZ PTR lpszClassName AS ASCIIZ PTR hIconSm AS DWORD END TYPE TYPE ICONINFO fIcon AS LONG xHotspot AS DWORD yHotspot AS DWORD hbmMask AS LONG hbmColor AS LONG END TYPE TYPE NMHDR hwndFrom AS DWORD idfrom AS DWORD CODE AS LONG ' used for messages, so needs to be LONG, not DWORD... END TYPE TYPE SCROLLINFO cbSize AS DWORD fMask AS DWORD nMin AS LONG nMax AS LONG nPage AS DWORD nPos AS LONG nTrackPos AS LONG END TYPE TYPE INIT_COMMON_CONTROLSEX dwSize AS DWORD ' size of this structure dwICC AS DWORD ' flags indicating which classes to be initialized END TYPE TYPE TV_ITEM mask AS DWORD hItem AS DWORD STATE AS DWORD stateMask AS DWORD pszText AS ASCIIZ PTR cchTextMax AS LONG iImage AS LONG iSelectedImage AS LONG cChildren AS LONG lParam AS LONG END TYPE TYPE TVITEMEX mask AS DWORD hItem AS DWORD STATE AS DWORD stateMask AS DWORD pszText AS ASCIIZ PTR cchTextMax AS LONG iImage AS LONG iSelectedImage AS LONG cChildren AS LONG lParam AS LONG iIntegral AS LONG END TYPE UNION TV_ITEM_UNION itemex AS TVITEMEX item AS TV_ITEM END UNION TYPE TV_INSERTSTRUCT hParent AS DWORD hInsertAfter AS DWORD item AS TV_ITEM_UNION END TYPE TYPE TV_HITTESTINFO pt AS POINTAPI flags AS DWORD hItem AS DWORD END TYPE TYPE NM_TREEVIEW hdr AS NMHDR action AS DWORD itemOld AS TV_ITEM itemNew AS TV_ITEM ptDrag AS POINTAPI END TYPE '----------------------------------------------------------------- ' Declared Functions: 40 '----------------------------------------------------------------- DECLARE FUNCTION CreateWindowEx LIB "USER32.DLL" ALIAS "CreateWindowExA" (BYVAL dwExStyle AS DWORD, lpClassName AS ASCIIZ, lpWindowName AS ASCIIZ, BYVAL dwStyle AS DWORD, BYVAL x AS LONG, BYVAL y AS LONG, _ BYVAL nWidth AS LONG, BYVAL nHeight AS LONG, BYVAL hWndParent AS DWORD, BYVAL hMenu AS DWORD, BYVAL hInstance AS DWORD, lpParam AS ANY) AS DWORD DECLARE FUNCTION DefWindowProc LIB "USER32.DLL" ALIAS "DefWindowProcA" (BYVAL hWnd AS DWORD, BYVAL uMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG DECLARE FUNCTION DeleteObject LIB "GDI32.DLL" ALIAS "DeleteObject" (BYVAL hObject AS DWORD) AS LONG DECLARE FUNCTION DispatchMessage LIB "USER32.DLL" ALIAS "DispatchMessageA" (lpMsg AS tagMSG) AS LONG DECLARE FUNCTION GetClientRect LIB "USER32.DLL" ALIAS "GetClientRect" (BYVAL hwnd AS DWORD, lpRect AS RECT) AS LONG DECLARE FUNCTION GetCursorPos LIB "USER32.DLL" ALIAS "GetCursorPos" (lpPoint AS POINTAPI) AS LONG DECLARE FUNCTION GetIconInfo LIB "USER32.DLL" ALIAS "GetIconInfo" (BYVAL hIcon AS DWORD, piconinfo AS ICONINFO) AS LONG DECLARE FUNCTION GetMessage LIB "USER32.DLL" ALIAS "GetMessageA" (lpMsg AS tagMSG, BYVAL hWnd AS DWORD, BYVAL uMsgFilterMin AS DWORD, BYVAL uMsgFilterMax AS DWORD) AS LONG DECLARE FUNCTION GetModuleHandle LIB "KERNEL32.DLL" ALIAS "GetModuleHandleA" (lpModuleName AS ASCIIZ) AS DWORD DECLARE FUNCTION GetScrollInfo LIB "USER32.DLL" ALIAS "GetScrollInfo" (BYVAL hWnd AS DWORD, BYVAL n AS LONG, lpScrollInfo AS SCROLLINFO) AS LONG DECLARE FUNCTION GetSystemMetrics LIB "USER32.DLL" ALIAS "GetSystemMetrics" (BYVAL nIndex AS LONG) AS LONG DECLARE FUNCTION ImageList_AddMasked LIB "COMCTL32.DLL" _ ALIAS "ImageList_AddMasked" (BYVAL himl AS DWORD, _ BYVAL hbmImage AS DWORD, BYVAL crMask AS DWORD) AS LONG DECLARE FUNCTION ImageList_BeginDrag LIB "COMCTL32.DLL" _ ALIAS "ImageList_BeginDrag" (BYVAL himlTrack AS DWORD, _ BYVAL iTrack AS LONG, BYVAL dxHotSpot AS LONG, BYVAL dyHotSpot AS LONG) _ AS LONG DECLARE FUNCTION ImageList_Create LIB "COMCTL32.DLL" ALIAS "ImageList_Create" _ (BYVAL cx AS LONG, BYVAL cy AS LONG, BYVAL flags AS DWORD, _ BYVAL cInitial AS LONG, BYVAL cGrow AS LONG) AS DWORD DECLARE FUNCTION ImageList_Destroy LIB "COMCTL32.DLL" _ ALIAS "ImageList_Destroy" (BYVAL himl AS DWORD) AS LONG DECLARE FUNCTION ImageList_DragEnter LIB "COMCTL32.DLL" _ ALIAS "ImageList_DragEnter" (BYVAL hWndLock AS DWORD, BYVAL x AS LONG, _ BYVAL y AS LONG) AS LONG DECLARE FUNCTION ImageList_DragLeave LIB "COMCTL32.DLL" _ ALIAS "ImageList_DragLeave" (BYVAL hWndLock AS DWORD) AS LONG DECLARE FUNCTION ImageList_DragMove LIB "COMCTL32.DLL" _ ALIAS "ImageList_DragMove" (BYVAL x AS LONG, BYVAL y AS LONG) AS LONG DECLARE FUNCTION ImageList_DragShowNolock LIB "COMCTL32.DLL" _ ALIAS "ImageList_DragShowNolock" (BYVAL fShow AS LONG) AS LONG DECLARE FUNCTION ImageList_ReplaceIcon LIB "COMCTL32.DLL" _ ALIAS "ImageList_ReplaceIcon" (BYVAL himl AS DWORD, BYVAL i AS LONG, _ BYVAL hIcon AS DWORD) AS LONG DECLARE FUNCTION ImageList_SetDragCursorImage LIB "COMCTL32.DLL" _ ALIAS "ImageList_SetDragCursorImage" (BYVAL himlDrag AS DWORD, _ BYVAL iDrag AS LONG, BYVAL dxHotSpot AS LONG, BYVAL dyHotSpot AS LONG) _ AS LONG DECLARE FUNCTION InitCommonControlsEx LIB "COMCTL32.DLL" ALIAS "InitCommonControlsEx" (icc AS INIT_COMMON_CONTROLSEX) AS LONG DECLARE FUNCTION InvalidateRect LIB "USER32.DLL" ALIAS "InvalidateRect" (BYVAL hWnd AS DWORD, lpRect AS RECT, BYVAL bErase AS LONG) AS LONG DECLARE FUNCTION KillTimer LIB "USER32.DLL" ALIAS "KillTimer" (BYVAL hWnd AS DWORD, BYVAL nIDEvent AS LONG) AS LONG DECLARE FUNCTION LoadBitmap LIB "USER32.DLL" ALIAS "LoadBitmapA" (BYVAL hInstance AS DWORD, lpBitmapName AS ASCIIZ) AS DWORD DECLARE FUNCTION LoadCursor LIB "USER32.DLL" ALIAS "LoadCursorA" (BYVAL hInstance AS DWORD, lpCursorName AS ASCIIZ) AS DWORD DECLARE FUNCTION MapWindowPoints LIB "USER32.DLL" ALIAS "MapWindowPoints" (BYVAL hWndFrom AS DWORD, BYVAL hWndTo AS DWORD, lppt AS ANY, BYVAL cPoints AS LONG) AS LONG DECLARE FUNCTION MoveWindow LIB "USER32.DLL" ALIAS "MoveWindow" (BYVAL hWnd AS DWORD, BYVAL x AS LONG, BYVAL y AS LONG, BYVAL nWidth AS LONG, BYVAL nHeight AS LONG, BYVAL bRepaint AS LONG) AS LONG DECLARE FUNCTION PtInRect LIB "USER32.DLL" ALIAS "PtInRect" (lpRect AS RECT, BYVAL ptx AS LONG, BYVAL pty AS LONG) AS LONG DECLARE FUNCTION RegisterClassEx LIB "USER32.DLL" ALIAS "RegisterClassExA" (pcWndClassEx AS WNDCLASSEX) AS WORD DECLARE FUNCTION ReleaseCapture LIB "USER32.DLL" ALIAS "ReleaseCapture" () AS LONG DECLARE FUNCTION ScreenToClient LIB "USER32.DLL" ALIAS "ScreenToClient" (BYVAL hWnd AS DWORD, lpPoint AS POINTAPI) AS LONG DECLARE FUNCTION SendMessage LIB "USER32.DLL" ALIAS "SendMessageA" (BYVAL hWnd AS DWORD, BYVAL dwMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG DECLARE FUNCTION SetCapture LIB "USER32.DLL" ALIAS "SetCapture" (BYVAL hWnd AS DWORD) AS LONG DECLARE FUNCTION SetTimer LIB "USER32.DLL" ALIAS "SetTimer" (BYVAL hWnd AS DWORD, BYVAL nIDEvent AS LONG, BYVAL uElapse AS DWORD, BYVAL lpTimerFunc AS LONG) AS LONG DECLARE FUNCTION SetWindowLong LIB "USER32.DLL" ALIAS "SetWindowLongA" (BYVAL hWnd AS DWORD, BYVAL nIndex AS LONG, BYVAL lNewLong AS LONG) AS LONG DECLARE FUNCTION ShowCursor LIB "USER32.DLL" ALIAS "ShowCursor" (BYVAL bShow AS LONG) AS LONG DECLARE FUNCTION ShowWindow LIB "USER32.DLL" ALIAS "ShowWindow" (BYVAL hWnd AS DWORD, BYVAL nCmdShow AS LONG) AS LONG DECLARE FUNCTION TranslateMessage LIB "USER32.DLL" ALIAS "TranslateMessage" (lpMsg AS tagMSG) AS LONG DECLARE FUNCTION UpdateWindow LIB "USER32.DLL" ALIAS "UpdateWindow" (BYVAL hWnd AS DWORD) AS LONG '----------------------------------------------------------------- ' Declared Subs: 3 '----------------------------------------------------------------- DECLARE SUB ImageList_EndDrag LIB "COMCTL32.DLL" ALIAS "ImageList_EndDrag" () DECLARE SUB InitCommonControls LIB "COMCTL32.DLL" ALIAS "InitCommonControls" () DECLARE SUB PostQuitMessage LIB "USER32.DLL" ALIAS "PostQuitMessage" (BYVAL nExitCode AS LONG) '----------------------------------------------------------------- ' Functions: 20 (begins with declarations) '----------------------------------------------------------------- DECLARE FUNCTION CreateWindow (lpClassName AS ASCIIZ, lpWindowName AS ASCIIZ, BYVAL dwStyle AS DWORD, BYVAL xx AS LONG, BYVAL yy AS LONG, BYVAL nWidth AS LONG, _ BYVAL nHeight AS LONG, BYVAL hwndParent AS DWORD, BYVAL hMenu AS DWORD, BYVAL hInstance AS DWORD, BYVAL lpParam AS DWORD) AS LONG DECLARE FUNCTION ImageList_AddIcon (BYVAL hIml AS DWORD, hIcon AS DWORD) AS LONG DECLARE FUNCTION TreeView_InsertItem (BYVAL hWnd AS LONG, lpis AS TV_INSERTSTRUCT) _ AS DWORD DECLARE FUNCTION TreeView_DeleteItem (BYVAL hWnd AS DWORD, BYVAL hitem AS DWORD) _ AS LONG DECLARE FUNCTION TreeView_Expand (BYVAL hWnd AS DWORD, BYVAL hitem AS LONG, _ BYVAL code AS DWORD) AS LONG DECLARE FUNCTION TreeView_GetItemRect (BYVAL hWnd AS DWORD, BYVAL hItem AS DWORD, _ prc AS RECT, BYVAL code AS LONG) AS LONG DECLARE FUNCTION TreeView_GetIndent (BYVAL hWnd AS DWORD) AS DWORD DECLARE FUNCTION TreeView_GetImageList (BYVAL hWnd AS DWORD, BYVAL iImage AS LONG) _ AS DWORD DECLARE FUNCTION TreeView_SetImageList (BYVAL hWnd AS DWORD, BYVAL himl AS DWORD, _ BYVAL iImage AS LONG) AS DWORD DECLARE FUNCTION TreeView_GetNextItem (BYVAL hWnd AS DWORD, BYVAL hitem AS DWORD, _ BYVAL code AS DWORD) AS DWORD DECLARE FUNCTION TreeView_GetParent (BYVAL hwnd AS DWORD, BYVAL hitem AS DWORD) _ AS DWORD DECLARE FUNCTION TreeView_GetDropHilight (BYVAL hwnd AS DWORD) AS DWORD DECLARE FUNCTION TreeView_GetRoot (BYVAL hwnd AS DWORD) AS DWORD DECLARE FUNCTION TreeView_Select (BYVAL hwnd AS DWORD, BYVAL hitem AS DWORD, _ BYVAL code AS LONG) AS LONG DECLARE FUNCTION TreeView_SelectItem (BYVAL hwnd AS DWORD, BYVAL hitem AS DWORD) _ AS LONG DECLARE FUNCTION TreeView_SelectDropTarget (BYVAL hwnd AS DWORD, _ BYVAL hitem AS DWORD) AS LONG DECLARE FUNCTION TreeView_GetItem (BYVAL hwnd AS DWORD, pitem AS TV_ITEM) AS LONG DECLARE FUNCTION TreeView_SetItem (BYVAL hwnd AS DWORD, pitem AS TV_ITEM) AS LONG DECLARE FUNCTION TreeView_HitTest (BYVAL hwnd AS DWORD, lpht AS TV_HITTESTINFO) _ AS DWORD DECLARE FUNCTION TreeView_CreateDragImage (BYVAL hwnd AS DWORD, BYVAL hitem AS DWORD) _ AS DWORD '- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - FUNCTION CreateWindow (lpClassName AS ASCIIZ, lpWindowName AS ASCIIZ, BYVAL dwStyle AS DWORD, BYVAL xx AS LONG, BYVAL yy AS LONG, BYVAL nWidth AS LONG, _ BYVAL nHeight AS LONG, BYVAL hwndParent AS DWORD, BYVAL hMenu AS DWORD, BYVAL hInstance AS DWORD, BYVAL lpParam AS DWORD) AS LONG FUNCTION = CreateWindowEx(0, lpClassName, lpWindowName, dwStyle, xx, yy, nWidth, nHeight, hWndParent, hMenu, hInstance, BYVAL lpParam) END FUNCTION FUNCTION ImageList_AddIcon (BYVAL hIml AS DWORD, hIcon AS DWORD) AS LONG FUNCTION = ImageList_ReplaceIcon(hIml, -1, hIcon) END FUNCTION FUNCTION TreeView_InsertItem (BYVAL hWnd AS LONG, lpis AS TV_INSERTSTRUCT) _ AS DWORD FUNCTION = SendMessage(hWnd, %TVM_INSERTITEM, 0, VARPTR(lpis)) END FUNCTION FUNCTION TreeView_DeleteItem (BYVAL hWnd AS DWORD, BYVAL hitem AS DWORD) _ AS LONG FUNCTION = SendMessage(hWnd, %TVM_DELETEITEM, 0, hitem) END FUNCTION FUNCTION TreeView_Expand (BYVAL hWnd AS DWORD, BYVAL hitem AS LONG, _ BYVAL code AS DWORD) AS LONG FUNCTION = SendMessage(hWnd, %TVM_EXPAND, CODE, hitem) END FUNCTION FUNCTION TreeView_GetItemRect (BYVAL hWnd AS DWORD, BYVAL hItem AS DWORD, _ prc AS RECT, BYVAL code AS LONG) AS LONG prc.nLeft = hItem FUNCTION = SendMessage(hWnd, %TVM_GETITEMRECT, CODE, VARPTR(prc)) END FUNCTION FUNCTION TreeView_GetIndent (BYVAL hWnd AS DWORD) AS DWORD FUNCTION = SendMessage(hWnd, %TVM_GETINDENT, 0, 0) END FUNCTION FUNCTION TreeView_GetImageList (BYVAL hWnd AS DWORD, BYVAL iImage AS LONG) _ AS DWORD FUNCTION = SendMessage(hWnd, %TVM_GETIMAGELIST, iImage, 0) END FUNCTION FUNCTION TreeView_SetImageList (BYVAL hWnd AS DWORD, BYVAL himl AS DWORD, _ BYVAL iImage AS LONG) AS DWORD FUNCTION = SendMessage(hWnd, %TVM_SETIMAGELIST, iImage, himl) END FUNCTION FUNCTION TreeView_GetNextItem (BYVAL hWnd AS DWORD, BYVAL hitem AS DWORD, _ BYVAL code AS DWORD) AS DWORD FUNCTION = SendMessage(hWnd, %TVM_GETNEXTITEM, CODE, hitem) END FUNCTION FUNCTION TreeView_GetParent (BYVAL hwnd AS DWORD, BYVAL hitem AS DWORD) _ AS DWORD FUNCTION = TreeView_GetNextItem(hwnd, hitem, %TVGN_PARENT) END FUNCTION FUNCTION TreeView_GetDropHilight (BYVAL hwnd AS DWORD) AS DWORD FUNCTION = TreeView_GetNextItem(hwnd, %NULL, %TVGN_DROPHILITE) END FUNCTION FUNCTION TreeView_GetRoot (BYVAL hwnd AS DWORD) AS DWORD FUNCTION = TreeView_GetNextItem(hwnd, %NULL, %TVGN_ROOT) END FUNCTION FUNCTION TreeView_Select (BYVAL hwnd AS DWORD, BYVAL hitem AS DWORD, _ BYVAL code AS LONG) AS LONG FUNCTION = SendMessage(hwnd, %TVM_SELECTITEM, CODE, hitem) END FUNCTION FUNCTION TreeView_SelectItem (BYVAL hwnd AS DWORD, BYVAL hitem AS DWORD) _ AS LONG FUNCTION = TreeView_Select(hwnd, hitem, %TVGN_CARET) END FUNCTION FUNCTION TreeView_SelectDropTarget (BYVAL hwnd AS DWORD, _ BYVAL hitem AS DWORD) AS LONG FUNCTION = TreeView_Select(hwnd, hitem, %TVGN_DROPHILITE) END FUNCTION FUNCTION TreeView_GetItem (BYVAL hwnd AS DWORD, pitem AS TV_ITEM) AS LONG FUNCTION = SendMessage(hwnd, %TVM_GETITEM, 0, VARPTR(pitem)) END FUNCTION FUNCTION TreeView_SetItem (BYVAL hwnd AS DWORD, pitem AS TV_ITEM) AS LONG FUNCTION = SendMessage(hwnd, %TVM_SETITEM, 0, VARPTR(pitem)) END FUNCTION FUNCTION TreeView_HitTest (BYVAL hwnd AS DWORD, lpht AS TV_HITTESTINFO) _ AS DWORD FUNCTION = SendMessage(hwnd, %TVM_HITTEST, 0, VARPTR(lpht)) END FUNCTION FUNCTION TreeView_CreateDragImage (BYVAL hwnd AS DWORD, BYVAL hitem AS DWORD) _ AS DWORD FUNCTION = SendMessage(hwnd, %TVM_CREATEDRAGIMAGE, 0, hitem) END FUNCTION '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ FUNCTION WINMAIN ( BYVAL hInstance AS LONG, _ BYVAL hPrevInstance AS LONG, _ BYVAL lpCmdLine AS ASCIIZ PTR, _ BYVAL iCmdShow AS LONG ) AS LONG 'This is all standard SDK stuff ; create a dialog and display it LOCAL uCC AS INIT_COMMON_CONTROLSEX LOCAL uClass AS WndClassEx LOCAL msg AS tagMsg LOCAL zTitle AS ASCIIZ * 30 LOCAL zClass AS ASCIIZ * 30 LOCAL hDialog AS DWORD 'Initialise... zTitle = $TITLE zClass = $CLASS 'Register main window class... uClass.cbSize = SIZEOF(uClass) uClass.style = 0 uClass.lpfnwndproc = CODEPTR(wndproc) uClass.cbClsExtra = 0 uClass.cbWndExtra = 0 uClass.hInstance = hInstance uClass.hIcon = %NULL uClass.hCursor = %NULL uClass.hbrBackground = %COLOR_BTNFACE + 1 uClass.lpszMenuName = %NULL uClass.lpszCLASSNAME = VARPTR(zClass) RegisterClassEx uClass 'Initialise the common controls module... uCC.dwSize = SIZEOF(uCC) uCC.dwICC = %ICC_TREEVIEW_CLASSES IF InitCommonControlsEx(uCC) = 0 THEN InitCommonControls 'Win95A END IF 'Create the dialog... hDialog = CreateWindow( zClass, _ 'window class name zTitle, _ 'window caption %WS_CLIPCHILDREN OR %WS_CAPTION OR %WS_SYSMENU OR %WS_THICKFRAME OR %WS_MINIMIZEBOX OR %WS_MAXIMIZEBOX, _ 300, _ 'initial x position 200, _ 'initial y position 300, _ 'initial x size 300, _ 'initial y size %HWND_DESKTOP, _ 'parent window handle %NULL, _ 'window menu handle hInstance, _ 'program instance handle BYVAL %NULL ) 'creation parameters 'Show it... ShowWindow hDialog, iCmdShow UpdateWindow hDialog 'Process messages... WHILE GetMessage( msg, %NULL, 0, 0 ) TranslateMessage msg DispatchMessage msg WEND END FUNCTION '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ FUNCTION wndproc ( BYVAL hWnd AS DWORD, BYVAL wmsg AS LONG, _ BYVAL wParam AS DWORD, BYVAL lParam AS LONG ) AS LONG STATIC xhTree AS DWORD STATIC xhDragList AS DWORD STATIC xhCursors AS DWORD STATIC xhDragItem AS DWORD STATIC xuHotSpot AS POINTAPI LOCAL pNMTV AS NM_TREEVIEW PTR LOCAL uIconInfo AS ICONINFO LOCAL uPoint AS POINTAPI LOCAL uTV_HIT_INFO AS TV_HITTESTINFO LOCAL uRect AS RECT LOCAL hList AS DWORD LOCAL hCursor AS DWORD LOCAL hDropItem AS DWORD LOCAL mIndent AS LONG 'per-item indent (pixels) LOCAL mLevel AS LONG 'item indentation level LOCAL mResult AS LONG SELECT CASE wmsg CASE %WM_CREATE 'Create the treeview and set up its image list... GetClientRect hWnd, uRect xhTree = CreateTree( GetModuleHandle( BYVAL %NULL ), hWnd, uRect ) IF xhTree = %NULL THEN MSGBOX "Couldn't create tree !", , $TITLE SendMessage hWnd, %WM_CLOSE, 0, 0 ELSE 'Assign a control ID to the tree... SetWindowlong xhTree, %GWL_ID, %ID_TREE 'Add some dummy data to the tree... PopulateTree xhTree 'Create the drag image list, and the drag cursor icon... xhCursors = ImageList_Create( 32, 32, %ILC_COLOR4 OR %ILC_MASK, 1, 1 ) hCursor = LoadCursor( %NULL, BYVAL %IDC_ARROW ) ImageList_AddIcon xhCursors, hCursor GetIconInfo hCursor, uIconInfo 'Record these in a static variable... xuHotSpot.x = uIconInfo.xHotSpot xuHotSpot.y = uIconInfo.yHotSpot 'Clean up unwanted bitmaps... DeleteObject uIconInfo.hbmMask DeleteObject uIconInfo.hbmColor END IF CASE %WM_SIZE 'Have the tree fill the dialog at all times... SELECT CASE wParam CASE %SIZE_MINIMIZED 'do nothing CASE %SIZE_RESTORED, %SIZE_MAXIMIZED MoveWindow xhTree, 0, 0, LOWRD(lParam), HIWRD(lParam), %TRUE END SELECT CASE %WM_NOTIFY 'Respond to tree notifications... IF wParam = %ID_TREE THEN pNMTV = lParam SELECT CASE @pNMTV.hdr.code CASE %TVN_ITEMEXPANDED 'tree item expanded/collapsed 'Set the item's image according to its new expanded or collapsed status... TVW_SetImage xhTree, @pNMTV.ItemNew.hItem, @pNMTV.ItemNew.state AND %TVIS_EXPANDED 'Refresh the whole window... InvalidateRect hWnd, BYVAL %NULL, %TRUE UpdateWindow hWnd CASE %TVN_BEGINDRAG 'We only allow certain tree items to be dragged... IF TVW_IsDragSource( xhTree, @pNMTV.ItemNew.hItem ) THEN 'This call creates a drag image from the tree item, and returns the 'handle of an image list containing it as item 0. Note that at this 'stage, the image is based solely on the tree item (it doesn't contain 'the arrow cursor yet)... xhDragList = TreeView_CreateDragImage( xhTree, @pNMTV.ItemNew.hItem ) 'Remove the existing selection... TreeView_SelectItem xhTree, %NULL 'Record the level this item is at... mIndent = TreeView_GetIndent( xhTree ) mLevel = TVW_GetLevel( xhTree, @pNMTV.ItemNew.hItem ) 'Get RECT for *entire line* occupied by dragged item. This is relative 'to treeview origin (proven)... TreeView_GetItemRect xhTree, @pNMTV.ItemNew.hItem, uRect, %FALSE '@pNMTV.ptDrag is measured relative to the tree (proven)... ImageList_BeginDrag xhDragList, _ 0, _ @pNMTV.ptDrag.x - uRect.nLeft - mIndent * mLevel, _ @pNMTV.ptDrag.y - uRect.nTop 'Without this line, the drag image won't contain an arrow... ImageList_SetDragCursorImage xhCursors, _ 0, _ @pNMTV.ptDrag.x - uRect.nLeft - xuHotSpot.x - mIndent * mLevel, _ @pNMTV.ptDrag.y - uRect.nTop - xuHotSpot.y 'We're off... ImageList_DragEnter xhTree, @pNMTV.ptDrag.x, @pNMTV.ptDrag.y 'Capture the mouse & hide the normal cursor... SetCapture hWnd ShowCursor %FALSE xhDragItem = @pNMTV.ItemNew.hItem END IF END SELECT END IF CASE %WM_MOUSEMOVE 'If dragging, move the drag cursor... IF xhDragList <> %NULL THEN 'See where we are... uPoint.x = LOWRD( lParam ) 'these are relative to <hWnd> uPoint.y = HIWRD( lParam ) 'Convert to tree co-ordinates... MapWindowPoints hWnd, xhTree, BYVAL VARPTR(uPoint), 1 'Load the hit test structure... uTV_HIT_INFO.pt.x = uPoint.x 'these are relative to <xhTree> uTV_HIT_INFO.pt.y = uPoint.y 'If over a valid drop target, hilight it... TreeView_HitTest xhTree, uTV_HIT_INFO IF TVW_IsDropTarget( xhTree, uTV_HIT_INFO.hItem ) AND (uTV_HIT_INFO.hItem <> TreeView_GetDropHilight( xhTree )) THEN 'Clear the drag image... ImageList_DragLeave xhTree 'Unlight the old item, hilight the new one... TreeView_SelectDropTarget xhTree, %NULL TreeView_SelectDropTarget xhTree, uTV_HIT_INFO.hItem 'Show the drag image... ImageList_DragEnter xhTree, uPoint.x, uPoint.y ELSE ImageList_DragMove uPoint.x, uPoint.y END IF 'Check if we need to auto-scroll... 'removed (see notes) END IF CASE %WM_LBUTTONUP 'If dragging, drop the object in its new location... IF xhDragList <> %NULL THEN 'Stop the dragging process... ImageList_DragLeave xhTree ImageList_EndDrag ImageList_Destroy xhDragList xhDragList = %NULL ReleaseCapture ShowCursor %TRUE 'We only continue if the mouse is within the tree... GetClientRect xhTree, uRect GetCursorPos uPoint ScreenToClient xhTree, uPoint IF PtInRect( uRect, uPoint.x, uPoint.y ) THEN 'inside the tree 'Determine which item was last hilighted... hDropItem = TreeView_GetDropHilight( xhTree ) 'Unselect the drop hilight item... TreeView_SelectDropTarget xhTree, %NULL IF hDropItem <> %NULL THEN 'drag source = xhDragItem 'drop target = hDropItem IF hDropItem <> xhDragItem THEN 'Disallow drops onto own children (actually, not possible in this demo)... IF TVW_IsChildOf( xhTree, hDropItem, xhDragItem ) THEN BEEP ELSE 'The final aim of the drag & drop operation... TVW_MoveItem xhTree, xhDragItem, hDropItem END IF ELSE 'Disallow drops onto self BEEP END IF END IF END IF 'Update the treeview display... InvalidateRect xhTree, BYVAL %NULL, %TRUE END IF CASE %WM_TIMER 'removed (see notes) CASE %WM_CLOSE hList = TreeView_GetImageList( xhTree, %TVSIL_NORMAL ) IF hList THEN ImageList_Destroy hList IF xhCursors THEN ImageList_Destroy xhCursors 'suspect unnecessary CASE %WM_DESTROY PostQuitMessage 0 mResult = 0 GOTO Bye_wndproc END SELECT 'If we get to here, the message wasn't handled, or needs completing by the default handler... mResult = DefWindowProc( hWnd, wmsg, wParam, lParam ) Bye_wndproc: FUNCTION = mResult EXIT FUNCTION END FUNCTION '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ SUB TVW_SetImage( BYVAL hTree AS DWORD, BYVAL hItem AS DWORD, BYVAL yExpanded AS LONG ) LOCAL uItem AS TV_ITEM LOCAL mImage AS LONG LOCAL mNewImage AS LONG 'Find out what image is used by this item... uItem.hItem = hItem 'this is the item handle we want it for uItem.mask = %TVIF_HANDLE OR %TVIF_IMAGE OR %TVIF_SELECTEDIMAGE 'vital to specify both images TreeView_GetItem hTree, uItem 'fetch it mImage = uItem.iImage mNewImage = -1 'impossible value 'Decide what (if anything) we need to change the image to... SELECT CASE mImage CASE %IDO_BOOK_C IF yExpanded <> 0 THEN IF TreeView_GetNextItem( hTree, hItem, %TVGN_CHILD ) <> %NULL THEN mNewImage = %IDO_BOOK_O END IF END IF CASE %IDO_BOOK_O IF yExpanded = 0 THEN mNewImage = %IDO_BOOK_C CASE %IDO_FOLDER_C IF yExpanded <> 0 THEN IF TreeView_GetNextItem( hTree, hItem, %TVGN_CHILD ) <> %NULL THEN mNewImage = %IDO_FOLDER_O END IF END IF CASE %IDO_FOLDER_O IF yExpanded = 0 THEN mNewImage = %IDO_FOLDER_C END SELECT 'Is a change required ? IF mNewImage <> -1 THEN uItem.iImage = mNewImage uItem.iSelectedImage = mNewImage TreeView_SetItem hTree, uItem END IF END SUB '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ SUB TVW_Expand( BYVAL hTree AS DWORD, BYVAL hItem AS DWORD, BYVAL yExpand AS LONG ) 'Purpose : Wrapper for the TreeView_Expand() macro, but adds the automatic adjustment ' of the image according to the new collapsed/expanded state ' 'Remarks : It turns out that if the *currently selected* item is expanded by code, no adjustment ' to its 'expanded' image takes place, so we do that here, if necessary ' LOCAL uItem AS TV_ITEM LOCAL mImage AS LONG LOCAL mToggledImage AS LONG 'Perform the basic action... IF yExpand <> 0 THEN TreeView_Expand hTree, hItem, %TVE_EXPAND ELSE TreeView_Expand hTree, hItem, %TVE_COLLAPSE END IF 'Update the item's images... TVW_SetImage hTree, hItem, yExpand END SUB '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ FUNCTION CreateTree( BYVAL hInstance AS DWORD, BYVAL hParent AS DWORD, uRect AS RECT ) AS DWORD 'Purpose : Creates the treeview control and sets up the image list ' 'Returns : Treeview handle ' 'Remarks : Does not create any items in the tree ' LOCAL hBitmap AS DWORD LOCAL hRoot AS DWORD LOCAL hPItem AS DWORD LOCAL hTree AS DWORD LOCAL hImages AS DWORD LOCAL mMaskRGB AS LONG 'Create the treeview... hTree = CreateWindowEx( %WS_EX_CLIENTEDGE, _ "SysTreeView32", _ "", _ 'window caption %WS_CHILD OR _ %WS_VISIBLE OR _ %WS_VSCROLL OR _ %TVS_HASLINES OR _ %TVS_HASBUTTONS OR _ %TVS_SHOWSELALWAYS, _ uRect.nLeft, _ uRect.nTop, _ uRect.nRight - uRect.nLeft, _ uRect.nBottom - uRect.nTop, _ hParent, _ %NULL, _ 'window menu handle hInstance, _ BYVAL %NULL) 'creation parameters IF hTree THEN hImages = ImageList_Create( 16, 16, %ILC_COLOR16 OR %ILC_MASK, 6, 0 ) TreeView_SetImageList hTree, hImages, %TVSIL_NORMAL 'This is the mask colour we always use in our images... mMaskRGB = RGB(255,0,255) 'Add bitmaps from the resource file to the image list 'Item 0 (%IDO_BOOK_C)... hBitmap = LoadBitmap(hInstance, BYVAL %IDB_BOOK_C) ImageList_AddMasked hImages, hBitmap, mMaskRGB DeleteObject hBitmap 'Item 1 (%IDO_BOOK_O)... hBitmap = LoadBitmap(hInstance, BYVAL %IDB_BOOK_O) ImageList_AddMasked hImages, hBitmap, mMaskRGB DeleteObject hBitmap 'Item 2 (%IDO_FOLDER_C)... hBitmap = LoadBitmap(hInstance, BYVAL %IDB_FOLDER_C) ImageList_AddMasked hImages, hBitmap, mMaskRGB DeleteObject hBitmap 'Item 3 (%IDO_FOLDER_O)... hBitmap = LoadBitmap(hInstance, BYVAL %IDB_FOLDER_O) ImageList_AddMasked hImages, hBitmap, mMaskRGB DeleteObject hBitmap 'Item 4 (%IDO_DOCUMENT)... hBitmap = LoadBitmap(hInstance, BYVAL %IDB_DOCUMENT) ImageList_AddMasked hImages, hBitmap, mMaskRGB DeleteObject hBitmap END IF 'We're done FUNCTION = hTree END FUNCTION '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ SUB PopulateTree( BYVAL hTree AS DWORD ) 'Purpose : Adds dummy data to the tree ' DIM sLName() AS STRING DIM sFName() AS STRING LOCAL uInsert AS TV_INSERTSTRUCT LOCAL hRoot AS DWORD LOCAL hFolder AS DWORD LOCAL hFile AS DWORD LOCAL zText AS ASCIIZ * %TV_ITEM_CHARS LOCAL mFolder AS LONG LOCAL mFile AS LONG 'Set up the insertion structure... uInsert.hInsertAfter = %TVI_LAST uInsert.item.item.mask = %TVIF_TEXT OR %TVIF_IMAGE OR %TVIF_SELECTEDIMAGE 'Root node... zText = "Family Visits" uInsert.hParent = %TVI_ROOT uInsert.item.item.pszText = VARPTR( zText ) uInsert.item.item.iImage = %IDO_BOOK_C uInsert.item.item.iSelectedImage = %IDO_BOOK_C uInsert.item.item.LPARAM = %NULL hRoot = TreeView_InsertItem( hTree, uInsert ) 'Create some dummy data... REDIM sLName( 1 TO 5 ) sLName(1) = "Smith" sLName(2) = "Jones" sLName(3) = "Clark" sLName(4) = "Green" sLName(5) = "Taylor" REDIM sFName( 1 TO 5 ) sFName(1) = "John" sFName(2) = "Susan" sFName(3) = "Bridget" sFName(4) = "Alan" sFName(5) = "Carol" 'Add some folders and files... FOR mFolder = 1 TO UBOUND( sLName ) 'Add folder... zText = sLName(mFolder) & " family" uInsert.hParent = hRoot uInsert.item.item.pszText = VARPTR( zText ) uInsert.item.item.iImage = %IDO_FOLDER_C uInsert.item.item.iSelectedImage = %IDO_FOLDER_C uInsert.item.item.LPARAM = %NULL hFolder = TreeView_InsertItem( hTree, uInsert ) 'Add files to this folder... FOR mFile = 1 TO UBOUND( sFName ) zText = sFName(mFile) & " " & sLName(mFolder) uInsert.hParent = hFolder uInsert.item.item.pszText = VARPTR( zText ) uInsert.item.item.iImage = %IDO_DOCUMENT uInsert.item.item.iSelectedImage = %IDO_DOCUMENT uInsert.item.item.LPARAM = %NULL hFile = TreeView_InsertItem( hTree, uInsert ) NEXT mFile 'Expand say the first 2 folders... IF mFolder <= 2 THEN TVW_Expand hTree, hFolder, %TRUE NEXT mFolder 'Expand the root node, so that all the first-level nodes are visible... TVW_Expand hTree, hRoot, %TRUE Bye_BuildTree: ERASE sLName ERASE sFName EXIT SUB END SUB '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ FUNCTION TVW_GetImage( BYVAL hTree AS DWORD, BYVAL hItem AS DWORD ) AS LONG 'Purpose : Returns the ordinal of the item's bitmap ; if the item is not ' found, returns -1 ' LOCAL ti AS TV_ITEM ti.hItem = hItem 'set up the item structure ti.mask = %TVIF_HANDLE OR %TVIF_IMAGE 'these are the valid fields IF TreeView_GetItem( hTree, ti ) = 0 THEN 'fetch info about the new item FUNCTION = -1 ELSE FUNCTION = ti.iImage END IF END FUNCTION '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ FUNCTION TVW_GetLevel( BYVAL hTree AS DWORD, BYVAL hItem AS DWORD ) AS LONG 'Purpose : Returns the item's level. The root item is assumed to be at ' level = zero. ' LOCAL hRoot AS DWORD LOCAL mLevel AS LONG IF hItem <> %NULL THEN 'Determine the root's handle... hRoot = TreeView_GetRoot( hTree ) 'Walk back up the tree, towards the root... WHILE hItem <> hRoot INCR mLevel hItem = TreeView_GetNextItem( hTree, hItem, %TVGN_PARENT ) WEND END IF FUNCTION = mLevel END FUNCTION '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ FUNCTION TVW_IsDragSource( BYVAL hTree AS DWORD, BYVAL hItem AS DWORD ) AS LONG 'Purpose : Determines whether the specified tree item is allowed to be dragged ' 'Returns : 1 ... yes ' 0 ... no ' 'Remarks : In this demo, we allow only 'people' to be dragged ' SELECT CASE TVW_GetImage( hTree, hItem ) CASE %IDO_DOCUMENT FUNCTION = 1 CASE ELSE FUNCTION = 0 END SELECT END FUNCTION '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ FUNCTION TVW_IsDropTarget( BYVAL hTree AS DWORD, BYVAL hItemDest AS DWORD ) AS LONG 'Returns : 0 or 1 ' ' The rules - ' ' 1. We can drop people onto a family or another person ' 2. We cannot drop people onto the root ' SELECT CASE TVW_GetImage( hTree, hItemDest ) CASE %IDO_FOLDER_C, %IDO_FOLDER_O, %IDO_DOCUMENT FUNCTION = 1 CASE ELSE FUNCTION = 0 END SELECT END FUNCTION '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ FUNCTION TVW_GetText( BYVAL hTree AS DWORD, BYVAL hItem AS DWORD ) AS STRING 'Purpose : Returns the item's text ; if the item is not found, returns "" ' LOCAL ti AS TV_ITEM LOCAL zText AS ASCIIZ * ( %TV_ITEM_CHARS + 1 ) LOCAL s AS STRING 'Set up the item structure... ti.hItem = hItem ti.mask = %TVIF_TEXT zText = SPACE$( %TV_ITEM_CHARS ) ti.cchTextMax = %TV_ITEM_CHARS + 1 ti.pszText = VARPTR( zText ) 'Query the tree... IF TreeView_GetItem( hTree, ti ) = 0 THEN 'call failed FUNCTION = "" ELSE s = zText FUNCTION = s END IF END FUNCTION '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ FUNCTION TVW_IsChildOf( BYVAL hTree AS DWORD, BYVAL hItem AS DWORD, BYVAL hPossParent AS DWORD ) AS LONG 'Purpose : Determines whether <hItem> is a child of <hItem2> ' 'Returns : 0 or 1 ' LOCAL mResult AS LONG LOCAL hRoot AS DWORD IF hItem <> %NULL AND hPossParent <> %NULL THEN 'Determine the root's handle... hRoot = TreeView_GetRoot( hTree ) 'Walk back up the tree, towards the root... WHILE hItem <> hRoot IF hItem = hPossParent THEN mResult = 1 EXIT LOOP ELSE hItem = TreeView_GetNextItem( hTree, hItem, %TVGN_PARENT ) END IF WEND END IF FUNCTION = mResult END FUNCTION '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ FUNCTION TVW_HasChildren( BYVAL hTree AS DWORD, BYVAL hItem AS DWORD ) AS LONG 'Purpose : Determines whether there are any child items under the specified ' item ' 'Returns : 1 ... yes there are ' 2 ... no there aren't ' IF TreeView_GetNextItem( hTree, hItem, %TVGN_CHILD ) = %NULL THEN FUNCTION = 0 ELSE FUNCTION = 1 END IF END FUNCTION '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ FUNCTION TVW_MoveItem( BYVAL hTree AS DWORD, BYVAL hItemSource AS DWORD, BYVAL hItemDest AS DWORD ) AS DWORD 'Purpose : Move a tree item following a successful drag & drop operation ' 'Returns : Handle of the newly-created item ' 'Remarks : In this demo, we only copy across the dragged item's image and text, but ' in general, you may want to also take across other attributes such as ' the item's LPARAM, expansion state, text bolding, etc ' LOCAL uInsert AS TV_INSERTSTRUCT LOCAL hSourceParent AS DWORD LOCAL hDestParent AS DWORD LOCAL zText AS ASCIIZ * %TV_ITEM_CHARS LOCAL hNewItem AS DWORD 'Start off the insertion structure... uInsert.item.item.mask = %TVIF_TEXT OR %TVIF_IMAGE OR %TVIF_SELECTEDIMAGE zText = TVW_GetText( hTree, hItemSource ) uInsert.item.item.pszText = VARPTR( zText ) uInsert.item.item.iImage = TVW_GetImage ( hTree, hItemSource ) uInsert.item.item.iSelectedImage = uInsert.item.item.iImage 'Are we dropping onto a folder, or onto another person ? SELECT CASE TVW_GetImage( hTree, hItemDest ) CASE %IDO_DOCUMENT 'Insert the dragged person after the dropped-on person uInsert.hParent = TreeView_GetParent( hTree, hItemDest ) uInsert.hInsertAfter = hItemDest CASE %IDO_FOLDER_C, %IDO_FOLDER_O 'Insert the dragged person as the first person under this folder uInsert.hParent = hItemDest uInsert.hInsertAfter = %TVI_FIRST CASE ELSE BEEP : GOTO Bye_TVW_MoveItem END SELECT 'Create the new item... hNewItem = TreeView_InsertItem( hTree, uInsert ) 'Did we succeed ? IF hNewItem THEN 'Record these... hSourceParent = TreeView_GetParent( hTree, hItemSource ) hDestParent = TreeView_GetParent( hTree, hItemDest ) 'Now it's safe to delete the source item... TreeView_DeleteItem hTree, hItemSource 'Ensure the new item is visible and selected; we don't use TreeView_EnsureVisible(), 'because that can leave an expanded parent's image in the wrong state... TVW_Expand hTree, hDestParent, 1 TreeView_SelectItem hTree, hNewItem 'If the source folder has been emptied, close it up... IF TVW_HasChildren( hTree, hSourceParent ) = 0 THEN TVW_Expand hTree, hSourceParent, 0 END IF END IF Bye_TVW_MoveItem: FUNCTION = hNewItem END FUNCTION
Code:'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' ' Purpose : TreeView drag & drop demo ' ' Author : Paul Noble, http://www.zippety.net, [email protected] ' ' Date : 29 Aug 2002 ' ' Remarks : Please refer to the README.TXT which accompanies this distribution, for ' important information relating to this project. ' '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ #COMPILE EXE #DIM ALL ' Main source code file: D:\PB\dragdrop\dragdrop.bas ' Resulting include file: D:\PB\dragdrop\WINCLEAN.INC ' ' Created by inClean v1.25, 08-29-2002, 11:53:43 ' Press Help-button for some useful information and tips. ' ' 31239 lines of include file data read and compared against ' 973 lines of code in 1.30 seconds. ' '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' ' ' Main include file for TreeView drag & drop demo ' ' '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ $TITLE = "TreeView Drag & Drop" $CLASS = "TDD_Demo" 'Control IDs... %ID_TREE = 500 'Tree bitmaps... %IDB_BOOK_C = 100 %IDB_BOOK_O = 101 %IDB_FOLDER_C = 102 %IDB_FOLDER_O = 103 %IDB_DOCUMENT = 104 'Tree ordinals... %IDO_BOOK_C = 0 %IDO_BOOK_O = 1 %IDO_FOLDER_C = 2 %IDO_FOLDER_O = 3 %IDO_DOCUMENT = 4 'Max length of treeview text, including terminating null %TV_ITEM_CHARS = 100 'Tree scrolling... %SCROLL_UP = 0 %SCROLL_DOWN = 1 %SCROLL_OFF = 0 %SCROLL_SLOWLY = 1 %SCROLL_QUICKLY = 2 'Tree scroll timer... %IDT_SCROLL = 200 #RESOURCE ".\dragdrop.pbr" 'For convenience, we use 2 globals to keep track of treeview automatic scrolling GLOBAL gyScrollTimerActive AS LONG GLOBAL gmScrollDirection AS LONG '----------------------------------------------------------------- ' Equates: 73 '----------------------------------------------------------------- %WINAPI = 1 %TRUE = 1 %FALSE = 0 %NULL = 0 %SB_VERT = 1 %SIF_RANGE = &H0001 %GWL_ID = -12 %WM_CREATE = &H1 %WM_DESTROY = &H2 %WM_SIZE = &H5 %WM_CLOSE = &H10 %WM_NOTIFY = &H4E %WM_TIMER = &H113 %WM_VSCROLL = &H115 %WM_MOUSEMOVE = &H200 %WM_LBUTTONUP = &H202 %SIZE_RESTORED = 0 %SIZE_MINIMIZED = 1 %SIZE_MAXIMIZED = 2 %WS_CHILD = &H40000000 %WS_VISIBLE = &H10000000 %WS_CLIPCHILDREN = &H02000000 %WS_CAPTION = &H00C00000 ' WS_BORDER OR WS_DLGFRAME %WS_VSCROLL = &H00200000 %WS_SYSMENU = &H00080000 %WS_THICKFRAME = &H00040000 %WS_MINIMIZEBOX = &H00020000 %WS_MAXIMIZEBOX = &H00010000 %WS_EX_CLIENTEDGE = &H00000200 %HWND_DESKTOP = 0 %SM_CYHSCROLL = 3 %COLOR_BTNFACE = 15 %IDC_ARROW = 32512& %ICC_TREEVIEW_CLASSES = &H00000002 ' treeview, tooltips %TV_FIRST = &H1100 ' TreeView messages %TVN_FIRST = 0-400 ' treeview %ILC_MASK = &H0001 %ILC_COLOR4 = &H0004 %ILC_COLOR16 = &H0010 %TVS_HASBUTTONS = &H00000001 %TVS_HASLINES = &H00000002 %TVS_SHOWSELALWAYS = &H00000020 %TVIF_TEXT = &H0001 %TVIF_IMAGE = &H0002 %TVIF_HANDLE = &H0010 %TVIF_SELECTEDIMAGE = &H0020 %TVIS_EXPANDED = &H0020 %TVI_ROOT = &HFFFF0000??? %TVI_FIRST = &HFFFF0001??? %TVI_LAST = &HFFFF0002??? %TVM_INSERTITEM = %TV_FIRST + 0 %TVM_DELETEITEM = %TV_FIRST + 1 %TVM_EXPAND = %TV_FIRST + 2 %TVE_COLLAPSE = &H00000001 %TVE_EXPAND = &H00000002 %TVM_GETITEMRECT = %TV_FIRST + 4 %TVM_GETINDENT = %TV_FIRST + 6 %TVM_GETIMAGELIST = %TV_FIRST + 8 %TVSIL_NORMAL = 0 %TVM_SETIMAGELIST = %TV_FIRST + 9 %TVM_GETNEXTITEM = %TV_FIRST + 10 %TVGN_ROOT = &H0000 %TVGN_PARENT = &H0003 %TVGN_CHILD = &H0004 %TVGN_DROPHILITE = &H0008 %TVGN_CARET = &H0009 %TVM_SELECTITEM = %TV_FIRST + 11 %TVM_GETITEM = %TV_FIRST + 12 %TVM_SETITEM = %TV_FIRST + 13 %TVM_HITTEST = %TV_FIRST + 17 %TVM_CREATEDRAGIMAGE = %TV_FIRST + 18 %TVN_ITEMEXPANDED = %TVN_FIRST - 6 %TVN_BEGINDRAG = %TVN_FIRST - 7 '----------------------------------------------------------------- ' TYPE and UNION structures: 14 '----------------------------------------------------------------- TYPE RECT nLeft AS LONG nTop AS LONG nRight AS LONG nBottom AS LONG END TYPE TYPE POINTAPI x AS LONG y AS LONG END TYPE TYPE tagMSG hwnd AS DWORD message AS DWORD wParam AS LONG lParam AS LONG time AS DWORD pt AS POINTAPI END TYPE TYPE WNDCLASSEX cbSize AS DWORD style AS DWORD lpfnWndProc AS LONG cbClsExtra AS LONG cbWndExtra AS LONG hInstance AS DWORD hIcon AS DWORD hCursor AS DWORD hbrBackground AS DWORD lpszMenuName AS ASCIIZ PTR lpszClassName AS ASCIIZ PTR hIconSm AS DWORD END TYPE TYPE ICONINFO fIcon AS LONG xHotspot AS DWORD yHotspot AS DWORD hbmMask AS LONG hbmColor AS LONG END TYPE TYPE NMHDR hwndFrom AS DWORD idfrom AS DWORD CODE AS LONG ' used for messages, so needs to be LONG, not DWORD... END TYPE TYPE SCROLLINFO cbSize AS DWORD fMask AS DWORD nMin AS LONG nMax AS LONG nPage AS DWORD nPos AS LONG nTrackPos AS LONG END TYPE TYPE INIT_COMMON_CONTROLSEX dwSize AS DWORD ' size of this structure dwICC AS DWORD ' flags indicating which classes to be initialized END TYPE TYPE TV_ITEM mask AS DWORD hItem AS DWORD STATE AS DWORD stateMask AS DWORD pszText AS ASCIIZ PTR cchTextMax AS LONG iImage AS LONG iSelectedImage AS LONG cChildren AS LONG lParam AS LONG END TYPE TYPE TVITEMEX mask AS DWORD hItem AS DWORD STATE AS DWORD stateMask AS DWORD pszText AS ASCIIZ PTR cchTextMax AS LONG iImage AS LONG iSelectedImage AS LONG cChildren AS LONG lParam AS LONG iIntegral AS LONG END TYPE UNION TV_ITEM_UNION itemex AS TVITEMEX item AS TV_ITEM END UNION TYPE TV_INSERTSTRUCT hParent AS DWORD hInsertAfter AS DWORD item AS TV_ITEM_UNION END TYPE TYPE TV_HITTESTINFO pt AS POINTAPI flags AS DWORD hItem AS DWORD END TYPE TYPE NM_TREEVIEW hdr AS NMHDR action AS DWORD itemOld AS TV_ITEM itemNew AS TV_ITEM ptDrag AS POINTAPI END TYPE '----------------------------------------------------------------- ' Declared Functions: 40 '----------------------------------------------------------------- DECLARE FUNCTION CreateWindowEx LIB "USER32.DLL" ALIAS "CreateWindowExA" (BYVAL dwExStyle AS DWORD, lpClassName AS ASCIIZ, lpWindowName AS ASCIIZ, BYVAL dwStyle AS DWORD, BYVAL x AS LONG, BYVAL y AS LONG, _ BYVAL nWidth AS LONG, BYVAL nHeight AS LONG, BYVAL hWndParent AS DWORD, BYVAL hMenu AS DWORD, BYVAL hInstance AS DWORD, lpParam AS ANY) AS DWORD DECLARE FUNCTION DefWindowProc LIB "USER32.DLL" ALIAS "DefWindowProcA" (BYVAL hWnd AS DWORD, BYVAL uMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG DECLARE FUNCTION DeleteObject LIB "GDI32.DLL" ALIAS "DeleteObject" (BYVAL hObject AS DWORD) AS LONG DECLARE FUNCTION DispatchMessage LIB "USER32.DLL" ALIAS "DispatchMessageA" (lpMsg AS tagMSG) AS LONG DECLARE FUNCTION GetClientRect LIB "USER32.DLL" ALIAS "GetClientRect" (BYVAL hwnd AS DWORD, lpRect AS RECT) AS LONG DECLARE FUNCTION GetCursorPos LIB "USER32.DLL" ALIAS "GetCursorPos" (lpPoint AS POINTAPI) AS LONG DECLARE FUNCTION GetIconInfo LIB "USER32.DLL" ALIAS "GetIconInfo" (BYVAL hIcon AS DWORD, piconinfo AS ICONINFO) AS LONG DECLARE FUNCTION GetMessage LIB "USER32.DLL" ALIAS "GetMessageA" (lpMsg AS tagMSG, BYVAL hWnd AS DWORD, BYVAL uMsgFilterMin AS DWORD, BYVAL uMsgFilterMax AS DWORD) AS LONG DECLARE FUNCTION GetModuleHandle LIB "KERNEL32.DLL" ALIAS "GetModuleHandleA" (lpModuleName AS ASCIIZ) AS DWORD DECLARE FUNCTION GetScrollInfo LIB "USER32.DLL" ALIAS "GetScrollInfo" (BYVAL hWnd AS DWORD, BYVAL n AS LONG, lpScrollInfo AS SCROLLINFO) AS LONG DECLARE FUNCTION GetSystemMetrics LIB "USER32.DLL" ALIAS "GetSystemMetrics" (BYVAL nIndex AS LONG) AS LONG DECLARE FUNCTION ImageList_AddMasked LIB "COMCTL32.DLL" _ ALIAS "ImageList_AddMasked" (BYVAL himl AS DWORD, _ BYVAL hbmImage AS DWORD, BYVAL crMask AS DWORD) AS LONG DECLARE FUNCTION ImageList_BeginDrag LIB "COMCTL32.DLL" _ ALIAS "ImageList_BeginDrag" (BYVAL himlTrack AS DWORD, _ BYVAL iTrack AS LONG, BYVAL dxHotSpot AS LONG, BYVAL dyHotSpot AS LONG) _ AS LONG DECLARE FUNCTION ImageList_Create LIB "COMCTL32.DLL" ALIAS "ImageList_Create" _ (BYVAL cx AS LONG, BYVAL cy AS LONG, BYVAL flags AS DWORD, _ BYVAL cInitial AS LONG, BYVAL cGrow AS LONG) AS DWORD DECLARE FUNCTION ImageList_Destroy LIB "COMCTL32.DLL" _ ALIAS "ImageList_Destroy" (BYVAL himl AS DWORD) AS LONG DECLARE FUNCTION ImageList_DragEnter LIB "COMCTL32.DLL" _ ALIAS "ImageList_DragEnter" (BYVAL hWndLock AS DWORD, BYVAL x AS LONG, _ BYVAL y AS LONG) AS LONG DECLARE FUNCTION ImageList_DragLeave LIB "COMCTL32.DLL" _ ALIAS "ImageList_DragLeave" (BYVAL hWndLock AS DWORD) AS LONG DECLARE FUNCTION ImageList_DragMove LIB "COMCTL32.DLL" _ ALIAS "ImageList_DragMove" (BYVAL x AS LONG, BYVAL y AS LONG) AS LONG DECLARE FUNCTION ImageList_DragShowNolock LIB "COMCTL32.DLL" _ ALIAS "ImageList_DragShowNolock" (BYVAL fShow AS LONG) AS LONG DECLARE FUNCTION ImageList_ReplaceIcon LIB "COMCTL32.DLL" _ ALIAS "ImageList_ReplaceIcon" (BYVAL himl AS DWORD, BYVAL i AS LONG, _ BYVAL hIcon AS DWORD) AS LONG DECLARE FUNCTION ImageList_SetDragCursorImage LIB "COMCTL32.DLL" _ ALIAS "ImageList_SetDragCursorImage" (BYVAL himlDrag AS DWORD, _ BYVAL iDrag AS LONG, BYVAL dxHotSpot AS LONG, BYVAL dyHotSpot AS LONG) _ AS LONG DECLARE FUNCTION InitCommonControlsEx LIB "COMCTL32.DLL" ALIAS "InitCommonControlsEx" (icc AS INIT_COMMON_CONTROLSEX) AS LONG DECLARE FUNCTION InvalidateRect LIB "USER32.DLL" ALIAS "InvalidateRect" (BYVAL hWnd AS DWORD, lpRect AS RECT, BYVAL bErase AS LONG) AS LONG DECLARE FUNCTION KillTimer LIB "USER32.DLL" ALIAS "KillTimer" (BYVAL hWnd AS DWORD, BYVAL nIDEvent AS LONG) AS LONG DECLARE FUNCTION LoadBitmap LIB "USER32.DLL" ALIAS "LoadBitmapA" (BYVAL hInstance AS DWORD, lpBitmapName AS ASCIIZ) AS DWORD DECLARE FUNCTION LoadCursor LIB "USER32.DLL" ALIAS "LoadCursorA" (BYVAL hInstance AS DWORD, lpCursorName AS ASCIIZ) AS DWORD DECLARE FUNCTION MapWindowPoints LIB "USER32.DLL" ALIAS "MapWindowPoints" (BYVAL hWndFrom AS DWORD, BYVAL hWndTo AS DWORD, lppt AS ANY, BYVAL cPoints AS LONG) AS LONG DECLARE FUNCTION MoveWindow LIB "USER32.DLL" ALIAS "MoveWindow" (BYVAL hWnd AS DWORD, BYVAL x AS LONG, BYVAL y AS LONG, BYVAL nWidth AS LONG, BYVAL nHeight AS LONG, BYVAL bRepaint AS LONG) AS LONG DECLARE FUNCTION PtInRect LIB "USER32.DLL" ALIAS "PtInRect" (lpRect AS RECT, BYVAL ptx AS LONG, BYVAL pty AS LONG) AS LONG DECLARE FUNCTION RegisterClassEx LIB "USER32.DLL" ALIAS "RegisterClassExA" (pcWndClassEx AS WNDCLASSEX) AS WORD DECLARE FUNCTION ReleaseCapture LIB "USER32.DLL" ALIAS "ReleaseCapture" () AS LONG DECLARE FUNCTION ScreenToClient LIB "USER32.DLL" ALIAS "ScreenToClient" (BYVAL hWnd AS DWORD, lpPoint AS POINTAPI) AS LONG DECLARE FUNCTION SendMessage LIB "USER32.DLL" ALIAS "SendMessageA" (BYVAL hWnd AS DWORD, BYVAL dwMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG DECLARE FUNCTION SetCapture LIB "USER32.DLL" ALIAS "SetCapture" (BYVAL hWnd AS DWORD) AS LONG DECLARE FUNCTION SetTimer LIB "USER32.DLL" ALIAS "SetTimer" (BYVAL hWnd AS DWORD, BYVAL nIDEvent AS LONG, BYVAL uElapse AS DWORD, BYVAL lpTimerFunc AS LONG) AS LONG DECLARE FUNCTION SetWindowLong LIB "USER32.DLL" ALIAS "SetWindowLongA" (BYVAL hWnd AS DWORD, BYVAL nIndex AS LONG, BYVAL lNewLong AS LONG) AS LONG DECLARE FUNCTION ShowCursor LIB "USER32.DLL" ALIAS "ShowCursor" (BYVAL bShow AS LONG) AS LONG DECLARE FUNCTION ShowWindow LIB "USER32.DLL" ALIAS "ShowWindow" (BYVAL hWnd AS DWORD, BYVAL nCmdShow AS LONG) AS LONG DECLARE FUNCTION TranslateMessage LIB "USER32.DLL" ALIAS "TranslateMessage" (lpMsg AS tagMSG) AS LONG DECLARE FUNCTION UpdateWindow LIB "USER32.DLL" ALIAS "UpdateWindow" (BYVAL hWnd AS DWORD) AS LONG '----------------------------------------------------------------- ' Declared Subs: 3 '----------------------------------------------------------------- DECLARE SUB ImageList_EndDrag LIB "COMCTL32.DLL" ALIAS "ImageList_EndDrag" () DECLARE SUB InitCommonControls LIB "COMCTL32.DLL" ALIAS "InitCommonControls" () DECLARE SUB PostQuitMessage LIB "USER32.DLL" ALIAS "PostQuitMessage" (BYVAL nExitCode AS LONG) '----------------------------------------------------------------- ' Functions: 20 (begins with declarations) '----------------------------------------------------------------- DECLARE FUNCTION CreateWindow (lpClassName AS ASCIIZ, lpWindowName AS ASCIIZ, BYVAL dwStyle AS DWORD, BYVAL xx AS LONG, BYVAL yy AS LONG, BYVAL nWidth AS LONG, _ BYVAL nHeight AS LONG, BYVAL hwndParent AS DWORD, BYVAL hMenu AS DWORD, BYVAL hInstance AS DWORD, BYVAL lpParam AS DWORD) AS LONG DECLARE FUNCTION ImageList_AddIcon (BYVAL hIml AS DWORD, hIcon AS DWORD) AS LONG DECLARE FUNCTION TreeView_InsertItem (BYVAL hWnd AS LONG, lpis AS TV_INSERTSTRUCT) _ AS DWORD DECLARE FUNCTION TreeView_DeleteItem (BYVAL hWnd AS DWORD, BYVAL hitem AS DWORD) _ AS LONG DECLARE FUNCTION TreeView_Expand (BYVAL hWnd AS DWORD, BYVAL hitem AS LONG, _ BYVAL code AS DWORD) AS LONG DECLARE FUNCTION TreeView_GetItemRect (BYVAL hWnd AS DWORD, BYVAL hItem AS DWORD, _ prc AS RECT, BYVAL code AS LONG) AS LONG DECLARE FUNCTION TreeView_GetIndent (BYVAL hWnd AS DWORD) AS DWORD DECLARE FUNCTION TreeView_GetImageList (BYVAL hWnd AS DWORD, BYVAL iImage AS LONG) _ AS DWORD DECLARE FUNCTION TreeView_SetImageList (BYVAL hWnd AS DWORD, BYVAL himl AS DWORD, _ BYVAL iImage AS LONG) AS DWORD DECLARE FUNCTION TreeView_GetNextItem (BYVAL hWnd AS DWORD, BYVAL hitem AS DWORD, _ BYVAL code AS DWORD) AS DWORD DECLARE FUNCTION TreeView_GetParent (BYVAL hwnd AS DWORD, BYVAL hitem AS DWORD) _ AS DWORD DECLARE FUNCTION TreeView_GetDropHilight (BYVAL hwnd AS DWORD) AS DWORD DECLARE FUNCTION TreeView_GetRoot (BYVAL hwnd AS DWORD) AS DWORD DECLARE FUNCTION TreeView_Select (BYVAL hwnd AS DWORD, BYVAL hitem AS DWORD, _ BYVAL code AS LONG) AS LONG DECLARE FUNCTION TreeView_SelectItem (BYVAL hwnd AS DWORD, BYVAL hitem AS DWORD) _ AS LONG DECLARE FUNCTION TreeView_SelectDropTarget (BYVAL hwnd AS DWORD, _ BYVAL hitem AS DWORD) AS LONG DECLARE FUNCTION TreeView_GetItem (BYVAL hwnd AS DWORD, pitem AS TV_ITEM) AS LONG DECLARE FUNCTION TreeView_SetItem (BYVAL hwnd AS DWORD, pitem AS TV_ITEM) AS LONG DECLARE FUNCTION TreeView_HitTest (BYVAL hwnd AS DWORD, lpht AS TV_HITTESTINFO) _ AS DWORD DECLARE FUNCTION TreeView_CreateDragImage (BYVAL hwnd AS DWORD, BYVAL hitem AS DWORD) _ AS DWORD '- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - FUNCTION CreateWindow (lpClassName AS ASCIIZ, lpWindowName AS ASCIIZ, BYVAL dwStyle AS DWORD, BYVAL xx AS LONG, BYVAL yy AS LONG, BYVAL nWidth AS LONG, _ BYVAL nHeight AS LONG, BYVAL hwndParent AS DWORD, BYVAL hMenu AS DWORD, BYVAL hInstance AS DWORD, BYVAL lpParam AS DWORD) AS LONG FUNCTION = CreateWindowEx(0, lpClassName, lpWindowName, dwStyle, xx, yy, nWidth, nHeight, hWndParent, hMenu, hInstance, BYVAL lpParam) END FUNCTION FUNCTION ImageList_AddIcon (BYVAL hIml AS DWORD, hIcon AS DWORD) AS LONG FUNCTION = ImageList_ReplaceIcon(hIml, -1, hIcon) END FUNCTION FUNCTION TreeView_InsertItem (BYVAL hWnd AS LONG, lpis AS TV_INSERTSTRUCT) _ AS DWORD FUNCTION = SendMessage(hWnd, %TVM_INSERTITEM, 0, VARPTR(lpis)) END FUNCTION FUNCTION TreeView_DeleteItem (BYVAL hWnd AS DWORD, BYVAL hitem AS DWORD) _ AS LONG FUNCTION = SendMessage(hWnd, %TVM_DELETEITEM, 0, hitem) END FUNCTION FUNCTION TreeView_Expand (BYVAL hWnd AS DWORD, BYVAL hitem AS LONG, _ BYVAL code AS DWORD) AS LONG FUNCTION = SendMessage(hWnd, %TVM_EXPAND, CODE, hitem) END FUNCTION FUNCTION TreeView_GetItemRect (BYVAL hWnd AS DWORD, BYVAL hItem AS DWORD, _ prc AS RECT, BYVAL code AS LONG) AS LONG prc.nLeft = hItem FUNCTION = SendMessage(hWnd, %TVM_GETITEMRECT, CODE, VARPTR(prc)) END FUNCTION FUNCTION TreeView_GetIndent (BYVAL hWnd AS DWORD) AS DWORD FUNCTION = SendMessage(hWnd, %TVM_GETINDENT, 0, 0) END FUNCTION FUNCTION TreeView_GetImageList (BYVAL hWnd AS DWORD, BYVAL iImage AS LONG) _ AS DWORD FUNCTION = SendMessage(hWnd, %TVM_GETIMAGELIST, iImage, 0) END FUNCTION FUNCTION TreeView_SetImageList (BYVAL hWnd AS DWORD, BYVAL himl AS DWORD, _ BYVAL iImage AS LONG) AS DWORD FUNCTION = SendMessage(hWnd, %TVM_SETIMAGELIST, iImage, himl) END FUNCTION FUNCTION TreeView_GetNextItem (BYVAL hWnd AS DWORD, BYVAL hitem AS DWORD, _ BYVAL code AS DWORD) AS DWORD FUNCTION = SendMessage(hWnd, %TVM_GETNEXTITEM, CODE, hitem) END FUNCTION FUNCTION TreeView_GetParent (BYVAL hwnd AS DWORD, BYVAL hitem AS DWORD) _ AS DWORD FUNCTION = TreeView_GetNextItem(hwnd, hitem, %TVGN_PARENT) END FUNCTION FUNCTION TreeView_GetDropHilight (BYVAL hwnd AS DWORD) AS DWORD FUNCTION = TreeView_GetNextItem(hwnd, %NULL, %TVGN_DROPHILITE) END FUNCTION FUNCTION TreeView_GetRoot (BYVAL hwnd AS DWORD) AS DWORD FUNCTION = TreeView_GetNextItem(hwnd, %NULL, %TVGN_ROOT) END FUNCTION FUNCTION TreeView_Select (BYVAL hwnd AS DWORD, BYVAL hitem AS DWORD, _ BYVAL code AS LONG) AS LONG FUNCTION = SendMessage(hwnd, %TVM_SELECTITEM, CODE, hitem) END FUNCTION FUNCTION TreeView_SelectItem (BYVAL hwnd AS DWORD, BYVAL hitem AS DWORD) _ AS LONG FUNCTION = TreeView_Select(hwnd, hitem, %TVGN_CARET) END FUNCTION FUNCTION TreeView_SelectDropTarget (BYVAL hwnd AS DWORD, _ BYVAL hitem AS DWORD) AS LONG FUNCTION = TreeView_Select(hwnd, hitem, %TVGN_DROPHILITE) END FUNCTION FUNCTION TreeView_GetItem (BYVAL hwnd AS DWORD, pitem AS TV_ITEM) AS LONG FUNCTION = SendMessage(hwnd, %TVM_GETITEM, 0, VARPTR(pitem)) END FUNCTION FUNCTION TreeView_SetItem (BYVAL hwnd AS DWORD, pitem AS TV_ITEM) AS LONG FUNCTION = SendMessage(hwnd, %TVM_SETITEM, 0, VARPTR(pitem)) END FUNCTION FUNCTION TreeView_HitTest (BYVAL hwnd AS DWORD, lpht AS TV_HITTESTINFO) _ AS DWORD FUNCTION = SendMessage(hwnd, %TVM_HITTEST, 0, VARPTR(lpht)) END FUNCTION FUNCTION TreeView_CreateDragImage (BYVAL hwnd AS DWORD, BYVAL hitem AS DWORD) _ AS DWORD FUNCTION = SendMessage(hwnd, %TVM_CREATEDRAGIMAGE, 0, hitem) END FUNCTION '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ FUNCTION PBMAIN() AS LONG DIM hWnd AS LONG DIALOG NEW 0, "TreeView Drag & Drop", 200, 200, 300, 300, %WS_CLIPCHILDREN OR %WS_CAPTION OR %WS_SYSMENU OR %WS_THICKFRAME OR %WS_MINIMIZEBOX OR %WS_MAXIMIZEBOX, 0 TO hWnd DIALOG SHOW MODAL hWnd, CALL Treeview_callback END FUNCTION '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ CALLBACK FUNCTION treeview_callback STATIC hWnd AS LONG 'Added as a static variable that takes on the value of CB.HNDL STATIC xhTree AS DWORD STATIC xhDragList AS DWORD STATIC xhCursors AS DWORD STATIC xhDragItem AS DWORD STATIC xuHotSpot AS POINTAPI LOCAL pNMTV AS NM_TREEVIEW PTR LOCAL uIconInfo AS ICONINFO LOCAL uPoint AS POINTAPI LOCAL uTV_HIT_INFO AS TV_HITTESTINFO LOCAL uRect AS RECT LOCAL hList AS DWORD LOCAL hCursor AS DWORD LOCAL hDropItem AS DWORD LOCAL mIndent AS LONG 'per-item indent (pixels) LOCAL mLevel AS LONG 'item indentation level LOCAL mResult AS LONG SELECT CASE CB.MSG CASE %WM_INITDIALOG 'Changed from %WM_CREATE hWnd = CB.HNDL 'Create the treeview and set up its image list... GetClientRect hWnd, uRect xhTree = CreateTree(GetModuleHandle(BYVAL %NULL), hWnd, uRect) IF xhTree = %NULL THEN MSGBOX "Couldn't create tree !", , "TreeView Drag & Drop" SendMessage hWnd, %WM_CLOSE, 0, 0 ELSE 'Assign a control ID to the tree... SetWindowlong xhTree, %GWL_ID, %ID_TREE CALL PopulateTree(xhTree) 'Create the drag image list, and the drag cursor icon... xhCursors = ImageList_Create( 32, 32, %ILC_COLOR4 OR %ILC_MASK, 1, 1 ) hCursor = LoadCursor( %NULL, BYVAL %IDC_ARROW ) ImageList_AddIcon xhCursors, hCursor GetIconInfo hCursor, uIconInfo 'Record these in a static variable... xuHotSpot.x = uIconInfo.xHotSpot xuHotSpot.y = uIconInfo.yHotSpot 'Clean up unwanted bitmaps... DeleteObject uIconInfo.hbmMask DeleteObject uIconInfo.hbmColor END IF CASE %WM_SIZE 'Have the tree fill the dialog at all times... SELECT CASE CB.WPARAM CASE %SIZE_MINIMIZED 'do nothing CASE %SIZE_RESTORED, %SIZE_MAXIMIZED MoveWindow xhTree, 0, 0, LOWRD(CB.LPARAM), HIWRD(CB.LPARAM), %TRUE END SELECT CASE %WM_NOTIFY 'Respond to tree notifications... IF CB.WPARAM = %ID_TREE THEN pNMTV = CB.LPARAM SELECT CASE @pNMTV.hdr.code CASE %TVN_ITEMEXPANDED 'tree item expanded/collapsed 'Set the item's image according to its new expanded or collapsed status... TVW_SetImage xhTree, @pNMTV.ItemNew.hItem, @pNMTV.ItemNew.state AND %TVIS_EXPANDED 'Refresh the whole window... InvalidateRect hWnd, BYVAL %NULL, %TRUE UpdateWindow hWnd CASE %TVN_BEGINDRAG 'We only allow certain tree items to be dragged... IF TVW_IsDragSource( xhTree, @pNMTV.ItemNew.hItem ) THEN 'This call creates a drag image from the tree item, and returns the 'handle of an image list containing it as item 0. Note that at this 'stage, the image is based solely on the tree item (it doesn't contain 'the arrow cursor yet)... xhDragList = TreeView_CreateDragImage( xhTree, @pNMTV.ItemNew.hItem ) 'Remove the existing selection... TreeView_SelectItem xhTree, %NULL 'Record the level this item is at... mIndent = TreeView_GetIndent( xhTree ) mLevel = TVW_GetLevel( xhTree, @pNMTV.ItemNew.hItem ) 'Get RECT for *entire line* occupied by dragged item. This is relative 'to treeview origin (proven)... TreeView_GetItemRect xhTree, @pNMTV.ItemNew.hItem, uRect, %FALSE '@pNMTV.ptDrag is measured relative to the tree (proven)... ImageList_BeginDrag xhDragList, _ 0, _ @pNMTV.ptDrag.x - uRect.nLeft - mIndent * mLevel, _ @pNMTV.ptDrag.y - uRect.nTop 'Without this line, the drag image won't contain an arrow... ImageList_SetDragCursorImage xhCursors, _ 0, _ @pNMTV.ptDrag.x - uRect.nLeft - xuHotSpot.x - mIndent * mLevel, _ @pNMTV.ptDrag.y - uRect.nTop - xuHotSpot.y 'We're off... ImageList_DragEnter xhTree, @pNMTV.ptDrag.x, @pNMTV.ptDrag.y 'Capture the mouse & hide the normal cursor... SetCapture hWnd ShowCursor %FALSE xhDragItem = @pNMTV.ItemNew.hItem END IF END SELECT END IF CASE %WM_MOUSEMOVE 'If dragging, move the drag cursor... IF xhDragList <> %NULL THEN 'See where we are... uPoint.x = LOWRD(CB.LPARAM ) 'these are relative to <hWnd> uPoint.y = HIWRD(CB.LPARAM ) 'Convert to tree co-ordinates... MapWindowPoints hWnd, xhTree, BYVAL VARPTR(uPoint), 1 'Load the hit test structure... uTV_HIT_INFO.pt.x = uPoint.x 'these are relative to <xhTree> uTV_HIT_INFO.pt.y = uPoint.y 'If over a valid drop target, hilight it... TreeView_HitTest xhTree, uTV_HIT_INFO IF TVW_IsDropTarget( xhTree, uTV_HIT_INFO.hItem ) AND (uTV_HIT_INFO.hItem <> TreeView_GetDropHilight( xhTree )) THEN 'Clear the drag image... ImageList_DragLeave xhTree 'Unlight the old item, hilight the new one... TreeView_SelectDropTarget xhTree, %NULL TreeView_SelectDropTarget xhTree, uTV_HIT_INFO.hItem 'Show the drag image... ImageList_DragEnter xhTree, uPoint.x, uPoint.y ELSE ImageList_DragMove uPoint.x, uPoint.y END IF 'Check if we need to auto-scroll... 'removed (see notes) END IF CASE %WM_LBUTTONUP 'If dragging, drop the object in its new location... IF xhDragList <> %NULL THEN 'Stop the dragging process... ImageList_DragLeave xhTree ImageList_EndDrag ImageList_Destroy xhDragList xhDragList = %NULL ReleaseCapture ShowCursor %TRUE 'We only continue if the mouse is within the tree... GetClientRect xhTree, uRect GetCursorPos uPoint ScreenToClient xhTree, uPoint IF PtInRect( uRect, uPoint.x, uPoint.y ) THEN 'inside the tree 'Determine which item was last hilighted... hDropItem = TreeView_GetDropHilight( xhTree ) 'Unselect the drop hilight item... TreeView_SelectDropTarget xhTree, %NULL IF hDropItem <> %NULL THEN 'drag source = xhDragItem 'drop target = hDropItem IF hDropItem <> xhDragItem THEN 'Disallow drops onto own children (actually, not possible in this demo)... IF TVW_IsChildOf( xhTree, hDropItem, xhDragItem ) THEN BEEP ELSE 'The final aim of the drag & drop operation... TVW_MoveItem xhTree, xhDragItem, hDropItem END IF ELSE 'Disallow drops onto self BEEP END IF END IF END IF 'Update the treeview display... InvalidateRect xhTree, BYVAL %NULL, %TRUE END IF CASE %WM_TIMER 'removed (see notes) CASE %WM_CLOSE hList = TreeView_GetImageList( xhTree, %TVSIL_NORMAL ) IF hList THEN ImageList_Destroy hList IF xhCursors THEN ImageList_Destroy xhCursors 'suspect unnecessary CASE %WM_DESTROY PostQuitMessage 0 mResult = -1 GOTO Bye_wndproc END SELECT 'If we get to here, the message wasn't handled, or needs completing by the default handler... mResult = DefWindowProc(hWnd, CB.MSG, CB.WPARAM, CB.LPARAM ) Bye_wndproc: FUNCTION = mResult EXIT FUNCTION END FUNCTION '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ SUB TVW_SetImage( BYVAL hTree AS DWORD, BYVAL hItem AS DWORD, BYVAL yExpanded AS LONG ) LOCAL uItem AS TV_ITEM LOCAL mImage AS LONG LOCAL mNewImage AS LONG 'Find out what image is used by this item... uItem.hItem = hItem 'this is the item handle we want it for uItem.mask = %TVIF_HANDLE OR %TVIF_IMAGE OR %TVIF_SELECTEDIMAGE 'vital to specify both images TreeView_GetItem hTree, uItem 'fetch it mImage = uItem.iImage mNewImage = -1 'impossible value 'Decide what (if anything) we need to change the image to... SELECT CASE mImage CASE %IDO_BOOK_C IF yExpanded <> 0 THEN IF TreeView_GetNextItem( hTree, hItem, %TVGN_CHILD ) <> %NULL THEN mNewImage = %IDO_BOOK_O END IF END IF CASE %IDO_BOOK_O IF yExpanded = 0 THEN mNewImage = %IDO_BOOK_C CASE %IDO_FOLDER_C IF yExpanded <> 0 THEN IF TreeView_GetNextItem( hTree, hItem, %TVGN_CHILD ) <> %NULL THEN mNewImage = %IDO_FOLDER_O END IF END IF CASE %IDO_FOLDER_O IF yExpanded = 0 THEN mNewImage = %IDO_FOLDER_C END SELECT 'Is a change required ? IF mNewImage <> -1 THEN uItem.iImage = mNewImage uItem.iSelectedImage = mNewImage TreeView_SetItem hTree, uItem END IF END SUB '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ SUB TVW_Expand( BYVAL hTree AS DWORD, BYVAL hItem AS DWORD, BYVAL yExpand AS LONG ) 'Purpose : Wrapper for the TreeView_Expand() macro, but adds the automatic adjustment ' of the image according to the new collapsed/expanded state ' 'Remarks : It turns out that if the *currently selected* item is expanded by code, no adjustment ' to its 'expanded' image takes place, so we do that here, if necessary ' LOCAL uItem AS TV_ITEM LOCAL mImage AS LONG LOCAL mToggledImage AS LONG 'Perform the basic action... IF yExpand <> 0 THEN TreeView_Expand hTree, hItem, %TVE_EXPAND ELSE TreeView_Expand hTree, hItem, %TVE_COLLAPSE END IF 'Update the item's images... TVW_SetImage hTree, hItem, yExpand END SUB '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ FUNCTION CreateTree( BYVAL hInstance AS DWORD, BYVAL hParent AS DWORD, uRect AS RECT ) AS DWORD 'Purpose : Creates the treeview control and sets up the image list ' 'Returns : Treeview handle ' 'Remarks : Does not create any items in the tree ' LOCAL hBitmap AS DWORD LOCAL hRoot AS DWORD LOCAL hPItem AS DWORD LOCAL hTree AS DWORD LOCAL hImages AS DWORD LOCAL mMaskRGB AS LONG 'Create the treeview... hTree = CreateWindowEx( %WS_EX_CLIENTEDGE, _ "SysTreeView32", _ "", _ 'window caption %WS_CHILD OR _ %WS_VISIBLE OR _ %WS_VSCROLL OR _ %TVS_HASLINES OR _ %TVS_HASBUTTONS OR _ %TVS_SHOWSELALWAYS, _ uRect.nLeft, _ uRect.nTop, _ uRect.nRight - uRect.nLeft, _ uRect.nBottom - uRect.nTop, _ hParent, _ %NULL, _ 'window menu handle hInstance, _ BYVAL %NULL) 'creation parameters IF hTree THEN hImages = ImageList_Create( 16, 16, %ILC_COLOR16 OR %ILC_MASK, 6, 0 ) TreeView_SetImageList hTree, hImages, %TVSIL_NORMAL 'This is the mask colour we always use in our images... mMaskRGB = RGB(255,0,255) 'Add bitmaps from the resource file to the image list 'Item 0 (%IDO_BOOK_C)... hBitmap = LoadBitmap(hInstance, BYVAL %IDB_BOOK_C) ImageList_AddMasked hImages, hBitmap, mMaskRGB DeleteObject hBitmap 'Item 1 (%IDO_BOOK_O)... hBitmap = LoadBitmap(hInstance, BYVAL %IDB_BOOK_O) ImageList_AddMasked hImages, hBitmap, mMaskRGB DeleteObject hBitmap 'Item 2 (%IDO_FOLDER_C)... hBitmap = LoadBitmap(hInstance, BYVAL %IDB_FOLDER_C) ImageList_AddMasked hImages, hBitmap, mMaskRGB DeleteObject hBitmap 'Item 3 (%IDO_FOLDER_O)... hBitmap = LoadBitmap(hInstance, BYVAL %IDB_FOLDER_O) ImageList_AddMasked hImages, hBitmap, mMaskRGB DeleteObject hBitmap 'Item 4 (%IDO_DOCUMENT)... hBitmap = LoadBitmap(hInstance, BYVAL %IDB_DOCUMENT) ImageList_AddMasked hImages, hBitmap, mMaskRGB DeleteObject hBitmap END IF 'We're done FUNCTION = hTree END FUNCTION '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ SUB PopulateTree( BYVAL hTree AS DWORD ) 'Purpose : Adds dummy data to the tree ' DIM sLName() AS STRING DIM sFName() AS STRING LOCAL uInsert AS TV_INSERTSTRUCT LOCAL hRoot AS DWORD LOCAL hFolder AS DWORD LOCAL hFile AS DWORD LOCAL zText AS ASCIIZ * %TV_ITEM_CHARS LOCAL mFolder AS LONG LOCAL mFile AS LONG 'Set up the insertion structure... uInsert.hInsertAfter = %TVI_LAST uInsert.item.item.mask = %TVIF_TEXT OR %TVIF_IMAGE OR %TVIF_SELECTEDIMAGE 'Root node... zText = "Family Visits" uInsert.hParent = %TVI_ROOT uInsert.item.item.pszText = VARPTR( zText ) uInsert.item.item.iImage = %IDO_BOOK_C uInsert.item.item.iSelectedImage = %IDO_BOOK_C uInsert.item.item.LPARAM = %NULL hRoot = TreeView_InsertItem( hTree, uInsert ) 'Create some dummy data... REDIM sLName( 1 TO 5 ) sLName(1) = "Smith" sLName(2) = "Jones" sLName(3) = "Clark" sLName(4) = "Green" sLName(5) = "Taylor" REDIM sFName( 1 TO 5 ) sFName(1) = "John" sFName(2) = "Susan" sFName(3) = "Bridget" sFName(4) = "Alan" sFName(5) = "Carol" 'Add some folders and files... FOR mFolder = 1 TO UBOUND( sLName ) 'Add folder... zText = sLName(mFolder) & " family" uInsert.hParent = hRoot uInsert.item.item.pszText = VARPTR( zText ) uInsert.item.item.iImage = %IDO_FOLDER_C uInsert.item.item.iSelectedImage = %IDO_FOLDER_C uInsert.item.item.LPARAM = %NULL hFolder = TreeView_InsertItem( hTree, uInsert ) 'Add files to this folder... FOR mFile = 1 TO UBOUND( sFName ) zText = sFName(mFile) & " " & sLName(mFolder) uInsert.hParent = hFolder uInsert.item.item.pszText = VARPTR( zText ) uInsert.item.item.iImage = %IDO_DOCUMENT uInsert.item.item.iSelectedImage = %IDO_DOCUMENT uInsert.item.item.LPARAM = %NULL hFile = TreeView_InsertItem( hTree, uInsert ) NEXT mFile 'Expand say the first 2 folders... IF mFolder <= 2 THEN TVW_Expand hTree, hFolder, %TRUE NEXT mFolder 'Expand the root node, so that all the first-level nodes are visible... TVW_Expand hTree, hRoot, %TRUE Bye_BuildTree: ERASE sLName ERASE sFName EXIT SUB END SUB '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ FUNCTION TVW_GetImage( BYVAL hTree AS DWORD, BYVAL hItem AS DWORD ) AS LONG 'Purpose : Returns the ordinal of the item's bitmap ; if the item is not ' found, returns -1 ' LOCAL ti AS TV_ITEM ti.hItem = hItem 'set up the item structure ti.mask = %TVIF_HANDLE OR %TVIF_IMAGE 'these are the valid fields IF TreeView_GetItem( hTree, ti ) = 0 THEN 'fetch info about the new item FUNCTION = -1 ELSE FUNCTION = ti.iImage END IF END FUNCTION '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ FUNCTION TVW_GetLevel( BYVAL hTree AS DWORD, BYVAL hItem AS DWORD ) AS LONG 'Purpose : Returns the item's level. The root item is assumed to be at ' level = zero. ' LOCAL hRoot AS DWORD LOCAL mLevel AS LONG IF hItem <> %NULL THEN 'Determine the root's handle... hRoot = TreeView_GetRoot( hTree ) 'Walk back up the tree, towards the root... WHILE hItem <> hRoot INCR mLevel hItem = TreeView_GetNextItem( hTree, hItem, %TVGN_PARENT ) WEND END IF FUNCTION = mLevel END FUNCTION '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ FUNCTION TVW_IsDragSource( BYVAL hTree AS DWORD, BYVAL hItem AS DWORD ) AS LONG 'Purpose : Determines whether the specified tree item is allowed to be dragged ' 'Returns : 1 ... yes ' 0 ... no ' 'Remarks : In this demo, we allow only 'people' to be dragged ' SELECT CASE TVW_GetImage( hTree, hItem ) CASE %IDO_DOCUMENT FUNCTION = 1 CASE ELSE FUNCTION = 0 END SELECT END FUNCTION '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ FUNCTION TVW_IsDropTarget( BYVAL hTree AS DWORD, BYVAL hItemDest AS DWORD ) AS LONG 'Returns : 0 or 1 ' ' The rules - ' ' 1. We can drop people onto a family or another person ' 2. We cannot drop people onto the root ' SELECT CASE TVW_GetImage( hTree, hItemDest ) CASE %IDO_FOLDER_C, %IDO_FOLDER_O, %IDO_DOCUMENT FUNCTION = 1 CASE ELSE FUNCTION = 0 END SELECT END FUNCTION '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ FUNCTION TVW_GetText( BYVAL hTree AS DWORD, BYVAL hItem AS DWORD ) AS STRING 'Purpose : Returns the item's text ; if the item is not found, returns "" ' LOCAL ti AS TV_ITEM LOCAL zText AS ASCIIZ * ( %TV_ITEM_CHARS + 1 ) LOCAL s AS STRING 'Set up the item structure... ti.hItem = hItem ti.mask = %TVIF_TEXT zText = SPACE$( %TV_ITEM_CHARS ) ti.cchTextMax = %TV_ITEM_CHARS + 1 ti.pszText = VARPTR( zText ) 'Query the tree... IF TreeView_GetItem( hTree, ti ) = 0 THEN 'call failed FUNCTION = "" ELSE s = zText FUNCTION = s END IF END FUNCTION '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ FUNCTION TVW_IsChildOf( BYVAL hTree AS DWORD, BYVAL hItem AS DWORD, BYVAL hPossParent AS DWORD ) AS LONG 'Purpose : Determines whether <hItem> is a child of <hItem2> ' 'Returns : 0 or 1 ' LOCAL mResult AS LONG LOCAL hRoot AS DWORD IF hItem <> %NULL AND hPossParent <> %NULL THEN 'Determine the root's handle... hRoot = TreeView_GetRoot( hTree ) 'Walk back up the tree, towards the root... WHILE hItem <> hRoot IF hItem = hPossParent THEN mResult = 1 EXIT LOOP ELSE hItem = TreeView_GetNextItem( hTree, hItem, %TVGN_PARENT ) END IF WEND END IF FUNCTION = mResult END FUNCTION '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ FUNCTION TVW_HasChildren( BYVAL hTree AS DWORD, BYVAL hItem AS DWORD ) AS LONG 'Purpose : Determines whether there are any child items under the specified ' item ' 'Returns : 1 ... yes there are ' 2 ... no there aren't ' IF TreeView_GetNextItem( hTree, hItem, %TVGN_CHILD ) = %NULL THEN FUNCTION = 0 ELSE FUNCTION = 1 END IF END FUNCTION '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ FUNCTION TVW_MoveItem( BYVAL hTree AS DWORD, BYVAL hItemSource AS DWORD, BYVAL hItemDest AS DWORD ) AS DWORD 'Purpose : Move a tree item following a successful drag & drop operation ' 'Returns : Handle of the newly-created item ' 'Remarks : In this demo, we only copy across the dragged item's image and text, but ' in general, you may want to also take across other attributes such as ' the item's LPARAM, expansion state, text bolding, etc ' LOCAL uInsert AS TV_INSERTSTRUCT LOCAL hSourceParent AS DWORD LOCAL hDestParent AS DWORD LOCAL zText AS ASCIIZ * %TV_ITEM_CHARS LOCAL hNewItem AS DWORD 'Start off the insertion structure... uInsert.item.item.mask = %TVIF_TEXT OR %TVIF_IMAGE OR %TVIF_SELECTEDIMAGE zText = TVW_GetText( hTree, hItemSource ) uInsert.item.item.pszText = VARPTR( zText ) uInsert.item.item.iImage = TVW_GetImage ( hTree, hItemSource ) uInsert.item.item.iSelectedImage = uInsert.item.item.iImage 'Are we dropping onto a folder, or onto another person ? SELECT CASE TVW_GetImage( hTree, hItemDest ) CASE %IDO_DOCUMENT 'Insert the dragged person after the dropped-on person uInsert.hParent = TreeView_GetParent( hTree, hItemDest ) uInsert.hInsertAfter = hItemDest CASE %IDO_FOLDER_C, %IDO_FOLDER_O 'Insert the dragged person as the first person under this folder uInsert.hParent = hItemDest uInsert.hInsertAfter = %TVI_FIRST CASE ELSE BEEP : GOTO Bye_TVW_MoveItem END SELECT 'Create the new item... hNewItem = TreeView_InsertItem( hTree, uInsert ) 'Did we succeed ? IF hNewItem THEN 'Record these... hSourceParent = TreeView_GetParent( hTree, hItemSource ) hDestParent = TreeView_GetParent( hTree, hItemDest ) 'Now it's safe to delete the source item... TreeView_DeleteItem hTree, hItemSource 'Ensure the new item is visible and selected; we don't use TreeView_EnsureVisible(), 'because that can leave an expanded parent's image in the wrong state... TVW_Expand hTree, hDestParent, 1 TreeView_SelectItem hTree, hNewItem 'If the source folder has been emptied, close it up... IF TVW_HasChildren( hTree, hSourceParent ) = 0 THEN TVW_Expand hTree, hSourceParent, 0 END IF END IF Bye_TVW_MoveItem: FUNCTION = hNewItem END FUNCTION
Attached Files
Leave a comment:
-
Hi Peter, you might increase the size of your "review panel" by providing compileable code!
Leave a comment:
Leave a comment: