Enregistrer et charger listview dans fichier avec image etc...

Soyez le premier à donner votre avis sur cette source.

Vue 9 897 fois - Téléchargée 1 155 fois

Télécharger le projet
Commenter

Description

Salut a tous,

Voici un ptit code pour enregistrer une listview dans un fichier et la recharger depuis ce fichier

Il permet d'enregister les elements texte, images et les proprietes d'apparence
Il permet aussi de sauvegarder la position et la taille...

Toutes les proprietes n'y sont pas mais il vous sera facile d'en ajouter...

Le code est un peu long a cause de mes structures a la noix, mais il est tres simple et relativement rapide (pas de traitement de chaine (split,left etc...)

La methode est peut etre discutable, si vous avez une meilleur idée je suis prenneur.

++

Source / Exemple : 


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
Télécharger le projet

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

Afficher les 6 commentaires
Signaler Commenter la réponse de ciberrique
ciberrique
Messages postés
591
Date d'inscription
lundi 25 août 2003
Statut
Membre
Dernière intervention
18 juillet 2010
 -
Trés bonne idée, le code est plutot joli, et j'y apprend même des choses j'aime bien ^^.

8/10
Signaler Commenter la réponse de cs_EBArtSoft
cs_EBArtSoft
Messages postés
4531
Date d'inscription
dimanche 29 septembre 2002
Statut
Modérateur
Dernière intervention
22 avril 2019
 3 -
utilise l'objet property bag c'est plus lent mais ça marche tres bien

@+
Signaler Commenter la réponse de draluorg
draluorg
Messages postés
627
Date d'inscription
vendredi 23 avril 2004
Statut
Membre
Dernière intervention
25 novembre 2010
 -
Salut a tous,

PCPT> pour les points manquants je l'ai dis dans la description, j'ai mis les principaux mais il est tres facile d'en ajouter...
Pour les params optionel dans le Load c'est fait expres, pour plus de souplesse...
Pour la classe, oui ce serait sans doutes plus pratique, mais j'ai une alergie aux classe lol

Sinon pour les objets j'ai en effet oublié de supprimer un LVI et de mettre un copymem pour detruire la structure je corrigerais ca quand j'aurais une minute ;)

ciberrique> Merci et content que ca te plaise :)

Eb> eh wai en effet le property bag est une solution mais la seule fois ou j'ai voulu l'utiliser ca m'a vite soulé...
Je vais quand meme regarder quand j'aurais le temps

Merci pour vos commentaires

++
Signaler Commenter la réponse de draluorg
draluorg
Messages postés
627
Date d'inscription
vendredi 23 avril 2004
Statut
Membre
Dernière intervention
25 novembre 2010
 -
plop,

j'ai mis le code a jour, il est maintemant compatible Common Control 5 et 6
j'ai aussi fais un module de classe et mis une verification de la presence du fichier avant le load...

++
Signaler Commenter la réponse de cs_PaTaTe
cs_PaTaTe
Messages postés
1878
Date d'inscription
mercredi 21 août 2002
Statut
Contributeur
Dernière intervention
7 janvier 2019
 -
EBArtSoft > Les propbag c'est bien c'est pratique mais dans ce cas si ça serait du suicide ! Testes tu verra le resultat d'un propbag donne le double de données par rapport à celles injectées (en terme de poids j'entends) donc ici c'est même pas la peine d'y penser.
Commenter la réponse de PCPT
S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (draluorg)