Advanced ListView Programming

Unfortunately, the wordwrap property on the listview only applies when in Icon views, not when in Report view.
I guess that it might be possible with userdrawing the subitems...
You might try to use MSFlexGrid instead, which can Wrap and use Images...
CHeers

I was going to say pretty much the same thing. I am sure that you could achieve this by subclassing the listview and drawing the subitem yourself. However this is obviously not a quick-fix.

The flexgrid is a good solution, I remember doing some work a while back which allowed the flexgrid to mimic the outlook contacts view which has a similar requirement.

Hi angellll,

>>I guess that it might be possible with userdrawing the subitems...
Can we done that by using some APIs? I'm sure that it use some APIs to do that, isn't it?

Do you have example on MSFlexGrid which can Wrap and use Images? If allow, i try to not using the MSFlexGrid bcos the final product installer need to be downloadable which i need to restrict controls that use to develop this application.

Tim,

Do you have some resources on subclassing listview and  drawing the subitem?

or any resources doing this in flexgrid?

thanks all.

Possible alternative (not seen the .jpgs) is to display a tooltip over the item when it would normally require wrapping.  However, this would also require subclassing and some messing about with tooltips

As it's not the direction you originally indicated, I've not looked up any references, but I should be able to find something if you want more info.

I'm confortable with listview control, but just need it so that it can word wrap the content in the item, but i dont know how to do that..

http://www.mvps.org/btmtz/listview/lvcustomdraw.zip

Hi TigerZhao,

But i need so that the text in the items can be display in more that 1 line..

Angellll, Tim, do you have any resource on how to solve this? I definitely need someone to guide me on this..

And Nazdor, do show me some example if you have some good idea, thks.

Hi
I've already done this with TreeView (which is a bit harder then TV - have to handle expanding/collapse functionality). All you need is make custom draw LV (see Tiger's link), subclass it, waiting CDDS_ITEMPREPAINT or CDDS_ITEMPOSTPAINT, and draw text with DT_WORDBREAK (possible also with Or DT_CALCRECT). Let me experiment a while...

Regards
Ark

Hi Ark,

Thanks for the code! :) but however the code is not working in my end. Err.. any reason?

thks

Hi
It's VERY strange... I check it in both versions of common controls - it works.
Some addidtional notes:
1. ListView can be only OwnerDraw fixed style - this mean that all rows should have same height. There are ways to adjust height by subclassing WM_MEASUREITEM or WM_SETFONT messages, but IMHO more simply is to use image list - just fill up image list with appropriate size images (even dummy), bound this ImageList to LV and you'll get height you need. In my sample I used 32x32 icons (BTW, your second snap use same technique :))
2. I made only first item word-wrapped. If you need subitems, uncomment 'iSubItem member in NMLVCUSTOMDRAW structure and change code as following:
'=============All code before is the same, only add
'Const CDDS_SUBITEM As Long = &H20000 in declaration area=======
              Case CDDS_ITEMPREPAINT
                   WindowProc = CDRF_NOTIFYPOSTPAINT Or CDRF_NOTIFYSUBITEMDRAW
                   Exit Function
              Case (CDDS_ITEMPOSTPAINT Or CDDS_SUBITEM)
                   rcItem.Left = LVIR_LABEL
                   SendMessage .hdr.hWndFrom, LVM_GETITEMRECT, .dwItemSpec, rcItem
                   If .uItemState And ODS_SELECTED Then
                      lBrushColor = COLOR_HIGHLIGHT + 1
                      SetTextColor .hDC, vbWhite
                   Else
                      lBrushColor = COLOR_WINDOWBACKGROUND + 1
                      SetTextColor .hDC, vbBlack
                   End If
                   If udtNMLVCUSTOMDRAW.iSubItem = 0 Then 'Main item
