Как поместить фоновую картинку в ListView
Данный код не обязателен для VB6, так как в нём у
ListView есть свойство Picture. Итак, добавьте на форму
элемент управления ListView и назовите его lvwTest.
Затем добавьте следующий код в форму.
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
|