Results 1 to 7 of 7

Cool MultiColoured ListBox !!

This is a discussion on Cool MultiColoured ListBox !! within the Excel Questions forums, part of the Question Forums category; Greetings, Download workbook demo Ok, this is a raw experiment and needs some more tweaking .The main issue is if ...

  1. #1
    Board Regular Jaafar Tribak's Avatar
    Join Date
    Dec 2002
    Location
    Larache--Morocco
    Posts
    4,965

    Default Cool MultiColoured ListBox !!

    Greetings,

    Download workbook demo

    Ok, this is a raw experiment and needs some more tweaking .The main issue is if the Listbox has a scrollbar ,the painting will not fit exactly as it should. This is because the listbox scrollbar has no hwnd so it's very difficult to manipulate it.


    Proceedings :

    Embeed a listbox in sheets(1), populate it with some items and make it large enough so as not to display a scrollbar(see above).


    * Code in Standard Module (Main)

    Code:
     
    Option Base 1
    Option Explicit
     
    Public Type RGB
        R As Byte
        G As Byte
        B As Byte
    End Type
     
    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 Declare Function GetWindowRect Lib "user32" _
    (ByVal hwnd As Long, _
    lpRect As RECT) As Long
     
    Private Type TEXTMETRIC
        tmHeight As Long
        tmAscent As Long
        tmDescent As Long
        tmInternalLeading As Long
        tmExternalLeading As Long
        tmAveCharWidth As Long
        tmMaxCharWidth As Long
        tmWeight As Long
        tmOverhang As Long
        tmDigitizedAspectX As Long
        tmDigitizedAspectY As Long
        tmFirstChar As Byte
        tmLastChar As Byte
        tmDefaultChar As Byte
        tmBreakChar As Byte
        tmItalic As Byte
        tmUnderlined As Byte
        tmStruckOut As Byte
        tmPitchAndFamily As Byte
        tmCharSet As Byte
    End Type
     
    Private Const MM_TEXT = 1
     
    Private Declare Function GetTextMetrics Lib "gdi32" _
    Alias "GetTextMetricsA" (ByVal hdc As Long, _
    lpMetrics As TEXTMETRIC) As Long
     
    Private Declare Function SetMapMode Lib "gdi32" _
    (ByVal hdc As Long, _
    ByVal nMapMode As Long) As Long
     
    Private Declare Function FindWindow Lib "user32" _
    Alias "FindWindowA" _
    (ByVal lpClassName As String, _
    ByVal lpWindowName As String) As Long
    
    Private Declare Function FindWindowEx Lib "user32" _
    Alias "FindWindowExA" _
    (ByVal hWnd1 As Long, _
    ByVal hWnd2 As Long, _
    ByVal lpsz1 As String, _
    ByVal lpsz2 As String) As Long
    
    Private Type SAFEARRAYBOUND
        cElements As Long
        lLbound As Long
    End Type
    
    Private Type SAFEARRAY2D
        cDims As Integer
        fFeatures As Integer
        cbElements As Long
        cLocks As Long
        pvData As Long
        Bounds(0 To 1) As SAFEARRAYBOUND
    End Type
     
    Private Declare Function VarPtrArray Lib "msvbvm50.dll" _
    Alias "VarPtr" (Ptr() As Any) As Long
     
    Private Type BLENDFUNCTION
        BlendOp As Byte
        BlendFlags As Byte
        SourceConstantAlpha As Byte
        AlphaFormat As Byte
    End Type
     
    Private Const AC_SRC_OVER = &H0
    
    Private Declare Function AlphaBlend Lib "msimg32.dll" _
    (ByVal hdc As Long, _
    ByVal lInt As Long, _
    ByVal lInt As Long, _
    ByVal lInt As Long, _
    ByVal lInt As Long, _
    ByVal hdc As Long, _
    ByVal lInt As Long, _
    ByVal lInt As Long, _
    ByVal lInt As Long, _
    ByVal lInt As Long, _
    ByVal BLENDFUNCT As Long) As Long
    
    Private Type MemoryBitmap
        hdc As Long
        hBM As Long
        oldhDC As Long
        lft As Long
        tp As Long
        wid As Long
        hgt As Long
    End Type
    
    Private Const LOGPIXELSX As Long = 88
    Private Const LOGPIXELSY As Long = 90
    Private Const PointsPerInch = 72
    
    Private Declare Function GetDeviceCaps Lib "gdi32" _
    (ByVal hdc As Long, _
    ByVal nIndex As Long) As Long
     
    Private Declare Function GetDC Lib "user32" _
    (ByVal hwnd As Long) As Long
     
    Private Declare Function CreateCompatibleDC Lib "gdi32" _
    (ByVal hdc As Long) As Long
     
    Private Declare Function ReleaseDC Lib "user32" _
    (ByVal hwnd As Long, _
    ByVal hdc As Long) As Long
    
    Private Declare Function SelectObject Lib "gdi32" _
    (ByVal hdc As Long, _
    ByVal hObject As Long) As Long
     
    Private Declare Function DeleteObject Lib "gdi32" _
    (ByVal hObject As Long) As Long
    
    Private Declare Sub CopyMemory Lib "kernel32" _
    Alias "RtlMoveMemory" _
    (Destination As Any, _
    Source As Any, ByVal Length As Long)
    
    Private Const GWL_WNDPROC = -4
     
    Private Declare Function CallWindowProc Lib "user32" _
    Alias "CallWindowProcA" _
    (ByVal lpPrevWndFunc As Long, _
    ByVal hwnd As Long, _
    ByVal MSG As Long, _
    ByVal wParam As Long, _
    ByVal lParam As Long) As Long
     
    Private Declare Function SetWindowLong Lib "user32" _
    Alias "SetWindowLongA" _
    (ByVal hwnd As Long, _
    ByVal nIndex As Long, _
    ByVal dwNewLong As Long) As Long
     
    Private Const WM_WINDOWPOSCHANGED As Long = &H47
    Private Const WM_MOUSEACTIVATE As Long = &H21
    Private Const WM_PAINT As Long = &HF
     
    Private Declare Function BitBlt Lib "gdi32" _
    (ByVal hDestDC As Long, _
    ByVal X As Long, _
    ByVal Y As Long, _
    ByVal nWidth As Long, _
    ByVal nHeight As Long, _
    ByVal hSrcDC As Long, _
    ByVal xSrc As Long, _
    ByVal ySrc As Long, _
    ByVal dwRop As Long) As Long
     
    Private Const SRCCOPY As Long = &HCC0020
    
    Private Type BITMAPINFOHEADER '40 bytes
        biSize As Long
        biWidth As Long
        biHeight As Long
        biPlanes As Integer
        biBitCount As Integer
        biCompression As Long
        biSizeImage As Long
        biXPelsPerMeter As Long
        biYPelsPerMeter As Long
        biClrUsed As Long
        biClrImportant As Long
    End Type
     
    Private Type RGBQUAD
        rgbBlue As Byte
        rgbGreen As Byte
        rgbRed As Byte
        rgbReserved As Byte
        End Type
        Private Type BITMAPINFO
        bmiHeader As BITMAPINFOHEADER
        bmiColors As RGBQUAD
    End Type
     
    Private Const BI_RGB As Long = 0&
    
    Private Const DIB_RGB_COLORS As Long = 0
     
    Private Declare Function CreateDIBSection Lib "gdi32" _
    (ByVal hdc As Long, _
    pBitmapInfo As BITMAPINFO, _
    ByVal un As Long, _
    lplpVoid As Long, _
    ByVal handle As Long, _
    ByVal dw As Long) As Long
     
    Private Declare Function CreateCompatibleBitmap Lib "gdi32" _
    (ByVal hdc As Long, _
    ByVal nWidth As Long, _
    ByVal nHeight As Long) As Long
     
    Private Declare Function GetWindowDC Lib "user32" _
    (ByVal hwnd As Long) As Long
    
    Private Declare Function UpdateWindow Lib "user32" _
    (ByVal hwnd As Long) As Long
    
    Private Declare Function InvalidateRect Lib "user32" _
    (ByVal hwnd As Long, _
    lpRect As Long, _
    ByVal bErase As Long) As Long
     
    Private Declare Function SendMessage Lib "user32" _
    Alias "SendMessageA" _
    (ByVal hwnd As Long, _
    ByVal MSG As Long, _
    wParam As Any, _
    lParam As Any) As Long
     
    Public g_lListBoxChildhwnd As Long
    Public g_lLbHook As Long '--handle for subclass.
    Public g_lMemSnapShot As Long
    Private g_oListBox As OLEObject
    Private g_lListBoxParenthwnd As Long
    Private oClistBox As ClistBox
    
    Private Function GetListBoxhwnd() As Long
    
        Dim lXLAPPhwnd As Long, lXLDESKhwnd As Long, lEXCEL7hwnd As Long
        
            lXLAPPhwnd = FindWindow("XLMAIN", Application.Caption)
            lXLDESKhwnd = FindWindowEx _
            (lXLAPPhwnd, ByVal 0&, "XLDESK", vbNullString)
            lEXCEL7hwnd = FindWindowEx _
            (lXLDESKhwnd, ByVal 0&, "EXCEL7", vbNullString)
            g_lListBoxParenthwnd = FindWindowEx _
            (lEXCEL7hwnd, ByVal 0&, "F3 Server 60000000", vbNullString)
            g_lListBoxChildhwnd = FindWindowEx _
            (g_lListBoxParenthwnd, ByVal 0&, "F3 Server 60000000", vbNullString)
        
        If g_lListBoxParenthwnd Then
            GetListBoxhwnd = g_lListBoxParenthwnd
        End If
    
    End Function
     
    Private Function GetListBoxRect(ListBox As OLEObject) As RECT
     
        Const PointsPerInch As Long = 72
        Dim hdc As Long
        Dim lDevCapsX As Double
        Dim lDevCapsY As Double
        Dim lCurZoom As Double
        Dim tRect As RECT
        Dim tRect2 As RECT
        Dim ListBoxWidth
        Dim lhdc As Long
        
        lhdc = GetWindowDC(g_lListBoxParenthwnd)
        lCurZoom = (ActiveWindow.Zoom / 100)
        lDevCapsX = _
        (GetDeviceCaps(lhdc, LOGPIXELSX) / PointsPerInch * lCurZoom)
        lDevCapsY = _
        (GetDeviceCaps(lhdc, LOGPIXELSY) / PointsPerInch * lCurZoom)
        With ActiveWindow
            tRect.Left = _
            .PointsToScreenPixelsX((ListBox.Left) * lDevCapsX)
            tRect.Top = _
            .PointsToScreenPixelsY(ListBox.Top * lDevCapsY)
            tRect.Right = _
            .PointsToScreenPixelsX _
            ((ListBox.Left + ListBox.Width) * lDevCapsX)
            tRect.Bottom = _
            .PointsToScreenPixelsY _
            ((ListBox.Top + ListBox.Height) * lDevCapsY)
        End With
        ReleaseDC g_lListBoxParenthwnd, lhdc
        
        GetListBoxRect = tRect
     
    End Function
    
    Private Function MakeMemoryBitmap(ByVal wid As Long, ByVal _
    hgt As Long, color As RGB) As MemoryBitmap
     
        Dim bDib() As Byte
        Dim X As Long, Y As Long
        Dim xMax As Long, yMax As Long
        Dim lB As Long, lG As Long, lR As Long
        Dim lA As Long, lA2 As Long
        Dim lTIme As Long
        Dim tSA As SAFEARRAY2D
        Dim result As MemoryBitmap
        Dim iDC As Long
        Dim iBitmap As Long
        Dim m_lPtr As Long
        
        
        Dim bi24BitInfo As BITMAPINFO, bBytes() As Byte, Cnt As Long
        With bi24BitInfo.bmiHeader
            .biBitCount = 24
            .biCompression = BI_RGB
            .biPlanes = 1
            .biSize = Len(bi24BitInfo.bmiHeader)
            .biWidth = wid
            .biHeight = hgt
        End With
        
        ReDim bBytes _
        (1 To bi24BitInfo.bmiHeader.biWidth * bi24BitInfo.bmiHeader.biHeight * 3) As Byte
        iDC = CreateCompatibleDC(GetWindowDC(g_lListBoxParenthwnd))
        iBitmap = _
        CreateDIBSection(iDC, bi24BitInfo, DIB_RGB_COLORS, m_lPtr, ByVal 0&, ByVal 0&)
        SelectObject iDC, iBitmap
        
        ' Get the bits in the from DIB section:
        With tSA
            .cbElements = 1
            .cDims = 2
            .Bounds(0).lLbound = 0
            ' Height of the bitmap
            .Bounds(0).cElements = hgt  'bi24BitInfo.bmiHeader.biHeight
            .Bounds(1).lLbound = 0
            ' Width of the bitmap in bits (see earlier):
            .Bounds(1).cElements = _
            (bi24BitInfo.bmiHeader.biWidth * 3 + 3) And &HFFFFFFFC
            .pvData = m_lPtr
        End With
        
        ' Make the bDib() array point to the memory addresses:
        CopyMemory ByVal VarPtrArray(bDib), VarPtr(tSA), 4
        
        yMax = bi24BitInfo.bmiHeader.biHeight - 1
        xMax = bi24BitInfo.bmiHeader.biWidth - 1
        
        For X = 0 To (xMax * 3) Step 3
            For Y = 0 To yMax
                bDib(X, Y) = color.B
                bDib(X + 1, Y) = color.G
                bDib(X + 2, Y) = color.R
            Next Y
        Next X
        
        CopyMemory ByVal VarPtrArray(bDib), 0&, 4
        
        With result
            .hBM = iBitmap
            .hdc = iDC
            .wid = wid
            .hgt = hgt
            .oldhDC = SelectObject(.hdc, result.hBM)
        End With
        
        ReleaseDC g_lListBoxParenthwnd, iDC
       
        MakeMemoryBitmap = result
        
    End Function
     
    Private Sub Hook(hWnd1 As Long)  '--subclass Listbox.
     
        If (g_lLbHook = 0) Then
            g_lLbHook = SetWindowLong(hWnd1, GWL_WNDPROC, AddressOf WindowProc)
        End If
     
    End Sub
     
    Private Sub Unhook(hWnd1 As Long)
     
        Dim LRet As Long
        
        'Set the message handler back to the original
        If (g_lLbHook <> 0) Then
            LRet = SetWindowLong(hWnd1, GWL_WNDPROC, g_lLbHook)
            g_lLbHook = 0
        End If
     
    End Sub
    
    Private Function WindowProc _
    (ByVal hwnd As Long, ByVal uMsg As Long, _
    ByVal wParam As Long, ByVal lParam As Long) As Long
     
        Dim lhdc As Long
        
        On Error Resume Next
        
        Select Case uMsg
            Case WM_PAINT
                lhdc = GetDC(g_lListBoxChildhwnd)
                SendMessage g_lListBoxChildhwnd, WM_PAINT, lhdc, 0
                RefreshListBox g_lMemSnapShot, g_lListBoxChildhwnd
                ReleaseDC g_lListBoxChildhwnd, lhdc
            Case WM_MOUSEACTIVATE
                RefreshListBox g_lMemSnapShot, g_lListBoxChildhwnd
        End Select
        
        WindowProc = CallWindowProc(g_lLbHook, hwnd, uMsg, wParam, lParam)
     
    End Function
     
    Private Function GetMemSnapshot(hwnd As Long, tRect As RECT) As Long
     
        Dim lMemoryDC As Long
        Dim lhdc As Long
        Dim lbmp As Long
        
        lhdc = GetWindowDC(hwnd)
        
        With tRect
            lMemoryDC = CreateCompatibleDC(lhdc)
            lbmp = CreateCompatibleBitmap _
            (lhdc, .Right - .Left, .Bottom - .Top)
            SelectObject lMemoryDC, lbmp
            DeleteObject (lbmp)
            BitBlt lMemoryDC, 0, 0, .Right - .Left, _
            .Bottom - .Top, lhdc, 0, 0, SRCCOPY
        End With
        
        GetMemSnapshot = lMemoryDC
     
    End Function
     
    
    Private Function GetListBoxTextSize(hwnd As Long) As Long
     
        Dim hdc As Long
        Dim PrevMapMode As Long, tm As TEXTMETRIC
        
        hdc = GetWindowDC(hwnd)
        ' Set the mapping mode to pixels
        PrevMapMode = SetMapMode(hdc, MM_TEXT)
        ' Get the size of the system font
        GetTextMetrics hdc, tm
        ' Set the mapping mode back to what it was
        PrevMapMode = SetMapMode(hdc, PrevMapMode)
        
        ' Release the device context
        ReleaseDC hwnd, hdc
        
        GetListBoxTextSize = tm.tmHeight
     
    End Function
    
    Sub PaintListBoxItems(ListBox As OLEObject, ItemsColors() As RGB)
     
        Dim lRowHeight
        Dim tRect As RECT
        Dim memory_bitmap As MemoryBitmap
        Dim BF As BLENDFUNCTION, lBF As Long
        Dim lColorsItem As Long
        
        
        If (g_lLbHook = 0) Then
            Set g_oListBox = ListBox
            Set oClistBox = New ClistBox
            Set oClistBox.ListBox = ListBox.Object
            ListBox.Object.ListIndex = -1
            g_lListBoxParenthwnd = GetListBoxhwnd()
            lRowHeight = _
            (GetListBoxTextSize(g_lListBoxChildhwnd)) * (ActiveWindow.Zoom / 100)
            UpdateWindow g_lListBoxChildhwnd
            tRect = GetListBoxRect(ListBox)
            With BF
                .BlendOp = AC_SRC_OVER
                .BlendFlags = 0
                .SourceConstantAlpha = 100
                .AlphaFormat = 0
            End With
            CopyMemory lBF, BF, 4
            With tRect
                For lColorsItem = LBound(ItemsColors) To UBound(ItemsColors)
                    memory_bitmap = MakeMemoryBitmap _
                    (.Right - .Left, .Bottom - .Top, ItemsColors(lColorsItem))
                    AlphaBlend _
                    GetWindowDC(g_lListBoxParenthwnd), 3, _
                    (lRowHeight) * (lColorsItem - 1) + 3, .Right - .Left, lRowHeight, _
                    memory_bitmap.hdc, 0, 0, .Right - .Left, .Bottom - .Top, (lBF)
                Next lColorsItem
            End With
            g_lMemSnapShot = GetMemSnapshot(g_lListBoxParenthwnd, tRect)
            RefreshListBox g_lMemSnapShot, g_lListBoxParenthwnd
            Call Hook(g_lListBoxParenthwnd)
        End If
     
    End Sub
    
    Sub RefreshListBox(lMemSnapShotDC As Long, ListBoxhwnd As Long)
     
        Dim tRect As RECT
        Dim lhdc As Long
        
        tRect = GetListBoxRect(g_oListBox)
        lhdc = GetWindowDC(ListBoxhwnd)
        With tRect
            BitBlt lhdc, 0, 0, _
            (.Right - .Left), _
            .Bottom - .Top, lMemSnapShotDC, 0, 0, SRCCOPY
        End With
        ReleaseDC ListBoxhwnd, lhdc
        
    End Sub
    
    Sub RestoreListBox()
     
        Call Unhook(g_lListBoxParenthwnd)
        InvalidateRect 0, 0, 0
        g_oListBox.Object.ListIndex = 0
     
    End Sub
    * Add a class module to your project , give it the name of ClistBox and place the following code it it :

    Code:
     
    Option Explicit
     
    Public WithEvents ListBox  As MSForms.ListBox
     
    Private Sub ListBox_KeyDown _
    (ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
     
        Call UpdateListBoxColors
     
    End Sub
     
    Private Sub ListBox_KeyUp _
    (ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
     
        Call UpdateListBoxColors
     
    End Sub
     
    Private Sub ListBox_MouseUp _
    (ByVal Button As Integer, ByVal Shift As Integer, _
    ByVal X As Single, ByVal Y As Single)
     
        Call UpdateListBoxColors
     
    End Sub
     
    Private Sub UpdateListBoxColors()
     
        If g_lLbHook Then
            RefreshListBox g_lMemSnapShot, g_lListBoxChildhwnd
            ListBox.ListIndex = -1
        End If
     
    End Sub
    * This is an example of how to call it in a standard module :

    Code:
     
    Option Explicit
     
    Sub Test()
     
        Dim ColoredItems() As RGB
        Dim i As Long
        Dim r1 As RGB
        Dim r2 As RGB
        Dim r3 As RGB
        Dim r4 As RGB
     
        With r1
            .R = 255
            .G = 0
            .B = 0
        End With
                                   
        With r2
            .R = 0
            .G = 255
            .B = 0
        End With
        
        With r3
            .R = 0
            .G = 0
            .B = 0
        End With
        
        With r4
            .R = 100
            .G = 0
            .B = 250
        End With
        On Error Resume Next
        
        With Sheets(1).OLEObjects("ListBox1")
            ReDim ColoredItems(.Object.ListCount)
            For i = LBound(ColoredItems) + 1 To UBound(ColoredItems) Step 4
                ColoredItems(i) = r1
                ColoredItems(i + 1) = r2
                ColoredItems(i + 2) = r3
                ColoredItems(i + 3) = r4
            Next i
            PaintListBoxItems Sheets(1).OLEObjects("ListBox1"), ColoredItems
        End With
     
    End Sub
    Tested on WIN XP Excel 2003.

    Other caveats :

    Zooming and changing the listbox Font size may affect the metrics of the diaplay.

    Hopefully, the scrollbar issue and the others will be solved somehow

    Any feedback on (other bugs, suggestions etc...) much appreciated .

    Regards.
    Office/Excel 2007 Win XP

    Common sense is not so common.


    http://photo-larache.blogspot.com/

  2. #2
    Board Regular Jaafar Tribak's Avatar
    Join Date
    Dec 2002
    Location
    Larache--Morocco
    Posts
    4,965

    Default Re: Cool MultiColoured ListBox !!

    Has anyone tried the workbook demo and got it working ?

    I would like to know if this multicoloured listbox hack works in different systems and is stable enough to deserve spending more time on improving it .

    Regards.
    Office/Excel 2007 Win XP

    Common sense is not so common.


    http://photo-larache.blogspot.com/

  3. #3
    Board Regular Oorang's Avatar
    Join Date
    Mar 2005
    Posts
    2,071

    Thumbs up Re: Cool MultiColoured ListBox !!

    Hi Jaafar,
    First up let me just say this is really, really cool I have been taking it apart (as I am wont to do) have found a few issues with it, but I was waiting until I had a solution to offer as well. I am working on a few methods but none that I feel is perfect. I'll go ahead and list them out though. First off, The numbers that follow the class name F3 Server are not always the same so you can't hard code them. Secondly you can have more than one listbox (and therefore more than one match to "F3 Server*". Finally I am getting a hang on find win process that I haven't quite run down.

    I am still going over it though so I will post back. But this really has a ton of potential and I want to thank you for the obvious amount of work that went into putting it all together.
    • Get better answers! Include your version of Office in your post.

  4. #4
    Board Regular Oorang's Avatar
    Join Date
    Mar 2005
    Posts
    2,071

    Default Re: Cool MultiColoured ListBox !!

    Also XLDESK can have more than one child named Excel7 if there are add-ins enabled.
    • Get better answers! Include your version of Office in your post.

  5. #5
    Board Regular Jaafar Tribak's Avatar
    Join Date
    Dec 2002
    Location
    Larache--Morocco
    Posts
    4,965

    Default Re: Cool MultiColoured ListBox !!

    Oorang,

    Thanks very much for taking an interest and trying this .

    Quote Originally Posted by Oorang View Post
    First off, The numbers that follow the class name F3 Server are not always the same so you can't hard code them..
    Actually they are always the same at least in Win XP Office XP XL2003. I used Winspector in different PCs and they all returned F3 Server 60000000.

    Quote Originally Posted by Oorang View Post
    Secondly you can have more than one listbox (and therefore more than one match to "F3 Server*". Finally I am getting a hang on find win process that I haven't quite run down.
    That's true, and the code will need some workround to identify the target Listbox as the Listbox can't be identified by it's window text as it has none. I am already working on this.

    The same goes for the EXCEL7 class name as there might be more than one workbook/Addin open simultaniously but i guess this easy to solve.

    Regards.
    Office/Excel 2007 Win XP

    Common sense is not so common.


    http://photo-larache.blogspot.com/

  6. #6
    Board Regular Oorang's Avatar
    Join Date
    Mar 2005
    Posts
    2,071

    Default Re: Cool MultiColoured ListBox !!

    Hmmm, on vista, it's "F3 Server 677e0000". Have you considered using a ListVIEW on a form instead. ListView has a nice HWND property that solves a lot of problems (I wouldn't try embedding into a sheet though.)
    • Get better answers! Include your version of Office in your post.

  7. #7
    Board Regular Jaafar Tribak's Avatar
    Join Date
    Dec 2002
    Location
    Larache--Morocco
    Posts
    4,965

    Default Re: Cool MultiColoured ListBox !!

    Here is an idea to overcome the scrolbar problem. Hopefully, we can figure out if the listbox is currently displaying a scrollbar when the listbox height is <= to the sum of each row height (in pixels). Once this is established we can adapt the result of the GetListBoxRect function accordingly.

    As for the listbox items that are off the listbox visible area , the MakeMemoryBitmap function hopefully can handle that as it creates the bitmaps in memory although it's going to be quite difficult repainting the listbox after each scroll.

    As far as getting the exact target listbox if there happens to be more than one on the worksheet, I think the TopLeft Property can come in handy to uniquely identify it.

    Will be looking into this and hoefully post back with any progress made.

    Regards.
    Office/Excel 2007 Win XP

    Common sense is not so common.


    http://photo-larache.blogspot.com/

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  


DMCA.com