'************Change to you spec. Actually, more correct is to use LVM_GETITEMTEXT
'to retrive text, but I leave this to you :)
                      sText = frmTest.ListView1.ListItems(.dwItemSpec + 1).Text
                      FillRect .hDC, rcItem, lBrushColor
                      DrawText .hDC, sText, -1, rcItem, DT_WORDBREAK + DT_VCENTER + DT_CENTER
                   Else 'subitems
'************Change to you spec. Actually, more correct is to use LVM_GETITEMTEXT
'to retrive text, but I leave this to you :)
                      sSubItem = frmTest.ListView1.ListItems(.dwItemSpec + 1).SubItems(udtNMLVCUSTOMDRAW.iSubItem)
                     .rc.Top = rcItem.Top: .rc.Bottom = rcItem.Bottom
                      FillRect .hDC, .rc, lBrushColor
                      DrawText .hDC, sSubItem, -1, .rc, DT_WORDBREAK + DT_VCENTER + DT_CENTER
                   End If
                   WindowProc = CDRF_NOTIFYPOSTPAINT
                   Exit Function
             End Select
'=======All code after is the same===============

3. This method works as label's wordwrap, ie it doesn't wrap if cell length is sufficient. But you can use vbCrLf in (sub)Item text to force 2 lines.

Regards
Ark

PS. If you still have troubles, contact me at ark@msun.ru - I'll send you full working sample.

Regards
Ark

Thanks all for the helps.

Thanks for points, glad I could help. Did you get it working? I tried e-mail you at ryancys78@yahoo.com, but server return a letter with "invalid address".

Regards
Ark

Ops, sorry that's my old email address and didnt realize it's full of storage. You can try this once, if you willing :) This is my work e-mail address: yitseng@junk.net

Thanks Ark, you're very helpful indeed, thks.

Hi Arc, I was searching a word wrap in Treeview control and I ran to this question. You said that you made it can you please tell me how?

Hi abass_a_hajj ,

Welcome to EE, this thread is closed long time ago, i suggest you try to ask your question by open a new question.

https://www.experts-exchange.com/Programming/Programming_Languages/Visual_Basic/askQuestion.jsp

cheers

Okay, I already asked the question it is titled "Treeview word wrap and right side scroll bar"

By the way, ryancys can you post the working code that you had before. I've interested to see the code too. You know the rule of EE. Should post the working code instead of email between the experts.


Thx

By the way, you can post on this question

https://www.experts-exchange.com/questions/21149327/Treeview-word-wrap-and-right-side-scroll-bar.html

Hi EDDYKT,

I think i will put what Ark gave me to a URL and post it here soon, once i find back the code sent to me by Ark.

btw, just wonder where is Ark now, busy doing something? ;-)

Hello, experts :)
I was realy busy last time and now. I spent last 2 month at sea teaching my navigational students here in Russia. Now I'm going to spend next month in Quingdao maritime college teaching chinese students. Hope to see you, ryancys :)
PS. Sorry for offtopic.

Hi guys,

Here is the code using the module that Ark gave me:

Form module:

Requirement:
Basically need a listview called lvItem, a picturebox called picBG, a Imagelist control.

Instructions:
Add some picture/icon into imagelist and then bounds the imagelist control to listview, finally put the listview inside the picturebox.



Private Const GWL_WNDPROC As Long = (-4&)
Private Declare Function SetWindowLong& Lib "user32" Alias "SetWindowLongA" (ByVal hWnd&, ByVal nIndex&, ByVal dwNewLong&)

Private Sub Form_Load()
    Dim sText As String
   
    Set globalLV = lvItem
   
    With globalLV
        '.FullRowSelect = True
        .View = lvwReport
        '.View = lvwIcon
        .ColumnHeaders.Add , , "Item Column"
        .ColumnHeaders.Add , , "Subitem 1"
        .ColumnHeaders.Add , , "Subitem 2"
        Dim i&
        For i = 1 To 30
            If (i Mod 3) = 0 Then sText = "Very long LV Item to be multilined No." & i Else sText = "List view item No." & i
            With .ListItems.Add(, , sText, 1, 1)
                .Tag = i
                .SubItems(1) = "Subitem 1 for item " & i
                .SubItems(2) = "Subitem 2 for item " & i
            End With
        Next
        g_MaxItems = .ListItems.Count - 1
    End With
    g_OldProc = SetWindowLong(picBG.hWnd, GWL_WNDPROC, AddressOf WindowProc)
   
    globalLV.Refresh
