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
A&A - WORK, DON´T PLAY!
http://al-bernardes.sites.uol.com.br/
bernardess@gmail.com