【恭喜+放分】恭喜CSDN终于有VB6语法高亮了.现在终于名正言顺,扬眉吐气了~~~

Question

爽.这下不用再用VBS或VB.NET语法高亮了.....终于成了正室了....为此,特来散分!!顺便整一些自己收藏的模块/类模块上来!

Answer 1

我来放一个基本的LISTVIEW类.之前我论坛里有人要,就在开始整了.网上好象没有这种类的源代码(也许是没搜到位吧),于是就参考不少的资料,写了一个基础类.大家可以在这个类的基础上添加其它功能.'窗体,frmMain.frm
Option ExplicitDim cLV As cListViewPrivate Sub Form_Load()
    Dim I As Long
    
    Set cLV = New cListView
    
    With cLV
        .CreateListView Me.hWnd, 0, 0, Me.ScaleWidth \ 15, Me.ScaleHeight \ 15     '建立LV控件
        For I = 1 To 5                          '加五个标头
            .LV_InsertColumn I, Chr(I + 64), 100
        Next I
        For I = 1 To 26                         '加26个项
            .LV_InsertItem I, Chr(I + 64)
        Next I
        For I = 0 To 22                             '设置几个子项文本
            .LV_SetSubItemText I, 1, Chr(I + 97)
        Next I
        .LV_SetHeadFlat             '平面样式
        .LV_SetExtendedStyle        '扩展样式
        .LV_SetBkColor vbBlue       '整个LV的背景色
        .LV_SetTextBkColor vbGreen  '每个项的背景色
    End With
End SubPrivate Sub Form_Unload(Cancel As Integer)
    Set cLV = Nothing
End Sub
'类模块,cListView.cls,第一部分
'基本的ListView类
'拥有最基本的"显示"功能,可以在此基础上完善其它功能.
'比如子类化自绘外观等变态应用.....
'
'由 嗷嗷叫的老马 参考N多资料整理而成.
'
Option ExplicitPrivate Declare Function INITCOMMONCONTROLSEX Lib "comctl32.dll" Alias _
     "InitCommonControlsEx" (ByRef TLPINITCOMMONCONTROLSEX As INITCOMMONCONTROLSEX) As Long
Private Declare Function CreateWindowEx Lib "user32.dll" Alias "CreateWindowExA" ( _
     ByVal dwExStyle As Long, _
     ByVal lpClassName As String, _
     ByVal lpWindowName As String, _
     ByVal dwStyle As Long, _
     ByVal X As Long, _
     ByVal Y As Long, _
     ByVal nWidth As Long, _
     ByVal nHeight As Long, _
     ByVal hWndParent As Long, _
     ByVal hMenu As Long, _
     ByVal hInstance As Long, _
     ByRef lpParam As Any) As Long
Private Declare Function DestroyWindow Lib "user32.dll" ( _
     ByVal hWnd As Long) As Long
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" ( _
     ByVal hWnd As Long, _
     ByVal wMsg As Long, _
     ByVal wParam As Long, _
     ByVal lParam As Long) As Long
Private Declare Function GetWindowLong Lib "user32.dll" Alias "GetWindowLongA" ( _
     ByVal hWnd As Long, _
     ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" ( _
     ByVal hWnd As Long, _
     ByVal nIndex As Long, _
     ByVal dwNewLong As Long) As LongPrivate Type INITCOMMONCONTROLSEX
    dwSize As Long 'size of this structure
    dwICC As Long 'flags indicating which classes to be initialized
End Type
Private Type LVITEM
    mask As Long
    iItem As Long
    iSubItem As Long
    State As Long
    stateMask As Long
    pszText As String
    cchTextMax As Long
    iImage As Long
    lParam As Long
    iIndent As Long
End Type
'typedef struct _LVCOLUMN {
'    UINT mask;
'    int fmt;
'    int cx;
'    LPTSTR pszText;
'    int cchTextMax;
'    int iSubItem;
'#if (_WIN32_IE >= 0x0300)
'    int iImage;
'    int iOrder;
'#End If
'} LVCOLUMN, FAR *LPLVCOLUMN;
Private Type LVCOLUMN
    mask As Long
    fmt As Long
    CX As Long
    pszText As String
    cchTextMax As Long
    iSubItem As Long
    iImage As Long
    iOrder As Long
End TypePrivate Const WS_CHILD As Long = &H40000000
Private Const WS_VISIBLE As Long = &H10000000Private Const HDS_BUTTONS As Long = &H2
Private Const GWL_STYLE As Long = -16Private Const ICC_LV_CLASSES As Long = &H1
Private Const WC_LISTVIEW32 As String = "SysListView32"
Private Const WS_EX_CLIENTEDGE As Long = &H200&Private Const LVS_LIST As Long = &H3
Private Const LVS_REPORT As Long = &H1
Private Const LVS_ICON As Long = &H0
Private Const LVS_SMALLICON As Long = &H2Private Const LVS_EX_BORDERSELECT As Long = &H8000
Private Const LVS_EX_CHECKBOXES As Long = &H4
Private Const LVS_EX_DOUBLEBUFFER As Long = &H10000
Private Const LVS_EX_FLATSB As Long = &H100
Private Const LVS_EX_FULLROWSELECT As Long = &H20
Private Const LVS_EX_GRIDLINES As Long = &H1
Private Const LVS_EX_HEADERDRAGDROP As Long = &H10
Private Const LVS_EX_HIDELABELS As Long = &H20000
Private Const LVS_EX_INFOTIP As Long = &H400
Private Const LVS_EX_LABELTIP As Long = &H4000
Private Const LVS_EX_MULTIWORKAREAS As Long = &H2000
Private Const LVS_EX_ONECLICKACTIVATE As Long = &H40
Private Const LVS_EX_REGIONAL As Long = &H200
Private Const LVS_EX_SINGLEROW As Long = &H40000
Private Const LVS_EX_SNAPTOGRID As Long = &H80000
Private Const LVS_EX_SUBITEMIMAGES As Long = &H2
Private Const LVS_EX_TRACKSELECT As Long = &H8
Private Const LVS_EX_TWOCLICKACTIVATE As Long = &H80
Private Const LVS_EX_UNDERLINECOLD As Long = &H1000
Private Const LVS_EX_UNDERLINEHOT As Long = &H800
Private Const LVS_SORTDESCENDING As Long = &H20

