狂菜，下拉列表里的内容太长显示不出来，我该咋办？

Question

能不能以提示文本的形式显示出来，但不知道在哪里写代码，请各位帮忙。

Answer 1

请参看<<VB编程技术大全>> API部分

Answer 2

Option ExplicitPrivate Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Const CB_SHOWDROPDOWN = &H14F
Const CB_GETDROPPEDWIDTH = &H15F
Const CB_SETDROPPEDWIDTH = &H160
Private Sub Form_Load()'改变下拉框的宽度,NewWidth为新宽度,可用strtmp取得最长的下拉框中的字符串,NewWidth=TextWidth(strTmp) * cbo1.FontSize / 9
SendMessage cbo1.hwnd, CB_SETDROPPEDWIDTH, 155, 0'弹出下拉框
SendMessage cbo1.hwnd, CB_SHOWDROPDOWN, True, 0
End Sub

Answer 3

为列表框添加水平滚动条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
 Const LB_FINDSTRING = &H18F
 Const LB_SETHORIZONTALEXTENT = &H194
Private Sub Form_Load()
    List1.AddItem "软件"
    List1.AddItem "电脑游戏"
    List1.AddItem "电视机"
    List1.AddItem "电视台"
    List1.AddItem "电脑"
    List1.AddItem "电脑游戏软件"
    '下一句为列表框添加水平滚动条
    SendMessage List1.hwnd, LB_SETHORIZONTALEXTENT, 250, 0
End Sub
Private Sub Text1_Change()
    List1.ListIndex = SendMessage(List1.hwnd, LB_FINDSTRING, -1, ByVal Text1.Text)
End Sub

Answer 4

我也提供几个常用的,和上面内容有雷同:
==================================================
Option Explicit'SystemMetrics Constants
Private Const SM_CXVSCROLL  As Long = &H2&  'System Vertical Scrollbar Width'ComboBox Constants
Private Const CB_GETDROPPEDWIDTH        As Long = &H15F&    '351
Private Const CB_SETDROPPEDWIDTH        As Long = &H160&    '352'ListBox Constants
Private Const LB_GETHORIZONTALEXTENT    As Long = &H193&    '403
Private Const LB_SETHORIZONTALEXTENT    As Long = &H194&    '404Private Type RectAPI
   Left    As Long
   Top     As Long
   Right   As Long
   Bottom  As Long
End TypePrivate Type SizeAPI
   Width   As Long
   Height  As Long
End TypePrivate Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDc As Long) As Long
Private Declare Function CreateDC Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, lpInitData As Any) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hDc As Long) As Long
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function GetTextExtentPoint32 Lib "gdi32" Alias "GetTextExtentPoint32A" (ByVal hDc As Long, ByVal lpsz As String, ByVal cbString As Long, lpSize As SizeAPI) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RectAPI) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hDc As Long, ByVal hObject 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
Public Function GetFontHandle(oFont As IFont) As Long'Returns a handle to a font.   'Passing a StdFont in as an IFont
   'allows access to the handle hFont.
   GetFontHandle = oFont.hFont
   
End FunctionPublic Function GetTextWidth(oFont As IFont, ByVal sText As String) As Long'Returns the Width of sText in Pixels.Dim lRet        As Long
Dim hDc         As Long
Dim hOldFont    As Long
Dim tSize       As SizeAPI   On Error GoTo LocalError
   
   'Create a Device Context to draw text
   hDc = CreateDC("DISPLAY", vbNullString, vbNullString, vbNull)
   
   If hDc <> 0 Then
       'Select the font into the DC
       hOldFont = SelectObject(hDc, oFont.hFont)
       
       'Get the TextWidth
       lRet = GetTextExtentPoint32(hDc, sText, Len(sText), tSize)
       
       'De-select the font and delete the DC
       lRet = SelectObject(hDc, hOldFont)
       lRet = DeleteDC(hDc)
   End If
   
   'Return the TextWidth
   GetTextWidth = tSize.Width
   
NormalExit:
   Exit Function
   
LocalError:
   MsgBox Err.Description, vbExclamation, "GetTextWidth"
   GetTextWidth = 0
   Resume NormalExit
   
