[SRC] cListBoxMultiAlign [by Mr. Frog ©]

[*PsyKE1*]

I leave my last class used to justify text in a ListBox, the novelty is that you can specifically act on each Item, I leave the code:

Option Explicit
'==================================================================================================
' º Class     : MultiAlignListBox.cls
' º Version   : 1.1
' º Author    : Mr.Frog ©
' º Country   : Spain
' º Mail      : [email protected]
' º Date      : 14/12/2010
' º Twitter   : http://twitter.com/#!/PsYkE1
' º Tested on : WinXp & Win7
' º Greets    : LaVolpe & Raul338 & BlackZer0x
' º Reference : http://www.elguille.info/colabora/vb2006/karmany_centrartextolistbox.htm
' º Recommended Websites :
'       http://visual-coders.com.ar
'       http://InfrAngeluX.Sytes.Net
'==================================================================================================
 
Private Declare Function GetDialogBaseUnits Lib "user32" () As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hDC As Long) As Long
Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetTextExtentPoint32 Lib "gdi32" Alias "GetTextExtentPoint32A" (ByVal hDC As Long, ByVal lpString As String, ByVal cbString As Long, lpSize As SIZE) As Long
 
Private Type RECT
    Left    As Long
    Top     As Long
    Right   As Long
    Bottom  As Long
End Type
 
Private Type SIZE
    cX      As Long
    cY      As Long
End Type
 
Private Const LB_SETTABSTOPS                        As Long = &H192&
Private Const WM_GETFONT                            As Long = &H31&
 
Private Const CHARS_LIST                            As String = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890"
Private Const CHARS_LEN                             As Long = &H3E&
 
Private myListBox                                   As ListBox
Private lListhWnd                                   As Long
Private lWidth                                      As Long
 
Public Sub SetListBox(myList As ListBox)
    If Not (myList Is Nothing) Then
        Set myListBox = myList
        lListhWnd = myListBox.hwnd
        SetRightTab
    End If
End Sub
 
Public Sub AddAlignItem(ByVal Item As String, ByVal Align As AlignmentConstants, Optional ByVal Index As Long = (-1))
Dim lCenterAlign                                    As Long
 
    With myListBox
        lCenterAlign = Int(.Width - PixelsPerUnit(Item))
        If lCenterAlign < 0 Then Align = vbLeftJustify
        
        If Index = (-1) Then Index = .ListCount
        
        Select Case Align
            Case vbRightJustify
                .AddItem vbTab & Item, Index
                If Not (lWidth = GetListSize) Then SetRightTab
            Case vbCenter
                .AddItem Space$(Abs(Int(lCenterAlign / PixelsPerUnit(Space$(1)) / 2) - 1.5)) & Item, Index
            Case Else
                .AddItem Item, Index
        End Select
    End With
End Sub
 
Public Sub ChangeListBoxAlign(Optional ByVal Index As Long = (-1), Optional ByVal Align As AlignmentConstants = vbAlignLeft)
Dim Q                                               As Long
 
    If Index > -1 Then
        SetAlign Index, Align
    Else
        For Q = 0 To (myListBox.ListCount - 1)
            SetAlign Q, Align
        Next Q
    End If
End Sub
 
Public Function GetItem(ByVal Index As Long) As String
    GetItem = LTrim$(myListBox.List(Index))
    
    If (GetItem Like (vbTab & "*")) Then
        GetItem = Right$(GetItem, (Len(GetItem) - 1))
    End If
End Function
 
Private Sub SetAlign(ByVal Index As Long, ByVal Align As AlignmentConstants)
Dim sItem                                           As String
 
    With myListBox
        sItem = GetRealItem(Index)
        If Not (.List(Index) = sItem) Then
            .RemoveItem (Index)
            AddAlignItem sItem, Align, Index
        End If
    End With
End Sub
 
Private Sub SetRightTab()
Dim lRightAlignTab                                  As Long
 
    lWidth = GetListSize
    lRightAlignTab = -(lWidth / PixelsPerUnit)
    
    SendMessage lListhWnd, LB_SETTABSTOPS, &H0&, ByVal &H0&
    SendMessage lListhWnd, LB_SETTABSTOPS, &H1&, lRightAlignTab
    
    myListBox.Refresh
End Sub
 
Private Function GetListSize() As Long
Dim RCT                                             As RECT
 
    GetClientRect lListhWnd, RCT
    With RCT
        GetListSize = (.Right - .Left)
    End With
End Function
 
 
Private Function PixelsPerUnit(Optional ByVal sText As String) As Single
Dim hDC                                             As Long
Dim hFont                                           As Long
Dim hFontOld                                        As Long
Dim SZ                                              As SIZE
 
    hDC = GetDC(lListhWnd)
    If CBool(hDC) = True Then
        hFont = SendMessage(lListhWnd, WM_GETFONT, &H0&, ByVal &H0&)
        hFontOld = SelectObject(hDC, hFont)
        
        If sText = vbNullString Then
            If GetTextExtentPoint32(hDC, CHARS_LIST, CHARS_LEN, SZ) Then
                PixelsPerUnit = CSng((2 * CLng(SZ.cX / CHARS_LEN)) / (GetDialogBaseUnits And &HFFFF&))
            End If
        Else
            If GetTextExtentPoint32(hDC, sText, Len(sText), SZ) Then
                PixelsPerUnit = (SZ.cX * Screen.TwipsPerPixelX)
            End If
        End If
        
        SelectObject hDC, hFontOld
        ReleaseDC lListhWnd, hDC
    End If
End Function
 
Private Sub Class_Initialize()
    Debug.Print "--> cListBoxMultiAlign.cls By Mr.Frog © <--"
End Sub

A picture is worth a thousand words: