Subclassing: Pozadí ListBoxu

Na formulář si přidejte ListBox a prvek Image. Do ListBoxu zadejte pár položek. Do prvku Image si načtěte obrázek, který chcete použít jako pozadí pro ListBox. Do modulu zapište:

Public gBGBrush 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
Private Declare Function SetBkMode Lib "gdi32" _
   (ByVal hdc As Long, ByVal nBkMode As Long) As Long
Private Const WM_CTLCOLORLISTBOX = &H134

Nyní je třeba modifikovat události Load a Unload formuláře:

Private Sub Form_Load()

    Image1.Visible = False
    gBGBrush = CreatePatternBrush(Image1.Picture.Handle)
    oldWindowProc = SetWindowLong(Me.hWnd, GWL_WNDPROC, _
      AddressOf NewWindowProc)

End Sub

Private Sub Form_Unload(Cancel As Integer)

    SetWindowLong Me.hWnd, GWL_WNDPROC, oldWindowProc
    DeleteObject gBGBrush

End Sub

Posledním krokem je modifikace vlastní procedury, která bude zpracovávat zprávy obdržené z Windows:

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
       SetBkMode wParam, 1 'Tisk textu transparentně
       NewWindowProc = gBGBrush
   Else
      NewWindowProc = CallWindowProc(oldWindowProc, hWnd, _
        uMsg, wParam, lParam)
   End If

End Function

Nyní projekt uložte a poté spusťte. Pokud je vše v pořádku, tak ListBox má jako pozadí obrázek natažený jako pozadí.

Zpět Další