frmmain.frm

WinBig. A file archive utility written in VB. Compression and decompression routines are LZSS. Full

    Load fFrmabout
    
    StatusPanelGreen
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Set fFrmExtractDir = Nothing
    Set fFrmabout = Nothing

    If Me.WindowState <> vbMinimized Then
        SaveSetting App.EXEName, "Settings", "MainLeft", Me.Left
        SaveSetting App.EXEName, "Settings", "MainTop", Me.Top
        SaveSetting App.EXEName, "Settings", "MainWidth", Me.Width
        SaveSetting App.EXEName, "Settings", "MainHeight", Me.Height
    End If
End Sub

Private Sub Form_Resize()
    On Error Resume Next
        
    lvList.Width = Me.Width - 150
    
    lvList.Height = Me.Height - lvList.Top - sbStatus.Height - tbBar.Height - 275

    sbStatus.Panels.Item(1).Width = Me.Width - (sbStatus.Panels.Item(2).Width + sbStatus.Panels.Item(3).Width) - 450
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Call ShutDown
End Sub

Private Sub lvList_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
    Dim llx As Long
                
    If ColumnHeader.Index - 1 <> lvList.SortKey Then
        lvList.SortOrder = lvwAscending
        lvList.SortKey = ColumnHeader.Index - 1
    Else
        If lvList.SortOrder = lvwAscending Then
            lvList.SortOrder = lvwDescending
        Else
            lvList.SortOrder = lvwAscending
        End If
    End If
    If ColumnHeader.Index = 4 Or ColumnHeader.Index = 6 Then
        mbNumSort = True
        lvList.Sorted = False
        SendMessage lvList.hWnd, LVM_SORTITEMS, lvList.hWnd, AddressOf LVSortNums
    Else
        mbNumSort = False
        lvList.Sorted = True
    End If
End Sub

Private Sub lvList_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    mSelectStart = True
End Sub

Private Sub mnuExtAll_Click()
    Dim llx As Long
    Dim ExtractDir As String
    
    If lvList.ListItems.Count = 0 Then Exit Sub
    
    If Not fFrmExtractDir.Display Then Exit Sub
    ExtractDir = fFrmExtractDir.Dir
    
    StatusPanelRed
    SetupBar lvList.ListItems.Count
    pbBar.Visible = True
    
    For llx = 1 To lvList.ListItems.Count
        pbBar.Value = llx
        Me.Refresh
        ExtractFile ExtractDir, lvList.ListItems(llx).Text, lvList.ListItems(llx).SubItems(6)
    Next llx
    
    pbBar.Visible = False
    StatusPanelGreen
End Sub

Private Sub mnuExtract_Click()
    Dim listcnt As Long, llx As Long
    Dim ExtractDir As String
    
    If mSelectStart = False Then Exit Sub
    
    If Not fFrmExtractDir.Display Then Exit Sub
    ExtractDir = fFrmExtractDir.Dir
    
    StatusPanelRed
    
    For llx = 1 To lvList.ListItems.Count
        If lvList.ListItems(llx).Selected Then
            listcnt = listcnt + 1
        End If
    Next llx
    
    SetupBar listcnt
    pbBar.Visible = True
    
    listcnt = 1
    For llx = 1 To lvList.ListItems.Count
        If lvList.ListItems(llx).Selected Then
            pbBar.Value = listcnt
            Me.Refresh
            If mbNumSort = False Then
                ExtractFile ExtractDir, lvList.ListItems(llx).Text, lvList.ListItems(llx).SubItems(6)
            Else
                ExtractFile ExtractDir, ListView_GetListItem(llx - 1, lvList.hWnd, 0), ListView_GetListItem(llx - 1, lvList.hWnd, 6)
            End If
            listcnt = listcnt + 1
        End If
    Next llx
    
    pbBar.Visible = False
    StatusPanelGreen
End Sub

