C'est une partie de code récupéré là
http://www.vbfrance.com/codes/UTILISATION-API-SENDMESSAGE-AVEC-LISTBOX-OU-COMBOBOX_26686.aspx, j'ai choisi "Form15" et ai supprimé les autres.
Bon, ce bout de code est probablement plus complexe que celui que j'ai fait, il pourrait s'adresse aux utilisateurs initiés.
Mais, on arrive pratiquement au même résultat que mon propre code.
Source / Exemple :
Option Explicit
'Augmente la taille de la barre de défilement horizontal d'une listbox
'si la longueur de texte des éléments ajoutés est plus long que certains éléments
'http://vbnet.mvps.org/index.html?code/core/sendmessage.htm
Private Const LB_GETHORIZONTALEXTENT = &H193
Private Const LB_SETHORIZONTALEXTENT = &H194
Private Const DT_CALCRECT = &H400
Private Const SM_CXVSCROLL = 2
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function DrawText Lib "user32" _
Alias "DrawTextA" _
(ByVal hDC As Long, _
ByVal lpStr As String, _
ByVal nCount As Long, _
lpRect As RECT, ByVal _
wFormat As Long) As Long
Private Declare Function GetSystemMetrics Lib "user32" _
(ByVal nIndex 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 Sub Form_Load()
Call AddItemToList(List1, "Ministry of Agriculture and Food")
Call AddItemToList(List1, "Ministry of the Attorney General")
Call AddItemToList(List1, "Ministry of Community, City and Social Services")
Call AddItemToList(List1, "Ministry of Education")
Call AddItemToList(List1, "Ministry of the Environment")
Call AddItemToList(List1, "Ministry of Health and Long-Term Care")
Call AddItemToList(List1, "Ministry of Housing")
End Sub
Private Sub Command1_Click()
Dim newIndex As Long
newIndex = AddItemToList(List1, Text1.Text)
'an 'EnsureVisible' method for the listbox
List1.TopIndex = newIndex
Label1.Caption = "Item " & newIndex & " added"
End Sub
Private Sub List1_Click()
Text1.Text = List1.List(List1.ListIndex)
End Sub
Private Function AddItemToList(ctl As Control, _
sNewItem As String, _
Optional dwNewItemData As Variant) As Long
Dim c As Long
Dim rcText As RECT
Dim newWidth As Long
Dim currWidth As Long
Dim sysScrollWidth As Long
Dim tmpFontName As String
Dim tmpFontSize As Long
Dim tmpFontBold As Boolean
'get the current width used
If Len(ctl.Tag) > 0 Then
currWidth = CLng(ctl.Tag)
End If
'determine the needed width for the new item
'save the font properties to tmp variables
tmpFontName = FAQ2.Font.Name
tmpFontSize = FAQ2.Font.Size
tmpFontBold = FAQ2.Font.Bold
FAQ2.Font.Name = List1.Font.Name
FAQ2.Font.Size = List1.Font.Size
FAQ2.Font.Bold = List1.Font.Bold
'get the width of the system scrollbar
sysScrollWidth = GetSystemMetrics(SM_CXVSCROLL)
'use DrawText/DT_CALCRECT to determine item length
Call DrawText(FAQ2.hDC, sNewItem, -1&, rcText, DT_CALCRECT)
newWidth = rcText.Right + sysScrollWidth
'if this is wider than the current setting,
'tweak the list and save the new horizontal
'extent to the tag property
If newWidth > currWidth Then
Call SendMessage(List1.hwnd, _
LB_SETHORIZONTALEXTENT, _
newWidth, _
ByVal 0&)
ctl.Tag = newWidth
End If
'restore the form font properties
FAQ2.Font.Name = tmpFontName
FAQ2.Font.Bold = tmpFontBold
FAQ2.Font.Size = tmpFontSize
'add the items to the control, and
'add the ItemData if supplied
ctl.AddItem sNewItem
If Not IsMissing(dwNewItemData) Then
If IsNumeric(dwNewItemData) Then
ctl.ItemData(ctl.newIndex) = dwNewItemData
End If
End If
'return the new index as the function result
AddItemToList = ctl.newIndex
End Function
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.