Проблема с ListBox

[XairOn]

Здравствуйте. Подскажите пожалуйста в чем тут ошибка: я пытаюсь добавить горизонтальную полосу прокрутки в ListBox, но почему-то никак не выходит. Вот код:

Код: Выделить всё

Option Explicit

Private Const LB_GETHORIZONTALEXTENT As Long = &H193
Private Const LB_ADDSTRING As Long = &H180
Private Const LB_SETHORIZONTALEXTENT As Long = &H194

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Any) As Long

Private Sub Form_Load()
    Dim i As Long
   
    SendMessage List1.hwnd, LB_ADDSTRING, 0, ByVal "Длинная строка которая не помещается в ListBox"
    i = SendMessage(List1.hwnd, LB_GETHORIZONTALEXTENT, ByVal 0&, ByVal 0&)
    SendMessage List1.hwnd, LB_SETHORIZONTALEXTENT, ByVal i&, ByVal 0&
    MsgBox i
End Sub


Перерыл весь MSDN, KB и кучу других источников, они все как один утверждают, что это должно работать. Но вот ни одного исходника мне найте не удалось ( только теория, которая на практике почему-то не работает.

[Хакер]

Ну вобщем, можно сделать так:
Поместить ListBox'в контейнер (например PictureBox) и добавить туду HScroll и делать всё искусственно. Хотя это уродско-извращенский способ (щас лучше ничего не придумаю)

[alibek]

Попробуй

Код: Выделить всё

Const WM_USER As Long = &H400
Const LB_SETHORIZONTALEXTENT As Long = WM_USER + 21
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long

Кроме того, проверь что в i действительно хранится длина самой большой строки. Помоему он возвращает всего-лишь текущую ширину вьюпорта. Если это так, то самую длинную строку тебе надо будет искать самому.

[XairOn]

Кроме того, проверь что в i действительно хранится длина самой большой строки.

В i вообще ничего почему-то не хранится... там у меня всегда ноль хранится.

[alibek]

Во-первых,

To respond to the LB_GETHORIZONTALEXTENT message, the list box must have been defined with the WS_HSCROLL style.

А во-вторых, попробуй такой код:

Код: Выделить всё

Sub HorzScroll(ListControl As ListBox)
Dim F As Form, oldScaleMode As Integer, oldFontName As String, oldFontSize As Single, oldFontBold As Integer, oldFontItalic As Integer
Dim ret As Long, MaxWidth As Integer, I As Integer
Const DW = 6

Set F = ListControl.Parent
oldScaleMode = F.ScaleMode
oldFontName = F.FontName
oldFontSize = F.FontSize
oldFontBold = F.FontBold
oldFontItalic = F.FontItalic

F.ScaleMode = 3
F.FontName = ListControl.FontName
F.FontSize = ListControl.FontSize
F.FontBold = ListControl.FontBold
F.FontItalic = ListControl.FontItalic

MaxWidth = 0
For I = 0 To ListControl.ListCount - 1
  If F.TextWidth(ListControl.List(I)) > MaxWidth Then MaxWidth = F.TextWidth(ListControl.List(I))
Next I
ret = SendMessage(ListControl.hWnd, LB_SetHorizontalExtent, MaxWidth + DW, NUL)

F.ScaleMode = oldScaleMode
F.FontName = oldFontName
F.FontSize = oldFontSize
F.FontBold = oldFontBold
F.FontItalic = oldFontItalic
Set F = Nothing
End Sub


Код старый, его можно значительно упростить и оптимизировать, но мне лень. Если очень хочется, сам подредактируй.

[XairOn]

Код старый, его можно значительно упростить и оптимизировать, но мне лень. Если очень хочется, сам подредактируй.

Да я бы с радостью подредактировал, но мне это не подходит. Дело в том, что мой окно создается динамически и ListBox соответсвенно тоже (CreateWindowEx) а вот можно например, как-нибудь узнать ширину текста любого из итемов листбокса в пикселях? Может есть какой-нибудь способ.

[VVitafresh]

Отображение горизонтального скроллбара необходимой длинны. Взято с сайта http://vbnet.mvps.org

Place the following code into the general declarations area of a bas module:

Код: Выделить всё

Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2006 VBnet, Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce
'               or publish this code on any web site,
'               online service, or distribute as source
'               on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Const LB_GETHORIZONTALEXTENT = &H193
Public Const LB_SETHORIZONTALEXTENT = &H194
Public Const DT_CALCRECT = &H400
Public Const SM_CXVSCROLL = 2

Public Type RECT
   Left As Long
   Top As Long
   Right As Long
   Bottom As Long
End Type

Public 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
   
Declare Function GetSystemMetrics Lib "user32" _
  (ByVal nIndex As Long) As Long

Public Declare Function SendMessage Lib "user32" _
   Alias "SendMessageA" _
  (ByVal hwnd As Long, _
   ByVal wMsg As Long, _
   ByVal wParam As Long, _
   lParam As Any) As Long

Add a list (List1), textbox (Text1), label (Label1) and a command button (Command1) to a form, along with the following code:

Код: Выделить всё

Option Explicit

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 = Form1.Font.Name
   tmpFontSize = Form1.Font.Size
   tmpFontBold = Form1.Font.Bold
   
   Form1.Font.Name = List1.Font.Name
   Form1.Font.Size = List1.Font.Size
   Form1.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(Form1.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
   Form1.Font.Name = tmpFontName
   Form1.Font.Bold = tmpFontBold
   Form1.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

[alibek]

VVitafresh, а чем он от моего примера (четырехлетней давности) отличается? Я думал, там хотя бы назначение стиля WS_HSCROLL задействуют.

[VVitafresh]

Принципиально мало отличается, просто более расширенный пример.
Кстати кто знает можно ли добавить горизонтальный скроллбар в комбобокс?

P.S. По-моему нельзя, а вдруг...

[Хакер]

Код: Выделить всё


Declare Function ShowScrollBar Lib "user32" (ByVal hwnd As Long, ByVal wBar As Long, ByVal bShow As Long) As Long
Private Const SB_HORZ = 0
Private Const SB_VERT = 1
Private Const SB_BOTH = 3
Private Sub Form_Load()

ShowScrollBar ListBox.hwnd, SB_HORZ, True



[VVitafresh]

Хакер, по-моему твой пример не в тему. Скроллбар то покажет, но прокрутить ты ничего не сможешь.

[Хакер]

А.... Уже не сображаю.... Пора на пенсию

А если серьёзно:
Прошу прощения, ступил, опять, что со мной

[XairOn]

VVitafresh спасибо, то что нужно, осталось только все это в синтаксис СиПиПи перевести