Access VBA - API: Alterando as propriedades ForeColor e Bold num nó selecionado de um Treeview

API: Alterando as propriedades ForeColor e Bold no NÓ selecionado de um Treeview:

Bem, para ser sincero com vocês o controle TreeView da Microsoft não suporta nenhum realce no texto de um NÓ que esteja selecionado.

Embora você possa destacar (highlight) um NÓ através da execução de um código no evento Click, o NÓ previamente destacado (highlighted) perderá tal destaque.

Para que possa testar este exemplo, coloque um Treeview (refiro-me a versão 6), sobre um formulário e, com o nome tvwTest-lo. Copie o seguinte código abaixo no módulo de classe do formulário.

Usando a API SendMessage, será possível recuperar as configurações atuais de um NÓ, e para repetir todos os NÓS, se a propriedade Bold for definida como verdadeira para um NÓ, pode forçar o NÓ para ser redefinido,  redesenhando-o normalmente.

Private Type TV_ITEM
    mask As Long
    hItem As Long
    state As Long
    stateMask As Long
    pszText As String
    cchTextMax As Long
    iImage As Long
    iSelectedImage As Long
    cChildren As Long
    lParam As Long
End Type
 
Private Declare Function apiSendMessage _
    Lib "user32" Alias "SendMessageA" _
  (ByVal hWnd As Long, _
  ByVal wMsg As Long, _
  ByVal wParam As Long, _
  lParam As Any) _
  As Long
 
Private Const TVIS_BOLD  As Long = &H10
Private Const TV_FIRST As Long = &H1100
Private Const TVM_GETITEM As Long = (TV_FIRST + 12)
Private Const TVIF_HANDLE = &H10
Private Const TVGN_ROOT = &H0

Private Const TVIF_CHILDREN = &H40
Private Const TVM_GETNEXTITEM = (TV_FIRST + 10)
Private Const TVGN_CHILD = &H4
Private Const TVIF_STATE = &H8
Private Const TVM_SETITEM = (TV_FIRST + 13)
Private Const TVGN_NEXT = &H1

Private Const TVGN_CARET = &H9
Private mobjLastNode As Node
Private mlngBackColor As Long
 
Private Sub Form_Load()
    Dim objNode As Node
    Dim i As Integer

    For i = 1 To 10
        Set objNode = tvwTest.Nodes.Add(, , "r" & i, "ANode" & i)
    Next
End Sub
 
Private Sub sResetItems _
(hWnd As Long, hItem As Long)

Dim tvi As TV_ITEM
Dim hItemChild As Long
Dim objNode As Node
 
    If hItem = 0 Then
        Let hItem = apiSendMessage(hWnd, _
                            TVM_GETNEXTITEM, _
                            TVGN_ROOT, _
                            ByVal 0&)
    End If

    If Not mobjLastNode Is Nothing Then
        With mobjLastNode
            Let .ForeColor = vbBlack
            Let .BackColor = mlngBackColor
        End With
    End If

    Do While Not hItem = 0
        Let tvi.hItem = hItem
        Let tvi.mask = TVIF_CHILDREN Or TVIF_STATE
        Let tvi.stateMask = TVIS_BOLD

        Call apiSendMessage(hWnd, _
                    TVM_GETITEM, _
                    0, _
                    tvi)
        If tvi.state And TVIS_BOLD = TVIS_BOLD Then
            Let tvi.state = tvi.state And Not TVIS_BOLD
            Call apiSendMessage( _
                hWnd, _
                TVM_SETITEM, _
                0, _
                tvi)
        End If

        If (tvi.cChildren) Then
            Let hItemChild = apiSendMessage( _
                        hWnd, _
                        TVM_GETNEXTITEM, _
                        TVGN_CHILD, _
                        ByVal hItem)

            Call sResetItems(hWnd, hItemChild)
        End If

        Let hItem = apiSendMessage (hWnd, _
                                    TVM_GETNEXTITEM, _
                                    TVGN_NEXT, _
                                    ByVal hItem)
    Loop
End Sub

Private Sub tvwTest_NodeClick _
(ByVal Node As Object)

   Call sResetItems(Me.tvwTest.hWnd, 0)

    With Node
        Let .Bold = True
        Let .ForeColor = vbBlue
        Let mlngBackColor = .BackColor
        Let .BackColor = vbYellow
    End With

    Set mobjLastNode = Node
End Sub

Developed by Dev Ashish

Veja também:
Tudo em VBA
VBA Excel
VBA Access

André Luiz Bernardes
A&A - WORK, DON´T PLAY!
http://al-bernardes.sites.uol.com.br/
bernardess@gmail.com