frmmanager.vb

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

		'刷新数据
		Call cmdLoad_Click()
		frmMain.DefInstance.Toolbar1.Buttons(5).Enabled = False
		frmMain.DefInstance.Toolbar1.Buttons(6).Enabled = False
		frmMain.DefInstance.Toolbar1.Buttons(7).Enabled = False
		MnuAddFile.Enabled = False
		MnuModifyFile.Enabled = False
		MnuDeleteFile.Enabled = False
		
	End Sub
	
	Public Sub MnuExit_Popup(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MnuExit.Popup
		MnuExit_Click(eventSender, eventArgs)
	End Sub
	Public Sub MnuExit_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MnuExit.Click
		
		frmMain.DefInstance.Close()
		
	End Sub
	
	Public Sub MnuFolder_Popup(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MnuFolder.Popup
		MnuFolder_Click(eventSender, eventArgs)
	End Sub
	Public Sub MnuFolder_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MnuFolder.Click
		
		Me.Cursor = System.Windows.Forms.Cursors.WaitCursor
		frmCatalog.DefInstance.ShowDialog()
		Me.Cursor = System.Windows.Forms.Cursors.Default
		
	End Sub
	
	Public Sub MnuModifyFile_Popup(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MnuModifyFile.Popup
		MnuModifyFile_Click(eventSender, eventArgs)
	End Sub
	Public Sub MnuModifyFile_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MnuModifyFile.Click
		
		Me.Cursor = System.Windows.Forms.Cursors.WaitCursor
		frmModifyForm.DefInstance.ShowDialog()
		Me.Cursor = System.Windows.Forms.Cursors.Default
		
	End Sub
	
	Public Sub MnuOpenFile_Popup(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MnuOpenFile.Popup
		MnuOpenFile_Click(eventSender, eventArgs)
	End Sub
	Public Sub MnuOpenFile_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MnuOpenFile.Click
		
		Call picEditFile_Click(picEditFile, New System.EventArgs())
		
	End Sub
	
	Public Sub MnuRefresh_Popup(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MnuRefresh.Popup
		MnuRefresh_Click(eventSender, eventArgs)
	End Sub
	Public Sub MnuRefresh_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MnuRefresh.Click
		
		strSearchString = "" '查询条件为空
		Call cmdLoad_Click()
		
	End Sub
	
	Public Sub MnuReturn_Popup(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MnuReturn.Popup
		MnuReturn_Click(eventSender, eventArgs)
	End Sub
	Public Sub MnuReturn_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MnuReturn.Click
		
		Me.Close()
		
	End Sub
	
	Public Sub MnuSearchFile_Popup(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MnuSearchFile.Popup
		MnuSearchFile_Click(eventSender, eventArgs)
	End Sub
	Public Sub MnuSearchFile_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MnuSearchFile.Click
		
		Me.Cursor = System.Windows.Forms.Cursors.WaitCursor
		frmSearchForm.DefInstance.ShowDialog()
		Me.Cursor = System.Windows.Forms.Cursors.Default
		
	End Sub
	
	Private Sub picEditFile_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles picEditFile.Click
		
		On Error Resume Next
		'编辑档案
		Dim retVal As Integer
		
		retVal = ShellExecute(Me.Handle.ToInt32, "Open", txtFields(1).Text, "", VB6.GetPath & "\File", 1)
		
		If retVal = 2 Then '文件不存在
			MsgBox("下面文件没有找到：    " & vbCrLf & vbCrLf & txtFields(1).Text & "    ", MsgBoxStyle.Information, "档案管理系统")
			Exit Sub
		End If
		
		If retVal = 31 Then '文件不能打开时
			If MsgBox("系统不能自动打开下面文件：    " & vbCrLf & vbCrLf & txtFields(1).Text & vbCrLf & vbCrLf & "是否使用其它Open方法试试,(是/否)?      ", MsgBoxStyle.YesNo + MsgBoxStyle.Question, "档案管理系统") = MsgBoxResult.No Then
				Exit Sub
			Else
				'使用Explorer打开文件
				retVal = Shell("Explorer.Exe " & txtFields(1).Text, AppWinStyle.NormalFocus)
			End If
		End If
		
	End Sub
	
	Private Sub picEditFile_MouseDown(ByVal eventSender As System.Object, ByVal eventArgs As System.Windows.Forms.MouseEventArgs) Handles picEditFile.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 picEditFile_MouseMove(ByVal eventSender As System.Object, ByVal eventArgs As System.Windows.Forms.MouseEventArgs) Handles picEditFile.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 picEditFile_MouseUp(ByVal eventSender As System.Object, ByVal eventArgs As System.Windows.Forms.MouseEventArgs) Handles picEditFile.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 TreeView_Collapse(ByVal eventSender As System.Object, ByVal eventArgs As AxComctlLib.ITreeViewEvents_CollapseEvent) Handles TreeView.Collapse
		
		If eventArgs.Node.Tag = "FileManager" Then eventArgs.Node.Image = "Closed"
		If eventArgs.Node.Tag = "File" Then eventArgs.Node.Image = "SClosed"
		
	End Sub
	
	Private Sub TreeView_Expand(ByVal eventSender As System.Object, ByVal eventArgs As AxComctlLib.ITreeViewEvents_ExpandEvent) Handles TreeView.Expand
		
		If eventArgs.Node.Tag = "FileManager" Then eventArgs.Node.Image = "Open"
		If eventArgs.Node.Tag = "File" Then eventArgs.Node.Image = "SOpen"
		
	End Sub
	
	Private Sub TreeView_MouseDownEvent(ByVal eventSender As System.Object, ByVal eventArgs As AxComctlLib.ITreeViewEvents_MouseDownEvent) Handles TreeView.MouseDownEvent
		
		If eventArgs.Button = 2 Then
			'UPGRADE_ISSUE: Form 方法 frmManager.PopupMenu 未升级。 单击以获得更多信息：'ms-help://MS.VSCC/commoner/redir/redirect.htm?keyword="vbup2064"'
			PopupMenu(MnuControl)
		End If
		
	End Sub
	
	Private Sub TreeView_NodeClick(ByVal eventSender As System.Object, ByVal eventArgs As AxComctlLib.ITreeViewEvents_NodeClickEvent) Handles TreeView.NodeClick
		
		lblFileCaption.Text = eventArgs.Node.Text
		lblFileCaption.Left = VB6.TwipsToPixelsX((VB6.PixelsToTwipsX(ListView.Width) - VB6.PixelsToTwipsX(lblFileCaption.Width)) / 2)
		
		If eventArgs.Node.Tag = "SFile" Then
			MnuAddFile.Enabled = True
			MnuModifyFile.Enabled = True
			MnuDeleteFile.Enabled = True
			frmMain.DefInstance.Toolbar1.Buttons(5).Enabled = True
			frmMain.DefInstance.Toolbar1.Buttons(6).Enabled = True
			frmMain.DefInstance.Toolbar1.Buttons(7).Enabled = True
			subPurView() '安装权限
		Else
			MnuAddFile.Enabled = False
			MnuModifyFile.Enabled = False
			MnuDeleteFile.Enabled = False
			frmMain.DefInstance.Toolbar1.Buttons(5).Enabled = False
			frmMain.DefInstance.Toolbar1.Buttons(6).Enabled = False
			frmMain.DefInstance.Toolbar1.Buttons(7).Enabled = False
		End If
		
		If eventArgs.Node.Tag = "SFile" And strHistory <> eventArgs.Node.Text Then
			If Trim(eventArgs.Node.Text) <> "" Then
				LoadData((eventArgs.Node.Text)) '安装数据库
				strHistory = eventArgs.Node.Text
				If Trim(txtFields(1).Text) <> "" And PurView <> "只能添加" Then
					MnuOpenFile.Enabled = True
				Else
					MnuOpenFile.Enabled = False
				End If
			End If
		End If
		
		If eventArgs.Node.Tag <> "SFile" Then
			txtFields(0).Text = ""
			txtFields(1).Text = ""
			txtFields(2).Text = ""
			txtFields(3).Text = ""
			strHistory = ""
			MnuOpenFile.Enabled = False
		End If
		
		'安装ID与类型,但为根目录时跳过
		If eventArgs.Node.Text = "档案仓库" Then
		ElseIf eventArgs.Node.Tag = "File" Then 
			MnuAddFile.Enabled = True
			frmMain.DefInstance.Toolbar1.Buttons(5).Enabled = True
			strFileType = eventArgs.Node.Text
			strFileID = ""
		Else
			strFileType = eventArgs.Node.Parent.Text
			strFileID = eventArgs.Node.Text
		End If
		
	End Sub
	
	Private Sub LoadData(ByRef strTemp As String)
		
		If PurView = "只能添加" Then Exit Sub
		
		mdbFile = DAODBEngine_definst.OpenDatabase(ConData, False, False, ConStr)
		Dim rsTitles As DAO.Recordset
		rsTitles = mdbFile.OpenRecordset("Select * From Detail Where 档案号='" & strTemp & "'", DAO.RecordsetTypeEnum.dbOpenDynaset)
		
		txtFields(0).Text = rsTitles.Fields("Name").Value
		txtFields(1).Text = rsTitles.Fields("文件名").Value
		txtFields(2).Text = rsTitles.Fields("文件说明").Value
		txtFields(3).Text = rsTitles.Fields("参考说明").Value
		rsTitles.Close()
		mdbFile.Close()
		'UPGRADE_NOTE: 在对对象 mdbFile 进行垃圾回收前，不可以销毁该对象。 单击以获得更多信息：'ms-help://MS.VSCC/commoner/redir/redirect.htm?keyword="vbup1029"'
		mdbFile = Nothing
		
	End Sub
	
	'UPGRADE_WARNING: 初始化窗体时可能激发事件 txtFields.TextChanged。 单击以获得更多信息：'ms-help://MS.VSCC/commoner/redir/redirect.htm?keyword="vbup2075"'
	Private Sub txtFields_TextChanged(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles txtFields.TextChanged
		Dim Index As Short = txtFields.GetIndex(eventSender)
		
		If Trim(txtFields(1).Text) = "" Then
			picEditFile.Visible = False
		Else
			picEditFile.Visible = True
		End If
		
	End Sub
	
	Private Sub txtFields_MouseMove(ByVal eventSender As System.Object, ByVal eventArgs As System.Windows.Forms.MouseEventArgs) Handles txtFields.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)
		Dim Index As Short = txtFields.GetIndex(eventSender)
		
		If lShow = False Then Exit Sub '已经隐藏时退出
		
		lLeft.Visible = False
		lRight.Visible = False
		lTop.Visible = False
		lBottom.Visible = False
		lShow = False
		
	End Sub
	
	Private Sub subPurView()
		
		'权限控制
		Select Case PurView
			Case "只能添加"
				MnuAddFile.Enabled = True
				MnuModifyFile.Enabled = False
				MnuDeleteFile.Enabled = False
				frmMain.DefInstance.Toolbar1.Buttons(5).Enabled = True
				frmMain.DefInstance.Toolbar1.Buttons(6).Enabled = False
				frmMain.DefInstance.Toolbar1.Buttons(7).Enabled = False
				MnuSearchFile.Enabled = False
				frmMain.DefInstance.Toolbar1.Buttons(9).Enabled = False
			Case "不能修改"
				MnuAddFile.Enabled = True
				MnuModifyFile.Enabled = False
				MnuDeleteFile.Enabled = False
				frmMain.DefInstance.Toolbar1.Buttons(5).Enabled = True
				frmMain.DefInstance.Toolbar1.Buttons(6).Enabled = False
				frmMain.DefInstance.Toolbar1.Buttons(7).Enabled = False
			Case "可以修改"
				'没有
			Case "超级权限"
				'没有权限限制
		End Select
		
	End Sub
	
	Private Function LocalPath(ByRef strFileName As String) As String
		
		strFileName = Trim(strFileName)
		
		Dim X As Short
		X = 1
		For X = 1 To Len(strFileName)
			If InStr(1, VB.Right(strFileName, X), "\", CompareMethod.Text) Then
				Exit For
			End If
		Next 
		
		If X > Len(strFileName) Then
			LocalPath = CurDir()
		Else
			LocalPath = VB.Left(strFileName, Len(strFileName) - X)
		End If
		
	End Function

    Private Sub ListView_Paint(ByVal sender As System.Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles ListView.Paint

    End Sub
End Class