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
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.