Answer 2

续上.'类模块,cListView.cls,第二部分Private Const LVM_FIRST As Long = &H1000
Private Const LVM_APPROXIMATEVIEWRECT As Long = (LVM_FIRST + 64)
Private Const LVM_ARRANGE As Long = (LVM_FIRST + 22)
Private Const LVM_CREATEDRAGIMAGE As Long = (LVM_FIRST + 33)
Private Const LVM_DELETEALLITEMS As Long = (LVM_FIRST + 9)
Private Const LVM_DELETECOLUMN As Long = (LVM_FIRST + 28)
Private Const LVM_DELETEITEM As Long = (LVM_FIRST + 8)
Private Const LVM_EDITLABELA As Long = (LVM_FIRST + 23)
Private Const LVM_EDITLABELW As Long = (LVM_FIRST + 118)
Private Const LVM_ENSUREVISIBLE As Long = (LVM_FIRST + 19)
Private Const LVM_ENABLEGROUPVIEW As Long = (LVM_FIRST + 157)
Private Const LVM_FINDITEMA As Long = (LVM_FIRST + 13)
Private Const LVM_FINDITEMW As Long = (LVM_FIRST + 83)
Private Const LVM_GETBKCOLOR As Long = (LVM_FIRST + 0)
Private Const LVM_GETBKIMAGEA As Long = (LVM_FIRST + 69)
Private Const LVM_GETBKIMAGEW As Long = (LVM_FIRST + 139)
Private Const LVM_GETCALLBACKMASK As Long = (LVM_FIRST + 10)
Private Const LVM_GETCOLUMNA As Long = (LVM_FIRST + 25)
Private Const LVM_GETCOLUMNORDERARRAY As Long = (LVM_FIRST + 59)
Private Const LVM_GETCOLUMNW As Long = (LVM_FIRST + 95)
Private Const LVM_GETCOLUMNWIDTH As Long = (LVM_FIRST + 29)
Private Const LVM_GETCOUNTPERPAGE As Long = (LVM_FIRST + 40)
Private Const LVM_GETEDITCONTROL As Long = (LVM_FIRST + 24)
Private Const LVM_GETEXTENDEDLISTVIEWSTYLE As Long = (LVM_FIRST + 55)
Private Const LVM_GETGROUPINFO As Long = (LVM_FIRST + 149)
Private Const LVM_GETGROUPMETRICS As Long = (LVM_FIRST + 156)
Private Const LVM_GETHEADER As Long = (LVM_FIRST + 31)
Private Const LVM_GETHOTCURSOR As Long = (LVM_FIRST + 63)
Private Const LVM_GETHOTITEM As Long = (LVM_FIRST + 61)
Private Const LVM_GETHOVERTIME As Long = (LVM_FIRST + 72)
Private Const LVM_GETIMAGELIST As Long = (LVM_FIRST + 2)
Private Const LVM_GETINSERTMARK As Long = (LVM_FIRST + 167)
Private Const LVM_GETINSERTMARKCOLOR As Long = (LVM_FIRST + 171)
Private Const LVM_GETINSERTMARKRECT As Long = (LVM_FIRST + 169)
Private Const LVM_GETISEARCHSTRINGA As Long = (LVM_FIRST + 52)
Private Const LVM_GETISEARCHSTRINGW As Long = (LVM_FIRST + 117)
Private Const LVM_GETITEMA As Long = (LVM_FIRST + 5)
Private Const LVM_GETITEMCOUNT As Long = (LVM_FIRST + 4)
Private Const LVM_GETITEMPOSITION As Long = (LVM_FIRST + 16)
Private Const LVM_GETITEMRECT As Long = (LVM_FIRST + 14)
Private Const LVM_GETITEMSPACING As Long = (LVM_FIRST + 51)
Private Const LVM_GETITEMSTATE As Long = (LVM_FIRST + 44)
Private Const LVM_GETITEMTEXTA As Long = (LVM_FIRST + 45)
Private Const LVM_GETITEMTEXTW As Long = (LVM_FIRST + 115)
Private Const LVM_GETITEMW As Long = (LVM_FIRST + 75)
Private Const LVM_GETNEXTITEM As Long = (LVM_FIRST + 12)
Private Const LVM_GETNUMBEROFWORKAREAS As Long = (LVM_FIRST + 73)
Private Const LVM_GETORIGIN As Long = (LVM_FIRST + 41)
Private Const LVM_GETOUTLINECOLOR As Long = (LVM_FIRST + 176)
Private Const LVM_GETSELECTEDCOLUMN As Long = (LVM_FIRST + 174)
Private Const LVM_GETSELECTEDCOUNT As Long = (LVM_FIRST + 50)
Private Const LVM_GETSELECTIONMARK As Long = (LVM_FIRST + 66)
Private Const LVM_GETSTRINGWIDTHA As Long = (LVM_FIRST + 17)
Private Const LVM_GETSTRINGWIDTHW As Long = (LVM_FIRST + 87)
Private Const LVM_GETSUBITEMRECT As Long = (LVM_FIRST + 56)
Private Const LVM_GETTEXTBKCOLOR As Long = (LVM_FIRST + 37)
Private Const LVM_GETTEXTCOLOR As Long = (LVM_FIRST + 35)
Private Const LVM_GETTILEVIEWINFO As Long = (LVM_FIRST + 163)
Private Const LVM_GETTILEINFO As Long = (LVM_FIRST + 165)
Private Const LVM_GETTOOLTIPS As Long = (LVM_FIRST + 78)
Private Const LVM_GETUNICODEFORMAT As Long = &H2006
Private Const LVM_GETVIEW As Long = (LVM_FIRST + 143)
Private Const LVM_GETVIEWRECT As Long = (LVM_FIRST + 34)
Private Const LVM_GETWORKAREAS As Long = (LVM_FIRST + 70)
Private Const LVM_HASGROUP As Long = (LVM_FIRST + 161)
Private Const LVM_HITTEST As Long = (LVM_FIRST + 18)
Private Const LVM_INSERTCOLUMNA As Long = (LVM_FIRST + 27)
Private Const LVM_INSERTCOLUMNW As Long = (LVM_FIRST + 97)
Private Const LVM_INSERTGROUP As Long = (LVM_FIRST + 145)
Private Const LVM_INSERTGROUPSORTED As Long = (LVM_FIRST + 159)
Private Const LVM_INSERTITEMA As Long = (LVM_FIRST + 7)
Private Const LVM_INSERTITEMW As Long = (LVM_FIRST + 77)
Private Const LVM_INSERTMARKHITTEST As Long = (LVM_FIRST + 168)
Private Const LVM_ISGROUPVIEWENABLED As Long = (LVM_FIRST + 175)
Private Const LVM_MOVEGROUP As Long = (LVM_FIRST + 151)
Private Const LVM_MOVEITEMTOGROUP As Long = (LVM_FIRST + 154)
Private Const LVM_REDRAWITEMS As Long = (LVM_FIRST + 21)
Private Const LVM_REMOVEALLGROUPS As Long = (LVM_FIRST + 160)
Private Const LVM_REMOVEGROUP As Long = (LVM_FIRST + 150)
Private Const LVM_SCROLL As Long = (LVM_FIRST + 20)
Private Const LVM_SETBKCOLOR As Long = (LVM_FIRST + 1)
Private Const LVM_SETBKIMAGEA As Long = (LVM_FIRST + 68)
Private Const LVM_SETBKIMAGEW As Long = (LVM_FIRST + 138)
Private Const LVM_SETCALLBACKMASK As Long = (LVM_FIRST + 11)
Private Const LVM_SETCOLUMNA As Long = (LVM_FIRST + 26)
Private Const LVM_SETCOLUMNORDERARRAY As Long = (LVM_FIRST + 58)
Private Const LVM_SETCOLUMNW As Long = (LVM_FIRST + 96)
Private Const LVM_SETCOLUMNWIDTH As Long = (LVM_FIRST + 30)
Private Const LVM_SETEXTENDEDLISTVIEWSTYLE As Long = (LVM_FIRST + 54)
Private Const LVM_SETGROUPINFO As Long = (LVM_FIRST + 147)
Private Const LVM_SETGROUPMETRICS As Long = (LVM_FIRST + 155)
Private Const LVM_SETHOTCURSOR As Long = (LVM_FIRST + 62)
Private Const LVM_SETHOTITEM As Long = (LVM_FIRST + 60)
Private Const LVM_SETHOVERTIME As Long = (LVM_FIRST + 71)
Private Const LVM_SETICONSPACING As Long = (LVM_FIRST + 53)
Private Const LVM_SETIMAGELIST As Long = (LVM_FIRST + 3)
Private Const LVM_SETINFOTIP As Long = (LVM_FIRST + 173)
Private Const LVM_SETINSERTMARK As Long = (LVM_FIRST + 166)
Private Const LVM_SETINSERTMARKCOLOR As Long = (LVM_FIRST + 170)
Private Const LVM_SETITEMA As Long = (LVM_FIRST + 6)
Private Const LVM_SETITEMCOUNT As Long = (LVM_FIRST + 47)
Private Const LVM_SETITEMPOSITION As Long = (LVM_FIRST + 15)
Private Const LVM_SETITEMPOSITION32 As Long = (LVM_FIRST + 49)
Private Const LVM_SETITEMSTATE As Long = (LVM_FIRST + 43)
Private Const LVM_SETITEMTEXTA As Long = (LVM_FIRST + 46)
Private Const LVM_SETITEMTEXTW As Long = (LVM_FIRST + 116)
Private Const LVM_SETITEMW As Long = (LVM_FIRST + 76)
Private Const LVM_SETOUTLINECOLOR As Long = (LVM_FIRST + 177)
Private Const LVM_SETSELECTEDCOLUMN As Long = (LVM_FIRST + 140)
Private Const LVM_SETSELECTIONMARK As Long = (LVM_FIRST + 67)
Private Const LVM_SETTEXTBKCOLOR As Long = (LVM_FIRST + 38)
Private Const LVM_SETTEXTCOLOR As Long = (LVM_FIRST + 36)
Private Const LVM_SETTILEINFO As Long = (LVM_FIRST + 164)
Private Const LVM_SETTILEVIEWINFO As Long = (LVM_FIRST + 162)
Private Const LVM_SETTILEWIDTH As Long = (LVM_FIRST + 141)
Private Const LVM_SETTOOLTIPS As Long = (LVM_FIRST + 74)
Private Const LVM_SETUNICODEFORMAT As Long = &H2005
Private Const LVM_SETVIEW As Long = (LVM_FIRST + 142)
Private Const LVM_SETWORKAREAS As Long = (LVM_FIRST + 65)
Private Const LVM_SORTGROUPS As Long = (LVM_FIRST + 158)
Private Const LVM_SORTITEMS As Long = (LVM_FIRST + 48)
Private Const LVM_SORTITEMSEX As Long = (LVM_FIRST + 81)
Private Const LVM_SUBITEMHITTEST As Long = (LVM_FIRST + 57)
Private Const LVM_UPDATE As Long = (LVM_FIRST + 42)Private Const LVCF_FMT As Long = &H1
Private Const LVCF_WIDTH As Long = &H2
Private Const LVCF_TEXT As Long = &H4
Private Const LVCF_SUBITEM As Long = &H8
Private Const LVCF_IMAGE As Long = &H10Private Const LVCFMT_LEFT As Long = &H0
Private Const LVCFMT_RIGHT As Long = &H1
Private Const LVCFMT_CENTER As Long = &H2
Private Const LVCFMT_JUSTIFYMASK As Long = &H3
Private Const LVCFMT_IMAGE As Long = &H800
Private Const LVCFMT_BITMAP_ON_RIGHT As Long = &H1000
Private Const LVCFMT_COL_HAS_IMAGES As Long = &H8000

