Solved

Unable to display items in Listview

Posted on 2002-07-10
3
349 Views
Last Modified: 2008-02-01
I have a problem that when I start my program with blank listview with open file (using common dialog) feature, after selecting a file from my hard drive, the status bar displays the file's information but the listview does not show anything.

Here is the coding for the whole form:

Option Explicit

Const title_name = "RelZip"

Dim OKcomp As Boolean  
Dim OKdecomp As Boolean
Dim busy As Boolean    
Public WithEvents huff As clsHuffman
Public WithEvents comp As clsLempel

Public Sub deleteitems()
    'remove selected items in listview
    Dim a, idx, OK
    Dim Item As ListItem
   
    On Error GoTo cancelDel
    Screen.MousePointer = vbArrowHourglass
    lsvDisplay.Sorted = False
    For a = lsvDisplay.ListItems.count To 1 Step -1
        Set Item = lsvDisplay.ListItems(a)
        If Item.Selected Then
            idx = Val(Item.Tag)
            lsvDisplay.ListItems.Remove a
            comp.DeleteFile idx
        End If
    Next
   
    lsvDisplay.Sorted = True
    lsvDisplay.Refresh
    update_info False
    Screen.MousePointer = vbNormal
    Exit Sub
   
cancelDel:
    OK = ReportErrorCont("DeleteItems()", ModName, Err, Error)
    If OK Then
        Resume Next
    Else
        Exit Sub
    End If
   
End Sub

Sub new_archive()
    dlgNewArchive.Show 1, Me
    If dlgAccept Then
        comp.NewArchive rel.comfile, rel.comfold, rel.inc_file, rel.inc_subfold
        Fill_List
     End If
End Sub

Sub AddingFile()
    Dim OK, n
    Dim FileList() As String
   
    OK = cus_select(commdlg, FileList())
    If OK Then
        n = comp.Add_Files(FileList())
        Fill_List
        update_info False
    End If
End Sub

Sub open_archive()
'Open an existing archive
    dlgOpen.Show 1, Me
    comp.OpenArchive rel.comfile
    update_info False
End Sub

Public Sub cus_resize()
    Dim wide, height
    Dim Clear
   
    wide = Me.Width
    height = Me.height
    If Me.WindowState <> vbMinimized Then
        Clear = True
        If wide < 6000 Then
            Me.Width = 6000
            Clear = False
        End If
        If height < 3500 Then
            Me.height = 3500
            Clear = False
        End If
        If Clear Then
            wide = Me.ScaleWidth
            height = Me.ScaleHeight
            lsvDisplay.Move 60, tbrButtons.height, wide - 120, height - tbrButtons.height - statDisplay.height - 30
        End If
        'statDisplay.Panels("Info").left , height - statDisplay.height + 45
    End If
End Sub

Function cus_select(cdlg As CommonDialog, FileName() As String) As Boolean
    'Use commondialog to add file to archive
    On Error GoTo cus_selErr
    cdlg.Filter = "All files (*.*)|*.*|"
    cdlg.FilterIndex = 1
    cdlg.flags = cdlOFNAllowMultiselect Or cdlOFNFileMustExist Or cdlOFNExplorer Or cdlOFNNoDereferenceLinks
    cdlg.FileName = ""
    cdlg.CancelError = True
    cdlg.ShowOpen
    FileName() = split(cdlg.FileName, vbNullChar)
    tbrButtons.Buttons.Item(6).Enabled = True
    tbrButtons.Buttons.Item(8).Enabled = True
    cus_select = True
    Exit Function

cus_selErr:
cus_select = False

End Function

Sub Fill_List()
    'Scan folders & files & fill listview
    Dim myItem As ListItem, OK
    Dim i As Long
    Dim x As Long
    On Error GoTo ListviewErr
    Screen.MousePointer = vbArrowHourglass
    lsvDisplay.Sorted = False
    lsvDisplay.ListItems.Clear
    x = comp.NumFiles
    For i = 1 To x
        Set myItem = lsvDisplay.ListItems.Add()
        myItem.Key = comp.Key(i)
        myItem.SmallIcon = comp.IconKey(i)
        myItem.text = comp.Name(i)
        myItem.Tag = CStr(i)
        With lsvDisplay
            myItem.SubItems(1) = rightjust(comp.Size(i), "###,###,##0")
            myItem.SubItems(2) = rightjust(comp.CompSize(i), "###,###,##0")
            myItem.SubItems(3) = rightjust(comp.Ratio(i), "##0.00%")
            myItem.SubItems(4) = Format(comp.Modified(i), "yyyy/mm/dd hh:mm")
            myItem.SubItems(5) = comp.RelativePath(i)
        End With
    Next
    lsvDisplay.Sorted = True
    Screen.MousePointer = vbNormal
    Exit Sub
