Visual Basic Toolbox/Visual Basic Toolbox (P.I.E.)(1996).ISO/compress/addzip/quickzip.frm

Visual Basic Form | 1996-05-19 | 11.3 KB | 324 lines

VERSION 2.00
Begin Form frmQuickZIP
   BackColor       =   &H00000000&
   Caption         =   "QuickZIP"
   ClientHeight    =   3645
   ClientLeft      =   1410
   ClientTop       =   1890
   ClientWidth     =   6840
   Height          =   4335
   Icon            =   QUICKZIP.FRX:0000
   Left            =   1350
   LinkTopic       =   "Form1"
   ScaleHeight     =   243
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   456
   Top             =   1260
   Width           =   6960
   Begin PictureBox picStatusBar
      BackColor       =   &H00C0C0C0&
      BorderStyle     =   0  'None
      Height          =   495
      Left            =   120
      ScaleHeight     =   33
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   81
      TabIndex        =   1
      Top             =   2760
      Width           =   1215
      Begin Label lblStatusBar
         BackColor       =   &H00C0C0C0&
         Caption         =   "Label1"
         FontBold        =   0   'False
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   8.25
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         Height          =   255
         Left            =   120
         TabIndex        =   3
         Top             =   120
         Width           =   1215
      End
   End
   Begin TextBox txtZIP
      Height          =   285
      Left            =   120
      TabIndex        =   2
      Text            =   "Text1"
      Top             =   3120
      Visible         =   0   'False
      Width           =   3255
   End
   Begin ColumnListbox colArchive
      Height          =   2655
      Left            =   0
      TabIndex        =   0
      Top             =   960
      Width           =   4530
   End
   Begin Menu mnuArchive
      Caption         =   "&Archive"
      Begin Menu mnuArchiveNew
         Caption         =   "&New"
      End
      Begin Menu mnuArchiveOpen
         Caption         =   "&Open..."
      End
      Begin Menu mnuArchiveSep1
         Caption         =   "-"
      End
      Begin Menu mnuArchiveExit
         Caption         =   "E&xit"
      End
   End
   Begin Menu mnuOptions
      Caption         =   "&Options"
      Begin Menu mnuOptionsCompression
         Caption         =   "&Compression..."
         Begin Menu mnuOptionsCompressionLevel
            Caption         =   "N&one"
            Index           =   0
         End
         Begin Menu mnuOptionsCompressionLevel
            Caption         =   "&Minimum"
            Index           =   1
         End
         Begin Menu mnuOptionsCompressionLevel
            Caption         =   "&Normal"
            Checked         =   -1  'True
            Index           =   2
         End
         Begin Menu mnuOptionsCompressionLevel
            Caption         =   "Ma&ximum"
            Index           =   3
         End
      End
      Begin Menu mnuOptionsStoreFull
         Caption         =   "Store full filename"
         Checked         =   -1  'True
      End
      Begin Menu mnuOptionsSep1
         Caption         =   "-"
      End
      Begin Menu mnuOptionsExtractTo
         Caption         =   "Extract to..."
      End
      Begin Menu mnuOptionsSep2
         Caption         =   "-"
      End
      Begin Menu mnuOptionsOnTop
         Caption         =   "Always on top"
         Checked         =   -1  'True
      End
   End
   Begin Menu mnuHelp
      Caption         =   "&Help"
      Begin Menu mnuHelpAbout
         Caption         =   "About..."
      End
   End
   Begin Menu mnuPopUp
      Caption         =   "PopUp"
      Visible         =   0   'False
      Begin Menu mnuPopSelect
         Caption         =   "&Select all"
         Enabled         =   0   'False
         Index           =   0
      End
      Begin Menu mnuPopSelect
         Caption         =   "&Deselect all"
         Enabled         =   0   'False
         Index           =   1
      End
      Begin Menu mnuPopSelect
         Caption         =   "&Invert selection"
         Enabled         =   0   'False
         Index           =   2
      End
      Begin Menu mnuPopSep1
         Caption         =   "-"
      End
      Begin Menu mnuPopExtract
         Caption         =   "&Extract"
         Enabled         =   0   'False
      End
   End