Answer 3

续上.
'类模块,cListView.cls,第三部分Private Const LVIF_TEXT As Long = &H1
Private Const LVIF_IMAGE As Long = &H2
Private Const LVIF_PARAM As Long = &H4
Private Const LVIF_STATE As Long = &H8
Private Const LVIF_INDENT As Long = &H10
Private Const LVIF_NORECOMPUTE As Long = &H800
Private Const LVIS_FOCUSED As Long = &H1
Private Const LVIS_SELECTED As Long = &H2
Private Const LVIS_CUT As Long = &H4
Private Const LVIS_DROPHILITED As Long = &H8
Private Const LVIS_ACTIVATING As Long = &H20
Private Const LVIS_OVERLAYMASK As Long = &HF00&
Private Const LVIS_SELCHECK = &H2000
Private Const LVIS_STATEIMAGEMASK As Long = &HF000&Public Enum LV_Style        '显示方式
    LVList = LVS_LIST
    LVReport = LVS_REPORT
    LVIcon = LVS_ICON
    LVSmallIcon = LVS_SMALLICON
End Enum
Public Enum LV_ExStyle      '扩展样式
    LVBorderSelect = LVS_EX_BORDERSELECT
    LVCheckBoxes = LVS_EX_CHECKBOXES        '检查框
    LVDoubleBuffer = LVS_EX_DOUBLEBUFFER    '双缓冲?
    LVFlatSB = LVS_EX_FLATSB                '平面滚动条
    LVFullSelect = LVS_EX_FULLROWSELECT     '整行选择
    LVGridLines = LVS_EX_GRIDLINES          '网格样式
    LVHeaderDragDrop = LVS_EX_HEADERDRAGDROP
    LVHideLabels = LVS_EX_HIDELABELS
    LVINFOTIP = LVS_EX_INFOTIP
    LVLABELTIP = LVS_EX_LABELTIP
    LVMULTIWORKAREAS = LVS_EX_MULTIWORKAREAS
    LVONECLICKACTIVATE = LVS_EX_ONECLICKACTIVATE
    LVREGIONAL = LVS_EX_REGIONAL
    LVSINGLEROW = LVS_EX_SINGLEROW
    LVSNAPTOGRID = LVS_EX_SNAPTOGRID
    LVSUBITEMIMAGES = LVS_EX_SUBITEMIMAGES
    LVTRACKSELECT = LVS_EX_TRACKSELECT
    LVTWOCLICKACTIVATE = LVS_EX_TWOCLICKACTIVATE
    LVUNDERLINECOLD = LVS_EX_UNDERLINECOLD
    LVUNDERLINEHOT = LVS_EX_UNDERLINEHOT
