已知VB實作Combox下拉串列顏色選擇控制元件的帖子：http://www.newxing.com/Code/VB/jiemian/Combox_533.html（原始碼粘貼在下面），目的是： 在主表單上實作自繪combox，并且可進行下拉串列顏色選取。
其特點是，不論我們在主表單自繪幾個combox，每個combox里面的下拉框選項都是完全相同的。
現在我 想：自繪兩個或多個combox，里面的下拉框內容各不同，該怎么修改程式代碼呢？
敬謝~！下面是網站鏈接的類模塊代碼：
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "ColorCombox"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'Download by http://www.NewXing.com
Option Explicit
Private Type VasmColorComBoxConst
ColorHDC As Long
ColorName As String
ColorRGB As Long
End Type
Private Type ThisClassSet
DefaultColor(0 To 17) As VasmColorComBoxConst
n_hWnd As Long
n_DefaultProc As Long
n_CID As Long
n_hBurshNor As Long
n_hBurshSel As Long
End Type
Dim PG As ThisClassSet
Dim LinkProc() As Long
Event ItemClick(ByVal RGBColor As Long)
Private Sub MsgHook(Result As Long, ByVal cHwnd As Long, ByVal Message As Long, ByVal wParam As Long, ByVal lParam As Long)
Dim Dit As DRAWITEMSTRUCT
Dim i As Long
Dim txtColor As Long
Dim hBrush As Long
Dim Rct As RECT
If (Message = WM_DRAWITEM) And (wParam = PG.n_CID) Then
CopyMemory Dit, ByVal lParam&, LenB(Dit)
If Dit.itemID = -1 Then Exit Sub
i = ((Dit.rcItem.bottom - Dit.rcItem.Top - 12) \ 2) + Dit.rcItem.Top
Select Case Dit.itemState
Case 1, 16, 17, 4113: hBrush = PG.n_hBurshSel: txtColor = GetSysColor(COLOR_HIGHLIGHTTEXT)
Case Else: hBrush = PG.n_hBurshNor: txtColor = 0
End Select
' Debug.Print Dit.itemID, Dit.itemState, Timer
SetBkMode Dit.hDC, 0&
FillRect Dit.hDC, Dit.rcItem, hBrush
BitBlt Dit.hDC, Dit.rcItem.Left + 2, i, 25, 12, PG.DefaultColor(Dit.itemID).ColorHDC, 0, 0, SRCCOPY
Dit.rcItem.Left = Dit.rcItem.Left + 30
SetTextColor Dit.hDC, txtColor&
DrawText Dit.hDC, PG.DefaultColor(Dit.itemID).ColorName, -1&, Dit.rcItem, DT_SINGLELINE Or DT_VCENTER
Exit Sub
End If
Result = CallWindowProc(ByVal PG.n_DefaultProc&, ByVal cHwnd, ByVal Message, ByVal wParam&, ByVal lParam&)
If Message = WM_COMMAND And lParam = PG.n_hWnd Then
i = ItemSelected
Dim ps As POINTS
CopyMemory ps, wParam&, 4&
If ps.y = CBN_SELCHANGE Then
If i = 1 Then
PG.DefaultColor(1).ColorRGB = UserGetColor(PG.n_hWnd, PG.DefaultColor(1).ColorRGB)
DrawColorLabel PG.DefaultColor(1).ColorHDC, PG.DefaultColor(1).ColorRGB
UpdateWindow cHwnd
End If
RaiseEvent ItemClick(PG.DefaultColor(i).ColorRGB)
End If
End If
End Sub
Function CreateColorComboBox(hWndParent As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, Optional ByVal cID As Long) As Long
'CBS_OWNERDRAWVARIABLE Or
Dim cHwnd As Long
cHwnd = CreateWindowEx(0&, "ComboBox", vbNullString, WS_CHILD Or WS_TABSTOP Or WS_VISIBLE Or WS_VSCROLL Or CBS_OWNERDRAWFIXED Or CBS_DROPDOWNLIST Or CBS_HASSTRINGS Or CBS_AUTOHSCROLL, X1, Y1, X2, 180&, hWndParent, cID&, App.hInstance, ByVal 0&)
If cHwnd Then
SendMessage cHwnd, WM_SETFONT, ByVal SendMessage(hWndParent, WM_GETFONT, ByVal 0&, ByVal 0&), ByVal 0&
Dim i As Long
For i = 17 To 0 Step -1
SendMessageStr cHwnd, CB_ADDSTRING, ByVal 0&, PG.DefaultColor(i).ColorName
Next
PG.n_CID = cID
PG.n_hWnd = cHwnd
PG.n_DefaultProc = SetWindowLong(hWndParent, ByVal GWL_WNDPROC, ByVal GetWndProcAddress(11))
ColorSelected = PG.DefaultColor(1).ColorRGB
End If
End Function
Public Property Get ItemSelected() As Long
ItemSelected = SendMessage(PG.n_hWnd, ByVal CB_GETCURSEL, ByVal 0&, ByVal 0&)
End Property
Public Property Let ItemSelected(ByVal vNewValue As Long)
SendMessage PG.n_hWnd, ByVal CB_SETCURSEL, ByVal vNewValue&, ByVal 0&
End Property
Public Property Get ColorSelected() As Long
Dim i As Long
i = SendMessage(PG.n_hWnd, ByVal CB_GETCURSEL, ByVal 0&, ByVal 0&)
ColorSelected = PG.DefaultColor(i).ColorRGB
End Property
Public Property Let ColorSelected(ByVal vNewValue As Long)
Dim i As Long
For i = 17 To 0 Step -1
If i <> 1 Then If PG.DefaultColor(i).ColorRGB = vNewValue Then GoTo l1
Next
i = 1
l1:
If i = 1 Then DrawColorLabel PG.DefaultColor(1).ColorHDC, vNewValue: i = 1: PG.DefaultColor(1).ColorRGB = vNewValue
SendMessage PG.n_hWnd, ByVal CB_SETCURSEL, ByVal i&, ByVal 0&
End Property
Public Property Get ColorCustom() As Long
ColorCustom = PG.DefaultColor(1).ColorRGB
End Property
Public Property Let ColorCustom(ByVal vNewValue As Long)
PG.DefaultColor(1).ColorRGB = vNewValue
DrawColorLabel PG.DefaultColor(1).ColorHDC, vNewValue
End Property
Public Property Get ID() As Long
ID = PG.n_CID
End Property
Public Property Get ColorDefault() As Long
ColorCustom = PG.DefaultColor(0).ColorRGB
End Property
Public Property Let ColorDefault(ByVal vNewValue As Long)
PG.DefaultColor(0).ColorRGB = vNewValue
DrawColorLabel PG.DefaultColor(0).ColorHDC, vNewValue
End Property
Private Sub DrawColorLabel(ColorHDC As Long, RGB_Color As Long)
Dim hBrush As Long, hBrush1 As Long
Dim Rct As RECT
SetRect Rct, 0&, 0&, 25&, 12&
hBrush1 = CreateSolidBrush(0&)
hBrush = CreateSolidBrush(RGB_Color&)
FillRect ColorHDC, Rct, hBrush
FrameRect ColorHDC, Rct, hBrush1
DeleteObject hBrush
DeleteObject hBrush1
End Sub
Private Function UserGetColor(ByVal hwndOwner As Long, ByVal ColorInit As Long) As Long
Dim Tcc As TCHOOSECOLOR
Dim Colors(16) As Long
With Tcc
.hInstance = App.hInstance
.hwndOwner = hwndOwner
.lStructSize = LenB(Tcc)
.rgbResult = ColorInit
.flags = CC_RGBINIT Or CC_FULLOPEN
.lpCustColors = VarPtr(Colors(0))
End With
ChooseColor Tcc
UserGetColor = Tcc.rgbResult
End Function
Private Function GetWndProcAddress(ByVal SinceCount As Long) As Long
' 地址指標 ＝ GetWndProcAddress( 取第 N 個公共函式（屬性） =或= 所有公共函式個數 + 第 N 個私有函式的函式地址）
Dim mePtr As Long
Dim jmpAddress As Long
mePtr = ObjPtr(Me)
CopyMemory jmpAddress, ByVal mePtr, 4
CopyMemory jmpAddress, ByVal jmpAddress + (SinceCount - 1) * 4 + &H1C, 4
ReDim LinkProc(10)
LinkProc(0) = &H83EC8B55
LinkProc(1) = &HFC8B14EC
LinkProc(2) = &H56FC758D
LinkProc(3) = &H3308758D
LinkProc(4) = &HFC04B1C9
LinkProc(5) = &HFF68A5F3
LinkProc(6) = &HB8FFFFFF
LinkProc(7) = &HFFFFFFFF
LinkProc(8) = &H48BD0FF
LinkProc(9) = &H10C2C924
CopyMemory ByVal VarPtr(LinkProc(5)) + 3, mePtr, 4
CopyMemory ByVal VarPtr(LinkProc(7)), jmpAddress, 4
GetWndProcAddress = VarPtr(LinkProc(0))
VirtualProtect ByVal VarPtr(LinkProc(0)), 44&, &H40, mePtr
End Function
Private Sub Class_Initialize()
PG.DefaultColor(2).ColorName = "黑色": PG.DefaultColor(2).ColorRGB = 0&
PG.DefaultColor(3).ColorName = "深紅色": PG.DefaultColor(3).ColorRGB = &H80& ' &H800000
PG.DefaultColor(4).ColorName = "綠色": PG.DefaultColor(4).ColorRGB = &H8000&
PG.DefaultColor(5).ColorName = "橄欖色": PG.DefaultColor(5).ColorRGB = &H8080& '
PG.DefaultColor(6).ColorName = "藏青色": PG.DefaultColor(6).ColorRGB = &H800000 ' &H80&
PG.DefaultColor(7).ColorName = "紫色": PG.DefaultColor(7).ColorRGB = &H800080
PG.DefaultColor(8).ColorName = "綠藍": PG.DefaultColor(8).ColorRGB = &H808000 '&H8080&
PG.DefaultColor(9).ColorName = "灰色": PG.DefaultColor(9).ColorRGB = &H808080
PG.DefaultColor(10).ColorName = "銀白": PG.DefaultColor(10).ColorRGB = &HC0C0C0
PG.DefaultColor(11).ColorName = "紅色": PG.DefaultColor(11).ColorRGB = &HFF&
PG.DefaultColor(12).ColorName = "亮綠色": PG.DefaultColor(12).ColorRGB = &HFF00&
PG.DefaultColor(13).ColorName = "黃色": PG.DefaultColor(13).ColorRGB = &HFFFF&
PG.DefaultColor(14).ColorName = "藍色": PG.DefaultColor(14).ColorRGB = &HFF0000
PG.DefaultColor(15).ColorName = "紫紅色": PG.DefaultColor(15).ColorRGB = &HFF00FF
PG.DefaultColor(16).ColorName = "蘭色": PG.DefaultColor(16).ColorRGB = &HFFFF00
PG.DefaultColor(17).ColorName = "白色": PG.DefaultColor(17).ColorRGB = &HFFFFFF
PG.DefaultColor(0).ColorName = "默認"
PG.DefaultColor(1).ColorName = "自定義"
Dim nHDC As Long, hBitmap As Long, hBursh As Long
Dim i As Long, Rct As RECT
Dim hBrush1 As Long
nHDC = GetDC(0&)
SetRect Rct, 0&, 0&, 25&, 12&
hBrush1 = CreateSolidBrush(0&)
For i = 2 To 17
PG.DefaultColor(i).ColorHDC = CreateCompatibleDC(nHDC)
hBitmap = CreateCompatibleBitmap(nHDC, 25&, 12&)
SelectObject PG.DefaultColor(i).ColorHDC, hBitmap
DeleteObject hBitmap
hBursh = CreateSolidBrush(PG.DefaultColor(i).ColorRGB)
FillRect PG.DefaultColor(i).ColorHDC, Rct, hBursh
FrameRect PG.DefaultColor(i).ColorHDC, Rct, hBrush1
DeleteObject ByVal hBursh
Next
PG.DefaultColor(0).ColorHDC = CreateCompatibleDC(nHDC)
hBitmap = CreateCompatibleBitmap(nHDC, 25&, 12&)
SelectObject PG.DefaultColor(0).ColorHDC, hBitmap
DeleteObject hBitmap
PG.DefaultColor(1).ColorHDC = CreateCompatibleDC(nHDC)
hBitmap = CreateCompatibleBitmap(nHDC, 25&, 12&)
SelectObject PG.DefaultColor(1).ColorHDC, hBitmap
DeleteObject hBitmap
DeleteObject hBrush1
ReleaseDC 0&, nHDC
PG.n_hBurshNor = CreateSolidBrush(&HFFFFFF)
PG.n_hBurshSel = GetSysColorBrush(COLOR_HIGHLIGHT)
End Sub
Private Sub Class_Terminate()
DestroyWindow PG.n_hWn
uj5u.com熱心網友回復：
每個“物件”在Class_Initialize()程序中，都給它賦予了相同的專案資料，當然會“每個都相同”啊。
你如果增加一些介面，比如洗掉專案的、增加專案的、更改專案的，等等。
當你對某個“物件的資料項”進行了修改后，它自然就與其它不同了。
uj5u.com熱心網友回復：
嗯，您說得沒錯。只是我是在Class_Initialize()程序修改了不同的專案資料的，但一運行起來，結果又變成相同了。我還更改了相關資料為陣列，但不是出錯，就是沒有用。昨天及今晨忙碌了很久，發現怎么也解決不了，除非是另建一個不同名的類模塊。故此有一問。
uj5u.com熱心網友回復：
你只用Class_Initialize()來設定資料，那當然所有物件的資料都一樣啊。
uj5u.com熱心網友回復：
您說得對，是我沒把握好處理問題的精髓。那么我冒昧請教：我具體應該如何做呢，感謝賜教~
uj5u.com熱心網友回復：
完全沒有必要自己做，顏色選取，這個在activebar就有了。ab中包含了全套的模仿office的控制元件uj5u.com熱心網友回復：
感謝老師的熱心指點。我按您的意思去學習了解一下activebar，第一次聽說過它。不過拋開這一點回到具體問題和技術，我倒是想學一下。uj5u.com熱心網友回復：
要“改”其實并沒什么難度，只是費事…………
另外就是很多具體的東西，要如何改，跟“具體需求細節”相關的，
并不是說，你描述個“大概功能”，別人就能寫出一個完全合乎你的心意的東西出來。
轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/43609.html