Option Explicit
Sub colArchive_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single)
    If (Button = 2) Then
        If (colArchive.ListCount > 0) Then mnuPopSelect(0).Enabled = True
        If (colArchive.SelectedCount > 0) Then
            mnuPopExtract.Enabled = True
            mnuPopSelect(1).Enabled = True
            mnuPopSelect(2).Enabled = True
        End If
        PopupMenu mnuPopUp
    End If
End Sub
Sub Form_Load ()
    Dim I As Integer
    g_cExtract = App.Path
    colArchive.ColumnCount = 5
    colArchive.ColumnHeading(0) = "Filename"
    colArchive.ColumnWidth(0) = TextWidth("WWWWWWWW.WWW")
    colArchive.ColumnHeading(1) = "Size"
    colArchive.ColumnJustification(1) = TA_RIGHT
    colArchive.ColumnAutoSort(1) = SORT_NUMERIC
    colArchive.ColumnHeading(2) = "Compressed"
    colArchive.ColumnJustification(2) = TA_RIGHT
    colArchive.ColumnAutoSort(2) = SORT_NUMERIC
    colArchive.ColumnHeading(3) = "Ratio"
    colArchive.ColumnWidth(3) = TextWidth("Ratio") + 5
    colArchive.ColumnJustification(3) = TA_RIGHT
    colArchive.ColumnAutoSort(3) = SORT_NUMERIC
    colArchive.ColumnHeading(4) = "Path"
    colArchive.MultiSelect = True
    If (Command$ <> "") Then ListArchiveContents (Command$)
    UpdateStatusBar
    '
    I = addZIP_SetParentWindowHandle(Me.hWnd)
    I = addUNZIP_SetParentWindowHandle(Me.hWnd)
    I = addZIP_SetWindowHandle(txtZIP.hWnd)
    I = addUNZIP_SetWindowHandle(txtZIP.hWnd)
    Me.Show
    SpyMessages
End Sub
Sub Form_Resize ()
    Dim I As Integer
    ' resize the column list box
    colArchive.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight - (TextHeight("lq") + 10)
    ' resize the status bar
    picStatusBar.Move 0, colArchive.Height, colArchive.Width, TextHeight("lq") + 10
    ' set window position - needed when windows is minimised
    If (mnuOptionsOnTop.Checked = True) Then
        I = SetWindowPos(Me.hWnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS)
    End If
End Sub
Sub Form_Unload (Cancel As Integer)
    End ' the program is closing
End Sub
Sub mnuArchiveExit_Click ()
    End
End Sub
Sub mnuArchiveNew_Click ()
    Load frmUtility
    frmUtility.Caption = "Enter new archive name"
    frmUtility.txtInput.Text = ""
    'frmUtility.txtInput.SetFocus
    frmUtility.Show 1
    If (g_cTemp <> "") Then ListArchiveContents (g_cTemp)
End Sub
Sub mnuOptionsCompressionLevel_Click (Index As Integer)
    Dim I As Integer
    For I = 0 To 3
        mnuOptionsCompressionLevel(I).Checked = False
    Next I
    mnuOptionsCompressionLevel(Index).Checked = True
End Sub
Sub mnuOptionsExtractTo_Click ()
    Load frmUtility
    frmUtility.Caption = "Set extract directory"
    frmUtility.txtInput.Text = g_cExtract
    'frmUtility.txtInput.SetFocus
    frmUtility.txtInput.SelStart = 0
    frmUtility.txtInput.SelLength = Len(g_cExtract)
    frmUtility.Show 1
    If (g_cTemp <> "") Then g_cExtract = g_cTemp
End Sub
Sub mnuOptionsOnTop_Click ()
    Dim I As Integer
    mnuOptionsOnTop.Checked = Not mnuOptionsOnTop.Checked
    If (mnuOptionsOnTop.Checked = True) Then
        I% = SetWindowPos(Me.hWnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS)
    Else
        I% = SetWindowPos(Me.hWnd, HWND_NOTOPMOST, 0, 0, 0, 0, FLAGS)
    End If
End Sub
Sub mnuOptionsStoreFull_Click ()
    mnuOptionsStoreFull.Checked = Not mnuOptionsStoreFull.Checked