ListviewErr:
OK = errReportConti("ListviewFiles()", title_name, Err, Error)
If OK Then
  Resume Next
Else
  Exit Sub
End If
End Sub
       
Private Sub proc(Val As Single, Info As String, Optional display As Boolean = True)

End Sub

Sub update_info(inc_time As Boolean)
    'Update the info panel in the status bar
    Select Case comp.Status
        Case csOK, csCreate
            statDisplay.Panels("Info") = Format(comp.NumFiles, "#,##0") & " file(s) " & Format(comp.TotalSize / 1024, "#,##0") & " Kb  " & Format(comp.TotalCompress_Size / 1024, "#,##0") & " Kb compressed  Ratio " & Format(comp.TotalCompress_Ratio, "##0.00%")
            Me.Caption = "RelZip - " & rel.comfile
        Case Else
            Me.Caption = "RelZip"
            statDisplay.Panels("Info") = ""
    End Select
End Sub

Sub stat_update(Optional nat As Boolean = False)
    'Check & Update status
    Static OldStatus As LempStatus
    'static OldStatus2 as
    If comp.Status <> OldStatus Or nat Then
        OldStatus = comp.Status
        Select Case OldStatus
            Case csEmpty
                tbrButtons.Buttons("Add").Enabled = False
                tbrButtons.Buttons("Extract").Enabled = False
                'tbrButtons.buttons("Refresh").enabled = False
                tbrButtons.Buttons("compress").Enabled = False
                tbrButtons.Buttons("password").Enabled = False
                'Menu Status
                mnuAdd.Enabled = False
                mnuExtract.Enabled = False
                mnuDelete.Enabled = False
                mnuCompress.Enabled = False
            Case csOK   'Ready to compress
                tbrButtons.Buttons("Add").Enabled = True
                tbrButtons.Buttons("Extract").Enabled = False
                'tbrButtons.buttons("Refresh").enabled = False
                tbrButtons.Buttons("compress").Enabled = False
                tbrButtons.Buttons("password").Enabled = True
                'Menu Status
                mnuAdd.Enabled = True
                mnuExtract.Enabled = False
                mnuDelete.Enabled = False
                mnuCompress.Enabled = False
                statDisplay.Panels("Status").text = "OK"
            Case csCreate   'Ready to decompress
                statDisplay.Panels("Percent").text = ""
                tbrButtons.Buttons("Add").Enabled = True
                'tbrButtons.Buttons("Add Folder").Enabled = True
                'tbrButtons.Buttons("Refresh").Enabled = True
                'tbrButtons.Buttons("Delete").Enabled = True
                tbrButtons.Buttons("compress").Enabled = True
                tbrButtons.Buttons("password").Enabled = True
                'Update Menu status
                mnuAdd.Enabled = True
                mnuExtract.Enabled = False
                mnuDelete.Enabled = True
                mnuCompress.Enabled = False
            Case csBusy
                statDisplay.Panels("Status").text = "Busy"
        End Select
        statDisplay.Refresh
    End If
End Sub

Sub Compress()
    dlgCompOpt.Show vbModal, Me
    If dlgAccept Then
    'Dim file_ext As String
    'Dim checkname As String
    'file_ext = dlgNewArchive.txtInput.text
    'checkname = right(file_ext, 3)
    'If checkname = "rlz" Then
        comp.Compress_File rel.comfile, rel.Comp_Level, rel.disk_split, rel.split_option
        Fill_List
        update_info True
    End If
    'ElseIf checkname = "rlh" Then
    '    huff.comp_file
    'End If
   
End Sub

Sub decompress()
    dlgExtract.Show 1
End Sub

Private Sub comp_StatChange(newStat As LempStatus)
    stat_update
End Sub

