ENREGISTRER ET CHARGER LISTVIEW DANS FICHIER AVEC IMAGE ETC...

Option Explicit

Public Enum LvImageOption
    Nop = 0
    IndexOnly = 2
    ImageAndIndex = 3
End Enum

Private Type RECT
    Left    As Long
    Top     As Long
    Right   As Long
    Bottom  As Long
End Type

Private Type LvSaveOption
    Appaerence      As Boolean
    Font            As Boolean
    Position        As Boolean
    Images          As Long
    SmallImages     As Long
End Type

Private Type LvSubItem
    index   As Long
    Caption As String
End Type

Private Type LvImage
    ImgData() As Byte
End Type

Private Type LvFont
    sName           As String
    Bold            As Boolean
    Italic          As Boolean
    Size            As Long
    Strikethrough   As Boolean
    Underline       As Boolean
End Type

Private Type LvItem
    Caption         As String
    Key             As String
    SubItemCount    As Long
    SubItems()      As LvSubItem
    index           As Long
    ImageIndex      As Long
    SmallImageIndex As Long
End Type

Private Type Column
    index       As Long
    Caption     As String
    width       As Single
    Key         As String
End Type

Private Type LvStruct
    View                As Long
    ForeColor           As Long
    ExtendedStyle       As Long
    LabelEdit           As Long
    Appearance          As Long
    Arrange             As Long
    BackColor           As Long
    BorderStyle         As Long
    Pos                 As RECT
    Font                As LvFont
    ImageList()         As LvImage
    SmallImageList()    As LvImage
    ImageCount          As Long
    SmallImageCount     As Long
    ItemCount           As Long
    ColumCount          As Long
    Items()             As LvItem
    Colums()            As Column
    SaveOption          As LvSaveOption
End Type

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 PathFileExistsA Lib "shlwapi.dll" (ByVal pszPath As String) As Long
Private Declare Function DeleteFileA Lib "KERNEL32" (ByVal lpFileName As String) As Long
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Private Declare Function SetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, lParam As Any) As Long

Private Type LVITEMA
    mask        As Long
    iItem       As Long
    iSubItem    As Long
    State       As Long
    stateMask   As Long
    pszText     As String
    cchTextMax  As Long
    iImage      As Long
    lParam      As Long
    iIndent     As Long
End Type

Private Const LVM_FIRST                     As Long = &H1000&
Private Const LVM_SETITEMTEXT               As Long = (LVM_FIRST + 46)
Private Const LVM_GETITEMTEXT               As Long = (LVM_FIRST + 45)
Private Const LVM_SETEXTENDEDLISTVIEWSTYLE  As Long = (LVM_FIRST + 54)
Private Const LVM_GETEXTENDEDLISTVIEWSTYLE  As Long = (LVM_FIRST + 55)
Private LvStruc As LvStruct
Private Lv As ListView

Public Property Let SaveAppaerence(ByVal Value As Boolean)
    LvStruc.SaveOption.Appaerence = Value
End Property
Public Property Let SaveFont(ByVal Value As Boolean)
    LvStruc.SaveOption.Font = Value
End Property
Public Property Let SavePosition(ByVal Value As Boolean)
    LvStruc.SaveOption.Position = Value
End Property
Public Property Let SaveImages(ByVal Value As LvImageOption)
    LvStruc.SaveOption.Images = Value
End Property
Public Property Let SaveSmallImages(ByVal Value As LvImageOption)
    LvStruc.SaveOption.SmallImages = Value
End Property