Private Sub mnuNew_Click()
    Dim ExtractDir As String
    
    If Not ValidateKey(fFrmabout.tbRegNbr) Then
        MsgBox "Go Away"
        Exit Sub
    End If

    If sfile = "" Then
        sfile = App.Path + "\*.big"
    End If
    
    With dlgCommonDialog
        .DialogTitle = "New File"
        .CancelError = False
        .Filename = Dot(sfile, False, "\") + "\*.big"
        .Filter = "Big file (*.big)|*.big"
        .ShowOpen
        If Len(.Filename) = 0 Or Right(.Filename, 5) = "*.big" Then
            Exit Sub
        End If
        sfile = .Filename
    End With

    If Dir(sfile) <> "" Then
        MsgBox "File already Exists"
        Exit Sub
    End If

    If Not fFrmExtractDir.Display(True) Then Exit Sub
    ExtractDir = fFrmExtractDir.Dir
    
    StatusPanelRed
    
    SetupListView
    SetupBar 1
    pbBar.Visible = True
    
    Me.Refresh
    
    If BuildBig(sfile, ExtractDir, pbBar) Then
        OpenFile sfile
    End If
    
    pbBar.Visible = False
    StatusPanelGreen
End Sub

Private Sub mnuOpen_Click()
    If sfile = "" Then
        sfile = App.Path + "\*.big"
    End If
    
    With dlgCommonDialog
        .DialogTitle = "Open"
        .CancelError = False
        .Filename = Dot(sfile, False, "\") + "\*.big"
        .Filter = "Big file (*.big)|*.big"
        .ShowOpen
        If Len(.Filename) = 0 Or Right(.Filename, 5) = "*.big" Then
            Exit Sub
        End If
        sfile = .Filename
    End With

    OpenFile sfile
End Sub

Public Sub OpenFile(Filename As String)
    If LCase(Right(Filename, 3)) = "big" Then
        StatusPanelRed
        Call LoadBigFile(Filename, Me.lvList)
        StatusPanelGreen
        
        Me.Caption = "WinBig - " + Filename
        
        WriteRecentFiles Me, Filename
        GetRecentFiles Me
    
        mSelectStart = False
    End If
End Sub

Private Sub mnuAbout_Click()
    fFrmabout.Show 1
End Sub

Private Sub mnuExit_Click()
    Unload Me
End Sub

Private Sub mnuRecentFile_Click(Index As Integer)
    OpenFile Mid$(mnuRecentFile(Index).Caption, 4)
End Sub

Private Sub tbBar_ButtonClick(ByVal Button As MSComctlLib.Button)
    Select Case Button.Key
        Case "Open"
            mnuOpen_Click
        Case "New"
            mnuNew_Click
        Case "Extract"
            mnuExtract_Click
        Case "Extractall"
            mnuExtAll_Click
    End Select
End Sub

Private Sub StatusPanelGreen()
    sbStatus.Panels.Item(2).Picture = ilImages.ListImages("Green").Picture
    sbStatus.Panels.Item(3).Picture = ilImages.ListImages("Gray").Picture
    Screen.MousePointer = vbNormal
End Sub

Private Sub StatusPanelRed()
    sbStatus.Panels.Item(2).Picture = ilImages.ListImages("Gray").Picture
    sbStatus.Panels.Item(3).Picture = ilImages.ListImages("Red").Picture
    Screen.MousePointer = vbHourglass
End Sub

Private Sub SetupListView()
    lvList.ListItems.Clear
    lvList.ColumnHeaders.Clear

    lvList.ColumnHeaders.Add , , "Name", 2400
    lvList.ColumnHeaders.Add , , "Type", 1100
    lvList.ColumnHeaders.Add , , "Modified", 1850
    lvList.ColumnHeaders.Add , , "Size", 1000
    lvList.ColumnHeaders.Add , , "Ratio", 700
    lvList.ColumnHeaders.Add , , "Packed", 1000
    lvList.ColumnHeaders.Add , , "Path", 6000
    
    lvList.ColumnHeaders(4).Alignment = lvwColumnRight
    lvList.ColumnHeaders(5).Alignment = lvwColumnRight
    lvList.ColumnHeaders(6).Alignment = lvwColumnRight

    lvList.SortOrder = lvwDescending
    lvList.SortKey = 0
    lvList.Sorted = False
    mbNumSort = False

    EmptyBig
End Sub

Private Sub SetupBar(Max As Long)
    pbBar.Top = sbStatus.Top + 50
    pbBar.Left = sbStatus.Left + sbStatus.Panels(1).Left
    pbBar.Width = sbStatus.Panels(1).Width - 10
    pbBar.Min = 0
    pbBar.Max = Max
End Sub