Перевернутый листбокс

Private Function Vertical_Horizontal(ByVal nStr As String) As String
Dim MyStr As String, i As Integer
Static Vert As Boolean
If Vert = False Then
For i = 1 To Len(nStr)
If i Then
MyStr = MyStr + Mid$(nStr, i, 1) & vbCrLf
Else
MyStr = MyStr + Mid$(nStr, i, 1)
End If
Next
Vertical_Horizontal = MyStr
Vert = True
Else
For i = 1 To Len(nStr) Step 3
MyStr = MyStr + Mid$(nStr, i, 1)
Next
Vertical_Horizontal = MyStr
Vert = False
End If
End Function
 
Private Sub Command1_Click()
Label1.AutoSize = True
Label1.Caption = Vertical_Horizontal(Label1.Caption)
End Sub

Private Sub SAV_Click() ' сохранение
    ' проверка запненности всех полей
    For R = 0 To 3
    If Комбо1(R).Text = "" Then MsgBox "Заполнены не все поля", vbCritical, "Будте внимательны": Exit Sub
    Next R
    If Текст1.Text = "" Or Текст2.Text = "" Then MsgBox "Заполнены не все поля", vbCritical, "Будте внимательны": Exit Sub
    
    With Главная.OL.object
        '    первая пустая строка
           PS = .Application.WorksheetFunction.CountA(.Sheets(1).range("A:A")) + 1
            For R = 0 To 3
                    .Sheets(1).Cells(PS, R + 1) = Комбо1(R).Text
            Next R
                    .Sheets(1).Cells(PS, 5) = CDbl(Текст1.Text)
                    .Sheets(1).Cells(PS, 6) = CDbl(Текст2.Text)
                .Save
    End With
        ECX_Click
End Sub

Option Explicit
 
Private Type POINTAPI
    X As Long
    Y As Long
End Type
 
Private Declare Function DPtoLP Lib "gdi32" (ByVal hdc As Long, lpPoint As POINTAPI, ByVal nCount As Long) As Long
Private Declare Function SetGraphicsMode Lib "gdi32" (ByVal hdc As Long, ByVal iMode As Long) As Long
Private Declare Function SetWorldTransform Lib "gdi32" (ByVal hdc As Long, lpXform As Any) As Long
Private Declare Function DrawFocusRect Lib "user32" (ByVal hdc As Long, lpRect As Any) As Long
 
Private Const GM_ADVANCED   As Long = 2
 
Private Type ListItem
    Text        As String
    ItemData    As Long
End Type
 
Private Const GRANULARITY   As Long = 100
Private Const ItemHeight    As Long = 16
 
Dim WithEvents hsb As HScrollBar
 
Dim mList()     As ListItem
Dim mListCount  As Long
Dim mListIndex  As Long
Dim isFocused   As Boolean
 
Public Property Get ListIndex() As Long
 
    ListIndex = mListIndex
    
End Property
 
Public Property Let ListIndex(ByVal Index As Long)
 
    If Index < 0 Or Index >= mListCount Then
        Err.Raise 9
        Exit Property
    End If
    
    mListIndex = Index
    UserControl.Refresh
    
End Property
 
Public Property Get ListCount() As Long
 
    ListCount = mListCount
    
End Property
 
Public Property Get List(ByVal Index As Long) As String
 
    If Index < 0 Or Index >= mListCount Then
        Err.Raise 9
        Exit Property
    End If
    
    List = mList(Index).Text
    
End Property
 
Public Property Let List(ByVal Index As Long, Text As String)
 
    If Index < 0 Or Index >= mListCount Then
        Err.Raise 9
        Exit Property
    End If
    
    mList(Index).Text = Text
    UserControl.Refresh
    
End Property
 
Public Sub AddItem(ByVal Item As String, Optional ByVal ItemData As Long)
    Dim idx1    As Long
    
    idx1 = mListCount
    
    If idx1 > UBound(mList) Then
        ReDim Preserve mList(UBound(mList) + GRANULARITY)
    End If
 
    mList(idx1).Text = Item
    mList(idx1).ItemData = ItemData
    
    mListCount = mListCount + 1
    
    UpdateScroll
    UserControl.Refresh
    