End EnumDim hListView As Long        '****************************************** 方法Public Function CreateListView(ByVal hWndParent As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, Optional ByVal style As LV_Style = LVReport)
    '生成一个LV
    'ByVal hWndParent As Long - 父窗口句柄.生成的LV将会是它的子窗口.
    'ByVal X As Long
    'ByVal Y As Long
    'ByVal nWidth As Long
    'ByVal nHeight As Long
    'Optional ByVal style As LV_Style = LVReport - 有四种样式可选.
    '返回值:
    '       生成的LV的句柄
    '备注:
    '       默认REPORT样式.
    hListView = CreateWindowEx(WS_EX_CLIENTEDGE, WC_LISTVIEW32, vbNullString, WS_CHILD Or WS_VISIBLE Or _
                               style, X, Y, nWidth, nHeight, hWndParent, ByVal 0, App.hInstance, 0&)
    CreateListView = hListView
End Function
    
Public Function LV_SetExtendedStyle(Optional ByVal dwExStyle As LV_ExStyle = LVFullSelect Or LVFlatSB Or LVGridLines)
    ' 设置扩展风格
    '
    '一大堆常量,不是很清楚每个的作用,用得到的再去查吧....反正都在枚举里了.
    
    Call SendMessage(hListView, LVM_SETEXTENDEDLISTVIEWSTYLE, 0, dwExStyle)
End FunctionPublic Function LV_SetHeadFlat()
    '标头平面样式
    Dim hStyle As Long
    Dim hHeader As Long
    
    hHeader = SendMessage(hListView, LVM_GETHEADER, 0, 0)
    hStyle = GetWindowLong(hHeader, GWL_STYLE)
    hStyle = hStyle Xor HDS_BUTTONS
    If hStyle Then
        Call SetWindowLong(hHeader, GWL_STYLE, hStyle)
    End If
