vbAccelerator - Contents of code file: frmVBPzip.frm

VERSION 5.00
Begin VB.Form frmVBPzip 
   Caption         =   "VBP Zip"
   ClientHeight    =   4875
   ClientLeft      =   2610
   ClientTop       =   2160
   ClientWidth     =   6480
   BeginProperty Font 
      Name            =   "Tahoma"
      Size            =   8.25
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "frmVBPzip.frx":0000
   LinkTopic       =   "Form1"
   OLEDropMode     =   1  'Manual
   ScaleHeight     =   4875
   ScaleWidth      =   6480
   Begin VB.PictureBox picWhere 
      BackColor       =   &H80000010&
      BorderStyle     =   0  'None
      Height          =   315
      Left            =   1080
      ScaleHeight     =   315
      ScaleWidth      =   5355
      TabIndex        =   13
      Top             =   0
      Width           =   5355
      Begin VB.Label lblWhere 
         AutoSize        =   -1  'True
         BackColor       =   &H8000000C&
         BackStyle       =   0  'Transparent
         Caption         =   " Zipping"
         BeginProperty Font 
            Name            =   "Tahoma"
            Size            =   9.75
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H80000005&
         Height          =   240
         Left            =   0
         TabIndex        =   14
         Top             =   0
         Width           =   735
      End
   End
   Begin VB.PictureBox picSettings 
      BackColor       =   &H80000005&
      Height          =   4575
      Left            =   2040
      ScaleHeight     =   4515
      ScaleWidth      =   3855
      TabIndex        =   3
      TabStop         =   0   'False
      Top             =   180
      Visible         =   0   'False
      Width           =   3915
      Begin VB.CommandButton cmdDefaults 
         Caption         =   "&Defaults"
         Height          =   315
         Left            =   1260
         Style           =   1  'Graphical
         TabIndex        =   12
         Top             =   3000
         Width           =   975
      End
      Begin VB.CommandButton cmdApplyNow 
         Caption         =   "Apply &Now"
         Height          =   315
         Left            =   240
         Style           =   1  'Graphical
         TabIndex        =   11
         Top             =   3000
         Width           =   975
      End
      Begin VB.PictureBox picOtherSettings 
         BackColor       =   &H80000005&
         BorderStyle     =   0  'None
         Height          =   735
         Left            =   240
         ScaleHeight     =   735
         ScaleWidth      =   3495
         TabIndex        =   8
         TabStop         =   0   'False
         Top             =   3720
         Width           =   3495
         Begin VB.ListBox lstSettings 
            Appearance      =   0  'Flat
            Height          =   930
            IntegralHeight  =   0   'False
            Left            =   60
            Style           =   1  'Checkbox
            TabIndex        =   9
            Top             =   -60
            Width           =   1575
         End
      End
      Begin VB.PictureBox picTypes 
         BackColor       =   &H80000005&
         BorderStyle     =   0  'None
         Height          =   2595
         Left            =   240
         ScaleHeight     =   2595
         ScaleWidth      =   3495
         TabIndex        =   5
         TabStop         =   0   'False
         Top             =   420
         Width           =   3495
         Begin VB.ListBox lstTypes 
            Appearance      =   0  'Flat
            Height          =   930
            IntegralHeight  =   0   'False
            Left            =   0
            Style           =   1  'Checkbox
            TabIndex        =   6
            Top             =   120
            Width           =   1575
         End
      End
      Begin VB.Label lblSettings 
         BackColor       =   &H80000010&
         Caption         =   "  &Settings:"
         ForeColor       =   &H80000005&
         Height          =   255
         Left            =   60
         TabIndex        =   7
         Top             =   3420
         Width           =   3735
      End
      Begin VB.Label lblTypes 
         BackColor       =   &H80000010&
         Caption         =   " File Types to &Zip:"
         ForeColor       =   &H80000005&
         Height          =   255
         Left            =   60
         TabIndex        =   4
         Top             =   120
         Width           =   3735
      End
   End
   Begin VB.PictureBox picMode 
      BackColor       =   &H80000010&
      ForeColor       =   &H80000005&
      Height          =   3855
      Left            =   60
      ScaleHeight     =   3795
      ScaleWidth      =   915
      TabIndex        =   0
      TabStop         =   0   'False
      Top             =   0
      Width           =   975
      Begin VB.Image imgButton 
         Height          =   480
         Index           =   1
         Left            =   240
         Picture         =   "frmVBPzip.frx":0442
         Top             =   600
         Visible         =   0   'False
         Width           =   480
      End
      Begin VB.Image imgButton 
         Height          =   480
         Index           =   0
         Left            =   240
         Picture         =   "frmVBPzip.frx":074C
         Top             =   60
         Visible         =   0   'False
         Width           =   480
      End
   End
   Begin VB.PictureBox picStatusBar 
      BorderStyle     =   0  'None
      Height          =   255
      Left            =   0
      ScaleHeight     =   255
      ScaleWidth      =   6375
      TabIndex        =   10
      TabStop         =   0   'False
      Top             =   3780
      Width           =   6375
   End
   Begin VB.PictureBox picBorder 
      Height          =   3375
      Left            =   1080
      ScaleHeight     =   3315
      ScaleWidth      =   3675
      TabIndex        =   1
      TabStop         =   0   'False
      Top             =   360
      Width           =   3735
      Begin VB.ListBox lstProjects 
         Appearance      =   0  'Flat
         Height          =   3255
         IntegralHeight  =   0   'False
         Left            =   0
         OLEDropMode     =   1  'Manual
         Style           =   1  'Checkbox
         TabIndex        =   2
         Top             =   0
         Width           =   3615
      End
   End
   Begin VB.Menu mnuFileTOP 
      Caption         =   "&File"
      Begin VB.Menu mnuFile 
         Caption         =   "&Open Project..."
         Index           =   0
         Shortcut        =   ^O
      End
      Begin VB.Menu mnuFile 
         Caption         =   "-"
         Index           =   1
      End
      Begin VB.Menu mnuFile 
         Caption         =   ""
         Index           =   2
         Visible         =   0   'False
      End
      Begin VB.Menu mnuFile 
         Caption         =   ""
         Index           =   3
         Visible         =   0   'False
      End
      Begin VB.Menu mnuFile 
         Caption         =   ""
         Index           =   4
         Visible         =   0   'False
      End
      Begin VB.Menu mnuFile 
         Caption         =   ""
         Index           =   5
         Visible         =   0   'False
      End
      Begin VB.Menu mnuFile 
         Caption         =   "-"
         Index           =   6
         Visible         =   0   'False
      End
      Begin VB.Menu mnuFile 
         Caption         =   "E&xit"
         Index           =   7
      End
   End
   Begin VB.Menu mnuProjectTOP 
      Caption         =   "&Project"
      Begin VB.Menu mnuProject 
         Caption         =   "&Zip All..."
         Index           =   0
         Shortcut        =   ^S
      End
      Begin VB.Menu mnuProject 
         Caption         =   "-"
         Index           =   1
         Visible         =   0   'False
      End
      Begin VB.Menu mnuProject 
         Caption         =   ""
         Index           =   2
         Visible         =   0   'False
      End
   End
   Begin VB.Menu mnuViewTOP 
      Caption         =   "&View"
      Begin VB.Menu mnuView 
         Caption         =   "&Full Mode"
         Checked         =   -1  'True
         Index           =   0
      End
      Begin VB.Menu mnuView 
         Caption         =   "&Status Bar"
         Checked         =   -1  'True
         Index           =   1
      End
      Begin VB.Menu mnuView 
         Caption         =   "-"
         Index           =   2
      End
      Begin VB.Menu mnuView 
         Caption         =   "&Zip Page"
         Checked         =   -1  'True
         Index           =   3
      End
      Begin VB.Menu mnuView 
         Caption         =   "&Options"
         Index           =   4
      End
   End
   Begin VB.Menu mnuHelpTOP 
      Caption         =   "&Help"
      Begin VB.Menu mnuHelp 
         Caption         =   "&vbAccelerator on the Web"
         Index           =   0
         Shortcut        =   {F1}
      End
      Begin VB.Menu mnuHelp 
         Caption         =   "-"
         Index           =   1
      End
      Begin VB.Menu mnuHelp 
         Caption         =   "&About..."
         Index           =   2
      End
   End