End Sub
 
Public Sub RemoveItem(ByVal Index As Long)
    Dim idx1    As Long
    
    If Index < 0 Or Index >= mListCount Then
        Err.Raise 9
        Exit Sub
    End If
    
    For idx1 = Index To mListCount - 2
        mList(idx1) = mList(idx1 + 1)
    Next
    
    mListCount = mListCount - 1
    
    If mListCount > 0 And (mListCount Mod GRANULARITY) = 0 Then
        ReDim Preserve mList(mListCount - 1)
    End If
    
    UpdateScroll
    UserControl.Refresh
    
End Sub
 
Private Sub UpdateScroll()
 
    If mListCount * ItemHeight > UserControl.ScaleWidth Then
        hsb.Move 0, UserControl.ScaleHeight - hsb.Height, UserControl.ScaleWidth
        hsb.Max = ((mListCount * ItemHeight) - UserControl.ScaleWidth) / ItemHeight
        
        If Not hsb.Visible Then
            hsb.Visible = True
        End If
    
    Else
        hsb.Max = 0
        hsb.Visible = False
    End If
    
End Sub
 
Private Sub Redraw()
    Dim mtx(5)  As Single
    Dim idx     As Long
    Dim curY    As Long
    
    mtx(0) = 1: mtx(3) = 1
    SetWorldTransform UserControl.hdc, mtx(0)
    UserControl.Cls
    mtx(0) = 0: mtx(1) = 1: mtx(2) = -1: mtx(4) = UserControl.ScaleWidth: mtx(3) = 0
    SetWorldTransform UserControl.hdc, mtx(0)
    
    For idx = hsb.Max - hsb.Value To mListCount - 1
    
        UserControl.CurrentY = curY
        
        If idx = mListIndex Then
            
            UserControl.Line -Step(UserControl.ScaleHeight, ItemHeight), vbHighlight, BF
            
            If isFocused Then
                Dim rc(3) As Long
                
                rc(0) = 0: rc(1) = curY: rc(2) = UserControl.ScaleHeight: rc(3) = curY + ItemHeight
                DrawFocusRect UserControl.hdc, rc(0)
                
            End If
 
            UserControl.CurrentY = UserControl.CurrentY - ItemHeight
 
        End If
        
        UserControl.CurrentX = 3
        
        UserControl.Print mList(idx).Text
        
        curY = curY + ItemHeight
        
        If curY > UserControl.ScaleWidth Then Exit For
        
    Next
    
End Sub
 
Private Sub hsb_Change()
    Redraw
End Sub
 
Private Sub hsb_Scroll()
    Redraw
End Sub
 
Private Sub UserControl_EnterFocus()
    UserControl_GotFocus
End Sub
 
Private Sub UserControl_ExitFocus()
    UserControl_LostFocus
End Sub
 
Private Sub UserControl_GotFocus()
 
    isFocused = True
    UserControl.Refresh
    
End Sub
 
Private Sub UserControl_LostFocus()
 
    isFocused = False
    UserControl.Refresh
    
End Sub
 
Private Sub UserControl_Initialize()
    ReDim mList(GRANULARITY - 1)
    SetGraphicsMode UserControl.hdc, GM_ADVANCED
    Set hsb = UserControl.Controls.Add("VB.HScrollBar", "hsb")
    UserControl.ScaleMode = vbPixels
    UserControl.DrawStyle = vbInvisible
End Sub
 
Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim pt  As POINTAPI
    Dim sel As Long
    
    If mListCount = 0 Then Exit Sub
    
    pt.X = X: pt.Y = Y
    
    DPtoLP UserControl.hdc, pt, 1
    
    sel = pt.Y \ ItemHeight + (hsb.Max - hsb.Value)
    
    If sel >= mListCount Then sel = mListCount - 1
    If sel < 0 Then sel = 0
    
    Me.ListIndex = sel
    
End Sub
 
Private Sub UserControl_Paint()
    Redraw
End Sub