请问如何举一反三使用如下VB帖子

chenlifeng168 2018-07-20 10:21:10
已知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

...全文
544 8 打赏 收藏 转发到动态 举报
写回复
用AI写文章
8 条回复
切换为时间正序
请发表友善的回复…
发表回复
舉杯邀明月 2018-07-25
  • 打赏
  • 举报
 回复
要“改”其实并没什么难度，只是费事…………


另外就是很多具体的东西，要如何改，跟“具体需求细节”相关的，
　并不是说，你描述个“大概功能”，别人就能写出一个完全合乎你的心意的东西出来。
chenlifeng168 2018-07-21
  • 打赏
  • 举报
 回复
感谢老师的热心指点。我按您的意思去学习了解一下activebar，第一次听说过它。不过抛开这一点回到具体问题和技术，我倒是想学一下。
threenewbee 2018-07-21
  • 打赏
  • 举报
 回复
完全没有必要自己做，颜色选取，这个在activebar就有了。ab中包含了全套的模仿office的控件
chenlifeng168 2018-07-20
  • 打赏
  • 举报
 回复
嗯，您说得没错。只是我是在Class_Initialize()过程修改了不同的项目数据的，但一运行起来，结果又变成相同了。我还更改了相关数据为数组，但不是出错，就是没有用。
昨天及今晨忙碌了很久，发现怎么也解决不了，除非是另建一个不同名的类模块。故此有一问。
舉杯邀明月 2018-07-20
  • 打赏
  • 举报
 回复
每个“对象”在Class_Initialize()过程中，都给它赋予了相同的项目数据，当然会“每个都相同”啊。


你如果增加一些接口，比如删除项目的、增加项目的、更改项目的，等等。
当你对某个“对象的数据项”进行了修改后，它自然就与其它不同了。
chenlifeng168 2018-07-20
  • 打赏
  • 举报
 回复
您说得对，是我没把握好处理问题的精髓。那么我冒昧请教：我具体应该如何做呢，感谢赐教~
舉杯邀明月 2018-07-20
  • 打赏
  • 举报
 回复

你只用Class_Initialize()来设置数据，那当然所有对象的数据都一样啊。
C#精髓 第四讲 GridView 72般绝技
说明：准备出一个系列，所谓精髓讲C#语言要点。这个系列没有先后顺序，不过尽量做到精。可能会不断增删整理，本系列最原始出处是csdn博客,谢谢关注。C#精髓第四讲 GridView 72般绝技作者：清清月儿 主页：http://blog.csdn.net/21aspnet/           时间：2007.3.24-26为了写本文，又搭工又搭料，累的2天2宿没睡觉，这篇文章实在是耗费我太多的心血
在Excel中应用VBA批量导入数据
在Excel中应用VBA批量导入数据  马维峰 1.       问题由来当一个漂亮MM向你请教如何录制并修改一个宏，把她每次的实验数据（几十个数据文件）导入Excel时，你感慨道：“很多Excel专家会录制一个宏来解决问题，然后每次使用的时候修改代码并粘贴到需要的地方，对于一个合格的程序员，这是最要命的事情。” 漂亮MM打断并告诉你，她不是程序员，也不想做程序员，然后
一年成为Emacs高手(像神一样使用编辑器)
简介 成为高手很容易.当初我在Vi阵营,偶尔用Emacs还忘记"退出"的快捷键,一年后我跨入高手行列. 很多文章强调Emacs有多牛,但关于"如何做"则语焉不详.即使涉及到"如何做",谈细节多而方法论少,所以本文就侧重方法论. 全文结构如下: 为什么Emacs值得学习,如对开源文化熟悉可跳过这一章 态度很重要 本文最核心观点,要充分利用高手成果,不要重新发明轮子 尽快掌...
嵌入式 一年成为Emacs高手(像神一样使用编辑器)
1 简介 成为高手很容易.刚开始我在Vi阵营,偶尔用Emacs还忘记"退出"的快捷键,但一年后我跨入高手行列. 很多文章都是强调 Emacs 有多牛,以激发你的兴趣.最有名是王垠的Emacs 是一种信仰！世界最强编辑器介绍. 但关于"如何做"则语焉不详,即使涉及到"如何做",谈细节多而方法论少,所以本文就是侧重方法论. 全文结构如下: 首先介绍为什么Emacs值得学习,如果你
【正点原子STM32连载】第一章 本书学习方法 摘自【正点原子】MiniPro STM32H750 开发指南_V1.1
1）实验平台正点原子MiniProH750开发板4）对正点原子STM32感兴趣的同学可以加群讨论879133275。
COM/DCOM/COM+

863

社区成员

3,659

社区内容

发帖
与我相关
我的任务
社区描述
VB COM/DCOM/COM+
c++ 技术论坛（原bbs）
社区管理员
  • COM/DCOM/COM+社区
加入社区
  • 近7日
  • 近30日
  • 至今

加载中

查看更多榜单
社区公告
暂无公告

试试用AI创作助手写篇文章吧

+ 用AI写文章