This code shows you how to add a background image to a listview control. (Note that you don't need to do this for VB6 - you can simply set the ListViews Picture property). First, add a ListView control to a form, and name it lvwTest. Then add the following code to the form.
Option Explicit
Private Const NOERROR = &H0&
Private Const S_OK = &H0&
Private Const S_FALSE = &H1&
Private Const LVM_FIRST = &H1000
Private Const LVM_SETBKIMAGE = (LVM_FIRST + 68)
Private Const LVM_SETTEXTBKCOLOR = (LVM_FIRST + 38)
Private Const LVBKIF_SOURCE_URL = &H2
Private Const LVBKIF_STYLE_TILE = &H10
Private Const CLR_NONE = &HFFFFFFFF
' Bitmaps in list views!
Private Type LVBKIMAGE
ulFlags As Long
hbm As Long
pszImage As String
cchImageMax As Long
xOffsetPercent As Long
yOffsetPercent As Long
End Type
Private Declare Sub CoUninitialize Lib "OLE32.DLL" ()
Private Declare Function CoInitialize Lib "OLE32.DLL" (ByVal
pvReserved As Long) As Long
Private Declare Function SendMessageLong Lib "user32" Alias "SendMessageA"
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As
Long) As Long
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 Sub SetBackground()
Dim sI As String
Dim lHDC As Long
' Set a background image:
sI = "BACK.GIF"
If (Len(sI) > 0) Then
If (InStr(sI, "")) = 0 Then
sI = App.Path &
"" & sI
End If
On Error Resume Next
If (Dir(sI) <> "") Then
If (Err.Number = 0) Then
' Set the
background:
Dim tLBI As
LVBKIMAGE
tLBI.pszImage
= sI & Chr$(0)
tLBI.cchImageMax = Len(sI) + 1
tLBI.ulFlags
= LVBKIF_SOURCE_URL Or LVBKIF_STYLE_TILE
SendMessage
lvwTest.hwnd, LVM_SETBKIMAGE, 0, tLBI
' Set the
background colour of the ListView to &HFFFFFFFF (-1)
' so it will
be transparent!
SendMessageLong lvwTest.hwnd, LVM_SETTEXTBKCOLOR, 0, CLR_NONE
Else
MsgBox
"Error with File '" & sI & "' :" &
Err.Description & ".", vbExclamation
End If
Else
MsgBox "File '" &
sI & "' not found.", vbExclamation
End If
End If
End Sub
Private Sub Form_Load()
Dim i As Byte
Dim itmX As ListItem
Dim lR As Long
With lvwTest
'// required for using bitmaps
lR = CoInitialize(0)
Debug.Print lR
If (lR <> NOERROR) And (lR
<> S_FALSE) Then
Debug.Print
"CoInitialize failed"
End If
.ColumnHeaders.Add , "H1",
"Col1"
.ColumnHeaders.Add , "H2",
"Col2"
.ColumnHeaders.Add , "H3",
"Col3"
.ColumnHeaders.Add , "H4",
"Col4"
Randomize
For i = 1 To 20
' Add text
Set itmX = .ListItems.Add(,
"C" & i, "Test Item " & i)
' Col2= Col2
+ Item
itmX.SubItems(1) = "Col2 " & i
' Col3= Item
Number
itmX.SubItems(2) = i
Next i
SetBackground
End With
End Sub
Comments