GFListHScroll/Mfrm.frm

VERSION 5.00
Begin VB.Form Mfrm
   Caption         =   "Form1"
   ClientHeight    =   3195
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4710
   LinkTopic       =   "Form1"
   ScaleHeight     =   3195
   ScaleWidth      =   4710
   StartUpPosition =   3 'Windows‑Standard
   Begin VB.PictureBox GFListHScrollFontSizePicture
      Enabled         =   0 'False
      Height          =   315
      Left            =   60
      ScaleHeight     =   17
      ScaleMode       =   3 'Pixel
      ScaleWidth      =   9
      TabIndex        =   2
      Top             =   2700
      Visible         =   0 'False
      Width           =   195
   End
   Begin VB.ListBox List1
      Height          =   2595
      Left            =   60
      TabIndex        =   1
      Top             =   60
      Width           =   4575
   End
   Begin VB.CommandButton Command1
      Caption         =   "Add Scroll Bars"
      Height          =   375
      Left            =   2520
      TabIndex        =   0
      Top             =   2760
      Width           =   2115
   End
End
Attribute VB_Name = "Mfrm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'(c)?, 2004 by Louis. Adds horizontal scroll bars to any VB ListBox.
'
'Downloaded from www.louis‑coder.com.
'This is a very useful function. Use it to add horizontal scroll bars to any VB ListBox.
'The scroll bars will only be visible if they are required. Copy GFListHScroll_AddScrollBars(),
'the API and constant declaration and GFListHScrollFontSizePicture to your project.
'
'GFListHScroll
Private Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'GFListHScroll
Private Const LB_SETHORIZONTALEXTENT = &H194

Private Sub Command1_Click()
    'on error resume next
    Call GFListHScroll_AddScrollBars(List1)
End Sub

Private Sub Form_Load()
    'on error resume next
    Dim Temp As Long
    Randomize Timer
    For Temp = 1 To 15
        List1.AddItem String(Int((100 ‑ 1 + 1) * Rnd(1) + 1), "s")
    Next Temp
End Sub

Private Sub GFListHScroll_AddScrollBars(ByRef TargetList As ListBox)
    'on error resume next 'this sub requires GFListHScrollFontSizePicture to be located on current form
    Dim TextWidthMax As Long
    Dim TempInt As Integer
    'preset
    GFListHScrollFontSizePicture.Font.Name = TargetList.Font.Name
    GFListHScrollFontSizePicture.Font.Size = TargetList.Font.Size
    GFListHScrollFontSizePicture.Font.Bold = TargetList.Font.Bold
    GFListHScrollFontSizePicture.Font.Italic = TargetList.Font.Italic
    GFListHScrollFontSizePicture.Font.Weight = TargetList.Font.Weight
    GFListHScrollFontSizePicture.Font.Charset = TargetList.Font.Charset
    'begin
    For TempInt = 1 To TargetList.ListCount
        If GFListHScrollFontSizePicture.TextWidth(TargetList.List(TempInt ‑ 1)) > TextWidthMax Then
            TextWidthMax = GFListHScrollFontSizePicture.TextWidth(TargetList.List(TempInt ‑ 1))
        End If
    Next TempInt
    Call SendMessageLong(TargetList.hWnd, LB_SETHORIZONTALEXTENT, TextWidthMax + 15, ByVal 0&) '15 pixels for v scroll bar
End Sub


[END OF FILE]