Public Function LvToFile(LstView As ListView, ByVal sFile As String, Optional ImgList As ImageList, Optional SmallImgList As ImageList) As Long

    Dim i           As Long
    Dim j           As Long
    Dim Litem       As LVITEMA
    
    Set Lv = LstView
    
    With LvStruc
        If .SaveOption.Appaerence = True Then GetAppearence
        If .SaveOption.Font = True Then GetFont
        If .SaveOption.Position Then GetWindowRect Lv.hwnd, .Pos
        If .SaveOption.Images = ImageAndIndex Then .ImageCount = GetImgList(ImgList, .ImageList)
        If .SaveOption.SmallImages = ImageAndIndex Then .SmallImageCount = GetImgList(SmallImgList, .SmallImageList)
        
        .ColumCount = Lv.ColumnHeaders.Count
        .ItemCount = Lv.ListItems.Count
        ReDim .Colums(.ColumCount)
        ReDim .Items(.ItemCount)
        
        For i = 0 To .ItemCount - 1
            .Items(i).Caption = Lv.ListItems(i + 1).Text
            .Items(i).index = i + 1
            .Items(i).SubItemCount = .ColumCount
            .Items(i).SmallImageIndex = Lv.ListItems(i + 1).SmallIcon
            .Items(i).ImageIndex = Lv.ListItems(i + 1).Icon
            
            If .SaveOption.SmallImages > 0 Then .Items(i).SmallImageIndex = Lv.ListItems(i + 1).SmallIcon
            If .SaveOption.Images > 0 Then .Items(i).ImageIndex = Lv.ListItems(i + 1).Icon
            
            ReDim .Items(i).SubItems(.Items(i).SubItemCount)
            
            For j = 0 To .Items(i).SubItemCount - 1
                Litem.iItem = i + 1
                Litem.iSubItem = j + 1
                Litem.cchTextMax = 255
                Litem.pszText = String$(255, 0)
                Call SendMessage(Lv.hwnd, LVM_GETITEMTEXT, i, Litem)
                .Items(i).SubItems(j).Caption = Left$(Litem.pszText, InStr(1, Litem.pszText, Chr$(0)) - 1)
                .Items(i).SubItems(j).index = j + 1
            Next j
            
        Next i
         
        For i = 0 To .ColumCount - 1
            .Colums(i).Caption = Lv.ColumnHeaders(i + 1).Text
            .Colums(i).width = Lv.ColumnHeaders(i + 1).width
            .Colums(i).index = Lv.ColumnHeaders(i + 1).index
            .Colums(i).Key = Lv.ColumnHeaders(i + 1).Key
        Next i
    End With
    
    Set Lv = Nothing
    DeleteFileA sFile
    
    Open sFile For Binary As #1
        Put #1, , LvStruc
    Close #1
    
    Erase LvStruc.ImageList
    Erase LvStruc.SmallImageList
    Erase LvStruc.Items

End Function

Public Function FileToLv(LstView As ListView, ByVal sFile As String, Optional ImgList As ImageList, Optional SmallImgList As ImageList, Optional TmpPicBox As PictureBox) As Long
        
    Dim i       As Long
    Dim j       As Long
    Dim Lvi     As ListItem
    Dim Litem   As LVITEMA
    
    If PathFileExistsA(sFile) = 0 Then MsgBox "Error file not found!", vbCritical: Exit Function
    Set Lv = LstView
    
    Open sFile For Binary As #1
        Get #1, , LvStruc
    Close #1
    
    With LvStruc
    
        If .SaveOption.Appaerence Then SetAppearence
        If .SaveOption.Font Then SetFont
        If .SaveOption.Position = True Then SetWindowPos Lv.hwnd, 0, .Pos.Left, .Pos.Top, .Pos.Right - .Pos.Left, .Pos.Bottom - .Pos.Top, 0
    
        If .SaveOption.Images = ImageAndIndex Then SetImgList .ImageList, ImgList, TmpPicBox
        If .SaveOption.SmallImages = ImageAndIndex Then
            If .SaveOption.Images = ImageAndIndex Then
                If ImgList.Name <> SmallImgList.Name Then
                    SetImgList .SmallImageList, SmallImgList, TmpPicBox
                End If
            Else
                SetImgList .SmallImageList, SmallImgList, TmpPicBox
            End If
        End If
    
        For i = 0 To .ColumCount - 1
            If .ColumCount > Lv.ColumnHeaders.Count Then
                Lv.ColumnHeaders.Add .Colums(i).index, .Colums(i).Key, .Colums(i).Caption, .Colums(i).width
            Else
                Lv.ColumnHeaders(.Colums(i).index).Key = .Colums(i).Key
                Lv.ColumnHeaders(.Colums(i).index).width = .Colums(i).width
                Lv.ColumnHeaders(.Colums(i).index).Text = .Colums(i).Caption
            End If
        Next i
        
        For i = 0 To .ItemCount - 1
            Set Lvi = Lv.ListItems.Add(, , .Items(i).Caption)
            If .SaveOption.Images > 0 Then Lvi.Icon = LvStruc.Items(i).ImageIndex
            If .SaveOption.SmallImages > 0 Then Lvi.SmallIcon = .Items(i).SmallImageIndex
            For j = 0 To .Items(i).SubItemCount - 1
                Litem.iItem = i + 1
                Litem.iSubItem = j + 1
                Litem.cchTextMax = Len(.Items(i).SubItems(j).Caption)
                Litem.pszText = .Items(i).SubItems(j).Caption
                Call SendMessage(Lv.hwnd, LVM_SETITEMTEXT, i, Litem)
            Next j
        Next i
    
    End With
    
    Erase LvStruc.ImageList
    Erase LvStruc.SmallImageList
    Erase LvStruc.Items
    Set Lvi = Nothing
    Set Lv = Nothing

