VBNet - Форум - Нашел!!! ListBox+Image !!!

Вопрос: Нашел!!! ListBox+Image !!! Добавлено: 21.01.06 07:20

Автор вопроса: KEP

'На форму поставьте List1(listbox), Image1(с любой картинкой!!!!) и Command1!!!!

'Это дело в модуль
Option Explicit

Public gBGBrush As Long
Public oldWindowProc As Long

Public Declare Function CreatePatternBrush Lib "gdi32" (ByVal hBitmap As Long) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal nBkMode As Long) As Long

Private Const WM_CTLCOLORLISTBOX = &H134
Public Const GWL_WNDPROC = (-4)



Public Function NewWindowProc( _
    ByVal hwnd As Long, _
    ByVal uMsg As Long, _
    ByVal wParam As Long, _
    ByVal lParam As Long) As Long

    'Debug.Print "&H" & Hex(uMsg), wParam, lParam

    If uMsg = WM_CTLCOLORLISTBOX And gBGBrush <> 0 Then
        'Make the words print transparently
        SetBkMode wParam, 1
        'allow the original process to set text color, etc. from the lbx properties.
        CallWindowProc oldWindowProc, hwnd, uMsg, wParam, lParam
        'Return our custom brush instead of the default one
        NewWindowProc = gBGBrush
    Else
        NewWindowProc = CallWindowProc(oldWindowProc, hwnd, uMsg, wParam, lParam)
    End If
End Function

'Это в форму

Option Explicit

Private Sub Command1_Click()
    Unload Me
End Sub
Private Sub Form_Load()
    Dim i As Long
    For i = 0 To 20
        List1.AddItem "Item " & Format$(i, "00")
    Next

    Image1.Visible = False
    gBGBrush = CreatePatternBrush(Image1.Picture.Handle)
    'Subclass the window
    oldWindowProc = SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf NewWindowProc)
End Sub
Private Sub Form_Unload(Cancel As Integer)
    'Unsubclass (return the original window process)
    SetWindowLong Me.hwnd, GWL_WNDPROC, oldWindowProc
    DeleteObject gBGBrush
End Sub
Private Sub List1_Scroll()
'если картинка со сложным рисунком
'то листбокс надо обновлять при скроллинге
'а то изображение будет смазываться

    'List1.Refresh
End Sub

Ответить

Ответы Всего ответов: 4

Номер ответа: 1 Автор ответа: HOOLIGAN Вопросов: 0 Ответов: 1066	Профиль \| \| #1	Добавлено: 21.01.06 08:48
	И что ? Ответить

Номер ответа: 2 Автор ответа: KEP Вопросов: 44 Ответов: 119	Профиль \| \| #2	Добавлено: 21.01.06 08:51
	Просто решил поделиться, я ранешь спрашевал об этом и не кто собственно толкового не предложил!!! Ответить

Номер ответа: 3 Автор ответа: [root] Вопросов: 45 Ответов: 1212	Web-сайт: bit.pirit.info Профиль \| \| #3	Добавлено: 21.01.06 10:41
	Гуд - только нада проверить! Ответить

Номер ответа: 4 Автор ответа: KEP Вопросов: 44 Ответов: 119	Профиль \| \| #4	Добавлено: 21.01.06 10:48
	Все тип топ Работат!!! Ответить

Страница: 1 |