netdata.vb

一个用vb开发的档案管理程序

		Me._Line3_0.Height = 1
		Me._Line3_0.Name = "_Line3_0"
		Me._Line2_0.BackColor = System.Drawing.Color.White
		Me._Line2_0.Visible = True
		Me._Line2_0.Location = New System.Drawing.Point(304, 15)
		Me._Line2_0.Width = 1
		Me._Line2_0.Height = 63
		Me._Line2_0.Name = "_Line2_0"
		Me._Line1_0.BackColor = System.Drawing.SystemColors.WindowText
		Me._Line1_0.Visible = True
		Me._Line1_0.Location = New System.Drawing.Point(9, 15)
		Me._Line1_0.Width = 1
		Me._Line1_0.Height = 61
		Me._Line1_0.Name = "_Line1_0"
		Me.Label1.Text = "请输入或选择网络数据库所在的路径!"
		Me.Label1.ForeColor = System.Drawing.Color.FromARGB(128, 0, 0)
		Me.Label1.Size = New System.Drawing.Size(198, 12)
		Me.Label1.Location = New System.Drawing.Point(48, 58)
		Me.Label1.TabIndex = 3
		Me.Label1.TextAlign = System.Drawing.ContentAlignment.TopLeft
		Me.Label1.BackColor = System.Drawing.SystemColors.Control
		Me.Label1.Enabled = True
		Me.Label1.Cursor = System.Windows.Forms.Cursors.Default
		Me.Label1.RightToLeft = System.Windows.Forms.RightToLeft.No
		Me.Label1.UseMnemonic = True
		Me.Label1.Visible = True
		Me.Label1.AutoSize = True
		Me.Label1.BorderStyle = System.Windows.Forms.BorderStyle.None
		Me.Label1.Name = "Label1"
		Me.Controls.Add(cmdBrowse)
		Me.Controls.Add(NetDataPath)
		Me.Controls.Add(NetCancel)
		Me.Controls.Add(OK)
		Me.Controls.Add(lBottom)
		Me.Controls.Add(lRight)
		Me.Controls.Add(lTop)
		Me.Controls.Add(lLeft)
		Me.Controls.Add(_Line1_4)
		Me.Controls.Add(_Line1_1)
		Me.Controls.Add(_Line1_2)
		Me.Controls.Add(_Line1_3)
		Me.Controls.Add(_Line2_2)
		Me.Controls.Add(_Line3_2)
		Me.Controls.Add(_Line2_1)
		Me.Controls.Add(_Line3_1)
		Me.Controls.Add(Image1)
		Me.Controls.Add(Line4)
		Me.Controls.Add(_Line3_0)
		Me.Controls.Add(_Line2_0)
		Me.Controls.Add(_Line1_0)
		Me.Controls.Add(Label1)
		Me.Line1.SetIndex(_Line1_4, CType(4, Short))
		Me.Line1.SetIndex(_Line1_1, CType(1, Short))
		Me.Line1.SetIndex(_Line1_2, CType(2, Short))
		Me.Line1.SetIndex(_Line1_3, CType(3, Short))
		Me.Line1.SetIndex(_Line1_0, CType(0, Short))
		Me.Line2.SetIndex(_Line2_2, CType(2, Short))
		Me.Line2.SetIndex(_Line2_1, CType(1, Short))
		Me.Line2.SetIndex(_Line2_0, CType(0, Short))
		Me.Line3.SetIndex(_Line3_2, CType(2, Short))
		Me.Line3.SetIndex(_Line3_1, CType(1, Short))
		Me.Line3.SetIndex(_Line3_0, CType(0, Short))
		CType(Me.Line3, System.ComponentModel.ISupportInitialize).EndInit()
		CType(Me.Line2, System.ComponentModel.ISupportInitialize).EndInit()
		CType(Me.Line1, System.ComponentModel.ISupportInitialize).EndInit()
	End Sub
#End Region 
#Region "升级支持"
	Private Shared m_vb6FormDefInstance As NetData
	Private Shared m_InitializingDefInstance As Boolean
	Public Shared Property DefInstance() As NetData
		Get
			If m_vb6FormDefInstance Is Nothing OrElse m_vb6FormDefInstance.IsDisposed Then
				m_InitializingDefInstance = True
				m_vb6FormDefInstance = New NetData()
				m_InitializingDefInstance = False
			End If
			DefInstance = m_vb6FormDefInstance
		End Get
		Set
			m_vb6FormDefInstance = Value
		End Set
	End Property