End
Attribute VB_Name = "frmVBPzip"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private m_cP As cVBProjectGroup
Private m_cODL As cSimpleODListBox
Private m_cODS As cSimpleODListBox
Private m_cODT As cSimpleODListBox
Private m_cSysILS As cVBALSysImageList
Private m_cSb As New cNoStatusBar
Private WithEvents m_cZ As cZip
Attribute m_cZ.VB_VarHelpID = -1
Private WithEvents m_cSSB As cSimpleSheetBar
Attribute m_cSSB.VB_VarHelpID = -1
Private m_bLoading As Boolean
Private m_lIndex As Long
Private m_bFolders As Boolean

Implements ISubclass

Private Sub LoadOptions()
   Dim cR As New cRegistry
   cR.ClassKey = HKEY_LOCAL_MACHINE
   If Not pbLoadOptions(cR) Then
      cR.ClassKey = HKEY_CURRENT_USER
      If Not pbLoadOptions(cR) Then
      End If
   End If
End Sub
Private Function pbLoadOptions(cR As cRegistry) As Boolean
   cR.SectionKey = "SOFTWARE\vbAccelerator\VBPzip"
   If cR.KeyExists Then
      
      ' Get default file types:
      If g_cFileTypes.Restore(cR) Then
      
         ' Get window position:
         pRestorePosition cR
         
         ' Get mode/status bar option:
         cR.Default = 1
         cR.ValueType = REG_DWORD
         cR.ValueKey = "FullMode"
         If cR.Value = 0 Then
            If mnuView(0).Checked Then
               mnuView_Click 0
            End If
         End If
         cR.ValueKey = "StatusBar"
         If cR.Value = 0 Then
            If mnuView(1).Checked Then
               mnuView_Click 1
            End If
         End If
         
         ' Other settings:
         cR.Default = 1
         cR.ValueKey = "ShowFolders"
         If cR.Value <> 0 Then
            lstSettings.Selected(0) = True
         End If
         cR.Default = 0
         cR.ValueKey = "FixPaths"
         If cR.Value <> 0 Then
            lstSettings.Selected(1) = True
         End If
         cR.Default = 0
         cR.ValueKey = "SaveXML"
         If cR.Value <> 0 Then
            lstSettings.Selected(1) = True
         End If
         m_bFolders = lstSettings.Selected(0)
         
         pbLoadOptions = True
      End If
   End If
