Autre petite faq

Soyez le premier à donner votre avis sur cette source.

Vue 9 814 fois - Téléchargée 361 fois

Description

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

Codes Sources

A voir également

Ajouter un commentaire Commentaires
Messages postés
308
Date d'inscription
lundi 16 décembre 2002
Statut
Membre
Dernière intervention
15 juin 2015
1
Mais que font les admins... Je pense qu'il est temps que les administrateurs freinent la publication de sources inutiles, sans intérêts, existantes déjà ou mal expliquées. Parce que consulter 10 sources avant d'en trouver une utile et commentée, ça démotive pour la suite.
Messages postés
103
Date d'inscription
lundi 9 avril 2001
Statut
Membre
Dernière intervention
16 juillet 2008

Encore une source qui sert à rien
Messages postés
15814
Date d'inscription
jeudi 8 août 2002
Statut
Modérateur
Dernière intervention
4 mars 2013
111
Quel est l'intérêt de passer par les API pour rajouter un texte dans une listbox ???

Les API c'est bien, mais faut quand même pas les utilser partout, sinon autant programmer en C !

DarK Sidious
Messages postés
14008
Date d'inscription
samedi 29 décembre 2001
Statut
Modérateur
Dernière intervention
28 août 2015
73
Salut
Et ta source sert à quoi ?
Quel est son intérêt ?
Qu'as tu réussi à faire ?
Explique mieux pourquoi tu es content du résultat ...

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.