End Sub

Private Sub Form_Resize()
    lvItem.Left = 0
    lvItem.Top = 0
    lvItem.Width = picBG.Width
    lvItem.Height = picBG.Height
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Call SetWindowLong(picBG.hWnd, GWL_WNDPROC, g_OldProc)
    Set globalLV = Nothing
    Set frmMain = Nothing
End Sub

Private Sub lvItem_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
    lvItem.SortKey = ColumnHeader.Index - 1
    lvItem.SortOrder = IIf(lvItem.SortOrder = lvwAscending, lvwDescending, lvwAscending)
    lvItem.Sorted = True
End Sub


Module mCustomeLV.bas:

Option Explicit

Const NM_CUSTOMDRAW = (-12&)
Const WM_NOTIFY As Long = &H4E&
Const WM_SETREDRAW = &HB

Const ODS_SELECTED = &H1

Const COLOR_WINDOWBACKGROUND = 9
Const COLOR_HIGHLIGHT = 13
Const COLOR_HIGHLIGHTTEXT = 14

Const CDDS_PREPAINT As Long = &H1&
Const CDDS_POSTPAINT As Long = &H2&
Const CDDS_PREERASE As Long = &H3&
Const CDDS_POSTERASE As Long = &H4&
Const CDDS_SUBITEM As Long = &H20000
 
Const CDRF_DODEFAULT = &H0&
Const CDRF_NEWFONT As Long = &H2&
Const CDRF_NOTIFYPOSTPAINT As Long = &H10&
Const CDRF_NOTIFYITEMDRAW As Long = &H20&
Const CDRF_NOTIFYSUBITEMDRAW As Long = &H20&
Const CDRF_NOTIFYPOSTERASE As Long = &H40&
Const CDRF_NOTIFYITEMERASE As Long = &H80&
Const CDDS_ITEM As Long = &H10000
Const CDDS_ITEMPREPAINT As Long = CDDS_ITEM Or CDDS_PREPAINT
Const CDDS_ITEMPOSTPAINT As Long = CDDS_ITEM Or CDDS_POSTPAINT
Const CDDS_ITEMPREERASE As Long = CDDS_ITEM Or CDDS_PREERASE
Const CDDS_ITEMPOSTERASE As Long = CDDS_ITEM Or CDDS_POSTERASE

Private Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hDC As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
Private Const DT_TOP = &H0
Private Const DT_LEFT = &H0
Private Const DT_CENTER = &H1
Private Const DT_RIGHT = &H2
Private Const DT_VCENTER = &H4
Private Const DT_BOTTOM = &H8
Private Const DT_WORDBREAK = &H10
Private Const DT_SINGLELINE = &H20
Private Const DT_EXPANDTABS = &H40
Private Const DT_TABSTOP = &H80
Private Const DT_NOCLIP = &H100
Private Const DT_EXTERNALLEADING = &H200
Private Const DT_CALCRECT = &H400
Private Const DT_NOPREFIX = &H800
Private Const DT_INTERNAL = &H1000
Private Const DT_EDITCONTROL = &H2000


 
Type NMHDR
    hWndFrom As Long   ' Window handle of control sending message
    idFrom As Long        ' Identifier of control sending message
    code  As Long          ' Specifies the notification code
End Type
 
  ' sub struct of the NMCUSTOMDRAW struct
Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
 
  ' generic customdraw struct