Private Sub Form_Load()
   
    tbrButtons.Buttons.Item(4).Enabled = False
    mnuAdd.Enabled = False
    mnuDelete.Enabled = False
    mnuExtract.Enabled = False
    Set comp = New clsLempel
    Set huff = New clsHuffman
    comp.Initialise lsvDisplay, imgIcon, picIco, picIcoDef
End Sub

Private Sub Form_Resize()
    cus_resize
End Sub

Private Sub lsvDisplay_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
    'sorting based on column
    Screen.MousePointer = vbArrowHourglass
    DoEvents
    If ColumnHeader.Index - 1 = lsvDisplay.SortKey Then
        If lsvDisplay.SortOrder = lvwAscending Then
            lsvDisplay.SortOrder = lvwDescending
        Else
            lsvDisplay.SortOrder = lvwAscending
        End If
    Else
        lsvDisplay.SortKey = ColumnHeader.Index - 1
    End If
    'set sorted = true for list sorting
    lsvDisplay.Sorted = True
    Screen.MousePointer = vbNormal
    DoEvents

End Sub

Private Sub lsvDisplay_KeyDown(KeyCode As Integer, Shift As Integer)
    'handling key in list view
    Select Case KeyCode
        Case vbKeyDelete
            deleteitems
        End Select
End Sub

Private Sub mnuAbout_Click()
    frmAbout.Show 1
End Sub

Private Sub mnuAdd_Click()
    AddingFile
End Sub

Private Sub mnuCompress_Click()
    Compress
End Sub

Private Sub mnuConfig_Click()
    frmOption.Show 1
End Sub

Private Sub mnuExit_Click()
    Unload Me
End Sub

Private Sub mnuExtract_Click()
    decompress
End Sub

Private Sub mnuNew_Click()
    new_archive
End Sub

Private Sub mnuOpen_Click()
    open_archive
End Sub

Private Sub mnuPassword_Click()
    dlgPassword.Show 1
End Sub

Private Sub tbrButtons_ButtonClick(ByVal Button As MSComctlLib.Button)
    'alternate way to execute functions
    On Error Resume Next
    Select Case Button.Key
        Case "New"
            new_archive
        Case "Open"
            open_archive
        Case "Extract"
            decompress
        Case "Add"
            AddingFile
        Case "compress"
            Compress
    End Select
End Sub

When I use a simple form with textbox to track the line "x = comp.numfiles" (refer to class module), the textbox displays 0, which means after opening a file and the counter did not register. What is the problem here?

I hope to receive reply ASAP. Thanks

Viewer
0
Comment
Question by:program_viewer
  • 2
3 Comments
 
LVL 18

Expert Comment

by:mdougan
ID: 7146084
Since you didn't provide the code for the clsLempel, we can only guess what is going on in

n = comp.Add_Files(FileList())

I'd put a beakpoint on the line (in AddingFiles)

OK = cus_select(commdlg, FileList())

I'd step through that procedure and then see what the contents of FileList is after it returns from that function.  If indeed you have at least one array element, then step through the code into the comp.Add_Files and verify that it's processing the file list correctly and updating it's own count property.  If the comp object's key array etc is not being properly initialized, or if the Add_Files method is not setting the count property, then your listview code wont work.
0
 

Author Comment

by:program_viewer
ID: 7150842
Actually the listview is able to display most of the items inside except the filename's icon, which is left blank inside the listview. Any comments on this.
0
 
LVL 18

Accepted Solution

by:
mdougan earned 45 total points
ID: 7151927
Well, the icon display is dependent upon which mode you are displaying the list in.  There is Report mode, which, if you are using subitems you are probably useing.  I always specify the icon in the listitems Add method.  And I usually specify both a Small and Large Icon (even if I point them to the same imagelist).  Make sure that you've set the image list for the listview control, and then I use the index number of the icon, not the text key.  Theoretically, you could use the key, but I prefer the number.
0

Featured Post

What Security Threats Are You Missing?

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

Join & Write a Comment

Most everyone who has done any programming in VB6 knows that you can do something in code like Debug.Print MyVar and that when the program runs from the IDE, the value of MyVar will be displayed in the Immediate Window. Less well known is Debug.Asse…
I was working on a PowerPoint add-in the other day and a client asked me "can you implement a feature which processes a chart when it's pasted into a slide from another deck?". It got me wondering how to hook into built-in ribbon events in Office.
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

743 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

9 Experts available now in Live!

Get 1:1 Help Now