2024年4月29日发(作者：)
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
m "项目：" & i
Next i
stBox
Mtk = GetTickCount
n = "添加10W行数据用时：" & Mtk - Tk & "毫秒"
End Sub
Private Sub Command2_Click()
Item dex
stBox
End Sub
Private Sub Command3_Click()
ntColor(3) = 255
stBox
End Sub
'自带列表添加数据
Private Sub Command4_Click()
Tk = GetTickCount
For i = 1 To 100000
m "项目：" & i
Next i
Mtk = GetTickCount
n = "添加10W行数据用时：" & Mtk - Tk & "毫秒"
End Sub
Usercontrol自定义代码
Option Explicit
'VB绘制简单的列表控件
'作者 扣：六五九三五四九五三 来水美树
‘
'添加工程组件 Timer ,PictureBox (命名：SollBar),各属性设置如下
'd 设为 False
' .InterVal 设为 1
'draw = True
'Style = 0
'ance = 0
'e = False
'draw = 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
Dim m_ListIndex
Dim m_Grid
Dim m_Page
Dim m_CurIndex
Dim m_ItemHeight
Dim m_Stretch
Dim m_BorderColor
Dim m_SelBackColor
Dim m_pic
As Long
As Long
As Boolean
As Integer
As Long
As Integer
As Boolean
As Long
As Long
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
Private Const DT_LEFT = &H0
Private Const DT_CENTER = &H1
Private Const DT_RIGHT = &H2
Private Const DT_SINGLELINE = &H20
Private Const DT_VCENTER = &H4
Private Const DT_WORDBREAK = &H10
Private Const DT_CALCRECT = &H400
Private Const DT_EDITCONTROL = &H2000
'添加行
Public Sub AddItem(ByVal Text As String)
If m_ListCount = 0 Then
ReDim Preserve m_List(0) As ListItems
Else
ReDim Preserve m_List(UBound(m_List) + 1) As ListItems
End If
m_ListCount = UBound(m_List) + 1
m_List(UBound(m_List)).Text = Text
m_List(UBound(m_List)).FontColor = lor
End Sub
'绘制矩形
Private Sub DrawRectEx(sRect As RECT, ByVal cColor As Long)
(, )-(, ), cColor
(, )-(, + 15),
cColor
(, )-(, ), cColor
(, )-(, ), cColor
End Sub
'取渐变色中间的值
Private Function BlendColors(ByVal lngColor1 As Long, _
ByVal lngColor2 As Long, _
ByVal bStyle As Boolean, _
Optional addValue As Long = 0) As Single
If bStyle = True Then
BlendColors = RGB(((lngColor1 And &HFF) + (lngColor2 And &HFF)) / 2 +
addValue, _
(((lngColor1 &H100) And &HFF) + ((lngColor2 &H100) And &HFF)) / 2
+ addValue, _
(((lngColor1 &H10000) And &HFF) + ((lngColor2 &H10000) And
&HFF)) / 2 + addValue)
Else
BlendColors = RGB(((lngColor1 And &HFF) + (lngColor2 And &HFF)) / 2 -
addValue, _
(((lngColor1 &H100) And &HFF) + ((lngColor2 &H100) And &HFF)) / 2
- addValue, _
(((lngColor1 &H10000) And &HFF) + ((lngColor2 &H10000) And
&HFF)) / 2 - addValue)
End If
End Function
Private Sub DrawGradientColor(ByVal sColor As Long, _
ByVal eColor As Long, _
ByRef sRect As RECT, _
Optional Variable As Boolean = True, _
Optional sStyle As Integer = 0)
Dim sR As Single
Dim sG As Single
Dim sB As Single
Dim eR As Single
Dim eG As Single
Dim eB As Single
Dim cR As Single
Dim cG As Single
Dim cB As Single
Dim Z As Long
On Error GoTo Err_Net
sR = sColor Mod 256
sG = sColor 256 Mod 256
sB = sColor 256 256
eR = eColor Mod 256
eG = eColor 256 Mod 256
eB = eColor 256 256
If Variable = True Then '变亮
sR = sR * 1.2: sG = sG * 1.2: sB = sB * 1.2
eR = eR * 1.2: eG = eG * 1.2: eB = eB * 1.2
End If
If sStyle = 0 Then '用垂直方式填充
cR = (sR - eR) /
cG = (sG - eG) /
cB = (sB - eB) /
For Z = To - 1
(, Z)-(, Z), RGB(eR + (Z * cR), eG + (Z *
cG), eB + (Z * cB))
Next Z
Else
cR = (sR - eR) /
cG = (sG - eG) /
cB = (sB - eB) /
For Z = To - 1
(Z, )-(Z, ), RGB(eR + (Z * cR), eG + (Z *
cG), eB + (Z * cB))
Next Z
End If
Exit Sub
Err_Net:
End Sub
Private Sub DrawGradientColorX(ByVal sColor As Long, _
ByVal eColor As Long, _
ByRef sRect As RECT, _
Optional Variable As Boolean = True, _
Optional cValue As Long = 0)
Dim sR As Single
Dim sG As Single
Dim sB As Single
Dim eR As Single
Dim eG As Single
Dim eB As Single
Dim cR As Single
Dim cG As Single
Dim cB As Single
Dim Z As Long
Dim tz As Long
sR = sColor Mod 256
sG = sColor 256 Mod 256
sB = sColor 256 256
eR = eColor Mod 256
eG = eColor 256 Mod 256
eB = eColor 256 256
If Variable = True Then '变亮
sR = sR * 1.2: sG = sG * 1.2: sB = sB * 1.2
eR = eR * 1.2: eG = eG * 1.2: eB = eB * 1.2
End If
cR = (sR - eR) /
cG = (sG - eG) /
cB = (sB - eB) /
If cValue = 1 Then
For Z = To - 1
If Z >= ( / 2) Then Exit Sub
(Z, )-(Z, ), RGB(eR + (Z * cR), eG + (Z
* cG), eB + (Z * cB))
Next Z
Else
For Z = ( / 2) To Step -1
tz = / 2
tz = tz + tz / 2
( / 2 + ( / 2 - Z),
)-( / 2 + ( / 2 - Z), ), RGB(eR + (tz * cR),
eG + (tz * cG), eB + (tz * cB))
Next Z
End If
End Sub
'输出文字
Private Sub sDrawText(ByRef sRect As RECT, ByVal Text As String, Align As
AlignmentConstants)
Select Case Align
Case vbLeftJustify
= + 1
= + 4
DrawText hdc, Text, -1, sRect, DT_LEFT Or DT_EDITCONTROL
Or DT_WORDBREAK
Case vbRightJustify
= + 1
DrawText hdc, Text, -1, sRect, DT_LEFT Or DT_VCENTER Or
DT_SINGLELINE
Case vbCenter
DrawText hdc, Text, -1, sRect, DT_CENTER Or DT_VCENTER
Or DT_WORDBREAK
End Select
End Sub
'绘制滚动条按钮
Private Sub DrawPoly()
Dim Rgn As Long
Dim FillMode As Long
Dim Brush As Long
Dim Bom As Long
Dim Wid, Hei As Long
Wid = idth / erPixelX
Hei = eight / erPixelY
Dim Poyl1(2) As POINTAPI
Dim Poyl2(2) As POINTAPI
Poyl1(0).x = Wid / 2
Poyl1(0).y = ButHeight / 2 - 1
Poyl1(1).x = Wid / 2 + 5
Poyl1(1).y = ButHeight / 2 + 4
Poyl1(2).x = Wid / 2 - 5
Poyl1(2).y = ButHeight / 2 + 4
Poyl2(0).x = Wid / 2 - 4
Poyl2(0).y = (Hei - ButHeight) + ButHeight / 2 - 3
Poyl2(1).x = Wid / 2 + 4
Poyl2(1).y = (Hei - ButHeight) + ButHeight / 2 - 3
Poyl2(2).x = Wid / 2
Poyl2(2).y = (Hei - ButHeight) + ButHeight / 2 + 1
FillMode = SetPolyFillMode(, ALTERNATE)
Rgn = CreatePolygonRgn(Poyl2(0), 3, FillMode)
Brush = CreateSolidBrush(255)
FillRgn , Rgn, Brush
DeleteObject Rgn
DeleteObject Brush
Rgn = CreatePolygonRgn(Poyl1(0), 3, FillMode)
Brush = CreateSolidBrush(255)
FillRgn , Rgn, Brush
DeleteObject Rgn
DeleteObject Brush
End Sub
Private Sub DrawSollbar(ByVal SollBarMaxValue As Long, ByVal nv As Long)
Dim x As Single
Dim y As Single
Dim sRe As RECT
DrawPoly
sReg = eight - SOLLCOMMANDHEIGHT * 2
m_Slid = sReg / (SollBarMaxValue + 1)
If m_Slid < SOLLCOMMANDHEIGHT Then
m_Slid = SOLLCOMMANDHEIGHT
End If
y = SOLLCOMMANDHEIGHT + (sReg - m_Slid) / SollBarMaxValue * nv
= 0
= y
= 255
= y + m_Slid
DrawGradientColorX &H80FF80, &H80FF80, sRe, True, 1
DrawGradientColorX &H80FF80, &H80FF80, sRe, True, 2
(, )-( - 15, ), m_BorderColor
(, )-(, ), m_BorderColor
m_BorderColor
(, )-( - 15, ),
( - 15, )-( - 15, + 10),
m_BorderColor
'For X = 1 To 255
' (X, Y)-(X, Y + m_Slid), 255
'Next X
End Sub
Private Function GetSollBarValue(ByVal y As Single, ByVal SlidHeight As Long,
ByVal SollBarMaxValue As Long, ByRef SlidRect As RECT) As Long
On Error GoTo Err_Net
If y <= Then: GetSollBarValue = -1: Exit Function ' 向上滚动按钮
点击
If y >= ( + ) Then: GetSollBarValue = -2: Exit
Function ' 向下滚动按钮点击
GetSollBarValue = (y - SlidHeight) / ( / SollBarMaxValue)
Exit Function
Err_Net:
GetSollBarValue = -1
End Function
Private Sub Sollbar_MouseDown(Button As Integer, Shift As Integer, x As
Single, y As Single)
If Button = 1 Then
Tk = GetTickCount
Dim sRect As RECT
Dim nv As Integer
With sRect
.Top = 255
.Left = 0
.Right = 255
.Bottom = sReg
End With
ret = GetSollBarValue(y, m_Slid, m_SollbarValueMax, sRect)
If ret = -1 Then
d = True
ElseIf ret = -2 Then
d = True
Else
m_SollbarValue = ret
End If
DrawSollbar m_SollbarValueMax, m_SollbarValue
m_CurIndex = m_SollbarValue
DrawListBox
End If
End Sub
Private Sub Sollbar_MouseMove(Button As Integer, Shift As Integer, x As
Single, y As Single)
If Button = 1 Then
Mtk = GetTickCount
If (Mtk - Tk) < 20 Then Exit Sub
Tk = GetTickCount
Sollbar_MouseDown Button, Shift, x, y
End If
End Sub
Private Sub Sollbar_MouseUp(Button As Integer, Shift As Integer, x As Single, y
As Single)
d = False
End Sub
'通过鼠标X,Y获取当前选中的行与列
Private Function GetMousedwValue(ByVal y As Single, ByVal x As Single) As
Long
Dim y1 As Long
Dim ix As Integer
Dim x1 As Long
On Error GoTo Err_Net
If m_ListCount = 0 Then: GetMousedwValue = -1: Exit Function
y1 = Int(y / m_ItemHeight) '
GetMousedwValue = y1 + m_CurIndex
Err_Net:
End Function
Private Sub UserControl_Click()
RaiseEvent Click
End Sub
Private Sub UserControl_DblClick()
RaiseEvent DblClick
End Sub
Private Sub UserControl_KeyPress(KeyAscii As Integer)
'Select Case KeyAscii
' Case 72
' If m_SollbarValue <= 0 Then Exit Sub
' m_SollbarValue = m_SollbarValue - 1
' Case 82
' If m_SollbarValue >= m_SollbarValueMax Then Exit Sub
' m_SollbarValue = m_SollbarValue + 1
'End Select
' DrawSollbar m_SollbarValueMax, m_SollbarValue
' m_CurIndex = m_SollbarValue
' DrawListBox
End Sub
Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, x As
Single, y As Single)
If Button = 1 Then
m_ListIndex = GetMousedwValue(y, x)
If m_ListIndex > (m_ListCount - 1) Then
m_ListIndex = m_ListCount - 1
End If
DrawListBox
End If
RaiseEvent MouseDown(Button, Shift, x, y)
End Sub
Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, x As
Single, y As Single)
RaiseEvent MouseMove(Button, Shift, x, y)
End Sub
Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, x As
Single, y As Single)
RaiseEvent MouseUp(Button, Shift, x, y)
End Sub
'绘制ListBox 核心代码
Public Sub DrawListBox()
Dim sBack As RECT
Dim selRect As RECT
Dim i As Integer
Dim cut As Long
Dim m_Count As Long
m_Page = eight / m_ItemHeight
= m_Page * m_ItemHeight
'有背景就画背景
If Not m_pic Is Nothing Then
If m_Stretch = False Then
Set e = m_pic
Else
icture
eight
m_pic, 0, 0, idth,
End If
End If
'绘制网格’
If m_Grid = True Then
For i = 1 To m_Page
(16, i * m_ItemHeight)-( - 16, i *
m_ItemHeight), m_BorderColor
'BlendColors(m_BorderColor, m_BorderColor, True, 1)
Next i
End If
'绘制边框
With sBack
.Top = 0
.Left = 0
.Right = idth - erPixelX
.Bottom = eight - erPixelY
End With
DrawRectEx sBack, m_BorderColor 'm_BorColor
If m_ListCount = 0 Then Exit Sub
'绘制列表
If m_ListCount <= m_Page Then
For cut = 0 To m_ListCount - 1
If cut = m_ListIndex Then '绘制选中行
= 16
= cut * m_ItemHeight - m_CurIndex * m_ItemHeight
= idth - 32
= + m_ItemHeight
DrawGradientColor m_SelBackColor, m_SelBackColor, selRect, False,
1
End If
= 1 '绘制行文字
= (cut * m_ItemHeight) / erPixelY
= idth - 16
= + m_ItemHeight / erPixelY
lor = m_List(cut).FontColor
sDrawText sBack, m_List(cut).Text, vbLeftJustify
Next cut
Else
e = True ' 加载滚动条
lor = &HE0E0E0
= 16
= eight - 32
= idth - - 16
m_SollbarValueMax = m_ListCount - m_Page
DrawSollbar m_SollbarValueMax, m_SollbarValue
If (m_CurIndex + m_Page) > m_ListCount Then
m_Count = m_ListCount
Else
m_Count = m_CurIndex + m_Page
End If
For cut = m_CurIndex To m_Count - 1
If cut = m_ListIndex Then
= 16
= cut * m_ItemHeight - m_CurIndex * m_ItemHeight
= idth - 32
= + m_ItemHeight
DrawGradientColor m_SelBackColor, m_SelBackColor, selRect,
False, 1
End If
= 1
= (cut * m_ItemHeight) / erPixelY -
m_CurIndex * (m_ItemHeight / erPixelY)
= idth - 16
= + m_ItemHeight / erPixelY
lor = m_List(cut).FontColor
sDrawText sBack, m_List(cut).Text, vbLeftJustify
Next cut
End If
End Sub
'行高
Public Property Get ItemHeight() As Integer
ItemHeight = m_ItemHeight
End Property
Public Property Let ItemHeight(ByVal vNewValue As Integer)
If vNewValue < 255 Then
vNewValue = 255
End If
m_ItemHeight = vNewValue
PropertyChanged "ItemHeight"
DrawListBox
End Property
Public Property Get Grid() As Boolean
Grid = m_Grid
End Property
Public Property Let Grid(ByVal vNewValue As Boolean)
m_Grid = vNewValue
PropertyChanged "Grid"
DrawListBox
End Property
Public Property Get ListIndex() As Long
ListIndex = m_ListIndex
End Property
Public Property Let ListIndex(ByVal vNewValue As Long)
m_ListIndex = vNewValue
PropertyChanged "ListIndex"
DrawListBox
End Property
Public Property Get ListCount() As Long
ListCount = m_ListCount
End Property
Public Property Get CurIndex() As Long
CurIndex = m_CurIndex
End Property
'边框颜色
Public Property Get BorderColor() As OLE_COLOR
BorderColor = m_BorderColor
End Property
Public Property Let BorderColor(ByVal vNewValue As OLE_COLOR)
m_BorderColor = vNewValue
PropertyChanged "BorderColor"
DrawListBox
End Property
'背景
Public Property Get BackColor() As OLE_COLOR
BackColor = lor
End Property
Public Property Let BackColor(ByVal vNewValue As OLE_COLOR)
lor = vNewValue
PropertyChanged "BackColor"
DrawListBox
End Property
'List数据
Public Property Get List(ByVal Index As Long) As String
List = m_List(Index).Text
End Property
Public Property Let List(ByVal Index As Long, ByVal vNewValue As String)
m_List(Index).Text = vNewValue
PropertyChanged "List"
'DrawListBox 为了提高速度，这段不建议在里面使用，
End Property
Public Property Get ItemFontColor(ByVal Index As Long) As Long
ItemFontColor = m_List(Index).FontColor
End Property
Public Property Let ItemFontColor(ByVal Index As Long, ByVal vNewValue As
Long)
m_List(Index).FontColor = vNewValue
PropertyChanged "ItemFontColor"
'DrawListBox 为了提高速度，这段不建议在里面使用，
End Property
Public Property Get ForeColor() As OLE_COLOR
ForeColor = lor
End Property
Public Property Let ForeColor(ByVal vNewValue As OLE_COLOR)
lor = vNewValue
PropertyChanged "ForeColor"
End Property
Public Property Get SelColor() As OLE_COLOR
SelColor = m_SelBackColor
End Property
Public Property Let SelColor(ByVal vNewValue As OLE_COLOR)
m_SelBackColor = vNewValue
PropertyChanged "SelColor"
End Property
Public Property Get Stretch() As Boolean
Stretch = m_Stretch
End Property
Public Property Let Stretch(ByVal vNewValue As Boolean)
m_Stretch = vNewValue
PropertyChanged "Stretch"
DrawListBox
End Property
'图片
Public Property Get Picture() As StdPicture
Set Picture = m_pic
End Property
Public Property Let Picture(ByVal vNewValue As StdPicture)
'
End Property
Public Property Set Picture(ByVal vNewValue As StdPicture)
Set m_pic = vNewValue
PropertyChanged "Picture"
DrawListBox
End Property
Private Sub Timer1_Timer()
If ret = -1 Then
If m_SollbarValue <= 0 Then Exit Sub
m_SollbarValue = m_SollbarValue - 1
ElseIf ret = -2 Then
If m_SollbarValue >= m_SollbarValueMax Then Exit Sub
m_SollbarValue = m_SollbarValue + 1
End If
DrawSollbar m_SollbarValueMax, m_SollbarValue
m_CurIndex = m_SollbarValue
DrawListBox
End Sub
Private Sub UserControl_Initialize()
m_BorderColor = &H8000000A
lor = vbWhite
lor = 0
m_SelBackColor = &HFFC0C0
m_Stretch = False
Set m_pic = Nothing
m_ItemHeight = 255
m_ListCount = 0
m_ListIndex = -1
m_SollbarValue = 0
m_SollbarValueMax = 0
m_CurIndex = 0
m_Grid = True
Erase m_List
End Sub
Public Sub Clear()
m_ListCount = 0
m_ListIndex = -1
m_SollbarValue = 0
m_SollbarValueMax = 0
m_CurIndex = 0
e = False
Erase m_List
End Sub
Public Sub RemoveItem(ByVal Index As Long)
Dim cut As Long
If Index = -1 Then Exit Sub
If m_ListCount = 1 Then: Clear: Exit Sub
If Index = UBound(m_List) Then
ReDim Preserve m_List(UBound(m_List) - 1) As ListItems
m_ListCount = UBound(m_List) + 1
m_ListIndex = -1
Exit Sub
End If
For cut = 0 To UBound(m_List)
If cut > Index Then
m_List(cut - 1) = m_List(cut)
Else
m_List(cut) = m_List(cut)
End If
Next cut
ReDim Preserve m_List(UBound(m_List) - 1) As ListItems
m_ListCount = UBound(m_List) + 1
m_ListIndex = -1
End Sub
Private Sub UserControl_Resize()
DrawListBox
End Sub
Private Sub UserControl_Show()
DrawListBox
End Sub
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
m_ItemHeight = operty("ItemHeight", m_ItemHeight)
m_Grid = operty("Grid", m_Grid)
m_ListIndex = operty("ListIndex", m_ListIndex)
m_BorderColor = operty("BorderColor", m_BorderColor)
lor
lor)
= operty("BackColor",
lor
lor)
= operty("ForeColor",
m_SelBackColor = operty("SelColor", m_SelBackColor)
m_Stretch = operty("Stretch", m_Stretch)
Set m_pic = operty("Picture", m_pic)
End Sub
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
roperty "ItemHeight", m_ItemHeight, m_ItemHeight
roperty "Grid", m_Grid
roperty "ListIndex", m_ListIndex
roperty "BorderColor", &H8000000A
roperty "BackColor", lor
roperty "ForeColor", lor
roperty "SelColor", m_SelBackColor
roperty "Stretch", m_Stretch
roperty "Picture", m_pic, Nothing
End Sub
发布评论