Type NMCUSTOMDRAW
    hdr As NMHDR
    dwDrawStage As Long
    hDC As Long
    rc As RECT
    dwItemSpec As Long
    uItemState As Long
    lItemlParam As Long
End Type
 
  ' listview specific customdraw struct
Type NMLVCUSTOMDRAW
    nmcd As NMCUSTOMDRAW
    clrText As Long
    clrTextBk As Long
    ' if IE >= 4.0 this member of the struct can be used
    iSubItem As Integer
End Type

Private Const LVM_FIRST = &H1000
Private Const LVM_GETITEMRECT = (LVM_FIRST + 14)
Private Const LVIR_LABEL = &H2
   
   
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDest As Any, lpSource As Any, ByVal cBytes&)
Public Declare Function CallWindowProc& Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc&, ByVal hWnd&, ByVal Msg&, ByVal wParam&, ByVal lParam&)
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Declare Function SetBkColor Lib "gdi32" (ByVal hDC As Long, ByVal crColor As Long) As Long
Declare Function SetTextColor Lib "gdi32" (ByVal hDC As Long, ByVal crColor As Long) As Long

Private Declare Function FillRect Lib "user32" (ByVal hDC As Long, lpRect As RECT, ByVal hBrush As Long) As Long

Public g_OldProc As Long, g_MaxItems As Long
Public globalLV As MSComctlLib.ListView

Public Function WindowProc(ByVal hWnd As Long, ByVal iMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  Dim sText As String, sSubItem As String
  Dim rcItem As RECT
  Dim lBrushColor As Long
 
  'Debug.Print iMsg
 
  Select Case iMsg
    Case WM_NOTIFY
      Dim udtNMHDR As NMHDR
      CopyMemory udtNMHDR, ByVal lParam, 12&
      With udtNMHDR
        If .code = NM_CUSTOMDRAW Then
            Dim udtNMLVCUSTOMDRAW As NMLVCUSTOMDRAW
            CopyMemory udtNMLVCUSTOMDRAW, ByVal lParam, Len(udtNMLVCUSTOMDRAW)
          With udtNMLVCUSTOMDRAW.nmcd
            Select Case .dwDrawStage
              Case CDDS_PREPAINT
                   WindowProc = CDRF_NOTIFYITEMDRAW
                   Exit Function
              Case CDDS_ITEMPREPAINT
                   WindowProc = CDRF_NOTIFYPOSTPAINT Or CDRF_NOTIFYSUBITEMDRAW
                   Exit Function
              Case (CDDS_ITEMPOSTPAINT Or CDDS_SUBITEM)
                   rcItem.Left = LVIR_LABEL
                   SendMessage .hdr.hWndFrom, LVM_GETITEMRECT, .dwItemSpec, rcItem
                   If .uItemState And ODS_SELECTED And udtNMLVCUSTOMDRAW.iSubItem = 0 Then
                      lBrushColor = COLOR_HIGHLIGHT + 1
                      SetTextColor .hDC, vbWhite
                   Else
                      lBrushColor = COLOR_WINDOWBACKGROUND + 1
                      SetTextColor .hDC, vbBlack
                   End If
                   If udtNMLVCUSTOMDRAW.iSubItem = 0 Then 'Main item
'************Change to you spec. Actually, more correct is to use LVM_GETITEMTEXT
'to retrive text, but I leave this to you :)
                      sText = globalLV.ListItems(.dwItemSpec + 1).Text
                     .rc.Top = rcItem.Top: .rc.Bottom = rcItem.Bottom: .rc.Left = rcItem.Left
                      FillRect .hDC, rcItem, lBrushColor
                      DrawText .hDC, sText, -1, rcItem, DT_WORDBREAK + DT_VCENTER + DT_CENTER
                   Else 'subitems
'************Change to you spec. Actually, more correct is to use LVM_GETITEMTEXT
'to retrive text, but I leave this to you :)
                      sSubItem = globalLV.ListItems(.dwItemSpec + 1).SubItems(udtNMLVCUSTOMDRAW.iSubItem)
                     .rc.Top = rcItem.Top: .rc.Bottom = rcItem.Bottom
                      FillRect .hDC, .rc, lBrushColor
                      DrawText .hDC, sSubItem, -1, .rc, DT_WORDBREAK + DT_VCENTER + DT_CENTER
                   End If
                   WindowProc = CDRF_NOTIFYPOSTPAINT
                   Exit Function
             End Select
          End With
        End If
      End With
  End Select
  WindowProc = CallWindowProc(g_OldProc, hWnd, iMsg, wParam, lParam)
End Function

A full demo can be downloaded at:
http://www34.brinkster.com/yshub/download/LVMultipleLinesByArk.zip

cheers, and thanks again for Ark for such great stuff!

btw, is Quingdao in China? I'm in Malaysia, i'm here just too far away from China... Anyway, Happy teaching there, Ark 8-)

