module1.bas

这里有很多很实用的VB编程案例,方便大家学习VB.

Attribute VB_Name = "Module1"
Option Explicit

Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
                            (ByVal hWnd As Long, _
                            ByVal wMsg As Long, _
                            wParam As Any, _
                            lParam As Any) As Long

Public Type TVITEM
  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

Public Enum TVITEM_mask
    TVIF_TEXT = &H1
    TVIF_IMAGE = &H2
    TVIF_PARAM = &H4
    TVIF_STATE = &H8
    TVIF_HANDLE = &H10
    TVIF_SELECTEDIMAGE = &H20
    TVIF_CHILDREN = &H40
#If (WIN32_IE >= &H400) Then
    TVIF_INTEGRAL = &H80
#End If
    TVIF_DI_SETITEM = &H1000
End Enum

Public Const MAX_ITEM = 256
Public Const TV_FIRST = &H1100
Public Const TVM_GETNEXTITEM = (TV_FIRST + 10)
Public Const TVM_GETITEM = (TV_FIRST + 12)

Public Enum TVGN_Flags
    TVGN_ROOT = &H0
    TVGN_NEXT = &H1
    TVGN_PREVIOUS = &H2
    TVGN_PARENT = &H3
    TVGN_CHILD = &H4
    TVGN_FIRSTVISIBLE = &H5
    TVGN_NEXTVISIBLE = &H6
    TVGN_PREVIOUSVISIBLE = &H7
    TVGN_DROPHILITE = &H8
    TVGN_CARET = &H9
#If (WIN32_IE >= &H400) Then
    TVGN_LASTVISIBLE = &HA
#End If
End Enum


Public Function GetTVItemText(hwndTV As Long, _
                                                  hItem As Long, _
                                                  Optional cbItem As Long = MAX_ITEM) As String
  Dim tvi As TVITEM
  tvi.mask = TVIF_TEXT
  tvi.hItem = hItem
  tvi.pszText = String$(cbItem, 0)
  tvi.cchTextMax = cbItem
  
  If TreeView_GetItem(hwndTV, tvi) Then
    GetTVItemText = GetStrFromBufferA(tvi.pszText)
  End If

End Function


Public Function GetStrFromBufferA(sz As String) As String
  If InStr(sz, vbNullChar) Then
    GetStrFromBufferA = Left$(sz, InStr(sz, vbNullChar) - 1)
  Else
    GetStrFromBufferA = sz
  End If
End Function


Public Function GetFirstTVNode(objTV As TreeView) As Node
  Dim nod As Node
  On Error GoTo NoNodes
  
  Set nod = objTV.Nodes(1)
  Do While (nod.Parent Is Nothing) = False
    Set nod = nod.Parent
  Loop
  
  Set GetFirstTVNode = nod.FirstSibling
  
NoNodes:
End Function


Public Function GetNodeFromTVItem(objTV As TreeView, _
ByVal hItem As Long) As Node
  Dim hwndTV As Long
  Dim anSiblingPos() As Integer
  Dim nLevel As Integer
  Dim nod As Node
  Dim i As Integer
  Dim nPos As Integer
  On Error GoTo Out
  
  hwndTV = objTV.hWnd
  Do While hItem
    nLevel = nLevel + 1
    ReDim Preserve anSiblingPos(nLevel)
    anSiblingPos(nLevel) = GetTVItemSiblingPos(hwndTV, hItem)
    hItem = TreeView_GetParent(hwndTV, hItem)
  Loop
  
  Set nod = GetFirstTVNode(objTV)
  If (nod Is Nothing) = False Then
    For i = nLevel To 1 Step -1
      nPos = anSiblingPos(i)
      
      Do While nPos > 1
        Set nod = nod.Next
        nPos = nPos - 1
      Loop
      
      If (i > 1) Then Set nod = nod.Child
    Next
    Set GetNodeFromTVItem = nod
  End If
  
Out:
End Function



Public Function GetTVItemSiblingPos(hwndTV As Long, _
ByVal hItem As Long) As Integer
  Dim nPos As Integer
  Do While hItem
    nPos = nPos + 1
    hItem = TreeView_GetPrevSibling(hwndTV, hItem)
  Loop
  
  GetTVItemSiblingPos = nPos
End Function



Public Function GetTVItemFromNode(hwndTV As Long, _
nod As Node) As Long
  Dim nod1 As Node
  Dim anSiblingPos() As Integer
  Dim nLevel As Integer
  Dim hItem As Long
  Dim i As Integer
  Dim nPos As Integer

  Set nod1 = nod
  Do While (nod1 Is Nothing) = False
    nLevel = nLevel + 1
    ReDim Preserve anSiblingPos(nLevel)
    anSiblingPos(nLevel) = GetNodeSiblingPos(nod1)
    Set nod1 = nod1.Parent
  Loop

  hItem = TreeView_GetRoot(hwndTV)
  If hItem Then
    For i = nLevel To 1 Step -1
      nPos = anSiblingPos(i)
      
      Do While nPos > 1
        hItem = TreeView_GetNextSibling(hwndTV, hItem)
        nPos = nPos - 1
      Loop
      
      If (i > 1) Then hItem = TreeView_GetChild(hwndTV, hItem)
    Next

    GetTVItemFromNode = hItem
  End If
End Function



Public Function GetNodeSiblingPos(nod As Node) As Integer
  Dim nod1 As Node
  Dim nPos As Integer
  Set nod1 = nod
  
  Do While (nod1 Is Nothing) = False
    nPos = nPos + 1
    Set nod1 = nod1.Previous
  Loop
  
  GetNodeSiblingPos = nPos
End Function



Public Function TreeView_GetItem(hWnd As Long, pitem As TVITEM) As Boolean
  TreeView_GetItem = SendMessage(hWnd, TVM_GETITEM, 0, pitem)
End Function



Public Function TreeView_GetNextItem(hWnd As Long, hItem As Long, flag As Long) As Long
  TreeView_GetNextItem = SendMessage(hWnd, TVM_GETNEXTITEM, ByVal flag, ByVal hItem)
End Function


Public Function TreeView_GetChild(hWnd As Long, hItem As Long) As Long
  TreeView_GetChild = TreeView_GetNextItem(hWnd, hItem, TVGN_CHILD)
End Function


Public Function TreeView_GetNextSibling(hWnd As Long, hItem As Long) As Long
  TreeView_GetNextSibling = TreeView_GetNextItem(hWnd, hItem, TVGN_NEXT)
End Function


Public Function TreeView_GetPrevSibling(hWnd As Long, hItem As Long) As Long
  TreeView_GetPrevSibling = TreeView_GetNextItem(hWnd, hItem, TVGN_PREVIOUS)
End Function


Public Function TreeView_GetParent(hWnd As Long, hItem As Long) As Long
  TreeView_GetParent = TreeView_GetNextItem(hWnd, hItem, TVGN_PARENT)
End Function


Public Function TreeView_GetRoot(hWnd As Long) As Long
  TreeView_GetRoot = TreeView_GetNextItem(hWnd, 0, TVGN_ROOT)
End Function