📄 netdata.frm
字号:
VERSION 5.00
Begin VB.Form NetData
AutoRedraw = -1 'True
BorderStyle = 1 'Fixed Single
Caption = "网络数据库配置"
ClientHeight = 1305
ClientLeft = 45
ClientTop = 330
ClientWidth = 6105
Icon = "NetData.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 1305
ScaleWidth = 6105
StartUpPosition = 1 '所有者中心
Begin VB.PictureBox cmdBrowse
AutoSize = -1 'True
BackColor = &H00C0C0C0&
BorderStyle = 0 'None
Height = 240
Left = 4080
Picture = "NetData.frx":0442
ScaleHeight = 240
ScaleWidth = 240
TabIndex = 4
ToolTipText = "请选择网络路径"
Top = 120
Width = 240
End
Begin VB.TextBox NetDataPath
BackColor = &H00FFFFFF&
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C00000&
Height = 330
Left = 360
MaxLength = 250
TabIndex = 0
Top = 240
Width = 3705
End
Begin VB.CommandButton NetCancel
Cancel = -1 'True
Caption = "取消(&C)"
Height = 405
Left = 4560
TabIndex = 2
Top = 720
Width = 1320
End
Begin VB.CommandButton OK
Caption = "确定修改(&O)"
Default = -1 'True
Enabled = 0 'False
Height = 405
Left = 4560
TabIndex = 1
Top = 120
Width = 1320
End
Begin VB.Line lRight
BorderColor = &H00FFFFFF&
Visible = 0 'False
X1 = 4185
X2 = 4185
Y1 = 300
Y2 = 615
End
Begin VB.Line Line1
BorderColor = &H00808080&
Index = 4
X1 = 0
X2 = 6345
Y1 = 0
Y2 = 0
End
Begin VB.Line Line1
BorderColor = &H00E0E0E0&
Index = 1
X1 = 30
X2 = 6330
Y1 = 15
Y2 = 15
End
Begin VB.Line Line1
BorderColor = &H00E0E0E0&
Index = 2
X1 = -225
X2 = 6090
Y1 = 1290
Y2 = 1290
End
Begin VB.Line Line2
BorderColor = &H00808080&
Index = 2
X1 = -360
X2 = -360
Y1 = -120
Y2 = 1290
End
Begin VB.Line Line3
BorderColor = &H00E0E0E0&
Index = 2
X1 = -345
X2 = -345
Y1 = -105
Y2 = 1290
End
Begin VB.Line Line2
BorderColor = &H00808080&
Index = 1
X1 = 6090
X2 = 6090
Y1 = -120
Y2 = 1290
End
Begin VB.Line Line3
BorderColor = &H00E0E0E0&
Index = 1
X1 = 6105
X2 = 6105
Y1 = -120
Y2 = 1290
End
Begin VB.Image Image1
Height = 480
Left = 0
Picture = "NetData.frx":058C
Top = 120
Width = 480
End
Begin VB.Line Line3
BorderColor = &H00FFFFFF&
Index = 0
X1 = -105
X2 = 4320
Y1 = 1035
Y2 = 1035
End
Begin VB.Line Line2
BorderColor = &H00FFFFFF&
Index = 0
X1 = 4320
X2 = 4320
Y1 = 105
Y2 = 1050
End
Begin VB.Line Line1
Index = 0
X1 = -225
X2 = -225
Y1 = 105
Y2 = 1020
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "请输入或选择网络数据库所在的路径!"
ForeColor = &H00000080&
Height = 180
Left = 480
TabIndex = 3
Top = 720
Width = 2970
End
End
Attribute VB_Name = "NetData"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Const m_wCurOptIdx = 0
Dim lShow As Boolean
Private Sub cmdBrowse_MouseDown(Button As Integer, Shift As Integer, X As Single, y As Single)
' lTop.BorderColor = &H808080
' lBottom.BorderColor = &HFFFFFF
End Sub
Private Sub cmdBrowse_MouseMove(Button As Integer, Shift As Integer, X As Single, y As Single)
If lShow = True Then Exit Sub '已经隐藏时退出
'lLeft.Visible = True
'lRight.Visible = True
' lTop.Visible = True
' lBottom.Visible = True
' lShow = True
End Sub
Private Sub cmdBrowse_MouseUp(Button As Integer, Shift As Integer, X As Single, y As Single)
'lTop.BorderColor = &HFFFFFF
'lBottom.BorderColor = &H808080
End Sub
Private Sub Form_Load()
' Me.Left = Val(GetSetting(App.EXEName, "NetData", "Left"))
'Me.Top = Val(GetSetting(App.EXEName, "NetData", "Top"))
' Dim wIdx As Integer, nFolder As Long
' Dim sPath As String * MAX_PATH
' Dim IDL As ITEMIDLIST
' NetDataPath.Text = ConData
'If Right(App.Path, 1) = "\" Then
' SystemConfigFile = App.Path & "System.ini"
' Else
' SystemConfigFile = App.Path & "\System.ini"
' End If
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, y As Single)
If lShow = False Then Exit Sub '已经隐藏时退出
'lLeft.Visible = False
'lRight.Visible = False
'lTop.Visible = False
'lBottom.Visible = False
'lShow = False
End Sub
Private Sub Form_Unload(Cancel As Integer)
SaveSetting App.EXEName, "NetData", "Left", Me.Left
SaveSetting App.EXEName, "NetData", "Top", Me.Top
End Sub
Private Sub NetCancel_Click()
Unload Me
End Sub
Private Sub NetDataPath_Change()
'FIXIT: 用 "Trim$" 函数替换 "Trim" 函数 FixIT90210ae-R9757-R1B8ZE
If Trim(NetDataPath.Text) = "" Then
OK.Enabled = False
Else
OK.Enabled = True
End If
End Sub
Private Sub NetDataPath_GotFocus()
NetDataPath.SelStart = 0
'FIXIT: 用 "Trim$" 函数替换 "Trim" 函数 FixIT90210ae-R9757-R1B8ZE
NetDataPath.SelLength = Len(Trim(NetDataPath.Text))
End Sub
Private Sub NetDataPath_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
KeyAscii = 0
SendKeys "{tab}"
End If
End Sub
Private Sub NetDataPath_MouseMove(Button As Integer, Shift As Integer, X As Single, y As Single)
If lShow = False Then Exit Sub '已经隐藏时退出
'lLeft.Visible = False
'lRight.Visible = False
'lTop.Visible = False
' lBottom.Visible = False
' lShow = False
End Sub
Private Sub OK_Click()
Dim FWrite As RegClass
' If InStr(1, UCase(Trim(NetDataPath.Text)), UCase("room.mdb"), vbTextCompare) Then
' checkPath Trim(NetDataPath.Text)
'FWrite.WriteINIString "system", "Database", Trim(NetDataPath.Text), SystemConfigFile
'ElseIf Right(Trim(NetDataPath.Text), 1) = "\" Then
'checkPath Trim(NetDataPath.Text) & "room.mdb"
' FWrite.WriteINIString "system", "Database", Trim(NetDataPath.Text) & "room.mdb", SystemConfigFile
' Else
' FWrite.WriteINIString "system", "Database", Trim(NetDataPath.Text) & "room.mdb", SystemConfigFile
' checkPath Trim(NetDataPath.Text) & "\room.mdb"
'End If
'显示路径
'Unload Me
' FWrite.WriteINIString "system", "Database", Trim(NetDataPath.Text) & "room.mdb", SystemConfigFile
End Sub
Private Function GetFolderValue(wIdx As Integer) As Long
If wIdx < 2 Then
GetFolderValue = 0
ElseIf wIdx < 12 Then
GetFolderValue = wIdx
Else
GetFolderValue = wIdx + 4
End If
End Function
Private Function GetReturnType() As Long
Dim dwRtn As Long
dwRtn = dwRtn
GetReturnType = dwRtn
End Function
Private Sub cmdBrowse_Click()
Dim BI As BROWSEINFO
Dim nFolder As Long
Dim IDL As ITEMIDLIST
Dim pIdl As Long
Dim sPath As String
Dim SHFI As SHFILEINFO
With BI
.hOwner = NetData.hwnd
nFolder = GetFolderValue(m_wCurOptIdx)
If SHGetSpecialFolderLocation(ByVal Me.hwnd, ByVal nFolder, IDL) = NOERROR Then
.pidlRoot = IDL.mkid.cb
End If
.pszDisplayName = String$(MAX_PATH, 0)
.lpszTitle = "请选择数据库的路径 => 客房管理系统，网络数据设置"
.ulFlags = GetReturnType()
End With
' 显示浏览对话框
pIdl = SHBrowseForFolder(BI)
If pIdl = 0 Then Exit Sub
sPath = String$(MAX_PATH, 0)
SHGetPathFromIDList ByVal pIdl, ByVal sPath
'FIXIT: 用 "Left$" 函数替换 "Left" 函数 FixIT90210ae-R9757-R1B8ZE
NetDataPath = Left(sPath, InStr(sPath, vbNullChar) - 1)
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -