scrolling listview background along with items

In order to get it to work, you have to add the Microsoft Windows Common Controls 5.0.

It doesn't work with the Version 6.

However, the background picture isn't static and still scrolls with the list.

hth.

Wileecoy.

A similar question was answered here:
https://www.experts-exchange.com/jsp/qShow.jsp?ta=visualbasic&qid=20120703

Gee, ada2...
Sorry, i didn't realize that was you again.

Well, i still fight....
https://www.experts-exchange.com/jsp/qShow.jsp?ta=visualbasic&qid=20140677

Hi
Followed two links, spent 30 points and what I got? Nothing... :). There is a wrong way. You need to subclass WM_ERASEBACKGROUND message.
OK, working a bit... - here is a way. I made this for VB6 common controls which have built-in BkGround picture property. For VB 5 control you have to use vbnet method first and then my trick.

'=============bas module code===========

Private Type BITMAP
        bmType As Long
        bmWidth As Long
        bmHeight As Long
        bmWidthBytes As Long
        bmPlanes As Integer
        bmBitsPixel As Integer
        bmBits As Long
End Type

Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hdc As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function ValidateRectBynum Lib "user32" Alias "ValidateRect" (ByVal hWnd As Long, ByVal lpRect As Long) As Long

Private Const WM_ERASEBKGND = &H14

Private 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 Const GWL_WNDPROC = (-4)

Dim OldProc As Long
Dim lv As ListView
Dim bPainting As Boolean

Public Function WndProc(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim lvDC As Long, TempDC As Long
    Dim oldbm As Long
    Dim bm As BITMAP
    Select Case wMsg
           Case WM_ERASEBKGND
                lvDC = GetDC(hWnd)
                TempDC = CreateCompatibleDC(lvDC)
                oldbm = SelectObject(TempDC, lv.Picture)
                Call GetObjectAPI(lv.Picture, Len(bm), bm)
                Call BitBlt(lvDC, 0, 0, bm.bmWidth, bm.bmHeight, TempDC, 0, 0, vbSrcCopy)
                Call ReleaseDC(hWnd, lvDC)
                Call SelectObject(TempDC, oldbm)
                Call DeleteDC(TempDC)
                If bPainting = False Then
                   bPainting = True
                   lv.Refresh
                   bPainting = False
                End If
                Call ValidateRectBynum(hWnd, 0)
                WndProc = 1
                Exit Function
           Case Else
   End Select
   WndProc = CallWindowProc(OldProc, hWnd, wMsg, wParam, lParam)
End Function

Public Sub SubClass(obj As Object)
   Dim h As Long
   On Error Resume Next
   h = obj.hWnd
   If Err Or (OldProc <> 0) Then Exit Sub
   Set lv = obj
   OldProc = SetWindowLong(h, GWL_WNDPROC, AddressOf WndProc)
End Sub

Public Sub UnSubClass(obj As Object)
   Dim h As Long
   On Error Resume Next
   h = obj.hWnd
   Set lv = Nothing
   If Err Or (OldProc = 0) Then Exit Sub
   SetWindowLong h, GWL_WNDPROC, OldProc
   OldProc = 0
End Sub

'=======Form code============

Private Sub Form_Load()
  With ListView1
     .View = lvwReport
     .FullRowSelect = True
     .ColumnHeaders.Add , , "Item Column"
     .ColumnHeaders.Add , , "Subitem 1"
     .ColumnHeaders.Add , , "Subitem 2"
     .Picture = LoadPicture("c:\windows\logow.sys")
     Dim i&
     For i = 1 To 30
       With .ListItems.Add(, , CStr(Int(200 * Rnd)))
         .SubItems(1) = "Subitem 1"
         .SubItems(2) = "Subitem 2"
         .Tag = CStr(QBColor(i Mod 15))
       End With
     Next
  End With
  SubClass ListView1
End Sub

Private Sub Form_Unload(Cancel As Integer)
   UnSubClass ListView1
End Sub

Cheers

Oops, sorry, .Tag = .... remain from previous code - remove it.

Looks messed up for me Ark.  I get a lot of residual pic with it.  Any ideas?

Wileecoy.

Strange... Works fine for me. Just checked from the scratch - started new project, added CommonControls (6.0), added listview1 on form, Copy/Paste form code, added bas module, copy/paste module code (repaire some formatting), run app - everything OK.

Oops, found! I wrote code for picture which is bigger (or equal) ListView size. If using picture less then ListView, we got this messy effect. Seems we need to use EcludeClipRect API.

Cheers

'Added to declaration area:
Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type

Private Declare Function GetClientRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long

'Added at bas module just before Call BitBlt....
    Call GetClientRect(hWnd, rc)
    Call FillRect(lvDC, rc, lv.BackColor)

Works fine with small pictures too.

More better: to reduce flickering - add to declaration
Private Type RECT
       Left As Long
       Top As Long
       Right As Long
       Bottom As Long
End Type

Private Declare Function GetClientRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long)
As Long
Private Declare Function SelectClipRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long) As Long
Private Declare Function ExcludeClipRect Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long

'=========inside bas module code==========

              Call GetObjectAPI(lv.Picture, Len(bm), bm)
'**************Added**********************
    Call GetClientRect(hWnd, rc)
    Call SelectClipRgn(lvDC, 0)
    Call ExcludeClipRect(lvDC, 0, 0, bm.bmWidth, bm.bmHeight)
    Call FillRect(lvDC, rc, lv.BackColor)
    Call SelectClipRgn(lvDC, 0)
'**************Added**********************
               Call BitBlt(lvDC, 0, 0, bm.bmWidth, bm.bmHeight, TempDC, 0, 0, vbSrcCopy)

sorry for the dalay .. that is an extra project ...got swamped at work ... COBOL and SQL ...somebody shootme!

Thanks for points, glad I could help you