www.pudn.com > 一个酷酷的录音程序.rar > frmOptions.frm
VERSION 5.00
Begin VB.Form frmOptions
BorderStyle = 3 'Fixed Dialog
Caption = "选项"
ClientHeight = 3570
ClientLeft = 45
ClientTop = 435
ClientWidth = 5955
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3570
ScaleWidth = 5955
ShowInTaskbar = 0 'False
StartUpPosition = 1 '所有者中心
Begin VB.CommandButton cmdApply
Caption = "应用"
Height = 495
Left = 2400
TabIndex = 3
Top = 2640
Width = 975
End
Begin VB.CommandButton cmdPath
Caption = "..."
Height = 255
Left = 5400
TabIndex = 2
Top = 1080
Width = 495
End
Begin VB.TextBox txtPath
Height = 285
Left = 0
TabIndex = 1
Top = 1080
Width = 5295
End
Begin VB.TextBox txtFilename
Height = 285
Left = 0
TabIndex = 0
Text = "Default.wav"
Top = 240
Width = 2415
End
Begin VB.Label lblPath
Caption = "默认路径:"
Height = 255
Left = 0
TabIndex = 5
Top = 720
Width = 1095
End
Begin VB.Label lblFilename
Caption = "默认文件名:"
Height = 255
Left = 60
TabIndex = 4
Top = 60
Width = 1455
End
End
Attribute VB_Name = "frmOptions"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'****************************************************************************
'人人为我，我为人人
'枕善居汉化收藏整理
'发布日期：05/05/08
'描 述：一个很酷的简单录音源码示例
'网 站：http://www.mndsoft.com/
'e-mail：mnd@mndsoft.com
'OICQ : 88382850
'****************************************************************************
Option Explicit
Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Const HWND_TOPMOST = -1 'bring to top and stay there
Private Const SWP_NOMOVE = &H2 'don't move window
Private Const SWP_NOSIZE = &H1 'don't size window
Private Declare Function CreateDirectory Lib "kernel32.dll" Alias "CreateDirectoryA" (ByVal lpPathName As String, lpSecurityAttributes As SECURITY_ATTRIBUTES) As Long
Private Declare Function CreateDirectoryEx Lib "kernel32.dll" Alias "CreateDirectoryExA" (ByVal lpTemplateDirectory As String, ByVal lpNewDirectory As String, lpSecurityAttributes As SECURITY_ATTRIBUTES) As Long
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpbi As BROWSEINFO) As Long
Private Declare Function SHGetPathFromIDListA Lib "shell32.dll" (pidl As Any, ByVal pszPath As String) As Long
Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, ppidl As ITEMIDLIST) As Long
Private Declare Function SHGetPathFromIDList Lib _
"Shell32" (ByVal pidList As Long, ByVal lpBuffer _
As String) As Long
Private Declare Function lstrcat Lib "Kernel32" _
Alias "lstrcatA" (ByVal lpString1 As String, ByVal _
lpString2 As String) As Long
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Boolean
End Type
Private Type BROWSEINFO
hwndOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Private Enum BROWSE_FLAGS
BIF_BROWSEFORCOMPUTER = &H1000
BIF_BROWSEFORPRINTER = &H2000
BIF_BROWSEINCLUDEFILES = &H4000
BIF_DONTGOBELOWDOMAIN = &H2
BIF_EDITBOX = &H10
BIF_RETURNFSANCESTORS = &H8
BIF_RETURNONLYFSDIRS = &H1
BIF_STATUSTEXT = &H4
BIF_USENEWUI = &H40
BIF_VALIDATE = &H20
End Enum
Private Const MAX_PATH = 260
Private Const MAX_NAME = 40
Private Type SHITEMID
cb As Long
abID As Byte
End Type
Private Type ITEMIDLIST
mkid As SHITEMID
End Type
Private Sub SetupDir()
On Error Resume Next
Dim lpIDList As Long ' Declare Varibles
Dim sBuffer As String
Dim szTitle As String
Dim tBrowseInfo As BROWSEINFO
Dim intRtn As Integer
Dim blnRepeat
szTitle = "请选择一个文件存放路径." & vbCrLf
szTitle = szTitle & "创建一个新文件夹, 单击 '创建文件夹'"
With tBrowseInfo
.hwndOwner = Me.hWnd ' Owner Form
.lpszTitle = szTitle & vbNullChar
.ulFlags = BROWSE_FLAGS.BIF_RETURNONLYFSDIRS + BROWSE_FLAGS.BIF_DONTGOBELOWDOMAIN + BROWSE_FLAGS.BIF_USENEWUI
End With
lpIDList = SHBrowseForFolder(tBrowseInfo)
If (lpIDList) Then
sBuffer = Space(MAX_PATH)
SHGetPathFromIDList lpIDList, sBuffer
sBuffer = Left(sBuffer, InStr(1, sBuffer, vbNullChar) - 1)
txtPath.Text = sBuffer
If Len(sBuffer) > 6 Then
If LCase(Mid(sBuffer, Len(sBuffer) - 6)) = "wwwroot" Or _
LCase(Mid(sBuffer, Len(sBuffer) - 6)) = "wwroot\" Or _
LCase(Mid(sBuffer, Len(sBuffer) - 6)) = "wwroot/" Then
intRtn = MsgBox("It is not recommended to install eLinkCart in the IIS Root Directory. " & vbCrLf & _
"Please select a different directory or select Continue to proceed.", vbApplicationModal + vbInformation + vbOKOnly)
If intRtn = vbCancel Then
blnRepeat = True
Exit Sub
End If
End If
End If
End If
End Sub
Private Sub cmdApply_Click()
SaveSetting App.EXEName, App.EXEName, "Default Filename", txtFilename.Text
SaveSetting App.EXEName, App.EXEName, "Default Path", txtPath.Text
Unload Me
End Sub
Private Sub cmdPath_Click()
Dim blnRepeat
On Error Resume Next
Call_Setup:
blnRepeat = False
SetupDir
If blnRepeat Then
GoTo Call_Setup
End If
End Sub
Private Sub Form_Load()
On Error GoTo Error_Handler
Call SetWindowPos(hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)
txtFilename.Text = GetSetting(App.EXEName, App.EXEName, "Default Filename")
txtPath.Text = GetSetting(App.EXEName, App.EXEName, "Default Path")
Error_Handler:
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
frmMain.Enabled = True
End Sub