End Sub
Sub mnuPopExtract_Click ()
    Dim I As Integer
    Dim J As Integer
    Dim cMessage As String
    Dim cFilename As String
    cMessage = "Do you want to extract the "
    cMessage = cMessage & Format$(colArchive.SelectedCount)
    cMessage = cMessage & " selected files to "
    cMessage = cMessage & g_cExtract & "?"
    If (MsgBox(cMessage, 36, "Confirm") = 6) Then
      For J = 1 To colArchive.ListCount
        If (colArchive.Selected(J - 1) <> False) Then
          I = addUNZIP_ArchiveName(g_cArchiveName)
          cFilename = GetPiece((colArchive.List(J - 1)), Chr$(9), 5) & "/" & GetPiece((colArchive.List(J - 1)), Chr$(9), 1)
          I = addUNZIP_Include(cFilename)
          I = addUNZIP_ExtractTo(g_cExtract)
          I = addUNZIP()
        End If
      Next J
    End If
End Sub
Sub mnuPopSelect_Click (Index As Integer)
  Dim I As Integer
  Select Case Index
    Case 0 ' select all
      For I = 1 To colArchive.ListCount
        colArchive.Selected(I - 1) = True
      Next I
    Case 1 ' deselect all
      For I = 1 To colArchive.ListCount
        colArchive.Selected(I - 1) = False
      Next I
    Case 2 ' invert selection
      For I = 1 To colArchive.ListCount
        colArchive.Selected(I - 1) = Not colArchive.Selected(I - 1)
      Next I
  End Select
End Sub
Sub picStatusBar_Paint ()
    ' Paint 3D effect of Status Bar
    picStatusBar.Line (0, 0)-(picStatusBar.ScaleWidth, 0), RGB(255, 255, 255)
    picStatusBar.Line (0, picStatusBar.ScaleHeight - 2)-(picStatusBar.ScaleWidth, picStatusBar.ScaleHeight - 2), RGB(128, 128, 128)
    picStatusBar.Line (0, picStatusBar.ScaleHeight - 1)-(picStatusBar.ScaleWidth, picStatusBar.ScaleHeight - 1), RGB(0, 0, 0)
    ' Resize label for status bar text
    lblStatusBar.Move 5, 5, picStatusBar.ScaleWidth - 10, TextHeight("lq")
    ' Paint 3D effect for status bar text
    picStatusBar.Line (4, 4)-Step(lblStatusBar.Width + 2, 0), RGB(128, 128, 128)
    picStatusBar.Line (4, 4)-Step(0, lblStatusBar.Height + 2), RGB(128, 128, 128)
    picStatusBar.Line (4, lblStatusBar.Height + 6)-Step(lblStatusBar.Width + 2, 0), RGB(255, 255, 255)
    picStatusBar.Line (4 + lblStatusBar.Width + 2, 4)-Step(0, lblStatusBar.Height + 2), RGB(255, 255, 255)
End Sub
Sub picStatusBar_Resize ()
    ' Need to refresh the picture box because reducing its size
    ' doesnt generate a paint event
    picStatusBar.Refresh
End Sub
Sub txtZIP_Change ()
    Dim cAdditem As String
    Dim cAction As String
    Dim lSize As Long
    Debug.Print txtZIP.Text
    cAction = GetPiece((txtZIP.Text), "|", 2)
    Select Case cAction
        Case "view"
            cAdditem = GetFileName((txtZIP.Text)) & Chr$(9)
            lSize = GetFileOriginalSize((txtZIP.Text))
            g_lSize = g_lSize + lSize
            cAdditem = cAdditem & Str$(lSize) & Chr$(9)
            cAdditem = cAdditem & Str$(GetFileCompressedSize((txtZIP.Text))) & Chr$(9)
            cAdditem = cAdditem & Str$(GetFileCompressionRatio((txtZIP.Text))) & "%" & Chr$(9)
            cAdditem = cAdditem & GetFilePath((txtZIP.Text))
            colArchive.AddItem cAdditem
            g_iCount = g_iCount + 1
        Case "error"
        Case "warning"
        Case Else
            cAdditem = Format$(cAction, ">&&&&&&&&&&&") & " " & GetFileName((txtZIP.Text))
            cAdditem = cAdditem & " - " & Str$(GetFileCompressionRatio((txtZIP.Text))) & "%"
            lblStatusBar.Caption = cAdditem
    End Select
    DoEvents
End Sub