добавляем на нее листбокс
файллистбокс и имэдж (имиджу присваивем картинку, свойство стретч ставим в труе, визибл ставим в фальш)
в модуле формы пишем:
- Код: Выделить всё
Private Sub Form_Load()
hBrush = CreatePatternBrush(Image1.Picture.Handle)
prevFuncPointer = SetWindowLong(Me.hWnd, GWL_WNDPROC, AddressOf frmWndProc)
prevListboxFuncPointer = SetWindowLong(List1.hWnd, GWL_WNDPROC, AddressOf lbWndProc)
End Sub
к проекту добавляем модуль и пишем в нем:
- Код: Выделить всё
Public Path As String
Public DataDir As String
Public INNPridorog As String
Public INNMaxMix As String
Public Npost As String
Public NumNukl As Long
Public FileN As String
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 InvalidateRect Lib "user32" (ByVal hwnd As Long, _
ByVal lpRect As Long, ByVal bErase As Long) As Long
Public Declare Function CreatePatternBrush Lib "gdi32" (ByVal hBitmap As Long) _
As Long
Private Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal nBkMode As Long) _
As Long
Private Const WM_CTLCOLOREDIT = &H133
Private Const WM_CTLCOLORLISTBOX = &H134
Private Const WM_VSCROLL = &H115
Private Const WM_ERASEBKGND = &H14
Public Const GWL_WNDPROC = (-4)
Public hBrush As Long
Public prevFuncPointer As Long
Public prevListboxFuncPointer As Long
Public Function frmWndProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, _
ByVal lParam As Long) As Long
If (uMsg = WM_CTLCOLORLISTBOX) And hBrush <> 0 Then
' Make the words print transparently
SetBkMode wParam, 1
' Allow the original process to set text color, etc. from the lbx properties.
CallWindowProc prevFuncPointer, hwnd, uMsg, wParam, lParam
' Return our custom brush instead of the default one
frmWndProc = hBrush
Else
frmWndProc = CallWindowProc(prevFuncPointer, hwnd, uMsg, wParam, lParam)
End If
End Function
Public Function lbWndProc(ByVal hwnd As Long, ByVal uMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
' Force the control to repaint itself every time the scroll message is received.
If uMsg = WM_VSCROLL Then
' Force windows to repaint the listbox
InvalidateRect hwnd, 0, 0
' Invoke the default process
lbWndProc = CallWindowProc(prevListboxFuncPointer, hwnd, uMsg, wParam, lParam)
ElseIf uMsg = WM_ERASEBKGND Then
' Don't return anything. Processing the default routine will actually cause
' flickering when' scrolling.
lbWndProc = 1
Else
' Invoke the default process
lbWndProc = CallWindowProc(prevListboxFuncPointer, hwnd, uMsg, wParam, lParam)
End If
End Function
Запускаем. Все это сделано для того, чтобы дать листбоксу фон от image1
Но у меня почему этот фон распространяется и на filelistbox (в прицепе),
как этого избежать?
Да в общем сколько листбоксов не помести, он все их раскарис, а охота, чтобы только один.