#End Region 
	
	Const m_wCurOptIdx As Short = 0
	Dim lShow As Boolean
	
	Private Sub cmdBrowse_MouseDown(ByVal eventSender As System.Object, ByVal eventArgs As System.Windows.Forms.MouseEventArgs) Handles cmdBrowse.MouseDown
		Dim Button As Short = eventArgs.Button \ &H100000
		Dim Shift As Short = System.Windows.Forms.Control.ModifierKeys \ &H10000
		Dim X As Single = VB6.PixelsToTwipsX(eventArgs.X)
		Dim Y As Single = VB6.PixelsToTwipsY(eventArgs.Y)
		
		lTop.BackColor = System.Drawing.ColorTranslator.FromOle(&H808080)
		lBottom.BackColor = System.Drawing.ColorTranslator.FromOle(&HFFFFFF)
		
	End Sub
	
	Private Sub cmdBrowse_MouseMove(ByVal eventSender As System.Object, ByVal eventArgs As System.Windows.Forms.MouseEventArgs) Handles cmdBrowse.MouseMove
		Dim Button As Short = eventArgs.Button \ &H100000
		Dim Shift As Short = System.Windows.Forms.Control.ModifierKeys \ &H10000
		Dim X As Single = VB6.PixelsToTwipsX(eventArgs.X)
		Dim Y As Single = VB6.PixelsToTwipsY(eventArgs.Y)
		
		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(ByVal eventSender As System.Object, ByVal eventArgs As System.Windows.Forms.MouseEventArgs) Handles cmdBrowse.MouseUp
		Dim Button As Short = eventArgs.Button \ &H100000
		Dim Shift As Short = System.Windows.Forms.Control.ModifierKeys \ &H10000
		Dim X As Single = VB6.PixelsToTwipsX(eventArgs.X)
		Dim Y As Single = VB6.PixelsToTwipsY(eventArgs.Y)
		
		lTop.BackColor = System.Drawing.ColorTranslator.FromOle(&HFFFFFF)
		lBottom.BackColor = System.Drawing.ColorTranslator.FromOle(&H808080)
		
	End Sub
	
	Private Sub NetData_Load(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.Load
		
		Me.Left = VB6.TwipsToPixelsX(Val(GetSetting(VB6.GetExeName(), "NetData", "Left")))
		Me.Top = VB6.TwipsToPixelsY(Val(GetSetting(VB6.GetExeName(), "NetData", "Top")))
		
		Dim wIdx As Short
		Dim nFolder As Integer
		Dim sPath As New VB6.FixedLengthString(MAX_PATH)
		Dim IDL As ITEMIDLIST
		
		NetDataPath.Text = ConData
		
	End Sub
	
	Private Sub NetData_MouseMove(ByVal eventSender As System.Object, ByVal eventArgs As System.Windows.Forms.MouseEventArgs) Handles MyBase.MouseMove
		Dim Button As Short = eventArgs.Button \ &H100000
		Dim Shift As Short = System.Windows.Forms.Control.ModifierKeys \ &H10000
		Dim X As Single = VB6.PixelsToTwipsX(eventArgs.X)
		Dim Y As Single = VB6.PixelsToTwipsY(eventArgs.Y)
		
		If lShow = False Then Exit Sub '已经隐藏时退出
		lLeft.Visible = False
		lRight.Visible = False
		lTop.Visible = False
		lBottom.Visible = False
		lShow = False
		
	End Sub
	
	'UPGRADE_WARNING: Form 事件 NetData.Unload 具有新的行为。 单击以获得更多信息：'ms-help://MS.VSCC/commoner/redir/redirect.htm?keyword="vbup2065"'
	Private Sub NetData_Closed(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.Closed
		
		SaveSetting(VB6.GetExeName(), "NetData", "Left", CStr(VB6.PixelsToTwipsX(Me.Left)))
		SaveSetting(VB6.GetExeName(), "NetData", "Top", CStr(VB6.PixelsToTwipsY(Me.Top)))
		
	End Sub
	
	Private Sub NetCancel_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles NetCancel.Click
		Me.Close()
	End Sub
	
	'UPGRADE_WARNING: 初始化窗体时可能激发事件 NetDataPath.TextChanged。 单击以获得更多信息：'ms-help://MS.VSCC/commoner/redir/redirect.htm?keyword="vbup2075"'
	Private Sub NetDataPath_TextChanged(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles NetDataPath.TextChanged
		If Trim(NetDataPath.Text) = "" Then
			OK.Enabled = False
		Else
			OK.Enabled = True
		End If
	End Sub
	
	Private Sub NetDataPath_Enter(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles NetDataPath.Enter
		NetDataPath.SelectionStart = 0
		NetDataPath.SelectionLength = Len(Trim(NetDataPath.Text))
	End Sub
	
	Private Sub NetDataPath_KeyPress(ByVal eventSender As System.Object, ByVal eventArgs As System.Windows.Forms.KeyPressEventArgs) Handles NetDataPath.KeyPress
		Dim KeyAscii As Short = Asc(eventArgs.KeyChar)
		If KeyAscii = 13 Then
			KeyAscii = 0
			System.Windows.Forms.SendKeys.Send("{tab}")
		End If
		If KeyAscii = 0 Then
			eventArgs.Handled = True
		End If
	End Sub
	
	Private Sub NetDataPath_MouseMove(ByVal eventSender As System.Object, ByVal eventArgs As System.Windows.Forms.MouseEventArgs) Handles NetDataPath.MouseMove
		Dim Button As Short = eventArgs.Button \ &H100000
		Dim Shift As Short = System.Windows.Forms.Control.ModifierKeys \ &H10000
		Dim X As Single = VB6.PixelsToTwipsX(eventArgs.X)
		Dim Y As Single = VB6.PixelsToTwipsY(eventArgs.Y)
		
		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(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles OK.Click
		
		If InStr(1, UCase(Trim(NetDataPath.Text)), UCase("File.MDB"), CompareMethod.Text) Then
			checkPath(Trim(NetDataPath.Text))
		ElseIf VB.Right(Trim(NetDataPath.Text), 1) = "\" Then 
			checkPath(Trim(NetDataPath.Text) & "File.Mdb")
		Else
			checkPath(Trim(NetDataPath.Text) & "\File.Mdb")
		End If
		
		'显示路径
		frmMain.DefInstance.MnuDataPathDisplay.Text = "当前数据库路径：" & ConData
		Me.Close()
		
	End Sub
	
	Private Function GetFolderValue(ByRef wIdx As Short) As Integer
		
		If wIdx < 2 Then
			GetFolderValue = 0
		ElseIf wIdx < 12 Then 
			GetFolderValue = wIdx
		Else
			GetFolderValue = wIdx + 4
		End If
		
	End Function
	
	
	Private Function GetReturnType() As Integer
		Dim dwRtn As Integer
		dwRtn = dwRtn
		GetReturnType = dwRtn
	End Function
	
	Private Sub cmdBrowse_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cmdBrowse.Click
		
		Dim BI As BROWSEINFO
		Dim nFolder As Integer
		Dim IDL As ITEMIDLIST
		Dim pIdl As Integer
		Dim sPath As String
		Dim SHFI As SHFILEINFO
		
		With BI
			.hOwner = NetData.DefInstance.Handle.ToInt32
			nFolder = GetFolderValue(m_wCurOptIdx)
			If SHGetSpecialFolderLocation(Me.Handle.ToInt32, nFolder, IDL) = NOERROR Then
				.pidlRoot = IDL.mkid.cb
			End If
			
			.pszDisplayName = New String(Chr(0), MAX_PATH)
			.lpszTitle = "请选择数据库的路径 => 档案管理系统，网络数据设置"
			.ulFlags = GetReturnType()
			
		End With
		
		' 显示浏览对话框
		pIdl = SHBrowseForFolder(BI)
		
		If pIdl = 0 Then Exit Sub
		sPath = New String(Chr(0), MAX_PATH)
		SHGetPathFromIDList(pIdl, sPath)
		
		NetDataPath.Text = VB.Left(sPath, InStr(sPath, vbNullChar) - 1)
		
	End Sub
End Class