www.pudn.com > 档案管理系统源码VB.zip > NetData.frm
VERSION 5.00
Begin VB.Form NetData
AutoRedraw = -1 'True
BorderStyle = 1 'Fixed Single
Caption = "网络数据库配置"
ClientHeight = 1425
ClientLeft = 45
ClientTop = 330
ClientWidth = 6360
Icon = "NetData.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 1425
ScaleWidth = 6360
Begin VB.PictureBox cmdBrowse
AutoSize = -1 'True
BackColor = &H00C0C0C0&
BorderStyle = 0 'None
Height = 240
Left = 4155
Picture = "NetData.frx":0442
ScaleHeight = 240
ScaleWidth = 240
TabIndex = 4
ToolTipText = "请选择网络路径"
Top = 450
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 = 345
MaxLength = 250
TabIndex = 0
Top = 420
Width = 3705
End
Begin VB.CommandButton NetCancel
Cancel = -1 'True
Caption = "取消(&C)"
Height = 405
Left = 4800
TabIndex = 2
Top = 675
Width = 1320
End
Begin VB.CommandButton OK
Caption = "确定(&O)"
Default = -1 'True
Enabled = 0 'False
Height = 405
Left = 4800
TabIndex = 1
Top = 240
Width = 1320
End
Begin VB.Line lBottom
BorderColor = &H00808080&
Visible = 0 'False
X1 = 4125
X2 = 4425
Y1 = 735
Y2 = 735
End
Begin VB.Line lRight
BorderColor = &H00FFFFFF&
Visible = 0 'False
X1 = 4425
X2 = 4425
Y1 = 420
Y2 = 735
End
Begin VB.Line lTop
BorderColor = &H00FFFFFF&
Visible = 0 'False
X1 = 4110
X2 = 4425
Y1 = 420
Y2 = 420
End
Begin VB.Line lLeft
BorderColor = &H00808080&
Visible = 0 'False
X1 = 4110
X2 = 4110
Y1 = 420
Y2 = 750
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 = 15
X2 = 6330
Y1 = 1410
Y2 = 1410
End
Begin VB.Line Line1
BorderColor = &H00808080&
Index = 3
X1 = 30
X2 = 6330
Y1 = 1395
Y2 = 1395
End
Begin VB.Line Line2
BorderColor = &H00808080&
Index = 2
X1 = 0
X2 = 0
Y1 = 0
Y2 = 1410
End
Begin VB.Line Line3
BorderColor = &H00E0E0E0&
Index = 2
X1 = 15
X2 = 15
Y1 = 15
Y2 = 1410
End
Begin VB.Line Line2
BorderColor = &H00808080&
Index = 1
X1 = 6330
X2 = 6330
Y1 = 0
Y2 = 1410
End
Begin VB.Line Line3
BorderColor = &H00E0E0E0&
Index = 1
X1 = 6345
X2 = 6345
Y1 = 0
Y2 = 1410
End
Begin VB.Image Image1
Height = 480
Left = 255
Picture = "NetData.frx":058C
Top = 720
Width = 480
End
Begin VB.Line Line4
X1 = 150
X2 = 4560
Y1 = 225
Y2 = 225
End
Begin VB.Line Line3
BorderColor = &H00FFFFFF&
Index = 0
X1 = 135
X2 = 4560
Y1 = 1155
Y2 = 1155
End
Begin VB.Line Line2
BorderColor = &H00FFFFFF&
Index = 0
X1 = 4560
X2 = 4560
Y1 = 225
Y2 = 1170
End
Begin VB.Line Line1
Index = 0
X1 = 135
X2 = 135
Y1 = 225
Y2 = 1140
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "请输入或选择网络数据库所在的路径!"
ForeColor = &H00000080&
Height = 180
Left = 720
TabIndex = 3
Top = 870
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
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()
If Trim(NetDataPath.Text) = "" Then
OK.Enabled = False
Else
OK.Enabled = True
End If
End Sub
Private Sub NetDataPath_GotFocus()
NetDataPath.SelStart = 0
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()
If InStr(1, UCase(Trim(NetDataPath.Text)), UCase("File.MDB"), vbTextCompare) Then
checkPath Trim(NetDataPath.Text)
ElseIf Right(Trim(NetDataPath.Text), 1) = "\" Then
checkPath Trim(NetDataPath.Text) & "File.Mdb"
Else
checkPath Trim(NetDataPath.Text) & "\File.Mdb"
End If
'显示路径
frmMain.MnuDataPathDisplay.Caption = "当前数据库路径：" & ConData
Unload Me
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
NetDataPath = Left(sPath, InStr(sPath, vbNullChar) - 1)
End Sub