denisdenmm
Newbie | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Я ТУТ ОПЯТЬ НАРИСОВАЛСЯ СО СВОЕЙ ПРОБЛЕМОЙ ВЫВОДА ПОЛНОЙ СТРОКИ ЕСЛИ ОНА ОБРЕЗАНА В ЛИСТБОКСЕ, ВОТ ЧТО НАШЁЛ, НО ПО ВСЯКОМУ ПЫТАЛСЯ ПОРАБОТАТЬ С ЭТИМ, ВЫДАЁТ ОШИБКИ, ТО ТАМ ТО СЯМ
В ИТОГЕ ПОСЛЕ МОИХ МЫТАРСТВ НИЧЕГО НЕ ПОЛУЧИЛОСЬ, МОЖЕТ БЫТЬ КТО-НИБУДЬ ТОЖЕ ПОПРОБУЕТ ПОВОЗИТСЯ
Нюанс 2. Создание расширения для ListBox: Свойство - ?Вывод в виде подсказки ToolTyp длинных элементов спискаЋ
Option Explicit
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 Const LB_ITEMFROMPOINT = &H1A9 'константа API-функции
Private Const m_def_ToolTypLong = True 'константа контрола
Dim m_ToolTypLong As Boolean 'переменная контрола
'Масштабирование ListBox - необязательно. Здесь показывается с чисто эстетических позиций
Private Sub UserControl_Resize()
List1.Move 0, 0, ScaleWidth, ScaleHeight
End Sub
'Данная функция здесь показана для удобства пользователя (проведение тестирования)
Public Sub AddItem(ByVal Item As String, Optional ByVal Index As Variant)
List1.AddItem Item, Index
End Sub
Private Sub UserControl_InitProperties()
m_ToolTypLong = m_def_ToolTypLong
End Sub
'данное свойство руководит выводом или невыводом подсказки
Public Property Get ToolTypLong() As Boolean
ToolTypLong = m_ToolTypLong
End Property
Public Property Let ToolTypLong(ByVal New_ToolTypLong As Boolean)
m_ToolTypLong = New_ToolTypLong
PropertyChanged "ToolTypLong"
End Property
Private Sub List1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim lXPoint As Long, lYPoint As Long, lIndex As Long
'если не нажата никакая клавиша мыши и свойство ToolTypLong установлено в True
If (Button = 0) And (m_ToolTypLong = True) Then
'перевод в пикселы
lXPoint = CLng(X / Screen.TwipsPerPixelX)
lYPoint = CLng(Y / Screen.TwipsPerPixelY)
With List1
'выбирает индекс списка, в зависимости от позиции курсора
lIndex = SendMessage(.hwnd, LB_ITEMFROMPOINT, 0, _
ByVal ((lYPoint * 65536) + lYPoint))
'если курсор вне записей списка
If (lIndex >= 0) And (lIndex <= .ListCount) Then
.ToolTipText = .List(lIndex)
Else
.ToolTipText = vbNullString
End If
End With
End If
End Sub
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
m_ToolTypLong = PropBag.ReadProperty("ToolTypLong", m_def_ToolTypLong)
End Sub
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
Call PropBag.WriteProperty("ToolTypLong", m_ToolTypLong, m_def_ToolTypLong)
End Sub
|
А вот для темы: обрати внимание на
