15 мая 2023 года "Исходники.РУ" отмечают своё 23-летие!
Поздравляем всех причастных и неравнодушных с этим событием!
И огромное спасибо всем, кто был и остаётся с нами все эти годы!

Главная Форум Журнал Wiki DRKB Discuz!ML Помощь проекту


Как поместить фоновую картинку в 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