End FunctionPublic Function GetWidestListItem(lstObj As Object) As Long'lstObj may be a ListBox or ComboBox.
'Returns the widest list item in pixels.Dim lIdx        As Long
Dim lRet        As Long
Dim lWidth      As Long
Dim hDc         As Long
Dim hOldFont    As Long
Dim sText       As String
Dim tSize       As SizeAPI
   
   On Error GoTo LocalError
   
   'Create a Device Context to draw text
   hDc = CreateCompatibleDC(lstObj.Parent.hDc)
   
   If hDc <> 0 Then
       'Select the font into the DC
       hOldFont = SelectObject(hDc, GetFontHandle(lstObj.Font))
       
       'Get the longest TextWidth from the list.
       For lIdx = 0 To lstObj.ListCount - 1
           sText = lstObj.List(lIdx)
           lRet = GetTextExtentPoint32(hDc, sText, Len(sText), tSize)
           If tSize.Width > lWidth Then
               lWidth = tSize.Width
           End If
       Next lIdx
       
       'De-select the font and delete the DC
       lRet = SelectObject(hDc, hOldFont)
       lRet = DeleteDC(hDc)
   End If
   
   GetWidestListItem = lWidth
   
NormalExit:
   Exit Function
   
LocalError:
   MsgBox Err.Description, vbExclamation, "GetTextWidth"
   GetWidestListItem = 0
   Resume NormalExit
   
End FunctionPublic Function SetComboDropDownWidth(cboBox As ComboBox, Optional ByVal bReset As Boolean) As Long
   
'Sets the dropdown width of a ComboBox
'to the width of the widest list item.
'Returns the dropdown width in pixels.Dim lRet    As Long
Dim lWidth  As Long
Dim lHeight As Long
Dim rcBox   As RectAPI   On Error GoTo LocalError
   
   If bReset Then
       'Reset to original Width (ComboBox.Width).
       lRet = GetWindowRect(cboBox.hWnd, rcBox)
       lWidth = rcBox.Right - rcBox.Left
   Else
       'Get the width of the widest item
       lWidth = GetWidestListItem(cboBox)
       
       'Takes borders, etc into account.
       lWidth = lWidth + 8 'Fudge factor       'Allow for Scrollbar Width if present.
       If cboBox.ListCount > 8 Then
           lWidth = lWidth + GetSystemMetrics(SM_CXVSCROLL)
       End If
   End If
   
   'Set the DropDown Width
   SetComboDropDownWidth = SendMessage(cboBox.hWnd, CB_SETDROPPEDWIDTH, lWidth, &H0&)
   
NormalExit:
   Exit FunctionLocalError:
   MsgBox Err.Description, vbExclamation, "SetComboDropDownWidth"
   Resume NormalExit
   
End Function
Public Function SetListHorizScrollWidth(lstBox As ListBox, Optional bReset As Boolean) As Long
   
'Adds a horizontal scrollbar to a ListBox and sets the
'scrollbar extent to the width of the widest list item.
'Returns the scrollbar extent in pixels.Dim lWidth  As Long   On Error GoTo LocalError
   
   If bReset Then
       'Reset to original extent (Remove Scrollbar).
       lWidth = 0
   Else
       'Get the width of the widest item
       lWidth = GetWidestListItem(lstBox)
   
       'Takes borders, etc into account.
       lWidth = lWidth + 8 'Fudge factor
   End If
   
   'Set the scrollbar extent.
   SetListHorizScrollWidth = SendMessage(lstBox.hWnd, LB_SETHORIZONTALEXTENT, lWidth, &H0&)
   
NormalExit:
   Exit FunctionLocalError:
   MsgBox Err.Description, vbExclamation, "SetListHorizScrollWidth"
   Resume NormalExit
   
End FunctionPublic Function GetComboDropdownWidth(cboBox As ComboBox) As Long'Returns the Width of the ComboBox's dropdown list in pixels.   GetComboDropdownWidth = SendMessage(cboBox.hWnd, CB_GETDROPPEDWIDTH, &H0&, &H0&)End FunctionPublic Function GetListHorizScrollWidth(lstBox As ListBox) As Long'Returns the ListBox's Horizontal Scrollbar extent in pixels.   GetListHorizScrollWidth = SendMessage(lstBox.hWnd, LB_GETHORIZONTALEXTENT, 0, 0)End Function
＝＝天下本无事，庸人自扰之==
得意淡然,失意泰然
[email protected]