End Function
Private Sub SaveOptions()
   Dim cR As New cRegistry
   cR.ClassKey = HKEY_CURRENT_USER
   pSaveOptions cR
   cR.ClassKey = HKEY_LOCAL_MACHINE
   pSaveOptions cR
End Sub
Private Sub pSaveOptions(cR As cRegistry)
   cR.SectionKey = "SOFTWARE\vbAccelerator\VBPzip"
   ' File types:
   g_cFileTypes.Persist cR
   ' Form Position:
   pPersistPosition cR
   ' Status Bar/Mode
   cR.ValueKey = "FullMode"
   cR.Value = CLng(Abs(mnuView(0).Checked))
   cR.ValueKey = "StatusBar"
   cR.Value = CLng(Abs(mnuView(1).Checked))
   ' Other options:
   cR.ValueKey = "ShowFolders"
   cR.Value = CLng(Abs(lstSettings.Selected(0)))
   cR.ValueKey = "FixPaths"
   cR.Value = CLng(Abs(lstSettings.Selected(1)))
   cR.ValueKey = "SaveXML"
   cR.Value = CLng(Abs(lstSettings.Selected(2)))
   

End Sub
Private Sub pPersistPosition(cR As cRegistry)
   
   cR.ValueType = REG_DWORD
   If Me.WindowState = vbMinimized Then
      ' don't bother
   ElseIf Me.WindowState = vbMaximized Then
      ' save that
      cR.Default = 0
      cR.ValueKey = "Maximized"
      cR.Value = 1
   Else
      ' position
      cR.Default = 0
      cR.ValueKey = "Maximized"
      cR.Value = 0
      cR.Default = -1
      cR.ValueKey = "Left"
      cR.Value = CLng(Me.Left)
      cR.ValueKey = "Top"
      cR.Value = CLng(Me.Top)
      cR.ValueKey = "Width"
      cR.Value = CLng(Me.Width)
      cR.ValueKey = "Height"
      cR.Value = CLng(Me.Height)
   End If
End Sub
Private Sub pRestorePosition(cR As cRegistry)
Dim lLeft As Long, lTop As Long
Dim lWidth As Long, lHeight As Long
Dim lV As Long

   cR.Default = 0
   cR.ValueKey = "Maximized"
   lV = cR.Value
   If lV <> 0 Then
      Me.WindowState = vbMaximized
   Else
      cR.Default = -1
      cR.ValueType = REG_DWORD
      cR.ValueKey = "Left"
      lLeft = cR.Value
      cR.ValueKey = "Top"
      lTop = cR.Value
      cR.ValueKey = "Width"
      lWidth = cR.Value
      cR.ValueKey = "Height"
      lHeight = cR.Value
      
      If lWidth = -1 Or lHeight = -1 Then
         ' default
      Else
         If lWidth < 3000 Or lHeight < 2500 Then
            ' all junked
            lWidth = 3000
            lHeight = 2500
         End If
      
         If lLeft < 0 Then lLeft = 0
         If lTop < 0 Then lTop = 0
         If lLeft + lWidth > Screen.Width Then
            lLeft = Screen.Width - lWidth
            If lLeft < 0 Then
               lLeft = 0
               lWidth = Screen.Width - 32 * Screen.TwipsPerPixelX
            End If
         End If
         If lTop + lHeight > Screen.Height Then
            lTop = Screen.Height - lHeight
            If lTop < 0 Then
               lTop = 0
               lHeight = Screen.Height - 32 * Screen.TwipsPerPixelY
            End If
         End If
         
         Me.Move lLeft, lTop, lWidth, lHeight
      End If
   End If
