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()
frmTestFolderBrowse.Enabled = True
frmTestFolderBrowse.SetFocus
Unload Me
End Sub
Private Sub cmdExtract_Click()
' Chosen to extract!
m_bCancel = False
frmTestFolderBrowse.Enabled = True
frmTestFolderBrowse.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 , frmTestFolderBrowse
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.
frmTestFolderBrowse.Enabled = True
frmTestFolderBrowse.SetFocus
Unload Me
End Sub
|
|