End FunctionPublic Function LV_SetBkColor(Optional BkColor As Long = 0)
    ' 设置背景色
    Call SendMessage(hListView, LVM_SETBKCOLOR, 0, BkColor)
End FunctionPublic Function LV_SetTextBkColor(Optional ByVal TextBkColor As Long = 0) As Boolean
    ' 设置列表项目的背景色
    Call SendMessage(hListView, LVM_SETTEXTBKCOLOR, 0, TextBkColor)
End FunctionPublic Function LV_InsertColumn(ByVal ColIndex As Long, ByVal ColumnText As String, Optional ByVal mnWidth As Long = 60) As Long
    '插入列表头
    'ByVal ColIndex As Long - 新插入的索引值
    'ByVal ColumnText As String
    'Optional ByVal mnWidth As Long = 60 - 默认的宽度
    '返回值:
    '       无
    '备注:
    '       无
    Dim lvCol As LVCOLUMN
    
    With lvCol
        .mask = LVCF_FMT Or LVCF_TEXT Or LVCF_WIDTH
        .fmt = LVCFMT_LEFT
        .CX = mnWidth
        .pszText = ColumnText
    End With
    Call SendMessage(hListView, LVM_INSERTCOLUMNA, ColIndex, VarPtr(lvCol))
End FunctionPublic Function LV_InsertItem(ByVal ItemIndex As Long, ByVal ItemText As String, Optional ByVal State As Long = 0)
    '插入列表项
    Dim tLVITEM As LVITEM
    
    With tLVITEM
        .mask = LVIF_TEXT Or LVIF_STATE
        .iItem = ItemIndex
        .pszText = ItemText
        .State = State              '不知道啥用,看不懂MSDN=_=,作为可选吧....
        .stateMask = LVIS_STATEIMAGEMASK
    End With
    Call SendMessage(hListView, LVM_INSERTITEMA, 0, VarPtr(tLVITEM))
    Call SendMessage(hListView, LVM_SETITEMSTATE, ItemIndex, VarPtr(tLVITEM))
End Function
    
Public Function LV_SetSubItemText(ByVal ItemIndex As Long, ByVal SubItemIndex As Long, ByVal pszText As String)
    '设置子项文本
    Dim tLVITEM As LVITEM
    
    With tLVITEM
        .mask = LVIF_TEXT Or LVIF_STATE
        .pszText = pszText
        .iSubItem = SubItemIndex  ' 列数
    End With
    Call SendMessage(hWnd, LVM_SETITEMTEXTA, ItemIndex, VarPtr(tLVITEM))
End FunctionPublic Function LV_SetItem(ByVal ItemIndex As Long, ByVal strItemText As String)
    '设置列表项文本
    Dim tLVITEM As LVITEM
    
    With tLVITEM
        .mask = LVIF_TEXT Or LVIF_STATE
        .iItem = ItemIndex
        .pszText = strItemText
    End With
    Call SendMessage(hListView, LVM_SETITEMA, 0, VarPtr(tLVITEM))
End FunctionPublic Function LV_GetItem(ByVal ItemIndex As Long) As String
    '取列表项文本
    Dim tLVITEM As LVITEM, ItemText As String
    
    ItemText = String$(260, Chr(0))
    With tLVITEM
        .mask = LVIF_TEXT
        .iItem = ItemIndex
        .pszText = ItemText
        .cchTextMax = 256
        .iSubItem = 0
    End With
    Call SendMessage(hListView, LVM_GETITEMA, 0, VarPtr(tLVITEM))
    LV_GetItem = Left$(tLVITEM.pszText, InStr(tLVITEM.pszText, vbNullChar) - 1)
End Function
    
Public Function LV_GetItemText(ByVal ItemIndex As Long, ByVal SubItemIndex As Long) As String
    '取子项文本
    Dim tLVITEM As LVITEM
    Dim SubItemText As String
    
    SubItemText = String$(28, Chr(0))
    With tLVITEM
        .iSubItem = SubItemIndex
        .cchTextMax = 28
        .pszText = SubItemText
    End With
    Call SendMessage(hListView, LVM_GETITEMTEXTA, ItemIndex, VarPtr(tLVITEM))
    LV_GetItemText = Left$(tLVITEM.pszText, InStr(tLVITEM.pszText, vbNullChar) - 1)
End FunctionPublic Function LV_DeleteItem(ByVal ItemIndex As Long) As Boolean
    '删除列表项
    LV_DeleteItem = SendMessage(hListView, LVM_DELETEITEM, ItemIndex, 0)
End FunctionPublic Function LV_GetItemCount() As Long
    '取列表项数量
    LV_GetItemCount = SendMessage(hListView, LVM_GETITEMCOUNT, 0, 0)
End FunctionPublic Function LV_SetItemState(ByVal State As Long, Optional ByVal staMask As Long)
    Dim tLVITEM As LVITEM
    
    With tLVITEM
        .mask = LVIF_STATE
        .State = State
        .stateMask = staMask Or LVIS_STATEIMAGEMASK
    End With
    Call SendMessage(hListView, LVM_SETITEMSTATE, -1, VarPtr(tLVITEM))
End FunctionPublic Function LV_GetNextItem() As Long
    LV_GetNextItem = SendMessage(hListView, LVM_GETNEXTITEM, -1, LVIS_SELECTED)
End FunctionPublic Function LV_GetItemState(ByVal ItemIndex As Long) As Long
    LV_GetItemState = SendMessage(hListView, LVM_GETITEMSTATE, ItemIndex, LVIS_STATEIMAGEMASK)