End Function

Private Sub GetAppearence()
    LvStruc.Appearance = Lv.Appearance
    LvStruc.Arrange = Lv.Arrange
    LvStruc.ExtendedStyle = GetListViewExtendedStyle(Lv.hwnd)
    LvStruc.BackColor = Lv.BackColor
    LvStruc.BorderStyle = Lv.BorderStyle
    LvStruc.ForeColor = Lv.ForeColor
    LvStruc.LabelEdit = Lv.LabelEdit
    LvStruc.View = Lv.View
End Sub
Private Sub SetAppearence()
    Lv.Appearance = LvStruc.Appearance
    Lv.Arrange = LvStruc.Arrange
    SetListViewExtendedStyle Lv.hwnd, LvStruc.ExtendedStyle
    Lv.BackColor = LvStruc.BackColor
    Lv.BorderStyle = LvStruc.BorderStyle
    Lv.ForeColor = LvStruc.ForeColor
    Lv.LabelEdit = LvStruc.LabelEdit
    Lv.View = LvStruc.View
End Sub

Private Sub GetFont()
    LvStruc.Font.Bold = Lv.Font.Bold
    LvStruc.Font.Italic = Lv.Font.Italic
    LvStruc.Font.Size = Lv.Font.Size
    LvStruc.Font.sName = Lv.Font.Name
    LvStruc.Font.Strikethrough = Lv.Font.Strikethrough
    LvStruc.Font.Underline = Lv.Font.Underline
End Sub
Private Sub SetFont()
    Lv.Font.Bold = LvStruc.Font.Bold
    Lv.Font.Italic = LvStruc.Font.Italic
    Lv.Font.Size = LvStruc.Font.Size
    Lv.Font.Name = LvStruc.Font.sName
    Lv.Font.Strikethrough = LvStruc.Font.Strikethrough
    Lv.Font.Underline = LvStruc.Font.Underline
End Sub

Private Sub SetImgList(LvImglist() As LvImage, ImList As ImageList, TmpPicBox As PictureBox)
    
    Dim i       As Long
    
    TmpPicBox.Picture = TmpPicBox.Image
    
    If ImList.ListImages.Count < UBound(LvImglist) Then
        For i = 0 To UBound(LvImglist)
            SetBitmapBits TmpPicBox.Picture.Handle, UBound(LvImglist(i).ImgData), LvImglist(i).ImgData(0)
            ImList.ListImages.Add , , TmpPicBox.Picture
        Next i
    End If
    
End Sub
Private Function GetImgList(ImgList As ImageList, LvImageList() As LvImage) As Long
    
    Dim BMP     As BITMAP
    Dim Size    As Long
    Dim b()     As Byte
    Dim icn     As IPictureDisp
    Dim l       As Long
    Dim i       As Long
    
    l = ImgList.ListImages.Count
    ReDim LvImageList(l - 1)
    
    For i = 0 To l - 1
        Set icn = ImgList.Overlay(i + 1, i + 1)
        GetObject icn.Handle, Len(BMP), BMP
        Size = BMP.bmWidth * BMP.bmHeight * BMP.bmBitsPixel \ BMP.bmPlanes
        ReDim LvImageList(i).ImgData(Size)
        GetBitmapBits icn.Handle, Size, LvImageList(i).ImgData(0)
    Next i
    
    Set icn = Nothing
    GetImgList = l
    
End Function

Private Function SetListViewExtendedStyle(ByVal LvHandle As Long, ByVal lvMask As Long)
    Call SendMessage(LvHandle, LVM_SETEXTENDEDLISTVIEWSTYLE, lvMask, ByVal -1)
End Function

Private Function GetListViewExtendedStyle(ByVal LvHandle As Long)
    GetListViewExtendedStyle = SendMessage(LvHandle, LVM_GETEXTENDEDLISTVIEWSTYLE, ByVal 0&, ByVal 0&)
End Function