End Sub

Private Function IsIn(v As Variant, ParamArray vIn() As Variant) As Boolean
Dim i As Long, iL As Long, iU As Long
On Error GoTo ErrorHandler
   iL = LBound(vIn)
   iU = UBound(vIn)
   For i = iL To iU
      If v = vIn(i) Then
         IsIn = True
         Exit Function
      End If
   Next i
   Exit Function
ErrorHandler:
   Debug.Assert (Err.Number = 0)
   Exit Function
   Resume 0
End Function

Private Sub pParseCommand(ByVal sCmd As String)
Dim s As Variant
Dim sText As String
Dim i As Long
Dim iU As Long

On Error GoTo ErrorHandler
   
   m_bLoading = True
   If Len(sCmd) > 0 Then
      RestoreAndActivate Me.hwnd
      
      sCmd = GetLongPath(ReplaceSection(sCmd, """", ""))
         
      ' We have a VBP file?
      m_cSb.PanelText("MAIN") = "Loading " & sCmd & "..."
      
      Set m_cP = New cVBProjectGroup
      m_cP.FixPaths = lstSettings.Selected(1)
      m_cP.Load sCmd
      m_cSb.PanelText("PROJECT") = m_cP.FileName
      
      ' Show the projects:
      lstProjects.Visible = False
      m_cP.Show lstProjects, m_cODL, m_cSysILS, lstSettings.Selected(0)
      lstProjects.Visible = True
      
      ' Set up the things to zip:
      If m_cP.FakeGroup Then
         For i = 1 To mnuProject.UBound
            mnuProject(i).Visible = False
         Next i
      Else
         iU = mnuProject.UBound
         mnuProject(1).Visible = True
         For i = 2 To 2 + m_cP.Count - 1
            If i > iU Then
               Load mnuProject(i)
            End If
            mnuProject(i).Visible = True
            mnuProject(i).Caption = "&" & i - 1 & ") Zip " & m_cP.Project(i -
             1).ProjectName & "(" & m_cP.Project(i - 1).ProjectFileName & ")
             ..."
         Next
      End If
      
      m_cSb.PanelText("MAIN") = "Loaded " & sCmd
      If mnuView(3).Checked Then
         m_cSSB_Click 1
      End If
   End If
   m_bLoading = False
   Exit Sub
   
ErrorHandler:
   MsgBox "An error occurred trying to load this project: " & Err.Description,
    vbExclamation
   Exit Sub
   
End Sub

Private Sub pZip(ByVal lProject As Long)
Dim sPath As String
Dim sOutput As String

On Error GoTo ErrorHandler

   If Not m_cP Is Nothing Then

      ' Get FileName:
      Dim cc As New cCommonDialog
      If lProject = 0 Then
         sPath = m_cP.Path
      Else
         sPath = m_cP.Project(lProject).ProjectPath
      End If
      
      If cc.VBGetSaveFileName(sOutput, , , "Zip Files (*.zip)|*.zip|All Files
       (*.*)|*.*", 1, sPath, , "zip", Me.hwnd) Then
         
         KillFileIfExists sOutput
         
         ' Ask the projects to serialise their file
         ' details into the Zip class:
         Set m_cZ = New cZip
         m_cZ.ZipFile = sOutput
         m_cZ.BasePath = sPath
         m_cZ.StoreFolderNames = True
         If lProject = 0 Then
            m_cP.Zip m_cZ
         Else
            m_cP.Project(lProject).Zip m_cZ
         End If
         
         ' To actually ensure that the paths of the files
         ' are relative to szRoot, we need to set
         ' recurse sub dirs & modify the file specs so
         ' they are relative to BasePath.  if BasePath
         ' proves unsuitable, we need to move down...
         pRelativeZip m_cZ
         m_cZ.RecurseSubDirs = True
      
         ' Do the zipping:
         m_cZ.Zip
         
         Dim iPos As Long, sMsg As String
         iPos = InstrRev(m_cZ.ZipFile, "\")
         If iPos = 0 Then
            iPos = Len(m_cZ.ZipFile)
         End If
         sMsg = Left$(m_cZ.ZipFile, iPos)
         m_cSb.PanelText("MAIN") = sMsg & " complete: " &
          Format$(FileLen(m_cZ.ZipFile), "#,##0") & " bytes"
      End If
   
      End If
   
   Exit Sub

ErrorHandler:
   MsgBox "An error occurred trying to zip this project file:" & vbCrLf &
    Err.Description, vbExclamation
   Exit Sub
   
End Sub

Private Sub pRelativeZip(ByRef m_cZ As cZip)
Dim sThis As String
Dim sTheItem As String
Dim sCompare As String
Dim iBase As Long
Dim sBase() As String
Dim iItem As Long
Dim sItem() As String
Dim bMatch As Boolean
Dim i As Long
Dim bBasePathUnacceptable As Boolean
Dim iDownCount As Long
Dim iMaxDownCount As Long
Dim sOrig() As String
Dim iPos As Long
Dim sFile As String
Dim sPath As String

   Dim cS As New cSplitString
   cS.Splitter = "\"
   cS.TheString = m_cZ.BasePath
   Do
      iBase = iBase + 1
      ReDim Preserve sBase(1 To iBase) As String
      sThis = NormalizePath(sThis) & cS.NextItem
      sBase(iBase) = GetShortPath(sThis)
   Loop While cS.More

   ' Pass 1:
   ReDim sOrig(1 To m_cZ.FileSpecCount) As String
   For i = 1 To m_cZ.FileSpecCount
      
      ' Get long filename version:
      If InStr(m_cZ.FileSpec(i), "*") = 0 Then
         m_cZ.FileSpec(i) = GetLongPath(m_cZ.FileSpec(i))
      Else
         sPath = m_cZ.FileSpec(i)
         iPos = InstrRev(sPath, "\")
         m_cZ.FileSpec(i) = NormalizePath(GetLongPath(Left$(sPath, iPos - 1)))
          & Mid$(sPath, iPos + 1)
      End If
      
      sOrig(i) = m_cZ.FileSpec(i)
      
      iItem = 0
      bMatch = True
      sThis = ""
      sCompare = ""
      
      cS.TheString = m_cZ.FileSpec(i)
      iDownCount = 0
      Do
         sTheItem = cS.NextItem
         iItem = iItem + 1
         If iItem <= iBase Then
            If bMatch Then
               sCompare = NormalizePath(sCompare) & sTheItem
               If InStr(sTheItem, "*") = 0 Then
                  sCompare = GetShortPath(sCompare)
               End If
               If Not StrComp(sCompare, sBase(iItem)) = 0 Then
                  bMatch = False
               End If
            End If
            If Not bMatch Then
               bBasePathUnacceptable = True
               iDownCount = iDownCount + 1
               sThis = "..\" & NormalizePath(sThis) & sTheItem
            End If
         Else
            sThis = NormalizePath(sThis) & sTheItem
         End If
      Loop While cS.More
      
      If iDownCount > iMaxDownCount Then
         iMaxDownCount = iDownCount
      End If
      
      Debug.Print cS.TheString, sThis
   
      m_cZ.FileSpec(i) = sThis
   
   Next i
   
   ' Pass 2: we must remove all the
   ' ..\ & set the base path accordingly:
   If bBasePathUnacceptable Then
      If iBase > iMaxDownCount Then
         ' Reset for correct base path:
         m_cZ.BasePath = sBase(iBase - iMaxDownCount)
         ' Recreate relative file names to this new path:
         For i = 1 To m_cZ.FileSpecCount
            sPath = ""
            iItem = 0
            cS.TheString = sOrig(i)
            Do
               sThis = cS.NextItem
               iItem = iItem + 1
               If iItem > iBase - iMaxDownCount Then
                  sPath = NormalizePath(sPath) & sThis
               End If
            Loop While cS.More
            m_cZ.FileSpec(i) = sPath
         Next i
      Else
         MsgBox "Constituent files on different physical media - Zip cannot be
          created with path names.", vbExclamation
      End If
   End If
   
   For i = 1 To m_cZ.FileSpecCount
      Debug.Print m_cZ.FileSpec(i)
   Next i


End Sub

Private Sub cmdApplyNow_Click()
Dim i As Long
Dim j As Long
Dim iProject As Long
Dim sThis As String
Dim iPos As Long
Dim iItem As Long
Dim bDone As Boolean
Dim sTag As String
   For i = 0 To lstProjects.ListCount - 1
      sThis = lstProjects.List(i)
      iPos = InStr(sThis, vbTab)
      If iPos > 1 Then
         sThis = Mid$(sThis, iPos + 1)
         iPos = InStr(sThis, "<Project>")
         If iPos > 0 Then
            iProject = iProject + 1
         Else
            If ExtractTag(sThis, "<ID>", "</ID>", sTag) Then
               iItem = CLng(sTag)
               bDone = False
               For j = 0 To lstTypes.ListCount - 1
                  If m_cP.Project(iProject).FileType(iItem) = j Then
                     lstProjects.Selected(i) = lstTypes.Selected(j)
                     Exit For
                  End If
               Next j
            End If
         End If
      End If
   Next i
End Sub

Private Sub cmdDefaults_Click()
   Set g_cFileTypes = New cVBFileTypes
   pShowTypeSettings
   cmdApplyNow_Click
End Sub

Private Sub Form_Load()

   ' Allow me to be found by another instance:
   TagWindow Me.hwnd

   ' Start checking for cross-instance messages:
   AttachMessage Me, Me.hwnd, WM_COPYDATA
      
   ' Display &c:
   ThinBorder picBorder.hwnd, True
   ThinBorder picMode.hwnd, True
   
   Set m_cODL = New cSimpleODListBox
   m_cODL.Attach lstProjects.hwnd
   
   Set m_cODS = New cSimpleODListBox
   m_cODS.Attach lstTypes.hwnd
   pShowTypeSettings
   
   Set m_cODT = New cSimpleODListBox
   m_cODT.Attach lstSettings.hwnd
   pShowOtherSettings
      
   Set m_cSysILS = New cVBALSysImageList
   m_cSysILS.IconSizeX = 16
   m_cSysILS.IconSizeY = 16
   m_cSysILS.Create
   m_cODL.ImageList = m_cSysILS.hIml
   
   Set m_cSb = New cNoStatusBar
   m_cSb.Create picStatusBar
   m_cSb.AddPanel , "vbAccelerator VBPZip", , , True, , , "MAIN"
   m_cSb.AddPanel , , , 96, , , , "PROJECT"
   m_cSb.AddPanel , , , , , , , "COUNTS"
   m_cSb.AddPanel , , , 26, , , , "ICON"
   m_cSb.SizeGrip = True
         
   Set m_cSSB = New cSimpleSheetBar
   m_cSSB.Create picMode, 48 * Screen.TwipsPerPixelY
   m_cSSB.Add "Zipping", imgButton(0).Picture.Handle
   m_cSSB.Add "Options", imgButton(1).Picture.Handle
         
   ' Options
   LoadOptions
         
   ' Ready to go!
   Me.Show
   Me.Refresh
   
   ' Add me to the list of items we can do
   ' with .VBP files:
   Dim sFullExeName As String
   sFullExeName = App.Path
   sFullExeName = NormalizePath(sFullExeName) & App.EXEName & ".exe"
   Dim cR As New cRegistry
   cR.CreateAdditionalEXEAssociations _
      "VisualBasic.Project", _
      "Zip", "Zip Project", """" & sFullExeName & " ""%1"""""
   cR.CreateAdditionalEXEAssociations _
      "VisualBasic.ProjectGroup", _
      "Zip", "Zip Project Group", """" & sFullExeName & " ""%1"""""
      
   ' If we have a cmd line, then process it:
   pParseCommand Command
   
End Sub

Private Sub Form_OLEDragDrop(Data As DataObject, Effect As Long, Button As
 Integer, Shift As Integer, x As Single, y As Single)
   If (Data.GetFormat(vbCFFiles)) Then
      If (Data.Files.Count = 1) Then
          pParseCommand Data.Files(1)
      End If
   End If
End Sub

Private Sub Form_OLEDragOver(Data As DataObject, Effect As Long, Button As
 Integer, Shift As Integer, x As Single, y As Single, State As Integer)
   If (Data.GetFormat(vbCFFiles)) Then
      Effect = vbDropEffectCopy
   End If
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
   
   ' Store
   SaveOptions
   
   ' Clear up the things we have to:
   m_cSSB.Destroy ' simple component/circular ref
   Set m_cSSB = Nothing
   
   ' Not subclassing:
   DetachMessage Me, Me.hwnd, WM_COPYDATA
   
End Sub


Private Sub Form_Resize()

Dim lL As Long
Dim lH As Long
Dim lT As Long

On Error Resume Next
   
   lT = Screen.TwipsPerPixelY
   lH = Me.ScaleHeight - Screen.TwipsPerPixelY * 2 - (picStatusBar.Height + 2 *
    Screen.TwipsPerPixelX) * Abs(picStatusBar.Visible)
   If picMode.Visible Then
      picMode.Move Screen.TwipsPerPixelX, lT, picMode.Width, lH
      lL = (picMode.Left + picMode.Width + 2 * Screen.TwipsPerPixelX)
   Else
      lL = Screen.TwipsPerPixelX
   End If
   If picWhere.Visible Then
      picWhere.Move lL, lT, Me.ScaleWidth - lL
      lH = lH - picWhere.Height - 2 * Screen.TwipsPerPixelY
      lT = lT + picWhere.Height + 2 * Screen.TwipsPerPixelY
   End If
   picBorder.Move lL, lT, Me.ScaleWidth - lL, lH
   picSettings.Move lL, picBorder.Top, picBorder.Width, lH
   picStatusBar.Move 0, picBorder.Top + picBorder.Height + 2 *
    Screen.TwipsPerPixelY, Me.ScaleWidth

End Sub

Private Property Let ISubclass_MsgResponse(ByVal RHS As EMsgResponse)
   '
End Property

Private Property Get ISubclass_MsgResponse() As EMsgResponse
   ISubclass_MsgResponse = emrPreprocess
End Property

Private Function ISubclass_WindowProc(ByVal hwnd As Long, ByVal iMsg As Long,
 ByVal wParam As Long, ByVal lParam As Long) As Long
Dim tCDS As COPYDATASTRUCT
Dim b() As Byte
Dim sCommand As String

   Select Case iMsg
   Case WM_COPYDATA
      ' Copy for processing:
      CopyMemory tCDS, ByVal lParam, Len(tCDS)
      If (tCDS.cbData > 0) Then
         ReDim b(0 To tCDS.cbData - 1) As Byte
         CopyMemory b(0), ByVal tCDS.lpData, tCDS.cbData
         sCommand = StrConv(b, vbUnicode)
         
         ' We've got the info, now do it:
         pParseCommand sCommand
      Else
         ' no data.  This is only sent by the main
         ' module if it detects this window is hidden.
         ' since this can't occur in this project,
         ' this won't occur.  However, in a project
         ' where your main window can be hidden, you
         ' would make your window visible and activate
         ' it here.
      End If
      
   End Select
End Function

Private Sub lstProjects_MouseDown(Button As Integer, Shift As Integer, x As
 Single, y As Single)
   m_lIndex = lstProjects.ListIndex
End Sub

Private Sub lstProjects_MouseUp(Button As Integer, Shift As Integer, x As
 Single, y As Single)
   If Not m_bLoading Then
      If m_lIndex > -1 Then
         'm_cODL.TreeSet lstProjects, m_lIndex
      End If
   End If
End Sub

Private Sub lstProjects_OLEDragDrop(Data As DataObject, Effect As Long, Button
 As Integer, Shift As Integer, x As Single, y As Single)
   Form_OLEDragDrop Data, Effect, Button, Shift, x, y
End Sub

Private Sub lstProjects_OLEDragOver(Data As DataObject, Effect As Long, Button
 As Integer, Shift As Integer, x As Single, y As Single, State As Integer)
   Form_OLEDragOver Data, Effect, Button, Shift, x, y, State
End Sub

Private Sub lstSettings_Click()
   If Not m_bFolders = lstSettings.Selected(0) Then
      m_bFolders = lstSettings.Selected(0)
      If Not m_cP Is Nothing Then
         m_cP.Show lstProjects, m_cODL, m_cSysILS, m_bFolders
      End If
   End If
   If Not m_cP Is Nothing Then
      m_cP.FixPaths = lstSettings.Selected(1)
   End If
End Sub

Private Sub m_cSSB_Click(ByVal iButton As Long)
Dim bDone As Boolean
   Select Case iButton
   Case 1
      If Not m_cP Is Nothing Then
         If m_cP.Path <> "" Then
            lblWhere.Caption = " " & m_cP.FileName
            bDone = True
         End If
      End If
      If Not bDone Then
         lblWhere.Caption = " Zipping"
      End If
      picBorder.Visible = True
      picSettings.Visible = False
      mnuView(3).Checked = True
      mnuView(4).Checked = False
   Case 2
      lblWhere.Caption = " Options"
      picSettings.Visible = True
      picBorder.Visible = False
      mnuView(3).Checked = False
      mnuView(4).Checked = True
   End Select
End Sub

Private Sub m_cZ_Cancel(ByVal sMsg As String, bCancel As Boolean)
   '
   ' If you had a cancel button, you could do this here:
   '
   
   ' DoEvents
   ' Sleep 10
   ' If m_BCancel then
   '     bCancel = true
   ' Endif
   '
   
   '
   ' I didn't think it was worthwhile, try it & if its positive,
   ' tell me!
   '      mailto:steve@vbaccelerator.com
   '
   
End Sub

Private Sub m_cZ_PasswordRequest(sPassword As String, bCancel As Boolean)
   '
End Sub

Private Sub m_cZ_Progress(ByVal lCount As Long, ByVal sMsg As String)
   '
   m_cSb.PanelText("MAIN") = sMsg
   '
End Sub

Private Sub mnuFile_Click(Index As Integer)
Dim sFile As String
   Select Case Index
   Case 0
      Dim c As New cCommonDialog
      If c.VBGetOpenFileName(sFile, , , , , , "VB Projects
       (*.vbp;*.vbg)|*.vbp;*.vbg;|VB Project Files (*.vbp)|*.vbp|VB Project
       Groups (*.vbg)|*.vbg|All Files (*.*)|*.*", , , , "vbp", Me.hwnd) Then
         pParseCommand sFile
      End If
   Case 2 - 5
      ' MRU
   Case 7
      Unload Me
   End Select
End Sub

Private Sub mnuHelp_Click(Index As Integer)
   Select Case Index
   Case 0
      ShellEx "/index.html", , , , , Me.hwnd
   Case 2
      frmAbout.Show vbModal, Me
   End Select
End Sub

Private Sub mnuProject_Click(Index As Integer)
   Select Case Index
   Case 0
      pZip 0
   Case Else
      pZip Index - 1
   End Select
   
End Sub

Private Sub mnuView_Click(Index As Integer)
Dim bState As Boolean
   Select Case Index
   Case 0
      bState = Not (mnuView(Index).Checked)
      mnuView(Index).Checked = bState
      picWhere.Visible = bState
      picMode.Visible = bState
      m_cSSB_Click 1
      Form_Resize
   Case 1
      bState = Not (mnuView(Index).Checked)
      mnuView(Index).Checked = bState
      picStatusBar.Visible = bState
      Form_Resize
   Case 3
      If mnuView(4).Checked Then
         m_cSSB_Click 1
      End If
   Case 4
      If mnuView(3).Checked Then
         m_cSSB_Click 2
      End If
   End Select
End Sub

Private Sub picBorder_Resize()
   On Error Resume Next
   lstProjects.Move -Screen.TwipsPerPixelX, -Screen.TwipsPerPixelY,
    picBorder.ScaleWidth + 2 * Screen.TwipsPerPixelX, picBorder.ScaleHeight + 2
    * Screen.TwipsPerPixelY
End Sub

Private Sub picMode_MouseDown(Button As Integer, Shift As Integer, x As Single,
 y As Single)
   m_cSSB.MouseDown Button, Shift, x, y
End Sub

Private Sub picMode_MouseMove(Button As Integer, Shift As Integer, x As Single,
 y As Single)
   m_cSSB.MouseMove Button, Shift, x, y
End Sub

Private Sub picMode_MouseUp(Button As Integer, Shift As Integer, x As Single, y
 As Single)
   m_cSSB.MouseUp Button, Shift, x, y
End Sub

Private Sub picMode_Paint()
   m_cSSB.Paint
End Sub

Private Sub picOtherSettings_Resize()
   On Error Resume Next
   lstSettings.Move -Screen.TwipsPerPixelX, -Screen.TwipsPerPixelY,
    picOtherSettings.ScaleWidth + Screen.TwipsPerPixelX * 2,
    picOtherSettings.ScaleHeight + Screen.TwipsPerPixelY * 2
End Sub

Private Sub picSettings_Resize()
   On Error Resume Next
   lblTypes.Width = picSettings.ScaleWidth - lblTypes.Left * 2
   lblSettings.Width = lblTypes.Width
   picTypes.Width = lblTypes.Width - (picTypes.Left - lblTypes.Left)
   picOtherSettings.Width = picTypes.Width
End Sub

Private Sub picStatusBar_Paint()
   On Error Resume Next
   m_cSb.Draw
End Sub

Private Sub picStatusBar_Resize()
   On Error Resume Next
   m_cSb.Draw
End Sub

Private Sub picTypes_Resize()
   On Error Resume Next
   lstTypes.Move -Screen.TwipsPerPixelX, -Screen.TwipsPerPixelY,
    picTypes.ScaleWidth + 2 * Screen.TwipsPerPixelX, picTypes.ScaleHeight + 2 *
    Screen.TwipsPerPixelY
End Sub
Private Sub pShowTypeSettings()
Dim i As Long
   lstTypes.Visible = False
   lstTypes.Clear
   For i = 0 To 10
      lstTypes.AddItem g_cFileTypes.Description(i)
      lstTypes.Selected(lstTypes.NewIndex) = g_cFileTypes.IncludeInZip(i)
   Next i
   lstTypes.Visible = True
End Sub
Private Sub pShowOtherSettings()
   lstSettings.Clear
   lstSettings.AddItem "Show Folders"
   lstSettings.AddItem "Fix Shortened paths and Resolve ..\[Path] References"
   lstSettings.AddItem "/home/VB/Utilities/VBPZip/Write_Project_File.xml"
End Sub
Private Sub pSaveOtherSettings()
   '
   
End Sub
Private Sub pSaveTypeSettings()
Dim i As Long
   For i = 0 To 11
      g_cFileTypes.IncludeInZip(i) = lstTypes.Selected(i)
   Next i
End Sub