Thx, it works.

8->

Hi all,
I wonder if this code of word wrapping could be applied to a treeview control as well...!!!! any ideas?

Regards

abass_a_hajj,


I expect the code works for listview, the changes this will work on treeview is high.

You should not continue on this thread since as  ryancys already pt out, this is closed for
long time.


8->

Didn't test it on all platforms but it works with WinXP

'===========Bas module code=============
Public Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Public Const SWP_FRAMECHANGED = &H20
Public Const SWP_NOMOVE = &H2
Public Const SWP_NOZORDER = &H4
Public Const SWP_NOSIZE = &H1

Private Const DT_TOP = &H0
Private Const DT_LEFT = &H0
Private Const DT_CENTER = &H1
Private Const DT_RIGHT = &H2
Private Const DT_VCENTER = &H4
Private Const DT_BOTTOM = &H8
Private Const DT_WORDBREAK = &H10
Private Const DT_SINGLELINE = &H20
Private Const DT_EXPANDTABS = &H40
Private Const DT_TABSTOP = &H80
Private Const DT_NOCLIP = &H100
Private Const DT_EXTERNALLEADING = &H200
Private Const DT_CALCRECT = &H400
Private Const DT_NOPREFIX = &H800
Private Const DT_INTERNAL = &H1000

Private Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hDC As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long

  Const NM_CUSTOMDRAW = (-12&)
  Const WM_NOTIFY As Long = &H4E&
  Const WM_SETREDRAW = &HB

  Const ODS_SELECTED = &H1
  Const COLOR_WINDOWBACKGROUND = 9
  Const COLOR_HIGHLIGHT = 13
  Const COLOR_HIGHLIGHTTEXT = 14

  Const CDDS_PREPAINT As Long = &H1&
  Const CDDS_POSTPAINT As Long = &H2&
  Const CDDS_PREERASE As Long = &H3&
  Const CDDS_POSTERASE As Long = &H4&
  Const CDDS_SUBITEM As Long = &H20000
 
  Const CDRF_DODEFAULT = &H0&
  Const CDRF_NEWFONT As Long = &H2&
  Const CDRF_NOTIFYPOSTPAINT As Long = &H10&
  Const CDRF_NOTIFYITEMDRAW As Long = &H20&
  Const CDRF_NOTIFYSUBITEMDRAW As Long = &H20&
  Const CDRF_NOTIFYPOSTERASE As Long = &H40&
  Const CDRF_NOTIFYITEMERASE As Long = &H80&
  Const CDDS_ITEM As Long = &H10000
  Const CDDS_ITEMPREPAINT As Long = CDDS_ITEM Or CDDS_PREPAINT
  Const CDDS_ITEMPOSTPAINT As Long = CDDS_ITEM Or CDDS_POSTPAINT
  Const CDDS_ITEMPREERASE As Long = CDDS_ITEM Or CDDS_PREERASE
  Const CDDS_ITEMPOSTERASE As Long = CDDS_ITEM Or CDDS_POSTERASE
 

  Type NMHDR
    hWndFrom As Long      ' Window handle of control sending message
    idFrom As Long        ' Identifier of control sending message
    code  As Long         ' Specifies the notification code
  End Type
 
  ' sub struct of the NMCUSTOMDRAW struct
  Public Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
  End Type
 
  ' generic customdraw struct
  Public Type NMCUSTOMDRAW
    hdr As NMHDR
    dwDrawStage As Long
    hDC As Long
    rc As RECT
    dwItemSpec As Long
    uItemState As Long
    lItemlParam As Long
  End Type
 
  ' treeview specific customdraw struct
  Public Type NMTVCUSTOMDRAW
    nmcd As NMCUSTOMDRAW
    clrText As Long
    clrTextBk As Long
    ' if IE >= 4.0 this member of the struct can be used
    iLevel As Integer
  End Type

Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDest As Any, lpSource As Any, ByVal cBytes&)
Declare Sub FillMemory Lib "kernel32" Alias "RtlFillMemory" (pDest As Any, ByVal dwLength As Long, ByVal bFill As Byte)

