📄 frmsetparameter.frm
字号:
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form frmSetParameter
Caption = "设置参数"
ClientHeight = 4965
ClientLeft = 3615
ClientTop = 1680
ClientWidth = 5880
Icon = "frmSetParameter.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4965
ScaleWidth = 5880
StartUpPosition = 1 '所有者中心
Begin MSComDlg.CommonDialog CommonDialog1
Left = 0
Top = 2280
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.CommandButton CmdExit
Caption = "退出"
Height = 375
Left = 4200
TabIndex = 12
Top = 3840
Width = 735
End
Begin VB.CommandButton CmdRestore
Caption = "恢复默认设置"
Height = 375
Left = 2400
TabIndex = 11
Top = 3840
Width = 1455
End
Begin VB.CommandButton CmdOK
Caption = "确认"
Height = 375
Left = 1320
TabIndex = 10
Top = 3840
Width = 735
End
Begin VB.Frame Frame2
Caption = "高级"
Height = 1215
Left = 1680
TabIndex = 6
Top = 240
Width = 3735
Begin VB.CheckBox CheckOpenDB
Caption = " 下次启动后打开默认数据库"
Height = 255
Left = 240
TabIndex = 9
Top = 720
Value = 1 'Checked
Width = 2775
End
Begin VB.CheckBox CheckPassWord
Caption = " 下次程序启动时密码验证"
Height = 375
Left = 240
TabIndex = 8
Top = 240
Width = 2535
End
End
Begin VB.Frame Frame1
Caption = "默认设置"
DragMode = 1 'Automatic
Height = 2055
Left = 240
TabIndex = 0
Top = 1560
Width = 5175
Begin VB.CommandButton CmdSave
Height = 345
Left = 4680
Picture = "frmSetParameter.frx":08CA
Style = 1 'Graphical
TabIndex = 7
Top = 1440
Width = 375
End
Begin VB.TextBox txtTacitlyDatabase
Height = 375
Left = 240
TabIndex = 5
Top = 600
Width = 4335
End
Begin VB.CommandButton CmdOpen
Height = 345
Left = 4680
Picture = "frmSetParameter.frx":0DFC
Style = 1 'Graphical
TabIndex = 3
Top = 600
Width = 375
End
Begin VB.TextBox txtTacitlySaveFolder
Height = 375
Left = 240
TabIndex = 2
Top = 1440
Width = 4335
End
Begin VB.Label Label2
Caption = "默认文件存放文件夹："
Height = 255
Left = 240
TabIndex = 4
Top = 1200
Width = 1815
End
Begin VB.Label Label1
Caption = "默认打开的数据库："
Height = 255
Left = 240
TabIndex = 1
Top = 360
Width = 1695
End
End
Begin VB.PictureBox PicCaption
AutoRedraw = -1 'True
AutoSize = -1 'True
BorderStyle = 0 'None
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 720
Left = 0
Picture = "frmSetParameter.frx":132E
ScaleHeight = 720
ScaleWidth = 9600
TabIndex = 13
TabStop = 0 'False
Top = 4200
Visible = 0 'False
Width = 9600
Begin VB.PictureBox PicBorder
AutoRedraw = -1 'True
AutoSize = -1 'True
BorderStyle = 0 'None
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 150
Left = 0
Picture = "frmSetParameter.frx":17B72
ScaleHeight = 150
ScaleWidth = 1050
TabIndex = 14
TabStop = 0 'False
Top = 0
Visible = 0 'False
Width = 1050
End
End
Begin VB.Image Image1
Height = 1140
Left = 360
Picture = "frmSetParameter.frx":18284
Top = 240
Width = 855
End
End
Attribute VB_Name = "frmSetParameter"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'//////////////////////////////////////////////////////////////////////////////////
'////////////////////////////////////////////////////////////////////////////
'////////// for browse
Option Explicit
Private Const MAX_PATH = 255
Private Const WM_NCLBUTTONDOWN = &HA1
Private Const HTCAPTION = 2
Private Type BROWSEINFO
hwndOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Integer
lpFn As Long
lParam As Long
iImage As Integer
End Type
Private Type SHELLEXECUTEINFO
cbSize As Long
fMask As Long
hwnd As Long
lpVerb As String
lpFile As String
lpParameters As String
lpDirectory As String
nShow As Long
hInstApp As Long
lpIDList As Long
lpClass As String
hkeyClass As Long
dwHotKey As Long
hIcon As Long
hProcess As Long
End Type
Private Const SEE_MASK_INVOKEIDLIST = &HC
Private Const SEE_MASK_NOCLOSEPROCESS = &H40
Private Const SEE_MASK_FLAG_NO_UI = &H400
Private Declare Function ShellExecuteEX Lib "shell32.dll" Alias _
"ShellExecuteEx" (SEI As SHELLEXECUTEINFO) As Long
'Private Declare Function SHFileOperation Lib "shell32.dll" Alias " SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
Private Declare Function SHGetPathFromIDList Lib "Shell32" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal szPath As String) As Long
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Declare Function SHBrowseForFolder Lib "Shell32" (bi As BROWSEINFO) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
'//////////////////////////////////////////////////////////////////////////////////
'////////////////////////////////////////////////////////////////////////////
Private m_cN As cNeoCaption 'for skin
Private Sub CmdExit_Click()
Unload Me
End Sub
Private Sub CmdOK_Click()
SetKeyValue HKEY_CURRENT_USER, "Software\Note", "CheckPassWord", Me.CheckPassWord.Value, REG_SZ
SetKeyValue HKEY_CURRENT_USER, "Software\Note", "CheckOpenDB", Me.CheckOpenDB, REG_SZ
SetKeyValue HKEY_CURRENT_USER, "Software\Note", "TacitlyDatabase", Me.txtTacitlyDatabase, REG_SZ
SetKeyValue HKEY_CURRENT_USER, "Software\Note", "TacitlySaveFolder", Me.txtTacitlySaveFolder, REG_SZ
Unload Me
End Sub
Private Sub CmdOpen_Click() '默认打开的数据库
CommonDialog1.FileName = ""
CommonDialog1.InitDir = QueryValue(HKEY_CURRENT_USER, "Software\Note", "TacitlySaveFolder")
CommonDialog1.Filter = "Note Files (*.not)|*.not"
CommonDialog1.CancelError = True '按“取消”，产生错误信息
On Error GoTo OpenCancel
CommonDialog1.ShowOpen
FName = CommonDialog1.FileName '将打开的文件名存入FName
If Dir(FName) = "" Then
MsgBox FName & "不存在", vbInformation + vbOKOnly, "错误信息"
Exit Sub
End If
txtTacitlyDatabase.Text = FName
OpenCancel:
End Sub
Private Sub CmdRestore_Click()
CheckPassWord.Value = 0
CheckOpenDB.Value = 1
txtTacitlyDatabase.Text = App.Path & "\database\friend.not"
txtTacitlySaveFolder.Text = App.Path & "\database"
End Sub
Private Sub CmdSave_Click() '默认文件存放文件夹
Dim i As Integer
Dim rc As Long
Dim itemID As Long
Dim sPath As String
Dim bi As BROWSEINFO
Dim PathName As String
bi.hwndOwner = Me.hwnd
itemID = SHBrowseForFolder(bi)
sPath = Space(MAX_PATH)
rc = SHGetPathFromIDList(itemID, sPath)
PathName = Trim$(sPath)
PathName = left(PathName, Len(PathName) - 1)
If PathName = vbNullString Then
Exit Sub
Else
If right(PathName, 2) = ":\" Then
PathName = left(PathName, Len(PathName) - 1)
Else
PathName = PathName + "\"
End If
End If
frmSetParameter.txtTacitlySaveFolder.Text = PathName
End Sub
Private Sub Form_Load()
CheckPassWord.Value = QueryValue(HKEY_CURRENT_USER, "Software\Note", "CheckPassWord")
CheckOpenDB.Value = QueryValue(HKEY_CURRENT_USER, "Software\Note", "CheckOpenDB")
txtTacitlyDatabase.Text = QueryValue(HKEY_CURRENT_USER, "Software\Note", "TacitlyDatabase")
txtTacitlySaveFolder.Text = QueryValue(HKEY_CURRENT_USER, "Software\Note", "TacitlySaveFolder")
'/////////////////////////////////////////////////////////////
'/// for skin
Set m_cN = New cNeoCaption
Skin Me, m_cN
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -