vbAccelerator - Contents of code file: frmCapture.frm

VERSION 5.00
Begin VB.Form frmCapture 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Extract To Folder..."
   ClientHeight    =   4005
   ClientLeft      =   4335
   ClientTop       =   1965
   ClientWidth     =   7290
   BeginProperty Font 
      Name            =   "Tahoma"
      Size            =   8.25
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "frmCapture.frx":0000
   LinkTopic       =   "Form2"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4005
   ScaleWidth      =   7290
   ShowInTaskbar   =   0   'False
   StartUpPosition =   1  'CenterOwner
   Begin VB.CommandButton cmdPick 
      Caption         =   "->"
      Height          =   315
      Left            =   2220
      TabIndex        =   7
      Top             =   300
      Width           =   375
   End
   Begin VB.ComboBox cboExtractTo 
      Height          =   315
      Left            =   60
      TabIndex        =   5
      Text            =   "Combo1"
      Top             =   300
      Width           =   2115
   End
   Begin VB.CommandButton cmdNewFolder 
      Caption         =   "&New Folder..."
      Height          =   375
      Left            =   6000
      TabIndex        =   3
      Top             =   3480
      Width           =   1215
   End
   Begin VB.CommandButton cmdExtract 
      Caption         =   "&Extract To"
      Height          =   375
      Left            =   6000
      TabIndex        =   2
      Top             =   60
      Width           =   1215
   End
   Begin VB.CommandButton cmdCancel 
      Caption         =   "Cancel"
      Height          =   375
      Left            =   6000
      TabIndex        =   1
      Top             =   480
      Width           =   1215
   End
   Begin VB.PictureBox picCapture 
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   3555
      Left            =   2640
      ScaleHeight     =   3495
      ScaleWidth      =   3195
      TabIndex        =   0
      Top             =   300
      Width           =   3255
   End
   Begin VB.Image imgVBAL 
      Height          =   495
      Left            =   75
      Picture         =   "frmCapture.frx":1272
      Top             =   3255
      Width           =   2490
   End
   Begin VB.Label lblExtractTo 
      Caption         =   "Extract To:"
      Height          =   195
      Left            =   120
      TabIndex        =   6
      Top             =   60
      Width           =   2415
   End
   Begin VB.Label lblFolder 
      Caption         =   "Folder/Dirs"
      Height          =   195
      Left            =   2640
      TabIndex        =   4
      Top             =   60
      Width           =   2895
   End
   Begin VB.Label Label1 
      BackColor       =   &H00000000&
      BorderStyle     =   1  'Fixed Single
      Caption         =   "Label1"
      Height          =   675
      Left            =   60
      TabIndex        =   8
      Top             =   3180
      Width           =   2535
   End
End
Attribute VB_Name = "frmCapture"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private m_c As cCaptureBF
Private m_sCurrentFolder As String
Private m_bCancel As Boolean

Private Declare Function SetFocusAPI Lib "user32" Alias "SetFocus" (ByVal hwnd
 As Long) As Long

Implements ICaptureBF

Public Property Get Cancelled() As Boolean
   Cancelled = m_bCancel
End Property
Public Property Get SelectedFolder() As String
   SelectedFolder = m_sCurrentFolder
End Property

Private Sub cmdCancel_Click()
   frmMain.Enabled = True
   frmMain.SetFocus
   Unload Me
End Sub

Private Sub cmdExtract_Click()
   ' Chosen to extract!
   m_bCancel = False
   frmMain.Enabled = True
   frmMain.SetFocus
   Unload Me
End Sub

Private Sub cmdNewFolder_Click()
Dim sI As String
   ' Get a new folder to extract to:
   sI = InputBox("Please enter the folder name.", , m_sCurrentFolder)
   If sI <> "" Then
      On Error Resume Next
      MkDir sI
      If Err.Number <> 0 Then
         MsgBox "An error occurred: " & Err.Description, vbExclamation
      Else
         ' Reload the browse dialog but point to
         ' the newly created path.  This is much
         ' smoother than the WinZip equivalent!!!
         m_c.Reload sI
      End If
   End If
End Sub

Private Sub cmdPick_Click()
   m_c.Browse.SetFolder cboExtractTo.Text
End Sub

Private Sub Form_Initialize()
   'DebugMsg "frmCapture:Initialize"
   m_bCancel = True
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
   ' Ensure we have unloaded the dialog:
   m_c.Unload
   ' Important: to ensure this class terminates we
   ' must set to nothing here:
   Set m_c = Nothing
   ' Re-enable the main form- this ensures it doesn't loose focus
End Sub

Private Sub Form_Terminate()
   'DebugMsg "frmCapture:Terminate"
End Sub

Private Property Let ICaptureBF_CaptureBrowseForFolder(RHS As Object)
   ' Provides you with a reference to the cCaptureBrowseForFolder
   ' object, which you can use to refer to the cBrowseForFolder
   ' dialog:
   Set m_c = RHS
End Property

Private Property Get ICaptureBF_CapturehWnd() As Long
   ' Requests the window you want to capture the folder browse
   ' dialog into.  You must ensure you have shown the form at this stage.
   Me.Show , frmMain
   picCapture.BorderStyle = 0
   ICaptureBF_CapturehWnd = picCapture.hwnd
End Property

Private Sub ICaptureBF_SelectionChanged(ByVal sPath As String)
   ' Fired when the selection in the folder browse dialog
   ' changes:
   cboExtractTo.Text = sPath
   cboExtractTo.SelStart = Len(sPath)
   If Len(sPath) > 0 Then
      cboExtractTo.SelLength = Len(sPath)
   End If
   m_sCurrentFolder = sPath
End Sub

Private Sub ICaptureBF_Unload()
   ' Fired when the browse for folder dialog
   ' is closed.  Ensures that you clear up at
   ' the right time.
   frmMain.Enabled = True
   frmMain.SetFocus
   Unload Me
End Sub