Declare Function CallWindowProc& Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc&, ByVal hWnd&, ByVal Msg&, ByVal wParam&, ByVal lParam&)
Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
Declare Function SetBkColor Lib "gdi32" (ByVal hDC As Long, ByVal crColor As Long) As Long
Declare Function SetTextColor Lib "gdi32" (ByVal hDC As Long, ByVal crColor As Long) As Long

Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Const TV_FIRST = &H1100&
Const TVM_SETITEMA = (TV_FIRST + 13)
Private Const TVM_GETITEMRECT = (TV_FIRST + 4)
Public Const TVM_SETTOOLTIPS = (TV_FIRST + 24)
Const TVM_ENSUREVISIBLE = (TV_FIRST + 20)
Const TVM_SETITEMHEIGHT = (TV_FIRST + 27)
Public Const TVM_GETITEMHEIGHT = (TV_FIRST + 28)

Const TVIF_INTEGRAL = &H80
Const TVIF_HANDLE = &H10

Public Const TVS_NONEVENHEIGHT = &H4000
Public Const TVS_NOSCROLL = &H2000
Public Const TVS_NOHSCROLL = &H8000
Public Const TVS_NOTOOLTIPS = &H80
Public Const TVS_SINGLEEXPAND = &H400
Public Const TVS_HASLINES As Long = 2

Public Type TVITEM   ' was TV_ITEM
  mask As Long
  hItem As Long
  state As Long
  stateMask As Long
  pszText As Long   ' pointer
  cchTextMax As Long
  iImage As Long
  iSelectedImage As Long
  cChildren As Long
  lParam As Long
End Type

Public Type TVITEMEX
  mask As Long
  hItem As Long
  state As Long
  stateMask As Long
  pszText As Long   ' pointer
  cchTextMax As Long
  iImage As Long
  iSelectedImage As Long
  cChildren As Long
  lParam As Long
  iIntegral As Long
End Type

Private Declare Function InvalidateRectByNum Lib "user32" Alias "InvalidateRect" (ByVal hWnd As Long, ByVal lpRect As Long, ByVal bErase As Long) As Long
Private Declare Function InvalidateRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT, ByVal bErase As Long) As Long
Declare Function ValidateRect& Lib "user32" (ByVal hWnd As Long, lpRect As RECT)
Declare Function ValidateRectBynum& Lib "user32" Alias "ValidateRect" (ByVal hWnd As Long, ByVal lpRect As Long)

Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Public Const GWL_STYLE = (-16)
Public Const GWL_WNDPROC As Long = (-4&)
Private Const WS_HSCROLL = &H100000

Public OldProc As Long
Public LineHeight As Long
Dim bFromCode As Boolean
Private Declare Function FillRect Lib "user32" (ByVal hDC As Long, lpRect As RECT, ByVal hBrush As Long) As Long