End Function        '****************************************** 属性
        
Public Property Get hWnd() As Long
    hWnd = hListView
End Property        '****************************************** 事件
        
Private Sub Class_Initialize()
    Dim InitCC As INITCOMMONCONTROLSEX
   
    With InitCC
        .dwSize = Len(InitCC)
        .dwICC = ICC_LV_CLASSES
    End With
    Call INITCOMMONCONTROLSEX(InitCC)
    hListView = 0
End SubPrivate Sub Class_Terminate()
    If hListView <> 0 Then
        Call DestroyWindow(hListView)
    End If
End Sub

Answer 4

干脆打个包上传了:http://p.blog.csdn.net/images/p_blog_csdn_net/myjian/cListView.rar.jpg要用右键---->另存为,再把后缀改了吧....

Answer 5

本质无差别,但感觉不同呀.之前总感觉VB6在这论坛不存在.现在OK了.听说要严重感谢一下蝈蝈同学.........呃对了,楼上怎么还不睡.

Answer 6

来来,都来~~~大家肯定都有收藏/原创功能性的模块,如果可以发上来的话,就都整出来吧:http://topic.csdn.net/u/20080529/00/573e70c3-e6c5-43be-86da-8654e8fb841b.html

Answer 7

//不太喜欢控件(以前刚学VB时的"绿色软件"思想影响深远呀....)我把它做成用户自定义控件吧尽量实现LV的常用功能.....

Answer 8

哈哈,现在正在修改呢,VB和VBNET,VBSCRIPT不同,不是所有关键字都上色,这个很头痛

Answer 9

老马的类模块不错，学到了，NICE CODE

Answer 10

再测试一个：
WithEvents

Answer 11

他们这些人不会VB的,他们只是跟网络上找个现成代码
没看见里面有什么Lua,这东西几人会用?所以最后还得我们自个去改才是正道.

Answer 12

从我BLOG里的JS语法高亮代码里提取VB6关键字来测试一下.里面貌似包含了比较全的VB6关键字.不过有些我都没见过......不管了,看看再说:AddHandler AddressOf AndAlso Alias And Ansi As Assembly Auto  
Boolean ByRef Byte ByVal Call Case Catch CBool CByte CChar CDate  
CDec CDbl Char CInt Class CLng CObj Const CShort CSng CStr CType  
Date Decimal Declare Default Delegate Dim DirectCast Do Double Each  
Else ElseIf End Enum Erase Error Event Exit False Finally For Friend  
Function Get GetType GoSub GoTo Handles If Implements Imports In  
Inherits Integer Interface Is Let Lib Like Long Loop Me Mod Module  
MustInherit MustOverride MyBase MyClass Namespace New Next Not Nothing  
NotInheritable NotOverridable Object On Option Optional Or OrElse  
Overloads Overridable Overrides ParamArray Preserve Private Property  
Protected Public RaiseEvent ReadOnly ReDim REM RemoveHandler Resume  
Return Select Set Shadows Shared Short Single Static Step Stop String  
Structure Sub SyncLock Then Throw To True Try TypeOf Unicode Until  
Variant When While With WithEvents WriteOnly Xor 
Abs Asc Atn CBool CByte CCur CDate CDbl CDec CInt CLng CSng CStr CVErr CVar Chr Command  
Cos CreateObject CurDir DDB Date DateAdd DateDiff DatePart DateSerial DateValue Day DeleteSetting EOF  
Eqv Exp FV FileAttr FileDateTime FileLen Filter Fix Format FormatCurrency FormatDateTime FormatNumber FormatPercent FreeFile  
GetAllSettings GetAttr GetObject GetSetting Hex Hour IIf IPmt IRR Imp InStr InStrRev InputBox  
IsArray IsDate IsEmpty IsError IsMissing IsNull IsNumeric IsObject Join LBound LCase LOF LSet LTrim Left Len  
LoadPicture LoadResData LoadResPicture LoadResString Loc Log MIRR MacID MacScript Mid Minute Month MonthName  
NPV NPer Now Oct PPmt QBColor RGB RSet RTrim Random Randomize Rate Replace Right Rnd Round SLN SYD SaveSetting Second  
Sgn Sin Space Split Sqr StrComp StrConv StrReverse Tan Time TimeSerial TimeValue UBound UCase Val VarPtr VarType  
Weekday WeekdayName Year

Answer 13

哈哈,貌似还有不少见过的关键字都没高亮呢~~Mmm快改快改~~~

Answer 14

<!--Code highlighting produced by Actipro CodeHighlighter (freeware)
http://www.CodeHighlighter.com/-->貌似是别人做的吧

Answer 15

老马，ListView之类的东西我记得有个叫vbaccelerator的网站有很多，而且质量很高的。

Answer 16

http://www.vbaccelerator.com/home/index.asp这么多年了这网站居然还在，也没更新过。

Answer 17

我觉着老马发的东西,还不如去看看vbaccelerator

Answer 18

再来发个利用互斥体实现只运行一次的代码:http://www.m5home.com/bbs/dispbbs.asp?boardid=28&Id=1550对于那种需要多个副本也可以实现一次运行,这个代码更有效

Answer 19

VB不是所有关键字都加亮的.你把VB配置里面把密码文字改成其他颜色就很好分别出来了. 所以你重新验证一次去,缺的再告诉我,我再去修改配置文件.

Answer 20

