module1.bas

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

Attribute VB_Name = "Module1"
Option Explicit

Public Const IIL_UNCHECKED = 1
Public Const IIL_CHECKED = 2

Public Const GWL_STYLE = (-16)

Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

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 POINTAPI
  x As Long
  y As Long
End Type

Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Declare Function ScreenToClient Lib "user32" (ByVal hWnd As Long, lpPoint As POINTAPI) As Long
Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer


Public Const TVS_CHECKBOXES = &H100

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 Const TVIF_TEXT = &H1
Public Const TVIF_STATE = &H8
Public Const TVIF_HANDLE = &H10

Public Const TVIS_STATEIMAGEMASK = &HF000

Public Type TVHITTESTINFO
  pt As POINTAPI
  flags As Long
  hItem As Long
End Type

Public Const TVHT_ONITEMSTATEICON = &H40
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 Const TVM_SETITEM = (TV_FIRST + 13)
Public Const TVM_HITTEST = (TV_FIRST + 17)

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 IsTVItemChecked(hwndTV As Long, _
hItem As Long) As Boolean
  Dim tvi As TVITEM
  tvi.mask = TVIF_HANDLE Or TVIF_STATE
  tvi.hItem = hItem
  tvi.stateMask = TVIS_STATEIMAGEMASK
  Call TreeView_GetItem(hwndTV, tvi)
  IsTVItemChecked = (tvi.state And INDEXTOSTATEIMAGEMASK(IIL_CHECKED))
End Function



Public Function IsTVItemCheckedFromClick(hwndTV As Long, x As Long, _
y As Long) As Boolean
  Dim tvhti As TVHITTESTINFO
  Dim fChecked As Boolean
    
  tvhti.pt.x = x
  tvhti.pt.y = y
  If TreeView_HitTest(hwndTV, tvhti) Then
    fChecked = IsTVItemChecked(hwndTV, tvhti.hItem)
    If (tvhti.flags And TVHT_ONITEMSTATEICON) Then fChecked = Not fChecked
    IsTVItemCheckedFromClick = fChecked
  End If
End Function



Public Function SetTVItemCheckImage(hwndTV As Long, hItem As Long, _
fCheck As Boolean) As Boolean
  Dim tvi As TVITEM
  
  tvi.mask = TVIF_HANDLE Or TVIF_STATE
  tvi.hItem = hItem
  tvi.stateMask = TVIS_STATEIMAGEMASK
  
  If fCheck Then
    tvi.state = INDEXTOSTATEIMAGEMASK(IIL_CHECKED)
  Else
    tvi.state = INDEXTOSTATEIMAGEMASK(IIL_UNCHECKED)
  End If
  
  SetTVItemCheckImage = TreeView_SetItem(hwndTV, tvi)
  
End Function



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 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_HitTest(hWnd As Long, lpht As TVHITTESTINFO) As Long
  TreeView_HitTest = SendMessage(hWnd, TVM_HITTEST, ByVal 0, lpht)
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_SetItem(hWnd As Long, pitem As TVITEM) As Boolean
  TreeView_SetItem = SendMessage(hWnd, TVM_SETITEM, 0, pitem)
End Function

Public Function INDEXTOSTATEIMAGEMASK(iState As Long) As Long
  INDEXTOSTATEIMAGEMASK = iState * (2 ^ 12)
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_GetFirstVisible(hWnd As Long) As Long
  TreeView_GetFirstVisible = TreeView_GetNextItem(hWnd, 0, TVGN_FIRSTVISIBLE)
End Function



Public Function TreeView_GetNextVisible(hWnd As Long, hItem As Long) As Long
  TreeView_GetNextVisible = TreeView_GetNextItem(hWnd, hItem, TVGN_NEXTVISIBLE)
End Function



Public Function TreeView_GetPrevVisible(hWnd As Long, hItem As Long) As Long
  TreeView_GetPrevVisible = TreeView_GetNextItem(hWnd, hItem, TVGN_PREVIOUSVISIBLE)
End Function



Public Function TreeView_GetSelection(hWnd As Long) As Long
  TreeView_GetSelection = TreeView_GetNextItem(hWnd, 0, TVGN_CARET)
End Function


Public Function TreeView_GetDropHilight(hWnd As Long) As Long
  TreeView_GetDropHilight = TreeView_GetNextItem(hWnd, 0, TVGN_DROPHILITE)
End Function

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