Public Function WindowProc(ByVal hWnd As Long, ByVal iMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  Dim style As Long, nd As Node, hgt_old As Long, hgt_new As Long
  Dim nLines As Long
  Dim hItem As Long
  Dim lBrushColor As Long
  Dim rc As RECT
  Dim tvex As TVITEMEX
  Dim lTemp As Long
  Static i As Integer
 
  Select Case iMsg
    Case WM_NOTIFY
      Dim udtNMHDR As NMHDR
      CopyMemory udtNMHDR, ByVal lParam, 12&
      With udtNMHDR
        If .code = NM_CUSTOMDRAW Then
          Dim udtNMTVCUSTOMDRAW As NMTVCUSTOMDRAW
          CopyMemory udtNMTVCUSTOMDRAW, ByVal lParam, Len(udtNMTVCUSTOMDRAW)
          With udtNMTVCUSTOMDRAW.nmcd
            Select Case .dwDrawStage
              Case CDDS_PREPAINT
                  If LineHeight = 0 Then
                      LineHeight = SendMessage(.hdr.hWndFrom, TVM_GETITEMHEIGHT, 0, ByVal 0&)
                  End If
                   WindowProc = CDRF_NOTIFYITEMDRAW Or CDRF_NOTIFYPOSTPAINT
                   Exit Function
              Case CDDS_ITEMPREPAINT
                   WindowProc = CDRF_NOTIFYPOSTPAINT Or CDRF_NEWFONT
                   Exit Function
              Case CDDS_ITEMPOSTPAINT
                   Set nd = GetNodeFromlParam(.lItemlParam)
                   hItem = .dwItemSpec
                   rc.Left = hItem
                   If SendMessage(.hdr.hWndFrom, TVM_GETITEMRECT, 1&, rc) = 0 Then
                      WindowProc = CDRF_DODEFAULT
                      Exit Function
                   End If
                   hgt_old = .rc.Bottom - .rc.Top
                   rc.Right = .rc.Right
                   Call DrawText(.hDC, nd.Text, Len(nd.Text), rc, DT_WORDBREAK Or DT_CALCRECT)
                   hgt_new = rc.Bottom - rc.Top
                   If hgt_new <= LineHeight Then
                      WindowProc = CDRF_DODEFAULT
                      Exit Function
                   End If
                   If hgt_new > hgt_old Then
                      nLines = Int(hgt_new / LineHeight) + 1
                      tvex.hItem = hItem
                      tvex.iIntegral = nLines
                      tvex.mask = TVIF_INTEGRAL Or TVIF_HANDLE
                      SendMessage .hdr.hWndFrom, TVM_SETITEMA, 0, tvex
                      On Error Resume Next
                      If nd.Parent.Expanded = True Then
                         SendMessage .hdr.hWndFrom, WM_SETREDRAW, True, ByVal 0&
                         nd.Parent.Expanded = False
                         nd.Parent.Expanded = True
                      End If
                      On Error GoTo 0
                   End If
                   With udtNMTVCUSTOMDRAW
                        SetBkColor .nmcd.hDC, .clrTextBk
                        SetTextColor .nmcd.hDC, .clrText
                        If .nmcd.uItemState And ODS_SELECTED Then
                           lBrushColor = COLOR_HIGHLIGHT + 1
                        Else
                           lBrushColor = COLOR_WINDOWBACKGROUND + 1
                        End If
                   End With
                   i = i + 1
                   rc.Right = .rc.Right
                   FillRect .hDC, rc, lBrushColor
                   Call DrawText(.hDC, nd.Text, -1, rc, DT_WORDBREAK)
                   WindowProc = CDRF_NOTIFYPOSTPAINT
                   Exit Function
                Case CDDS_POSTPAINT
                   If bFromCode Then
                      WindowProc = 4&
                      bFromCode = False
                      Exit Function
                   End If
                   bFromCode = True
                   SetWindowLong .hdr.hWndFrom, GWL_STYLE, GetWindowLong(.hdr.hWndFrom, GWL_STYLE) And Not WS_HSCROLL
                   SetWindowPos .hdr.hWndFrom, 0, 0, 0, 0, 0, SWP_FRAMECHANGED Or SWP_NOMOVE Or SWP_NOZORDER Or SWP_NOSIZE
                   SendMessage .hdr.hWndFrom, WM_SETREDRAW, True, ByVal 0&
             End Select
          End With
        End If
      End With
  End Select
  WindowProc = CallWindowProc(OldProc, hWnd, iMsg, wParam, lParam)
End Function

Function GetNodeFromlParam(ByVal lParam As Long) As Node
  Dim pNode As Long
  Dim nod As Node
  If lParam Then
    CopyMemory pNode, ByVal lParam + 8, 4
    If pNode Then
      CopyMemory nod, pNode, 4
      Set GetNodeFromlParam = nod
      FillMemory nod, 4, 0
    End If
  End If
End Function

Private Function hItemFromNode(ByVal nod As Node) As Long
   CopyMemory hItemFromNode, ByVal (ObjPtr(nod) + 68), 4&
End Function

Public Function TrimNulls(sTemp As String) As String
   Dim l As Long
   l = InStr(1, sTemp, Chr(0))
   If l = 1 Then
      TrimNulls = ""
   ElseIf l > 0 Then
      TrimNulls = Left$(sTemp, l - 1)
   Else
      TrimNulls = sTemp
   End If
End Function

'=======Form code==========
Private Sub Form_Load()
    Caption = "Multiline treeview nodes demo"
    TreeView1.Nodes.Clear
    TreeView1.Nodes.Add , , , "C:", 4
    TreeView1.Nodes(1).Sorted = True
    EnumFilesUnder TreeView1.Nodes.Item(1)
    TreeView1.Nodes(1).Expanded = True
    TreeView1.Nodes(1).Selected = True
    SetWindowLong TreeView1.hWnd, GWL_STYLE, GetWindowLong(TreeView1.hWnd, GWL_STYLE) Or TVS_NOTOOLTIPS Or TVS_HASLINES
    OldProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub

Private Sub Form_Unload(Cancel As Integer)
  Call SetWindowLong(hWnd, GWL_WNDPROC, OldProc)
End Sub

Private Sub EnumFilesUnder(n As Node)
    Dim hFind As Long
    Dim sPath As String, oldPath As String
    Dim wf As WIN32_FIND_DATA
    Dim n2 As Node
    sPath = n.FullPath & "\*.*"
    hFind = FindFirstFile(sPath, wf)
    Do
        If InStr(wf.cFileName, Chr$(0)) > 0 Then
            sPath = Left$(wf.cFileName, InStr(wf.cFileName, Chr$(0)) - 1)
        Else
            sPath = wf.cFileName
        End If
        If Len(sPath) = 0 Or StrComp(sPath, oldPath) = 0 Then
            Exit Do
        ElseIf sPath = "." Or sPath = ".." Then
            GoTo Iterate
        End If
        If (wf.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY Then
            Set n2 = TreeView1.Nodes.Add(n, tvwChild, , TrimNulls(wf.cFileName), 1)
            n2.ExpandedImage = 2
            TreeView1.Nodes.Add n2, tvwChild
            n2.Sorted = True
        End If

Iterate:
        FindNextFile hFind, wf
        oldPath = sPath
    Loop
    FindClose hFind
End Sub

Private Sub TreeView1_Expand(ByVal Node As MSComctlLib.Node)
    If Node.Children = 1 Then
        TreeView1.Nodes.Remove Node.Child.Index
        EnumFilesUnder Node
    End If
End Sub


>>btw, is Quingdao in China? I'm in Malaysia, i'm here just too far away from China... << 
It's much more closer then from Vladivostok :) In Russia towns closer than 1000 km are neigbours :)

Hi Ark, what was the above code for?