把UE的VB关键字拉了出来.将IDE里的Keyword Text与Identifier Text都设为同样的颜色,就区别出来了.不少的我都没见过也没用过.以下是列表:Abs   Array   Asc   AscB   AscW   Atn   Avg
CBool   CByte   CCur   CDate   CDbl   Cdec   Choose   Chr   ChrB   ChrW   CInt   CLng   Command   Cos   Count   CreateObject   CSng   CStr   CurDir   CVar   CVDate   CVErr
Date   DateAdd   DateDiff   DatePart   DateSerial   DateValue   Day   DDB   Dir   DoEvents
Environ   EOF   Error   Exp
FileAttr   FileDateTime   FileLen   Fix   Format   FreeFile   FV
GetAllStrings   GetAttr   GetAutoServerSettings   GetObject   GetSetting
Hex Hour
IIf   IMEStatus   Input   InputB   InputBox   InStr   InstB   Int   IPmt   IsArray   IsDate   IsEmpty   IsError   IsMissing   IsNull   IsNumeric   IsObject
LBound   LCase   Left   LeftB   Len   LenB   LoadPicture   Loc   LOF   Log   LTrim
Max   Mid   MidB   Min   Minute   MIRR   Month   MsgBox
Now   NPer   NPV
Oct
Partition   Pmt   PPmt   PV
QBColor
Rate   RGB   Right   RightB   Rnd   RTrim
Second   Seek   Sgn   Shell   Sin   SLN   Space   Spc   Sqr   StDev   StDevP   Str   StrComp   StrConv   String   Switch   Sum   SYD
Tab   Tan   Time   Timer   TimeSerial   TimeValue   Trim   TypeName
UBound   UCase
Val   Var   VarP   VarType
Weekday
Year
Accept   Activate   Add   AddCustom   AddFile   AddFromFile   AddFromTemplate   AddItem   AddNew   AddToAddInToolbar   AddToolboxProgID   Append   AppendChunk   Arrange   Assert   AsyncRead
BatchUpdate   BeginTrans   Bind
Cancel   CancelAsyncRead   CancelBatch   CancelUpdate   CanPropertyChange   CaptureImage   CellText   CellValue   Circle   Clear   ClearFields   ClearSel   ClearSelCols   Clone   Close   Cls   ColContaining   ColumnSize   CommitTrans   CompactDatabase   Compose   Connect   Copy   CopyQueryDef   CreateDatabase   CreateDragImage   CreateEmbed   CreateField   CreateGroup   CreateIndex   CreateLink   CreatePreparedStatement   CreatePropery   CreateQuery   CreateQueryDef   CreateRelation   CreateTableDef   CreateUser   CreateWorkspace   Customize
Delete   DeleteColumnLabels   DeleteColumns   DeleteRowLabels   DeleteRows   DoVerb   Drag   Draw
Edit   EditCopy   EditPaste   EndDoc   EnsureVisible   EstablishConnection   Execute   ExtractIcon
Fetch   FetchVerbs   Files   FillCache   Find   FindFirst   FindItem   FindLast   FindNext   FindPrevious   Forward
GetBook   GetChunk   GetClipString   GetData   GetFirstVisible   GetFormat   GetHeader   GetLineFromChar   GetNumTicks   GetRows   GetSelectedPart   GetText   GetVisibleCount   GoBack   GoForward
Hide   HitTest   HoldFields
Idle   InitializeLabels   InsertColumnLabels   InsertColumns   InsertObjDlg   InsertRowLabels   InsertRows   Item
KillDoc
Layout   Line   LinkExecute   LinkPoke   LinkRequest   LinkSend   Listen   LoadFile   LoadResData   LoadResPicture   LoadResString   LogEvent
MakeCompileFile   MakeReplica   MoreResults   Move   MoveData   MoveFirst   MoveLast   MoveNext   MovePrevious
NavigateTo   NewPage   NewPassword   NextRecordset
OLEDrag   OnAddinsUpdate   OnConnection   OnDisconnection   OnStartupComplete   Open   OpenConnection   OpenDatabase   OpenQueryDef   OpenRecordset   OpenResultset   OpenURL   Overlay
PaintPicture   Paste   PastSpecialDlg   PeekData   Play   Point   PopulatePartial   PopupMenu   Print   PrintForm   PropertyChanged   PSet
Quit
Raise   RandomDataFill   RandomFillColumns   RandomFillRows   rdoCreateEnvironment   rdoRegisterDataSource   ReadFromFile   ReadProperty   Rebind   ReFill   Refresh   RefreshLink   RegisterDatabase   Reload   Remove   RemoveAddInFromToolbar   RemoveItem   Render   RepairDatabase   Reply   ReplyAll   Requery   ResetCustom   ResetCustomLabel   ResolveName   RestoreToolbar   Resync   Rollback   RollbackTrans   RowBook   RowContaining   RowTop
Save   SaveAs   SaveFile   SaveToFile   SaveToolbar   SaveToOle1File   Scale   ScaleX   ScaleY   Scroll   Select   SelectAll   SelectPart   SelPrint   Send   SendData   Set   SetAutoServerSettings   SetData   SetFocus   SetOption   SetSize   SetText   SetViewport   Show   ShowColor   ShowFont   ShowHelp   ShowOpen   ShowPrinter   ShowSave   ShowWhatsThis   SignOff   SignOn   Size   Span   SplitContaining   StartLabelEdit   StartLogging   Stop   Synchronize
TextHeight   TextWidth   ToDefaults   TwipsToChartPart   TypeByChartType
Update   UpdateControls   UpdateRecord   UpdateRow   Upto
WhatsThisMode WriteProperty
ZOrder
AccessKeyPress   AfterAddFile   AfterChangeFileName   AfterCloseFile   AfterColEdit   AfterColUpdate   AfterDelete   AfterInsert   AfterLabelEdit   AfterRemoveFile   AfterUpdate   AfterWriteFile   AmbienChanged   ApplyChanges   Associate   AsyncReadComplete   AxisActivated   AxisLabelActivated   AxisLabelSelected   AxisLabelUpdated   AxisSelected   AxisTitleActivated   AxisTitleSelected   AxisTitleUpdated   AxisUpdated
BeforeClick   BeforeColEdit   BeforeColUpdate   BeforeConnect   BeforeDelete   BeforeInsert   BeforeLabelEdit   BeforeLoadFile   BeforeUpdate   ButtonClick   ButtonCompleted   ButtonGotFocus   ButtonLostFocus
Change   ChartActivated   ChartSelected   ChartUpdated   Click   ColEdit   Collapse   ColResize   ColumnClick   Compare   ConfigChageCancelled   ConfigChanged   ConnectionRequest
DataArrival   DataChanged   DataUpdated   DblClick   Deactivate   DeviceArrival   DeviceOtherEvent   DeviceQueryRemove   DeviceQueryRemoveFailed   DeviceRemoveComplete   DeviceRemovePending   DevModeChange   Disconnect   DisplayChanged   Dissociate   DoGetNewFileName   Done   DonePainting   DownClick   DragDrop   DragOver   DropDown
EditProperty   EnterCell   EnterFocus   Event   ExitFocus   Expand
FootnoteActivated   FootnoteSelected   FootnoteUpdated
GotFocus
HeadClick
InfoMessage   Initialize   IniProperties   ItemActivated   ItemAdded   ItemCheck   ItemClick   ItemReloaded   ItemRemoved   ItemRenamed   ItemSeletected
KeyDown   KeyPress   KeyUp
LeaveCell   LegendActivated   LegendSelected   LegendUpdated   LinkClose   LinkError   LinkNotify   LinkOpen   Load   LostFocus
MouseDown   MouseMove   MouseUp
NodeClick
ObjectMove   OLECompleteDrag   OLEDragDrop   OLEDragOver   OLEGiveFeedback   OLESetData   OLEStartDrag   OnAddNew   OnComm
Paint   PanelClick   PanelDblClick   PathChange   PatternChange   PlotActivated   PlotSelected   PlotUpdated   PointActivated   PointLabelActivated   PointLabelSelected   PointLabelUpdated   PointSelected   PointUpdated   PowerQuerySuspend   PowerResume   PowerStatusChanged   PowerSuspend
QueryChangeConfig   QueryComplete   QueryCompleted   QueryTimeout   QueryUnload
ReadProperties   Reposition   RequestChangeFileName   RequestWriteFile   Resize   ResultsChanged   RowColChange   RowCurrencyChange   RowResize   RowStatusChanged
SelChange   SelectionChanged   SendComplete   SendProgress   SeriesActivated   SeriesSelected   SeriesUpdated   SettingChanged   SplitChange   StateChanged   StatusUpdate   SysColorsChanged
Terminate   TimeChanged   TitleActivated   TitleSelected   TitleActivated
UnboundAddData   UnboundDeleteRow   UnboundGetRelativeBook   UnboundReadData   UnboundWriteData   Unload   UpClick   Updated
Validate ValidationError
WillAssociate   WillChangeData   WillDissociate   WillExecute   WillUpdateRows   WithEvents   WriteProperties
AppActivate
Base Beep
Call   Case   ChDir   ChDrive   Const
Declare   DefBool   DefByte   DefCur   DefDate   DefDbl   DefDec   DefInt   DefLng   DefObj   DefSng   DefStr   Deftype   DefVar   DeleteSetting   Dim   Do
Else   ElseIf   End   Enum   Erase   Event   Exit   Explicit
FileCopy   For   ForEach   Friend   Function
Get   GoSub   GoTo
If   Implements
Kill
Let   LineInput   Lock   LSet
MkDir
Name   Next
OnError   On   Option
Private   Property   Public   Put
RaiseEvent   Randomize   ReDim   Rem   Reset   Resume   Return   RmDir   RSet
SavePicture   SaveSetting   SendKeys   SetAttr   Static   Sub
Then   Type
Unlock
Wend   While   Width   With   Write

