ListView out of memory

[kmomberg]

I have been working on a VB6 project off and on for the past several months to allow me to preview graphic files (primarily JPG's) on the HDD as thumbnails to identify duplicates or partial images. I originally started out using the ListView control but found with a thumbnail size of 100x100 pixels, I run out of memory after ~300 files. The filesize of these jpg's is an average of 30K. The directory size is ~5MB. I also wanted to stretch the image to fit the horizontal or vertical size of the thumbnail preserving the aspect ratio. I could not find a way to accomplish this. I also wanted to do something like a tooltip to give image details when the cursor is over the thumbnail. Sample code (without the DIM's to save post space) is below:

Private Sub cmdImageList_Click()
  
  ListView1.Icons = Nothing
  ListView1.SmallIcons = Nothing
  
  ListView1.ListItems.Clear
  ImageList1.ListImages.Clear
  
  ImageList1.ImageHeight = GetThumbnailsize()
  ImageList1.ImageWidth = GetThumbnailsize()

  ListView1.View = lvwIcon

  ListView1.ColumnHeaders.Clear
  ListView1.ColumnHeaders.Add , , "Filename", 2000
  ListView1.ColumnHeaders.Add , , "X x Y", 1000
  ListView1.ColumnHeaders.Add , , "Length", 1000
  ListView1.ColumnHeaders.Add , , "N", 500
  
  cntPics = 0
  cntThumbs = 0
  On Error Resume Next
  Err.Clear
  
  List1.Clear
  List1.AddItem Dir1.Path & "\"
  
  SSTab1.Tab = 2
  
  i = 1
  Do While List1.ListCount > 0
    nextdir = List1.List(0)                     'save top most element
    List1.RemoveItem (0)                        'do not process the same directory twice
    SBar1.Panels(enmSBar1.srcpath) = nextdir
    filename = Dir(nextdir & "*.jpg")
  
  Do While filename <> &quot;&quot;
    fname = nextdir & filename
    ImageList1.ListImages.Add i, , LoadPicture(fname)
    
    If Err.Number = 0 Then
      imginfo.ReadImageInfo_2 fname
      picX = imginfo.width
      picY = imginfo.height
      
      ListView1.Icons = ImageList1
      Set itmX = ListView1.ListItems.Add(i, , filename, i)
      itmX.SubItems(1) = Trim(Format(picX, &quot;##,##0&quot;)) & &quot; x &quot; & Trim(Format(picY, &quot;##,##0&quot;))
      itmX.SubItems(2) = Right(Space(10) & Str(FileLen(fname)), 10)
      itmX.SubItems(3) = i
      
      cntThumbs = cntThumbs + 1
      SBar1.Panels(enmSBar1.Extensions) = &quot;Pics: &quot; & Str(cntThumbs) & &quot; &quot;
      DoEvents
    Else
      SBar1.Panels(enmSBar1.Extensions) = &quot;Pics: &quot; & Str(cntThumbs) & &quot;/&quot; & Str(i) & &quot; &quot;
    End If
    filename = Dir
    i = i + 1
    Err.Clear
  Loop 'filename <> &quot;&quot;
  DoEvents
  
  Loop 'list1.listcount > 0
  DoEvents
  Exit Sub

So I investigated the use of a picturebox within a picturebox. This allows me to easily scroll the window vertically. The limitation I found with this, besides being slow, is after you reach a height of ~32K you run out of space to draw the picturebox of the next image. I am able to stretch the picture horizontally or vertically to fit the thumbnail size preserving the aspect ratio of the original image. As a bonus I get a tooltip with the picture details by resting the mouse on the thumbnail.

Public Sub ShowPicInPic()

  On Error Resume Next

  PicFrame.Top = SSTab1.TabHeight + 50
  VScroll1.Top = PicFrame.Top
  picThumbs.Top = PicFrame.Top + 5
  picThumbs.Left = PicFrame.Left + 5
  picThumbs.width = PicFrame.width - 10
  picThumbs.height = PicTNn(0).height
  
  PicFrame.height = SSTab1.height - SSTab1.TabHeight - 300
  VScroll1.height = PicFrame.height
  VScroll1.Min = 1
  VScroll1.Max = 1
  
  startx = 0
  starty = 0
  currX = startx
  currY = starty
  i = 1
  cntPics = i
  cntPicsMax = i
  
  filename = Dir(vbPicList & "*.jpg")
  Do While filename <> &quot;&quot;
    fname = vbPicList & filename
    
    Err.Clear
    Load PicTNn(i)
    PicTNn(i).Picture = Nothing
    If Err.Number = 0 Then
      cntPics = i
      If currY > picThumbs.height Then
        picThumbs.height = currY + PicTNn(i).height
      End If
        
      PicTNn(i).height = GetThumbnailsize * Screen.TwipsPerPixelY
      PicTNn(i).width = GetThumbnailsize * Screen.TwipsPerPixelX
      PicTNn(i).Left = currX
      PicTNn(i).Top = currY
      PicTNn(0).Picture = LoadPicture(fname)
      
      imginfo.ReadImageInfo_2 fname
      
      picwidth = imginfo.width
      picheight = imginfo.height
          
      If picwidth <> 0 And picheight <> 0 Then
        PicTNn(i).Visible = True
        aspratio = picwidth / picheight
        If aspratio < 1 Then                   'height > width
          scaledY = PicTNn(i).height
          scaledX = scaledY * aspratio
          startx = (PicTNn(i).width - scaledX) \ 2
          endx = startx + scaledX
          starty = 0
          endy = PicTNn(i).height
        Else
          scaledX = PicTNn(i).width
          scaledY = scaledX / aspratio
          startx = 0
          endx = PicTNn(i).width
          starty = (PicTNn(i).height - scaledY) \ 2
          endy = starty + scaledY
        End If
        
        PicTNn(i).PaintPicture PicTNn(0).Picture, startx, starty, endx - startx, endy - starty
      
        PicTNn(i).ToolTipText = ParseFilename(fname) & Space(5) _
         & Trim(Str(picwidth)) & &quot; x &quot; & Trim(Str(picheight)) & Space(5) _
         & Format(FileLen(fname), &quot;#,###,##0  &quot;)
        
        SBar1.Panels(enmSBar1.misc) = &quot; Pics: &quot; & Trim(Str(i)) & &quot;  &quot;
        
        currX = currX + PicTNn(i).width
        If currX + PicTNn(i).width > SSTab1.width Then
          currX = 0                            'startX
          currY = currY + PicTNn(i).height
          VScroll1.Max = currY
        End If
      End If
    Else
      SBar1.Panels(enmSBar1.misc) = &quot; Pics: &quot; & Trim(Str(cntPics)) _
       & &quot;/&quot; & Trim(Str(cntPicsMax)) & &quot;  &quot;
    End If
    cntPicsMax = i
    i = i + 1
    filename = Dir
    DoEvents
  Loop
End Sub

Is there a way around each of these limitations? I prefer to use the ListView. The objectives are: vertically scroll the thumbnails of perhaps as many as 1000-3000 images, resize the original image to maximize the horizontal OR vertical thumbnail size preserving the aspect ratio, and a tooltip feature to display the file details.

I have seen commercial and shareware programs capable of doing this in one window without resorting to next page, previous page controls. VB should be capable of doing this without me resorting to learning VC where I can control the allocation of additional memory.

 

[SemperFiDownUnda]

The problem you are incountering is that though your images might not be large on disk they use up alot more resources on screen. Let me explain

100x100 image is ~40k (even though the full resolution image may be a smaller size JPEG) That means that every 25 takes up a meg. To boot you have to account for off screen buffers and the like.

What you may want to do is set up your own paging. Have a dynamic array of picture boxes and a scrollbar you control and when you scroll you shift the pictures up or down and just read in the new pictures to the bottom or top. You wear a load time when ever you move the scroll bar but then agian you don't actually have 300 images on screen at once. Even at 100x100 image on a desktop of 1024x768 your looking at only around 70 images.

But why reinvent the wheel unless you are doing this for a learning process. Programs like AC-DSee do what you want and are VERY efficient and fast.

 

[kmomberg]

Can you give an example of how the dynamic array would work? As you insert or delete elements of the array, would this not create a lot of flicker due to having to repaint the entire window to accommodate the new view? Do you imagine this is how programs like ACDSee works? Those programs always seem to scroll rather smoothly leading me to believe there is some programmer trick they are using.

This project is intended to to provide the main interface of maintaining my own picture library. The thumbnails would allow me to quickly view incomplete downloads or improperly converted files.

Since I usually always desire some additional feature in a freeware, shareware or commercial program I like to know what API or technique is used so I can modify the source as needed.

 

[SemperFiDownUnda]

Programs like ACDSee work well because they manage the bliting of images. Only visible images get drawn to the offscreen buffer. Often what happens is they shift whole blocks of memory up or down then just fill in the gap. As an example look at this web page and the scroll bar. Size the window to about 640x480.
Take a screen shot using Alt-Print Scrn and paste that into an instance of Paint.
Press the down or up button on the scroll bar once
Take a screen shot using Alt-Print Scrn and paste that into a second instance of Paint.
Look at the images side by side. 90% of the image is the same....just shifted up or down. The most effective way to display the image is shift memory up or down leaving a gap that needs to be filled in and then figure out what should be drawn there and blit that to the off screen buffer then blit the entire off screen buffer to the on screen buffer.

Unfortunately you don't directly have the ability to do this type of work with VB. You can do a similar thing

Here is some code I just quickly hacked together
Create a EXE with 1 form.
Opent the .FRM file in notepad and copy this in

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   10440
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   14775
   LinkTopic       =   "Form1"
   ScaleHeight     =   10440
   ScaleWidth      =   14775
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton Command2 
      Caption         =   "Command2"
      Height          =   495
      Left            =   13440
      TabIndex        =   4
      Top             =   600
      Width           =   1215
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   495
      Left            =   13440
      TabIndex        =   3
      Top             =   0
      Width           =   1215
   End
   Begin VB.TextBox Text1 
      Height          =   315
      Left            =   0
      TabIndex        =   1
      Text            =   "Text1"
      Top             =   0
      Width           =   11415
   End
   Begin VB.CommandButton cmdGetLocation 
      Caption         =   "..."
      Height          =   315
      Left            =   11520
      TabIndex        =   0
      Top             =   0
      Width           =   495
   End
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   12240
      Top             =   1320
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.FileListBox File1 
      Height          =   1065
      Left            =   12120
      TabIndex        =   2
      Top             =   0
      Visible         =   0   'False
      Width           =   1215
   End
   Begin VB.Image Image1 
      Height          =   1500
      Index           =   0
      Left            =   0
      Stretch         =   -1  'True
      Top             =   360
      Width           =   1500
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub cmdGetLocation_Click()
    CommonDialog1.ShowOpen
    Dim i As Integer
    i = InStrRev(CommonDialog1.FileName, "\")
    Text1.Text = Left(CommonDialog1.FileName, i)
    LoadImages
End Sub

Private Sub Command1_Click()
    For i = 0 To 39
        Image1(i).Picture = Image1(i + 8).Picture
    Next i
    'load bottom row of pictures from disk
End Sub

Private Sub Command2_Click()
    For i = 47 To 8 Step -1
        Image1(i).Picture = Image1(i - 8).Picture
    Next i
    'load top row of pictures from disk

End Sub

Private Sub Form_Load()
    For i = 1 To 47
        Load Image1(i)
        If ((i + 1) Mod 8) = 1 Then
            Image1(i).Left = 0
            Image1(i).Top = Image1(i - 1).Top + 1500
        Else
            Image1(i).Left = Image1(i - 1).Left + 1500
            Image1(i).Top = Image1(i - 1).Top
        End If
        Image1(i).Visible = True
    Next i
End Sub


Private Sub LoadImages()
    File1.Path = Text1.Text
    Dim i As Integer
    Dim j As Integer
    Dim sFileName As String
    Dim sExt As String
    Dim iCurRow As Integer
    Dim iCurColumn As Integer
    iCurColumn = 1
    iCurRow = 1
    For i = 0 To 47
        File1.ListIndex = i
        sFileName = File1.FileName
        j = InStrRev(sFileName, ".")
        sExt = Right(sFileName, Len(sFileName) - j)
        If (LCase(sExt) = "gif") Or (LCase(sExt) = "bmp") Or (LCase(sExt) = "jpg") Or (LCase(sExt) = "jpeg") Then
            Image1(i).Picture = LoadPicture(Text1.Text & sFileName)
        End If
    Next
End Sub

Now does it flicker? a bit but nothing that you really can counter.

 

[kmomberg]

Most excellent. I only tinkered with this a short time today to customize it to expound on your technique. I know what I will be doing this weekend. Thanks for the tip.

 

[SemperFiDownUnda]

Glad to help