Module Dftreevw.pkg
1//************************************************************************
2//--- Dftreevw.pkg TREE-VIEW Package
3//
4// Copyright (c) 1983-2009 Data Access Corporation, Miami Florida,
5// All rights reserved.
6// DataFlex is a registered trademark of Data Access Corporation.
7//
8//***************************************************************************
9// Description:
10// A DataFlex class to support the Windows' Tree-View class.
11// The Tree-View permits data to be displayed in a hierarchical fashion.
12// The data can be read-in or added item by item.
13//
14// Author: Stuart W. Booth
15//***************************************************************************
16
17Use Windows.pkg
18Use CommCtrl.pkg
19Use WinKern.pkg
20Use seq_chnl.pkg
21Use tWinStructs.pkg
22
23
24// old Types. I wonder if anyone is using them? It is probably risky and pointless
25// to actually remove them. Don't use these. Use the structs in tWinStructs!
26
27Type tTvItem
28 Field tTvItem.mask as Dword
29 Field tTvItem.hItem as Handle
30 Field tTvItem.state as Dword
31 Field tTvItem.stateMask as Dword
32 Field tTvItem.pszText as Pointer
33 Field tTvItem.cchTextMax as Dword
34 Field tTvItem.iImage as Dword
35 Field tTvItem.iSelectedImage as Dword
36 Field tTvItem.cChildren as Dword
37 Field tTvItem.lParam as Dword
38End_Type
39
40Type tTvItemEx
41 Field tTvItemEx.mask as Dword
42 Field tTvItemEx.hItem as Handle
43 Field tTvItemEx.state as Dword
44 Field tTvItemEx.stateMask as Dword
45 Field tTvItemEx.pszText as Pointer
46 Field tTvItemEx.cchTextMax as Dword
47 Field tTvItemEx.iImage as Dword
48 Field tTvItemEx.iSelectedImage as Dword
49 Field tTvItemEx.cChildren as Dword
50 Field tTvItemEx.lParam as Dword
51 Field tTvItemEx.iIntegral as Dword
52End_Type
53
54Type tTvInsertStruct
55 Field tTvInsertStruct.hParent as Handle
56 Field tTvInsertStruct.hInsertAfter as Handle
57 Field tTvInsertStruct.tTvItemEx.mask as Dword
58 Field tTvInsertStruct.tTvItemEx.hItem as Handle
59 Field tTvInsertStruct.tTvItemEx.state as Dword
60 Field tTvInsertStruct.tTvItemEx.stateMask as Dword
61 Field tTvInsertStruct.tTvItemEx.pszText as Pointer
62 Field tTvInsertStruct.tTvItemEx.cchTextMax as Dword
63 Field tTvInsertStruct.tTvItemEx.iImage as Dword
64 Field tTvInsertStruct.tTvItemEx.iSelectedImage as Dword
65 Field tTvInsertStruct.tTvItemEx.cChildren as Dword
66 Field tTvInsertStruct.tTvItemEx.lParam as Dword
67End_Type
68
69Type tNmTreeView
70 Field tNmTreeView.hdr.hwndFrom as Handle
71 Field tNmTreeView.hdr.idFrom as Integer
72 Field tNmTreeView.hdr.code as Integer
73 Field tNmTreeView.action as Integer
74 Field tNmTreeView.ItemOld.mask as Integer
75 Field tNmTreeView.ItemOld.hItem as Handle
76 Field tNmTreeView.ItemOld.state as Integer
77 Field tNmTreeView.ItemOld.stateMask as Integer
78 Field tNmTreeView.ItemOld.pszText as Pointer
79 Field tNmTreeView.ItemOld.cchTextMax as Integer
80 Field tNmTreeView.ItemOld.iImage as Integer
81 Field tNmTreeView.ItemOld.iSelectedImage as Integer
82 Field tNmTreeView.ItemOld.cChildren as Integer
83 Field tNmTreeView.ItemOld.lParam as Dword
84 Field tNmTreeView.ItemNew.mask as Integer
85 Field tNmTreeView.ItemNew.hItem as Handle
86 Field tNmTreeView.ItemNew.state as Integer
87 Field tNmTreeView.ItemNew.stateMask as Integer
88 Field tNmTreeView.ItemNew.pszText as Pointer
89 Field tNmTreeView.ItemNew.cchTextMax as Integer
90 Field tNmTreeView.ItemNew.iImage as Integer
91 Field tNmTreeView.ItemNew.iSelectedImage as Integer
92 Field tNmTreeView.ItemNew.cChildren as Integer
93 Field tNmTreeView.ItemNew.lParam as Dword
94 Field tNmTreeView.ptDrag.x as Dword
95 Field tNmTreeView.ptDrag.y as Dword
96End_Type
97
98Type tTvHitTestInfo
99 Field tTvHitTestInfo.Pt.x as Dword
100 Field tTvHitTestInfo.Pt.y as Dword
101 Field tTvHitTestInfo.flags as Dword
102 Field tTvHitTestInfo.hItem as Handle
103End_Type
104
105Type tNmTvGetInfoTip
106 Field tNmTvGetInfoTip.Hdr.hwndFrom as Handle
107 Field tNmTvGetInfoTip.Hdr.idFrom as Integer
108 Field tNmTvGetInfoTip.Hdr.code as Integer
109 Field tNmTvGetInfoTip.pszText as Pointer
110 Field tNmTvGetInfoTip.cchTextMax as Dword
111 Field tNmTvGetInfoTip.hItem as Handle
112 Field tNmTvGetInfoTip.lParam as Dword
113End_Type
114
115Type tNmTvDispInfo
116 Field tNmTvDispInfo.hdr.hwndFrom as Handle
117 Field tNmTvDispInfo.hdr.idFrom as Integer
118 Field tNmTvDispInfo.hdr.code as Integer
119 Field tNmTvDispInfo.Item.mask as Integer
120 Field tNmTvDispInfo.Item.hItem as Handle
121 Field tNmTvDispInfo.Item.state as Integer
122 Field tNmTvDispInfo.Item.stateMask as Integer
123 Field tNmTvDispInfo.Item.pszText as Pointer
124 Field tNmTvDispInfo.Item.cchTextMax as Integer
125 Field tNmTvDispInfo.Item.iImage as Integer
126 Field tNmTvDispInfo.Item.iSelectedImage as Integer
127 Field tNmTvDispInfo.Item.cChildren as Integer
128 Field tNmTvDispInfo.Item.lParam as Dword
129End_Type
130
131
132// definitions needed to support checkboxes in treeviews.
133Define UM_CHECKSTATECHANGE for (WM_USER + 100)
134Define TVCheckboxImageBit for 12 // bits 12 to 15 determine checkbox image
135Define NM_FIRST for 0
136Define NM_TVSTATEIMAGECHANGING for (NM_FIRST-24) // fired when treeviews state image is changing.
137
138
139{ ClassType=Abstract }
140{ HelpTopic=AbstractTreeView }
141Class AbstractTreeView is a List
142 Procedure Construct_Object
143 Forward Send Construct_Object
144 { Category=Appearance }
145 Property integer TreeIndentWidth 15
146 { Category=Behavior }
147 { PropertyType=Boolean }
148 Property Integer TreeEditLabelsState False
149 { Category=Appearance }
150 { PropertyType=Boolean }
151 Property Integer TreeLinesState True
152 { Category=Appearance }
153 { PropertyType=Boolean }
154 Property Integer TreeRootLinesState True
155 { Category=Appearance }
156 { PropertyType=Boolean }
157 Property Integer TreeButtonsState True
158 { Category=Appearance }
159 { PropertyType=Boolean }
160 Property Integer TreeSortedState False
161 { Category=Behavior }
162 { PropertyType=Boolean }
163 Property Integer TreeRetainSelState True
164 { Category=Appearance }
165 Property Integer ImageListObject 0
166 { Category=Appearance }
167 Property string TreeLevelDelimeter '\'
168 { InitialValue=False }
169 { Category=Appearance }
170 { PropertyType=Boolean }
171 Property Integer pbHotTracking False
172 { InitialValue=False }
173 { Category=Appearance }
174 { PropertyType=Boolean }
175 Property Integer pbFullRowSelect False
176 { Category=Appearance }
177 { PropertyType=Boolean }
178 Property Integer pbShowTooltips True
179 { InitialValue=False }
180 { Category=Behavior }
181 { PropertyType=Boolean }
182 Property Integer pbSingleExpand False
183
184 { PropertyType=Color }
185 { EnumList="clScrollBar, clBackground, clActiveCaption, clInactiveCaption, clMenu, clWindow, clWindowFrame, clMenuText, clWindowText, clCaptionText, clActiveBorder, clInactiveBorder" }
186 { EnumList+="clAppWorkSpace, clHighlight, clHighlightText, clBtnFace, clBtnShadow, clGrayText, clBtnText, clInactiveCaptionText, clBtnHighlight, cl3DDkShadow, cl3DLight, clInfoText, clInfoBk, clDefault, clNone" }
187 { EnumList+="clAqua, clBlack, clBlue, clDkGray, clFuchsia, clGray, clGreen, clLime, clLtGray, clMaroon, clNavy, clOlive, clPurple, clRed, clSilver, clTeal, clWhite, clYellow" }
188 { InitialValue=clDefault }
189 { Category=Appearance }
190 Property Integer piLineColor clDefault
191
192 { PropertyType=Color }
193 { EnumList="clScrollBar, clBackground, clActiveCaption, clInactiveCaption, clMenu, clWindow, clWindowFrame, clMenuText, clWindowText, clCaptionText, clActiveBorder, clInactiveBorder" }
194 { EnumList+="clAppWorkSpace, clHighlight, clHighlightText, clBtnFace, clBtnShadow, clGrayText, clBtnText, clInactiveCaptionText, clBtnHighlight, cl3DDkShadow, cl3DLight, clInfoText, clInfoBk, clDefault, clNone" }
195 { EnumList+="clAqua, clBlack, clBlue, clDkGray, clFuchsia, clGray, clGreen, clLime, clLtGray, clMaroon, clNavy, clOlive, clPurple, clRed, clSilver, clTeal, clWhite, clYellow" }
196 { InitialValue=clNone }
197 { Category=Appearance }
198 Property Integer piBackColor clNone
199
200 { PropertyType=Color }
201 { EnumList="clScrollBar, clBackground, clActiveCaption, clInactiveCaption, clMenu, clWindow, clWindowFrame, clMenuText, clWindowText, clCaptionText, clActiveBorder, clInactiveBorder" }
202 { EnumList+="clAppWorkSpace, clHighlight, clHighlightText, clBtnFace, clBtnShadow, clGrayText, clBtnText, clInactiveCaptionText, clBtnHighlight, cl3DDkShadow, cl3DLight, clInfoText, clInfoBk, clDefault, clNone" }
203 { EnumList+="clAqua, clBlack, clBlue, clDkGray, clFuchsia, clGray, clGreen, clLime, clLtGray, clMaroon, clNavy, clOlive, clPurple, clRed, clSilver, clTeal, clWhite, clYellow" }
204 { InitialValue=clNone }
205 { Category=Appearance }
206 Property Integer piTextColor clNone
207
208 // Set to true to enable checkboxes in the treeview.
209 { Category=Appearance }
210 { PropertyType=Boolean }
211 Property Boolean pbEnableCheckboxes False
212
213 // Set to true to enable OnGetInfoTip notification.
214 { Category=Behavior }
215 { PropertyType=Boolean }
216 Property Boolean pbEnableInfoTips False
217
218 // can be set by the developer in OnBeginLabelEdit and OnEndLabelEdit to cancel an edit
219 { DesignTime=False }
220 { Obsolete=True }
221 Property Boolean pbCancelEdit False
222 End_Procedure
223
224 Function AddTreeItem String sValue Handle hParent Integer iItemData Integer iImage Integer iSelImage Returns Handle
225 Integer bSorted
226 Handle hInsertAfter hItem
227
228 Get TreeSortedState To bSorted
229 Move (If(bSorted, TVI_SORT, TVI_LAST)) to hInsertAfter
230 Get InsertTreeItem sValue hParent hInsertAfter iItemData iImage iSelImage to hItem
231 Function_Return hItem
232 End_Function
233
234 Function InsertTreeItem String sValue Handle hParent Handle hInsertAfter Integer iItemData Integer iImage Integer iSelImage Returns Handle
235 Pointer lpStruct pszValue pVoid
236 tWinTvInsertStruct TvInsertStruct
237
238 If (Oem_translate_state(Self)) Begin
239 Move (ToAnsi(sValue)) to sValue
240 End
241 Move (sValue+Character(0)) to sValue
242
243 Move (AddressOf(TvInsertStruct)) to lpStruct
244 Move (AddressOf(sValue)) to pszValue
245
246 Move (TVIF_TEXT + TVIF_PARAM +TVIF_IMAGE+TVIF_SELECTEDIMAGE) to TvInsertStruct.TvItemEx.mask
247 Move hInsertAfter to TvInsertStruct.hInsertAfter
248 Move pszValue to TvInsertStruct.TvItemEx.pszText
249 Move iItemData to TvInsertStruct.TvItemEx.lParam
250 Move iImage to TvInsertStruct.TvItemEx.iImage
251 Move iSelImage to TvInsertStruct.TvItemEx.iSelectedImage
252 Move hParent to TvInsertStruct.hParent
253
254 Function_Return (WindowsMessage(TVM_INSERTITEM, 0, lpStruct))
255 End_Function
256
257 { MethodType=Property }
258 { DesignTime=False}
259 Procedure SET CurrentTreeItem Handle hItem
260 Send Windows_Message TVM_SELECTITEM TVGN_CARET hItem
261 End_Procedure
262
263 { MethodType=Property }
264 Function CurrentTreeItem Returns Handle
265 Function_Return (WindowsMessage(TVM_GETNEXTITEM, TVGN_CARET, 0))
266 End_Function
267
268 { MethodType=Property }
269 // the bNotify is a dummy property. This always sets it true.
270 Procedure Set ExpandedOnceState Handle hItem Integer bNotify
271 Pointer lpTvItem
272 tWinTvItemEx TvItem
273
274 Move hItem to TvItem.hItem
275 Move (TVIF_Handle ior TVIF_STATE ior TVIS_EXPANDEDONCE) to TvItem.mask
276
277 Move (AddressOf(TvItem)) to lpTvItem
278 Send Windows_Message TVM_SETITEM 0 lpTvItem
279
280 End_Procedure
281
282 { MethodType=Property }
283 Function ExpandedOnceState Handle hItem Returns Integer // T or F
284 Pointer lpTvItem
285 tWinTvItemEx TvItem
286
287 Move (AddressOf(TvItem)) to lpTvItem
288
289 Move hItem to TvItem.hItem
290 Move (TVIF_Handle ior TVIF_STATE) to TvItem.mask
291
292 Send Windows_Message TVM_GETITEM 0 lpTvItem
293
294 Function_Return ((TvItem.state iand TVIS_EXPANDEDONCE) = TVIS_EXPANDEDONCE)
295 End_Function
296
297 { MethodType=Property }
298 Procedure Set ItemChildCount Handle hItem Integer icChildren
299 Pointer lpTvItem
300 tWinTvItemEx TvItem
301
302 Move hItem to TvItem.hItem
303 Move (TVIF_Handle ior TVIF_CHILDREN) to TvItem.mask
304 Move icChildren to TvItem.cChildren
305
306 Move (AddressOf(TvItem)) to lpTvItem
307
308 Send Windows_Message TVM_SETITEM 0 lpTvItem
309 End_Procedure
310
311 { MethodType=Property }
312 Function ItemChildCount Handle hItem Returns Integer
313 Pointer lpTvItem
314 tWinTvItemEx TvItem
315
316 Move (AddressOf(TvItem)) to lpTvItem
317
318 Move hItem to TvItem.hItem
319 Move (TVIF_Handle ior TVIF_CHILDREN) to TvItem.mask
320
321 Send Windows_Message TVM_GETITEM 0 lpTvItem
322
323 Function_Return TvItem.cChildren
324 End_Function
325
326 { MethodType=Property }
327 Procedure Set ItemLabel Handle hItem String sText
328 Pointer lpsText lpTvItem pVoid
329 tWinTvItemEx TvItem
330
331 If (Oem_translate_state(Self)) Begin
332 Move (ToAnsi(sText)) to sText
333 End
334 Move (sText + Character(0)) to sText
335
336 Move (AddressOf(sText)) to lpsText
337 Move (AddressOf(TvItem)) to lpTvItem
338 Move (TVIF_Handle ior TVIF_TEXT ) to TvItem.mask
339 Move hItem to TvItem.hItem
340 Move lpsText to TvItem.pszText
341 Send Windows_Message TVM_SETITEM 0 lpTvItem
342 End_Procedure
343
344 { MethodType=Property }
345 Function ItemLabel Handle hItem Returns String
346 Pointer lpTvItem lpsText pVoid
347 tWinTvItemEx TvItem
348 String sText
349
350 Move (repeat(Character(0),4096)) To sText
351 Move (AddressOf(sText)) to lpsText
352 Move (AddressOf(TvItem)) to lpTvItem
353 Move hItem to TvItem.hItem
354 Move (TVIF_Handle ior TVIF_TEXT ) to TvItem.mask
355 Move lpsText to TvItem.pszText
356 Move 4096 to TvItem.cchTextMax
357 Send Windows_Message TVM_GETITEM 0 lpTvItem
358 If (Oem_translate_state(Self)) Begin
359 Move (ToOEM(sText)) to sText
360 End
361 Function_Return (CString(sText))
362 End_Function
363
364 { MethodType=Property }
365 Procedure Set ItemData Handle hItem Integer iData
366 Pointer lpTvItem
367 tWinTvItemEx TvItem
368 Move (AddressOf(TvItem)) to lpTvItem
369 Move (TVIF_Handle ior TVIF_PARAM) to TvItem.mask
370 Move hItem to TvItem.hItem
371 Move iData to TvItem.lParam
372 Send Windows_Message TVM_SETITEM 0 lpTvItem
373 End_Procedure
374
375 { MethodType=Property }
376 Function ItemData Handle hItem Returns Integer
377 Pointer lpTvItem
378 tWinTvItemEx TvItem
379 Move (AddressOf(TvItem)) to lpTvItem
380 Move hItem to TvItem.hItem
381 Move (TVIF_Handle ior TVIF_PARAM ) to TvItem.mask
382 Send Windows_Message TVM_GETITEM 0 lpTvItem
383 Function_Return TvItem.lParam
384 End_Function
385
386 { MethodType=Property }
387 Procedure Set ItemImage Handle hItem Integer iImage
388 Pointer lpsText lpTvItem
389 tWinTvItemEx TvItem
390 Move (AddressOf(TvItem)) to lpTvItem
391 Move (TVIF_Handle ior TVIF_IMAGE) to TvItem.mask
392 Move hItem to TvItem.hItem
393 Move iImage to TvItem.iImage
394 Send Windows_Message TVM_SETITEM 0 lpTvItem
395 End_Procedure
396
397 { MethodType=Property }
398 Function ItemImage Handle hItem Returns Integer
399 Pointer lpTvItem
400 tWinTvItemEx TvItem
401 Move (AddressOf(TvItem)) to lpTvItem
402 Move hItem to TvItem.hItem
403 Move (TVIF_Handle ior TVIF_IMAGE ) to TvItem.mask
404 Send Windows_Message TVM_GETITEM 0 lpTvItem
405 Function_Return TvItem.iImage
406 End_Function
407
408 { MethodType=Property }
409 Procedure Set ItemSelectedImage Handle hItem Integer iImage
410 Pointer lpsText lpTvItem
411 tWinTvItemEx TvItem
412 Move (AddressOf(TvItem)) to lpTvItem
413 Move (TVIF_Handle ior TVIF_SELECTEDIMAGE) to TvItem.mask
414 Move hItem to TvItem.hItem
415 Move iImage to TvItem.iSelectedImage
416 Send Windows_Message TVM_SETITEM 0 lpTvItem
417 End_Procedure
418
419 { MethodType=Property }
420 Function ItemSelectedImage Handle hItem Returns Integer
421 Pointer lpTvItem
422 tWinTvItemEx TvItem
423 Move (AddressOf(TvItem)) to lpTvItem
424 Move hItem to TvItem.hItem
425 Move (TVIF_Handle ior TVIF_SELECTEDIMAGE ) to TvItem.mask
426 Send Windows_Message TVM_GETITEM 0 lpTvItem
427 Function_Return TvItem.iSelectedImage
428 End_Function
429
430 // Set/Get a tree item's bold state.
431 { MethodType=Property }
432 Procedure Set ItemBold Handle hItem Boolean bBold
433 Pointer lpTvItem
434 tWinTvItemEx TvItem
435
436 Move hItem to TvItem.hItem
437 Move (TVIF_HANDLE ior TVIF_STATE) to TvItem.Mask
438 Move (TVIS_BOLD) to TvItem.StateMask
439
440 If (bBold) Move (TVIS_BOLD) to TvItem.State
441
442 Move (AddressOf(TvItem)) to lpTvItem
443
444 Send Windows_Message TVM_SETITEM 0 lpTvItem
445 End_Procedure
446
447 { MethodType=Property }
448 Function ItemBold Handle hItem Returns Boolean
449 Pointer lpTvItem
450 tWinTvItemEx TvItem
451
452 Move (hItem) to TvItem.hItem
453 Move (TVIF_HANDLE ior TVIF_STATE) to TvItem.Mask
454
455 Move (AddressOf(TvItem)) to lpTvItem
456
457 Send Windows_Message TVM_GETITEM 0 lpTvItem
458
459 Function_Return (IsFlagIn(TVIS_BOLD, TvItem.State))
460 End_Function // BoldState
461
462 // Binary left shifts (<<) the integer iVal by iPositions.
463 { Visibility=Private }
464 Function LMaskShift Integer iVal Integer iPositions Returns Integer
465 Integer i
466 BigInt bVal
467 For i from 1 to iPositions
468 Move (iVal * 2) to bVal
469 If (bVal >= 2147483648) Move (bVal - 2147483648) to iVal
470 Else Move bVal to iVal
471 Loop
472 Function_Return iVal
473 End_Function
474
475 // Binary right shifts (<<) the integer iVal by iPositions.
476 { Visibility=Private }
477 Function RMaskShift Integer iVal Integer iPositions Returns Integer
478 Function_Return (iVal / (2^iPositions))
479 End_Function
480
481 { Visibility=Private }
482 Procedure SetItemCheckboxImage Handle hItem Integer iState
483 Pointer lpTvItem
484 tWinTvItemEx TvItem
485
486 // State image index is in bits 12-15)....
487 // 0=no checkbox image, 1=unchecked image, 2=checked image
488 Get LMaskShift iState TVCheckboxImageBit to iState
489
490 Move hItem to TvItem.hItem
491 Move (TVIF_HANDLE ior TVIF_STATE) to TvItem.Mask
492 Move (TVIS_STATEIMAGEMASK) to TvItem.StateMask
493 Move iState to TvItem.State
494
495 Move (AddressOf(TvItem)) to lpTvItem
496
497 Send Windows_Message TVM_SETITEM 0 lpTvItem
498 End_Procedure
499
500 { MethodType=Property }
501 { Visibility=Private }
502 Function GetItemCheckboxImage Handle hItem Returns Integer
503 Boolean bChecked
504 Integer iImage
505 Pointer lpTvItem
506 tWinTvItemEx TvItem
507
508 Move hItem to TvItem.hItem
509 Move (TVIF_HANDLE ior TVIF_STATE) to TvItem.Mask
510 Move (TVIS_STATEIMAGEMASK) to TvItem.StateMask
511
512 Move (AddressOf(TvItem)) to lpTvItem
513
514 Send Windows_Message TVM_GETITEM 0 lpTvItem
515
516 // Get the State Image index (bits 12-15)....
517 // 0=no checkbox image, 1=unchecked image, 2=checked image
518 Move TvItem.State to iImage
519 Get RMaskShift iImage TVCheckboxImageBit to iImage
520
521 Function_Return iImage
522 End_Function
523
524 // Get/Set an item's checked state. pbCheckboxes must be set to true for this setting to work
525 { MethodType=Property }
526 Procedure Set ItemChecked Handle hItem Boolean bChecked
527 Send SetItemCheckboxImage hItem (If(bChecked,2,1))
528 End_Procedure
529
530 { MethodType=Property }
531 Function ItemChecked Handle hItem Returns Boolean
532 Integer iImage
533 Get GetItemCheckboxImage hItem to iImage
534 Function_Return (iImage = 2)
535 End_Function // CheckedState
536
537 // Get/Set an item's checkbox appearance state. pbCheckboxes must be set to true for this setting to work
538 { MethodType=Property }
539 Procedure Set ItemCheckBox Handle hItem Boolean bCheckbox
540 Send SetItemCheckboxImage hItem (If(bCheckbox,1,0))
541 End_Procedure
542
543 { MethodType=Property }
544 Function ItemCheckBox Handle hItem Returns Boolean
545 Integer iImage
546 Get GetItemCheckboxImage hItem to iImage
547 Function_Return (iImage <> 0)
548 End_Function
549
550 Procedure DoDeleteItem Handle hItem
551 Send Windows_Message TVM_DELETEITEM 0 hItem
552 End_Procedure
553
554 { Visibility=Private }
555 Procedure DoInitWindow
556 Handle hWnd hIml iVoid
557 Integer iStyle iIndent hoIml
558 Integer bEdit bLInes bRootLines bButtons bRetainSel
559 Integer bHotTracking bFullRowSelect bShowTooltips bSingleExpand
560 Integer bEnableCheckboxes bEnableInfoTips
561
562 Get Window_Handle To hWnd
563 Move (GetWindowLong(hWnd, GWL_STYLE)) To iStyle
564
565 Get TreeIndentWidth To iIndent
566 Get TreeEditLabelsState To bEdit
567 Get TreeLinesState To bLines
568 Get TreeRootLinesState To bRootLines
569 Get TreeButtonsState To bButtons
570 Get TreeRetainSelState To bRetainSel
571 Get ImageListObject To hoIml
572 Get pbHotTracking To bHotTracking
573 Get pbFullRowSelect To bFullRowSelect
574 Get pbShowTooltips To bShowTooltips
575 Get pbSingleExpand to bSingleExpand
576 Get pbEnableCheckboxes to bEnableCheckboxes
577 Get pbEnableInfoTips to bEnableInfoTips
578
579 If bEdit Move (iStyle ior TVS_EDITLABELS) to iStyle
580 If bLines Move (iStyle ior TVS_HASLINES) to iStyle
581 If bRootLines Move (iStyle ior TVS_LINESATROOT) to iStyle
582 If bButtons Move (iStyle ior TVS_HASBUTTONS) to iStyle
583 If bRetainSel Move (iStyle ior TVS_SHOWSELALWAYS) to iStyle
584 If bHotTracking Move (iStyle ior TVS_TRACKSELECT) to iStyle
585 If bFullRowSelect Move (iStyle ior TVS_FULLROWSELECT) to iStyle
586 If bSingleExpand Move (iStyle ior TVS_SINGLEEXPAND) to iStyle
587 If (bShowTooltips=False) Move (iStyle ior TVS_NOTOOLTIPS) to iStyle
588 If bEnableCheckboxes Move (iStyle ior TVS_CHECKBOXES) to iStyle
589 If bEnableInfoTips Move (iStyle ior TVS_INFOTIP) to iStyle
590
591 Move (SetWindowLong(hWnd, GWL_STYLE, iStyle) ) to iVoid
592
593 Send Windows_Message TVM_SETINDENT iIndent 0
594
595 If hoIml Begin
596 Get Window_Handle of hoIml To hIml
597 Send Windows_Message TVM_SETIMAGELIST 0 hIml
598 End
599
600 Set piLineColor To (piLineColor(self))
601 Set piBackColor To (piBackColor(self))
602 Set piTextColor To (piTextColor(self))
603
604 Send OnCreateTree
605 End_Procedure
606
607 Procedure DoEnumerateTree Integer iMsg Handle hItem Integer iRecurseLevel
608 Handle hChildItem
609 // if zero is passed, we want to start at the root. Although this was not a documented feature it seems to
610 // be one that is used so we will support this for backwards compatibility. This acts a little differently than
611 // the older tree-view class which would sent a message passing 0 for the first item. This is an extra call and
612 // is wrong.
613 If (hItem=0) begin
614 Get RootItem to hItem
615 end
616 While hItem
617 Send iMsg hItem iRecurseLevel
618 Move (WindowsMessage(TVM_GETNEXTITEM, TVGN_CHILD, hItem)) To hChildItem
619 If hChildItem Begin
620 Send DoEnumerateTree iMsg hChildItem (iRecurseLevel +1)
621 end
622 Move (WindowsMessage(TVM_GETNEXTITEM, TVGN_NEXT, hItem)) To hItem
623 Loop
624 End_Procedure
625
626 Procedure DoEnumerateTreeUp Integer iMsg Handle hItem Integer iRecurseLevel
627 Handle hChildItem hFirstItem hLastItem
628 // see comments in DoEnumerateTreeUp
629 If (hItem=0) begin
630 Get RootItem to hItem
631 end
632 Move hItem To hFirstItem
633 // find list sibling item in list
634 While hItem
635 Move hItem To hLastItem
636 Move (WindowsMessage(TVM_GETNEXTITEM, TVGN_NEXT, hItem)) To hItem
637 Loop
638
639 // traverse list in reverse sibling order. Send first to children, then send to self
640 While (hLastItem>0 )
641 Move (WindowsMessage(TVM_GETNEXTITEM, TVGN_CHILD, hLastItem)) To hChildItem
642 If hChildItem Begin
643 Send DoEnumerateTreeUp iMsg hChildItem (iRecurseLevel +1) // do children first
644 end
645 Send iMsg hLastItem iRecurseLevel // do self
646 // We check for FirstItem in the off chance that the node passed was not the first node
647 If (hLastItem=hFirstItem) begin // if we just processed the starting item, we are done
648 Move 0 to hLastItem
649 end
650 else begin
651 Move (WindowsMessage(TVM_GETNEXTITEM, TVGN_PREVIOUS, hLastItem)) To hLastItem // get previous sibling
652 end
653 Loop
654 End_Procedure
655
656
657 { MethodType=Event }
658 Procedure OnItemChanging Handle hItem Handle hItemOld Boolean ByRef bCancel
659 End_Procedure
660
661 { MethodType=Event }
662 Procedure OnItemChanged Handle hItem Handle hItemOld
663 End_Procedure
664
665 { MethodType=Event }
666 Procedure OnItemExpanding Handle hItem Boolean ByRef bCancel
667 End_Procedure
668
669 { MethodType=Event }
670 Procedure OnItemExpanded Handle hItem
671 End_Procedure
672
673 { MethodType=Event }
674 Procedure OnItemCollapsing Handle hItem Boolean ByRef bCancel
675 End_Procedure
676
677 { MethodType=Event }
678 Procedure OnItemCollapsed Handle hItem
679 End_Procedure
680
681 { MethodType=Event }
682 Procedure OnBeginDrag Handle hItem
683 End_Procedure
684
685 { MethodType=Event }
686 Procedure OnBeginRDrag Handle hItem
687 End_Procedure
688
689 { MethodType=Event }
690 Procedure OnDeleteItem Handle hItem
691 End_Procedure
692
693 { MethodType=Event }
694 Procedure OnBeginLabelEdit Handle hItem Boolean ByRef bCancel
695 End_Procedure
696
697 { MethodType=Event }
698 Procedure OnEndLabelEdit Handle hItem String sNewLabel Boolean bWasCanceled Boolean ByRef bCancel
699 End_Procedure
700
701 { MethodType=Event }
702 Procedure OnKeyDown
703 End_Procedure
704
705 { MethodType=Event }
706 Procedure OnGetDispInfo Handle hItem
707 End_Procedure
708
709 { MethodType=Event }
710 Procedure OnSetDispInfo Handle hItem
711 End_Procedure
712
713 { MethodType=Event }
714 Procedure OnItemEnter
715 End_Procedure
716
717 { MethodType=Event }
718 Procedure OnItemClick Handle hItem Boolean ByRef bCancel
719 End_Procedure
720
721 { MethodType=Event }
722 Procedure OnItemRClick Handle hItem
723 End_Procedure
724
725 { MethodType=Event }
726 Procedure OnItemDblClick Handle hItem Boolean ByRef bCancel
727 End_Procedure
728
729 { MethodType=Event }
730 Procedure OnItemRDblClick Handle hItem
731 End_Procedure
732
733 { MethodType=Event }
734 Procedure OnGetInfoTip Handle hItem String ByRef sInfoTip
735 End_Procedure // OnGetInfoTip
736
737 { Visibility=Private }
738 Function TVHitTest Returns tWinTvHitTestInfo
739 Handle hWnd hItem
740 Integer iVoid
741 Pointer lpPt
742 tWinPoint Pt
743 tWinTvHitTestInfo TVHitTestInfo
744 Get Window_Handle to hWnd
745 Move (AddressOf(Pt)) to lpPt
746 Move (GetCursorPos(lpPt)) to iVoid
747 Move (ScreenToClient(hWnd, lpPt)) to iVoid
748 Move Pt to TVHitTestInfo.Pt
749 Get WindowsMessage TVM_HITTEST 0 (AddressOf(TVHitTestInfo)) to hItem
750 Function_Return TVHitTestInfo
751 End_Function
752
753
754 { Visibility=Private }
755 Function ItemHitTest Returns Handle
756 tWinTvHitTestInfo TVHitTestInfo
757 Get TVHitTest to TVHitTestInfo
758 Function_Return TVHitTestInfo.hItem
759 End_Function
760
761 { MethodType=Event Visibility=Private }
762 Procedure Notify Integer wParam Integer lParam
763 Handle hWnd
764 Handle hItemHt
765 Integer iVoid
766 Handle hItem hItemOld
767 Integer iAction iTextSize
768 Pointer pText
769 String sItemText
770 Boolean bCancelledByUser bCancel bEnableCheckboxes bItemCheckBox
771 Integer iMask
772 String sInfoTip
773 Pointer lpszInfoTip
774 tWinNmHdr Header
775 tWinNmTvKeyDown KeyInfo
776 tWinTvHitTestInfo HitTest
777 tWinNmTvGetInfoTip GetInfoTip
778 tWinNmTvDispInfo NmDispInfo
779 tWinNmTreeView NmTreeView
780 tWinNmTvStateImageChanging NmTvStateImageChanging
781
782 Move (MemCopy(AddressOf(Header), lParam, SizeOfType(tWinNmHdr))) to iVoid
783 Get Window_Handle to hWnd
784
785 // Note that different actions use different structures
786 If (Header.Code = TVN_DELETEITEM or Header.Code = TVN_ITEMEXPANDING or Header.Code = TVN_ITEMEXPANDED or ;
787 Header.Code = TVN_BEGINDRAG or Header.Code = TVN_BEGINRDRAG or Header.Code = TVN_SELCHANGING or ;
788 Header.Code = TVN_SELCHANGED) Begin
789
790 Move (MemCopy(AddressOf(NmTreeView), lParam, SizeOfType(tWinNmTreeView))) to iVoid
791
792 Move NmTreeView.action to iAction
793 Move NmTreeView.itemNew.hItem to hItem
794 Move NmTreeView.itemOld.hItem to hItemOld
795 End
796 Else If (Header.Code = TVN_BEGINLABELEDIT or Header.Code = TVN_ENDLABELEDIT or ;
797 Header.Code = TVN_GETDISPINFO or Header.Code = TVN_SETDISPINFO) Begin
798
799 Move (MemCopy(AddressOf(NmDispInfo), lParam, SizeOfType(tWinNmTvDispInfo))) to iVoid
800
801 Move NmDispInfo.item.hItem to hItem
802
803 If (Header.Code = TVN_BEGINLABELEDIT or Header.Code = TVN_ENDLABELEDIT) Begin
804 Move NmDispInfo.item.mask to iMask
805
806 If (iMask iand TVIF_TEXT) Begin // only get text if text actually exists
807 Move NmdispInfo.item.pszText to pText
808 End
809 Else Begin
810 Move 0 to pText
811 End
812
813 // if pText is 0, the edit was cancelled. If it points to something it was not cancelled
814 If (pText <> 0) Begin // this can point to an empty string (i.e., empty but not cancelled)
815 Move NmDispInfo.item.cchTextMax to iTextSize
816 Move (Repeat(Character(0),iTextSize)) to sItemText
817 Move (MemCopy(AddressOf(sItemText), pText, iTextSize)) to iVoid
818 Move False to bCancelledByUser
819 End
820 Else Begin
821 Move "" to sItemText
822 Move True to bCancelledByUser
823 End
824 End
825 End
826
827 // Handle the different notification events
828
829 Move False to bCancel
830
831 Case Begin
832
833 Case (Header.Code = TVN_DELETEITEM)
834 Send OnDeleteItem hItemOld
835 Case Break
836
837 Case (Header.Code = TVN_ITEMEXPANDING)
838 If (iAction = TVE_EXPAND) Send OnItemExpanding hItem (&bCancel)
839 Else Send OnItemCollapsing hItem (&bCancel)
840 Case Break
841
842 Case (Header.Code = TVN_ITEMEXPANDED)
843 If (iAction = TVE_EXPAND) Send OnItemExpanded hItem
844 Else Send OnItemCollapsed hItem
845 Case Break
846
847 Case (Header.Code = TVN_BEGINDRAG)
848 Send OnBeginDrag hItem
849 Case Break
850
851 Case (Header.Code = TVN_BEGINRDRAG)
852 Send OnBeginRDrag hItem
853 Case Break
854
855 Case (Header.Code = TVN_BEGINLABELEDIT)
856 // Note: pbCancelEdit is obsolete technique but it will still work. It is now easier to just
857 // change the bCancel byref param
858 Set pbCancelEdit to False // developer may change this in OnBeginLabelEdit to cancel edit
859 Send OnBeginLabelEdit hItem (&bCancel) // sItemText // extra removed in 11.0 -- this was not doc'ed and should not be.
860 Move (If(bCancel or pbCancelEdit(Self),True, False)) to bCancel // True cancels the edit
861 Case Break
862
863 Case (Header.Code = TVN_ENDLABELEDIT)
864 Set pbCancelEdit to False // developer may change this in OnEndLabelEdit to cancel edit
865 // note if bCancelledByUser, the edit will be cancel unconditionally
866 Send OnEndLabelEdit hItem sItemText bCancelledByUser (&bCancel)
867 Move (If(bCancel or pbCancelEdit(Self), False, True)) to bCancel // False cancels the edit
868 Case Break
869
870 Case (Header.Code = TVN_SELCHANGING)
871 Set pbCancelEdit to False // developer may change this in OnItemChanging to cancel item change
872 Send OnItemChanging hItem hItemOld (&bCancel)
873 // note if pbCancelEdit, the item change will be cancel unconditionally
874 Move (If(bCancel or pbCancelEdit(Self), True, False)) to bCancel // True cancels the item change
875 Case Break
876
877 Case (Header.Code = TVN_SELCHANGED)
878 Send OnItemChanged hItem hItemOld
879 Case Break
880
881 Case (Header.Code = TVN_GETDISPINFO)
882 Send OnGetDispInfo hItem
883 Case Break
884
885 Case (Header.Code = TVN_SETDISPINFO)
886 Send OnSetDispInfo hItem
887 Case Break
888
889 Case (Header.Code = NM_RETURN)
890 Send OnItemEnter
891 // This is needed to inform Windows that the notification is handled. It stops the bell from ringing
892 Move True to bCancel
893 Case Break
894
895 Case (Header.Code = NM_DBLCLK)
896 Get ItemHitTest to hItemHt
897 Send OnItemDblClick hItemHt (&bCancel)
898 Case Break
899
900 Case (Header.Code = NM_RCLICK)
901 Get ItemHitTest to hItemHt
902 Send OnItemRClick hItemHt
903 Case Break
904
905 Case (Header.Code = NM_RDBLCLK) // this appears to be a bug in Windows: it is never sent
906 Get ItemHitTest to hItemHt
907 Send OnItemRDblClick hItemHt
908 Case Break
909
910 Case (Header.Code = NM_CLICK)
911 Get ItemHitTest to hItemHt
912 Send OnItemClick hItemHt (&bCancel)
913 Get pbEnableCheckboxes to bEnableCheckboxes
914 If (hItemHt and bEnableCheckboxes and not(bCancel)) Begin
915 Get TVHitTest to HitTest
916 // OK, so was it a checkbox mouseclick?....
917 If (IsFlagIn(TVHT_ONITEMSTATEICON, HitTest.flags)) Begin
918 // Use PostMessage to generate the event to ensure that the
919 // checkbox's state has been properly set after the click.
920 Move (PostMessage(hWnd, UM_CHECKSTATECHANGE, 0, HitTest.hItem)) to iVoid
921 End
922 End
923 Case Break
924
925 Case (Header.Code = TVN_KEYDOWN)
926 Send OnKeyDown (&bCancel)
927 Get pbEnableCheckboxes to bEnableCheckboxes
928 If bEnableCheckboxes Begin
929 Get CurrentTreeItem to hItem
930 Get ItemCheckBox hItem to bItemCheckBox
931 If bItemCheckBox Begin
932 // Checkbox Support: Test for spacebar key....
933 Move (MemCopy(AddressOf(KeyInfo), lParam, SizeOfType(tWinNmTvKeyDown))) to iVoid
934
935 If (KeyInfo.wVKey = VK_SPACE) Begin
936 // Use PostMessage to generate the event to ensure that the
937 // checkbox's state has been properly set after the click....
938 Move (PostMessage(hWnd, UM_CHECKSTATECHANGE, 0, CurrentTreeItem(Self))) to iVoid
939 End
940 End
941 End
942 Case Break
943
944 Case (Header.code=NM_TVSTATEIMAGECHANGING)
945 // When checkboxes are allowed but the item is not a checkbox, the spacebar can still toggle this
946 // which causes a blank checkbox to appear. A notification is sent when the image is changing and we
947 // can test for this case and stop it. Note that support for mixed checkbox/non-checkbox items is shaky. This
948 // is not something that is well supported or documented by Microsoft. If feels like their intention was to
949 // support all checkboxes or no checkboxes. It does work, but if problems arise it might become a "don't do this"
950 // sort of feature.
951 Move (MemCopy(AddressOf(NmTvStateImageChanging), lParam, SizeOfType(tWinNmTvStateImageChanging))) to iVoid
952 Get ItemCheckBox NmTvStateImageChanging.hti to bItemCheckBox
953 // We test a very specific condition. If it is not this exact case, we don't know what is happening and we leave it alone
954 If (not(bItemCheckBox) and NmTvStateImageChanging.iNewStateImageIndex<>0 and NmTvStateImageChanging.iOldStateImageIndex=0) Begin
955 Move True to bCancel
956 End
957 Case Break
958
959 Case (Header.code = TVN_GETINFOTIP)
960 // InfoTip support. Provide info text for item
961
962 Move (MemCopy(AddressOf(GetInfoTip), lParam, SizeOfType(tWinNmTvGetInfoTip))) to iVoid
963
964 // Send the event message.
965 Send OnGetInfoTip GetInfoTip.hItem (&sInfoTip)
966
967 If (Oem_translate_state(Self)) Begin
968 Move (ToANSI(sInfoTip)) to sInfoTip
969 End
970
971 // make sure we don't exceed the maximum tip length
972 Move (Trim(sInfoTip)) to sInfoTip
973
974 If (Length(sInfoTip) >= GetInfoTip.cchTextMax) Begin
975 Move (Left(sInfoTip, GetInfoTip.cchTextMax - 1)) to sInfoTip
976 End
977
978 // Write the sInfoTip string back into the GetInfoTip struct....
979 Move (sInfoTip + Character(0)) to sInfoTip
980 Move (AddressOf(sInfoTip)) to lpszInfoTip
981 Move (MemCopy(GetInfoTip.pszText, lpszInfoTip, CStringLength(lpszInfoTip) + 1)) to iVoid
982 Case Break
983
984 Case End
985
986 Procedure_Return bCancel
987 End_Procedure // Notify
988
989
990 { Visibility=Private }
991 Procedure External_SetFocus
992 integer iFail
993 // if focus is already here then DF knows about the focus
994 // change (it started it) and we need to do nothing. Else,
995 // Windows started the focus change and we need to tell the
996 // df side about it.
997 if (Focus(desktop) <> self) Begin
998 // this should not fail. If the object cannot be activated
999 // then it should be disabled.
1000 get msg_Activate to iFail
1001 if not iFail ;
1002 Send Notify_Focus_Change true
1003 end
1004 End_Procedure
1005
1006 { Visibility=Private }
1007 Procedure External_KillFocus
1008 // this is not getting sent when the external control loses
1009 // the focus
1010 Send Notify_Focus_Change false
1011 End_Procedure
1012
1013 // Set focus is supposed to send notify_focus_change. It is not, so
1014 // we will add this here.
1015 //
1016 { MethodType=Property Visibility=Private }
1017 procedure set Focus integer h1 integer h2
1018 integer rval
1019 Forward Set focus to h1 h2
1020 Send Notify_Focus_Change true
1021 end_procedure
1022End_Class
1023
1024{ DesignerClass=cDTTreeView }
1025{ HelpTopic=TreeView }
1026{ OverrideProperty=Color DesignTime=False }
1027{ OverrideProperty=TextColor DesignTime=False }
1028{ OverrideProperty=Search_case DesignTime=False }
1029{ OverrideProperty=Search_Mode DesignTime=False }
1030{ OverrideProperty=Select_Mode DesignTime=False }
1031{ OverrideProperty=Select_state DesignTime=False }
1032{ OverrideProperty=Wrap_state DesignTime=False }
1033
1034Class TreeView is a AbstractTreeView
1035 Procedure Construct_Object
1036
1037 Forward Send Construct_Object
1038 Set External_Class_Name 'cVdfTreeView' To 'SysTreeView32'
1039 Set External_Message WM_SETFOCUS To External_SetFocus
1040 Set External_Message WM_KILLFOCUS To External_KillFocus
1041 Set External_Message WM_PAINT To OnWmPaint
1042 Set External_Message UM_CHECKSTATECHANGE to NotifyCheckStateChange
1043 Set External_Message WM_SYSCOLORCHANGE to OnWmSysColorChange
1044
1045 End_Procedure
1046
1047 { MethodType=Event Visibility=Private }
1048 Procedure OnWmPaint DWord wParam DWord lParam
1049// // resets the colors during a system color change, etc.
1050// Set piLineColor To (piLineColor (Self))
1051// Set piBackColor To (piBackColor (Self))
1052// Set piTextColor To (piTextColor (Self))
1053 End_Procedure
1054
1055 // Augmented to force a redraw of the treeview portions that are affected by any system color changes.
1056 // used in 15.0 instead of OnWmPaint to avoid flashing.
1057 { MethodType=Event Visibility=Private }
1058 Procedure OnWmSysColorChange DWord wParam DWord lParam
1059 // resets the colors during a system color change, etc.
1060 Set piLineColor to (piLineColor(Self))
1061 Set piBackColor to (piBackColor(Self))
1062 Set piTextColor to (piTextColor(Self))
1063 End_Procedure
1064
1065
1066 // Recieved after the passed tree item's checked state has been changed.
1067 { MethodType=Event }
1068 Procedure OnCheckStateChange Handle hItem
1069 End_Procedure
1070
1071 { Visibility=Private}
1072 Procedure NotifyCheckStateChange Integer wParam Integer lParam
1073 // lParam has the item handle
1074 Set CurrentTreeItem to lParam // always set the current item first
1075 Send OnCheckStateChange lParam
1076 End_Procedure
1077
1078 { Visibility=Private }
1079 Function CountTreeLevels string sLine Returns Integer
1080 Integer iCount
1081 String sDelimeter
1082 Get TreeLevelDelimeter To sDelimeter
1083 While (Pos(sDelimeter,sLine))
1084 Move (Replace(sDelimeter,sLine,"")) to sLine
1085 Increment iCount
1086 Loop
1087 Function_Return iCount
1088 End_Function
1089
1090 Procedure DoReadTree string sFile
1091 Handle hPrevLevel hParent hNewItem
1092 Integer iLevel iLastLevel icLevels iLoop iLoop2 lParam iImage
1093 Integer bExpanded
1094 String sLine sDelimeter
1095 Integer iChannel
1096
1097 Move 0 To iLastLevel
1098 If (hNewItem=0) Move -1 to iLastLevel
1099 Get TreeLevelDelimeter to sDelimeter
1100 Move (Seq_New_Channel()) to iChannel
1101 If ( iChannel=DF_SEQ_CHANNEL_NOT_AVAILABLE) Begin
1102 Error DFERR_CANT_OPEN_OUTPUT_FILE (sFile + ":" * C_$ChannelNotAvailable)
1103 Procedure_Return
1104 End
1105
1106 Direct_Input channel iChannel sFile
1107 If (not (seqeof)) Begin
1108
1109 Readln channel iChannel sLine
1110 While (not (seqeof))
1111
1112 Get CountTreeLevels sLine To iLevel
1113 Replace (Repeat(sDelimeter,iLevel)) In sLine With ''
1114
1115 If (iLevel=0) Get AddTreeItem sLine 0 lParam iImage iImage To hNewItem
1116
1117 Else If (iLastLevel < iLevel) Begin // expanded
1118 Get AddTreeItem sLine hNewItem lParam iImage iImage To hNewItem
1119 End
1120 Else If (iLastLevel=iLevel) Begin // same level
1121 Get WindowsMessage TVM_GETNEXTITEM TVGN_PARENT hNewItem To hParent
1122 Get AddTreeItem sLine hParent lParam iImage iImage To hNewItem
1123 End
1124 Else If (iLastLevel > iLevel) Begin // collapsed
1125 Move (iLastLevel - iLevel) to icLevels
1126 Move hNewItem To hPrevLevel
1127 For iLoop2 from 1 To (icLevels +1)
1128 Get WindowsMessage TVM_GETNEXTITEM TVGN_PARENT hPrevLevel To hPrevLevel
1129 Loop
1130 Get AddTreeItem sLine hPrevLevel lParam iImage iImage To hNewItem
1131 End
1132
1133 Move iLevel To iLastLevel
1134 Readln channel iChannel sLine
1135 Loop
1136 End
1137 Close_Input channel iChannel
1138 Send Seq_Release_Channel iChannel
1139 End_Procedure
1140
1141 Procedure DoMakeItemVisible Handle hItem
1142 Send Windows_Message TVM_ENSUREVISIBLE 0 hItem
1143 End_Procedure
1144
1145 Procedure DoMakeItemFirstVisible Handle hItem
1146 Send Windows_Message TVM_SELECTITEM TVGN_FIRSTVISIBLE hItem
1147 End_Procedure
1148
1149 { MethodType=Property }
1150 Function ItemFullPath Handle hItem Returns String
1151 Handle hPrevLevel
1152 String sFullPath sParent sDelimeter
1153 get TreeLevelDelimeter To sDelimeter
1154 Get ItemLabel hItem To sFullPath
1155 Repeat
1156 Get WindowsMessage TVM_GETNEXTITEM TVGN_PARENT hItem To hItem
1157 If not hItem Function_Return sFullPath
1158 Get ItemLabel hItem To sParent
1159 Move (sParent + sDelimeter + sFullPath) to sFullPath
1160 Loop
1161 End_Function
1162
1163 { Visibility=Public }
1164 Function ItemExpandedState Handle hItem Returns Integer //T or F
1165 Integer iState
1166 Pointer lpTvItem
1167 tWinTvItemEx TvItem
1168
1169 Move (AddressOf(TvItem)) to lpTvItem
1170
1171 Move hItem to TvItem.hItem
1172 Move (TVIF_Handle ior TVIF_STATE) to TvItem.mask
1173
1174 Send Windows_Message TVM_GETITEM 0 lpTvItem
1175
1176 Move TvItem.state to iState
1177 Function_Return ((iState IAND TVIS_EXPANDED) = TVIS_EXPANDED)
1178 End_Function
1179
1180 Procedure DoExpandItem Handle hItem
1181 Send Windows_Message TVM_EXPAND TVE_EXPAND hItem
1182 End_Procedure
1183
1184 Procedure DoCollapseItem Handle hItem
1185 Send Windows_Message TVM_EXPAND TVE_COLLAPSE hItem
1186 End_Procedure
1187
1188 Procedure DoExpandAll Handle hItem // if no Handle provided, use Root
1189 Handle hRoot
1190 If (Num_Arguments =0) Get WindowsMessage TVM_GETNEXTITEM TVGN_ROOT 0 To hRoot
1191 Else Move hItem To hRoot
1192 Set Dynamic_Update_State To FALSE
1193 Send DoEnumerateTree msg_DoExpandItem hRoot 0
1194 Set Dynamic_Update_State To TRUE
1195 End_Procedure
1196
1197 Procedure DoCollapseAll Handle hItem // if no Handle provided, use Root
1198 Handle hRoot
1199 If (Num_Arguments =0) Get WindowsMessage TVM_GETNEXTITEM TVGN_ROOT 0 To hRoot
1200 Else Move hItem To hRoot
1201 Set Dynamic_Update_State To FALSE
1202 Send DoEnumerateTree msg_DoCollapseItem hRoot 0
1203 Set Dynamic_Update_State To TRUE
1204 End_Procedure
1205
1206 { MethodType=Property }
1207 Function RootItem Returns Handle
1208 Function_Return (WindowsMessage(TVM_GETNEXTITEM, TVGN_ROOT, 0))
1209 End_Function
1210
1211 { MethodType=Property }
1212 Function NextSiblingItem Handle hItem Returns Handle
1213 Function_Return (WindowsMessage(TVM_GETNEXTITEM, TVGN_NEXT, hItem))
1214 End_Function
1215
1216 { MethodType=Property }
1217 Function ParentItem Handle hItem Returns Handle
1218 Function_Return (WindowsMessage(TVM_GETNEXTITEM, TVGN_PARENT, hItem))
1219 End_Function
1220
1221 { MethodType=Property }
1222 Function PreviousSiblingItem Handle hItem Returns Handle
1223 Function_Return (WindowsMessage(TVM_GETNEXTITEM, TVGN_PREVIOUS, hItem))
1224 End_Function
1225
1226 { MethodType=Property }
1227 Function ChildItem Handle hItem Returns Handle
1228 Function_Return (WindowsMessage(TVM_GETNEXTITEM, TVGN_CHILD, hItem))
1229 End_Function
1230
1231 { MethodType=Property }
1232 Function FirstVisibleItem Returns Handle
1233 Function_Return (WindowsMessage(TVM_GETNEXTITEM, TVGN_FIRSTVISIBLE, 0))
1234 End_Function
1235
1236 { MethodType=Property }
1237 Function PreviousVisibleItem Handle hItem Returns Handle
1238 Function_Return (WindowsMessage(TVM_GETNEXTITEM, TVGN_PREVIOUSVISIBLE, hItem))
1239 End_Function
1240
1241 { MethodType=Property }
1242 Function NextVisibleItem Handle hItem Returns Handle
1243 Function_Return (WindowsMessage(TVM_GETNEXTITEM, TVGN_NEXTVISIBLE, hItem))
1244 End_Function
1245
1246 { MethodType=Property }
1247 Function VisibleItemCount Returns Integer
1248 Function_Return (WindowsMessage(TVM_GETVISIBLECOUNT,0, 0))
1249 End_Function
1250
1251 { MethodType=Property }
1252 Function ItemCount Returns Integer
1253 Function_Return (WindowsMessage(TVM_GETCOUNT,0, 0))
1254 End_Function
1255
1256 { MethodType=Property NoDoc=True }
1257 Procedure Set piLineColor Integer iColor
1258 Forward Set piLineColor To iColor
1259 Send Windows_Message TVM_SETLINECOLOR 0 iColor
1260 End_Procedure
1261
1262 { MethodType=Property NoDoc=True }
1263 Procedure Set piTextColor Integer iColor
1264 Forward Set piTextColor To iColor
1265 Send Windows_Message TVM_SETTEXTCOLOR 0 iColor
1266 End_Procedure
1267
1268 { MethodType=Property NoDoc=True }
1269 //{ PropertyType=Color }
1270 //{ EnumList= "clScrollBar, clBackground, clActiveCaption, clInactiveCaption, clMenu, clWindow, clWindowFrame, clMenuText, clWindowText, clCaptionText, clActiveBorder, clInactiveBorder" }
1271 //{ EnumList+="clAppWorkSpace, clHighlight, clHighlightText, clBtnFace, clBtnShadow, clGrayText, clBtnText, clInactiveCaptionText, clBtnHighlight, cl3DDkShadow, cl3DLight, clInfoText, clInfoBk, clDefault, clNone" }
1272 //{ EnumList+="clAqua, clBlack, clBlue, clDkGray, clFuchsia, clGray, clGreen, clLime, clLtGray, clMaroon, clNavy, clOlive, clPurple, clRed, clSilver, clTeal, clWhite, clYellow" }
1273 //{ Category=Appearance }
1274 //{ InitialValue=clNone }
1275 Procedure Set piBackColor Integer iColor
1276 Forward Set piBackColor To iColor
1277 Send Windows_Message TVM_SETBKCOLOR 0 iColor
1278 End_Procedure
1279
1280 { MethodType=Property NoDoc=True }
1281 { PropertyType=Boolean }
1282 Procedure Set pbSingleExpand Integer bSingleExpand
1283 Forward Set pbSingleExpand To bSingleExpand
1284 If bSingleExpand Set TreeLinesState To False // single-select only works if this lines are not drawn
1285 End_Procedure
1286
1287 { MethodType=Property NoDoc=True InitialValue=True }
1288 { PropertyType=Boolean }
1289 Procedure Set TreeLinesState Integer bLines
1290 Forward Set TreeLinesState To bLines
1291 If bLines Set pbSingleExpand To False // if lines are drawn, single-select is not supported
1292 End_Procedure
1293
1294 { MethodType=Event }
1295 Procedure OnCreateTree
1296 // Stub for method sent at 'real' object creation time.
1297 // This is where you would add items into the tree
1298 End_Procedure
1299
1300 { Visibility=Private }
1301 Procedure Page_Object integer iState
1302 Handle hWnd
1303 Get Window_Handle To hWnd
1304 Forward Send Page_Object iState
1305 If (iState and hWnd=0) Send DoInitWindow
1306 End_Procedure
1307
1308 // Deletes all treeview item with faster paint logic.
1309 Procedure ClearAll
1310 Integer iVoid
1311 Handle hWnd
1312
1313 Get Window_Handle to hWnd
1314 If (hWnd <> 0) Begin
1315 Move (SendMessage(hWnd, WM_SETREDRAW, 0, 0)) to iVoid // turn off painting (faster)
1316 End
1317
1318 Send Windows_Message TVM_DELETEITEM 0 TVI_ROOT
1319
1320 If (hWnd <> 0) Begin
1321 Move (SendMessage(hWnd, WM_SETREDRAW, 1, 0)) to iVoid // turn back on painting
1322 Move (InvalidateRect(hWnd, 0, 0)) to iVoid
1323 End
1324 End_Procedure
1325
1326
1327End_Class
1328