Answer 21

本帖最后由 daisy8675 于 2008-06-01 12:42:27 编辑

  

Answer 22

已经不写vb了，以前写vb总被bs

Answer 23

那个网站也没实现LV背景图引用内存图片的问题！老大们，这个能实现吗？Set ListView1.Picture=Picture1.Picture

Answer 24

可惜，好像与VBScript一样，ByVal、Optional等关键字还是没标记出来。

Answer 25

Adodc1.CommandType = adCmdText
    Adodc1.RecordSource = "Select * From UserData Where 标记=1"
    Adodc1.Refresh

Answer 26

Adodc1.CommandType = adCmdText
    Adodc1.RecordSource = "Select * From UserData Where 标记=1"
    Adodc1.Refresh

Answer 27

[code=VB]
[/Adodc1.CommandType = adCmdText
    Adodc1.RecordSource = "Select * From UserData Where 标记=1"
    Adodc1.Refresh
]

Answer 28

我来试试看吧dim a as integer,b as long,c as double
a=100: b=2000
c=(a+b)/2
msgbox c

Answer 29

刚才怎么没成功？再试一次……dim a as integer,b as long,c as double 
a=100: b=2000 
c=(a+b)/2 
msgbox c 

Answer 30

注意:VB是大写,你上面小写就不成功了Msgbox是关键字没错,但是我们测试了,VB的IDE确实是不加亮的.

Answer 31

响应莫依号召，继续测试。
但一行就是完整代码鸟....
Implements ISubclass