'$include "windows.inc" 
TYPE NMCUSTOMDRAW 
    NMHDR   hdr 
    UINT    dwDrawStage 
    UINT    hdc 
    WINRECT rc 
    UINT    dwItemSpec 
    UINT    uItemState 
    UINT    lItemlParam 
ENDTYPE 

TYPE NMTVCUSTOMDRAW 
    NMCUSTOMDRAW nmcd 
    UINT clrText 
    UINT clrTextBk 
    INT  iLevel 
ENDTYPE 

Const TVM_EXPAND = 4354 
Const TVE_EXPAND = 0x2 
Const CDRF_DODEFAULT = 0 
Const NM_CUSTOMDRAW = -12 
Const CDRF_NOTIFYITEMDRAW = 0x20 
Const CDIS_SELECTED = 1 
Const CDIS_FOCUS = 0x10 
Const CDRF_NEWFONT = 2 
Const CDDS_PREPAINT = 1 
Const CDDS_ITEMPREPAINT = 0x10000 | CDDS_PREPAINT
CONST TVS_CHECKBOXES=0x100

WINDOW d1 

OpenWindow d1,0,0,295,230,@caption,d1,"Advanced TreeView demo",&handler 
CONTROL d1,@TREEVIEW,"Static",18,3,252,188,0x50800027|TVS_CHECKBOXES,1 
AddItems() 

WaitUntil d1.hwnd=0
	END

'------------------------- 
Sub handler(),INT
   Select @message 
      Case @idcreate 
         CenterWindow d1 

      Case @IDCLOSEWINDOW 
         CloseWindow d1 

      Case @IDCONTROL 
         Select @CONTROLID 
            Case 1 
               Select @NOTIFYCODE 
                  Case NM_CUSTOMDRAW 
                     Return SubclassTree(*<NMTVCUSTOMDRAW>@lParam) 
               EndSelect 

         EndSelect 
   EndSelect 
   Return 0
EndSub 

Sub SubclassTree(lParam:NMTVCUSTOMDRAW),uint 

   Select lParam.nmcd.dwDrawStage 

      Case CDDS_PREPAINT 
         ' Need to process this case and set pResult to CDRF_NOTIFYITEMDRAW, 
         ' otherwise parent will never receive CDDS_ITEMPREPAINT notification. (GGH) 
         Return CDRF_NOTIFYITEMDRAW 

      Case CDDS_ITEMPREPAINT 
         Select lParam.iLevel 

            Case 0 :' painting all 0-level items blue 
               IF lParam.nmcd.uItemState = (CDIS_FOCUS | CDIS_SELECTED) 
                  lParam.clrText = RGB(0, 0, 0) 
                  lParam.clrTextBk = RGB(0, 255, 0) 
               Else 
                  lParam.clrText = RGB(0, 0, 255) 
               Endif 
               Return CDRF_NEWFONT 

            Case 1 :' painting all 1-level items red 
               IF lParam.nmcd.uItemState = (CDIS_FOCUS | CDIS_SELECTED) 
                  lParam.clrText = RGB(0, 0, 0) 
                  lParam.clrTextBk = RGB(255, 255, 0) 
               Else    
                  lParam.clrText = RGB(255, 0, 0) 
               Endif 
               Return CDRF_NEWFONT 

            Case 2 :' painting all 2-level items green 
               IF lParam.nmcd.uItemState = (CDIS_FOCUS | CDIS_SELECTED) 
                  lParam.clrText = RGB(0, 0, 0) 
                  lParam.clrTextBk = RGB(0, 255, 255) 
               Else    
                  lParam.clrText = RGB(0, 255, 0) 
               Endif 
               Return CDRF_NEWFONT 

         EndSelect 
         Return CDRF_NEWFONT 

   EndSelect 
       
   Return CDRF_DODEFAULT 
EndSub 

Sub AddItems()
   UINT handle[9] 
   handle[0] = tvInsertItem(d1, 1, "root item 1", 0) 
   handle[1] = tvInsertItem(d1, 1, "subitem 1.1", handle[0]) 
   handle[2] = tvInsertItem(d1, 1, "subitem 1.1.1", handle[1]) 
   handle[3] = tvInsertItem(d1, 1, "root item 2", 0) 
   handle[4] = tvInsertItem(d1, 1, "subitem 2.1", handle[3]) 
   handle[5] = tvInsertItem(d1, 1, "subitem 2.1.1", handle[4]) 
   handle[6] = tvInsertItem(d1, 1, "root item 3", 0) 
   handle[7] = tvInsertItem(d1, 1, "subitem 3.1", handle[6]) 
   handle[8] = tvInsertItem(d1, 1, "subitem 3.2", handle[6]) 
   SendMessage d1, TVM_EXPAND, TVE_EXPAND, handle[0], 1 
      SendMessage d1, TVM_EXPAND, TVE_EXPAND, handle[1], 1 
   SendMessage d1, TVM_EXPAND, TVE_EXPAND, handle[3], 1 
      SendMessage d1, TVM_EXPAND, TVE_EXPAND, handle[4], 1 
   SendMessage d1, TVM_EXPAND, TVE_EXPAND, handle[6], 1 
EndSub