VB6自定义ListBox控件
从测试图中可以看到自定义控件比系统自带的控件速度快58倍
Form 代码
Private Declare Function GetTickCount Lib "kernel32" () As Long
Dim Tk As Long
Dim Mtk As Long
'自定义控件添加数据
Private Sub Command1_Click()
Tk = GetTickCount
For i = 1 To 100000
  xList1.AddItem "项目：" & i
Next i
xList1.DrawListBox
Mtk = GetTickCount
Label2.Caption = "添加10W行数据用时：" & Mtk - Tk & "毫秒"
End Sub
Private Sub Command2_Click()
xList1.RemoveItem xList1.ListIndex
xList1.DrawListBox
End Sub
Private Sub Command3_Click()
xList1.ItemFontColor(3) = 255
xList1.DrawListBox
End Sub
'自带列表添加数据
Private Sub Command4_Click()
Tk = GetTickCount
For i = 1 To 100000
  List1.AddItem "项目：" & i
Next i
Mtk = GetTickCount
Label3.Caption = "添加10W行数据用时：" & Mtk - Tk & "毫秒"
End Sub
Usercontrol自定义代码
Option Explicit
'VB绘制简单的列表控件
'作者 扣：六五九三五四九五三 来水美树
‘
'添加工程组件 Timer ,PictureBox (命名：SollBar),各属性设置如下
'timer.Enabled 设为 False
'    .InterVal 设为 1
'Sollbar.AutoRedraw = True
'Sollbar.BorderStyle = 0
'Sollbar.Appearance = 0
'Sollbar.Visible = False
'UserControl.AutoRedraw = True
'粘贴以下代码即可运行
Private Type POINTAPI
    x As Long
    y As Long
End Type
Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type
Private Type ListItems
        Text As String
        FontColor As Long
      ' Check As Boolean    '
      ' Icon As StdPicture  此处可为每行添加图标，
End Type
Dim m_ListCount        As Long            '总行
Dim m_ListIndex        As Long            '当前选中行
Dim m_Grid              As Boolean        '线段
Dim m_Page              As Integer        '
Dim m_CurIndex          As Long            '当前置顶的行号
Dim m_ItemHeight        As Integer        '行高
Dim m_Stretch          As Boolean        '决定图片与窗口一样大小
Dim m_BorderColor      As Long
Dim m_SelBackColor      As Long
Dim m_pic              As StdPicture
Dim m_SollbarValue      As Long
Dim m_SollbarValueMax  As Long
Dim sReg                As Long  '滑动区域
Dim m_Slid              As Long  '滑块
Dim m_List() As ListItems
Dim Tk            As Long
Dim Mtk            As Long
Dim ret            As Long
Public Event MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Public Event MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Public Event MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
Public Event Click()
Public Event DblClick()
Private Const ButHeight = 18
Private Const SLIDERMINHEIGHT = 10    '滑块最小高度
Private Const SOLLCOMMANDHEIGHT = &HFF      '滚动条上下按钮的高度
Private Const SLIDHEIGHTMIN = &HFF          '滚动条最小滑块高度
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpPoint As Long) As Long
Private Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As POINTAPI, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
Private Declare Function Polygon Lib "gdi32" (ByVal hdc As Long, lpPoint As POINTAPI, ByVal nCount As Long) As Long
Private Const ALTERNATE = 1
Private Const WINDING = 2
Private Declare Function SetPolyFillMode Lib "gdi32" (ByVal hdc As Long, ByVal nPolyFillMode As Long) As Long
Private Declare Function CreateRectRgn Lib "gdi32" (ByVal x1 As Long, ByVal y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function FrameRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long, ByVal hBrush As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function FillRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long, ByVal hBrush As Long) As Long
Private Declare Function FloodFill Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
borderbox

版权声明：本站内容均来自互联网，仅供演示用，请勿用于商业和其他非法用途。如果侵犯了您的权益请与我们联系QQ:729038198，我们将在24小时内删除。