'Vla 1 exemple sur une listbox (cf API-guide)
' Code submitted by Alok Sathaye (alok_sathaye@rediffmail.com)
'
'Place a Listbox on the Form. Name it
'List1
'Paste this code in the Declarations module
Private Const DT_CALCRECT = &H400
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
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
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
Public Function AutosizeListbox(List1 As ListBox) As Boolean
'Automatically sizes a list box to hold the longest item within it
Dim lngRet As Long
Dim rectCboText As RECT
Dim lngParentHDC As Long
Dim lngListCount As Long
Dim lngCounter As Long
Dim lngTempWidth As Long
Dim lngWidth As Long
Dim strSavedFont As String
Dim sngSavedSize As Single
Dim blnSavedBold As Boolean
Dim blnSavedItalic As Boolean
Dim blnSavedUnderline As Boolean
Dim blnFontSaved As Boolean
On Error GoTo ErrorHandler
'Grab the List1 handle and list count
lngParentHDC = List1.Parent.hdc
lngListCount = List1.ListCount
If lngParentHDC = 0 Or lngListCount = 0 Then Exit Function
'Save List1 box fonts, etc. to the parent object (form), for testing lengths with the API
With List1.Parent
strSavedFont = .FontName
sngSavedSize = .FontSize
blnSavedBold = .FontBold
blnSavedItalic = .FontItalic
blnSavedUnderline = .FontUnderline
.FontName = List1.FontName
.FontSize = List1.FontSize
.FontBold = List1.FontBold
.FontItalic = List1.FontItalic
.FontUnderline = List1.FontItalic
End With
blnFontSaved = True
'Get the width of the widest item
For lngCounter = 0 To lngListCount
DrawText lngParentHDC, List1.List(lngCounter), -1, rectCboText, DT_CALCRECT
'Add 10 to the the number as a margin
lngTempWidth = rectCboText.Right - rectCboText.Left + 10
If (lngTempWidth > lngWidth) Then
lngWidth = lngTempWidth
End If
Next
lngWidth = (lngWidth) * Screen.TwipsPerPixelX
If lngWidth > Screen.Width - 20 Then lngWidth = Screen.Width - 20
'Set the width of our List1
List1.Width = lngWidth
AutosizeListbox = True
ErrorHandler:
On Error Resume Next
If blnFontSaved Then
With List1.Parent
.FontName = strSavedFont
.FontSize = sngSavedSize
.FontUnderline = blnSavedUnderline
.FontBold = blnSavedBold
.FontItalic = blnSavedItalic
End With
End If
End Function
'**************************
Private Sub Form_Load()
Dim x As Boolean
x = AutosizeListbox(List1)
End Sub
-------------------------------
Réponse au message :
-------------------------------
Salut
Y a t il un moyen d'utiliser la fonction :
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
|
sur une listbox ou bien une dirlistbox?
Merci d'avance
-------------------------------
Réponse au message :
-------------------------------
Salut
Y a t il un moyen d'utiliser la fonction :
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
|
sur une listbox ou bien une dirlistbox?
Merci d'avance