addguesttype.vb

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

	Private Sub DeleteB_MouseMove(ByVal eventSender As System.Object, ByVal eventArgs As System.Windows.Forms.MouseEventArgs) Handles DeleteB.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)
		
		GetStatus("删除左边选定的档案类型")
		
	End Sub
	
	Private Sub ExitB_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles ExitB.Click
		
		If IT = True And NoChange = True Then
			Call frmManager.DefInstance.cmdLoad_Click()
		End If
		
		Me.Close()
		
	End Sub
	
	Private Sub ExitB_MouseMove(ByVal eventSender As System.Object, ByVal eventArgs As System.Windows.Forms.MouseEventArgs) Handles ExitB.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)
		
		GetStatus("关闭")
		
	End Sub
	
	Private Sub frmCatalog_KeyDown(ByVal eventSender As System.Object, ByVal eventArgs As System.Windows.Forms.KeyEventArgs) Handles MyBase.KeyDown
		Dim KeyCode As Short = eventArgs.KeyCode
		Dim Shift As Short = eventArgs.KeyData \ &H10000
		
		Select Case KeyCode
			
			Case 46
				If DeleteB.Enabled = True Then
					Call DeleteB_Click(DeleteB, New System.EventArgs())
				End If
			Case 27
				If picDraw.Visible = False Then
					Call CancelRecord_Click(CancelRecord, New System.EventArgs())
				End If
		End Select
		
		
	End Sub
	
	Private Sub frmCatalog_Load(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.Load
		
		frmCatalog.DefInstance.Left = VB6.TwipsToPixelsX(Val(GetSetting(VB6.GetExeName(), "Type", "Left")))
		frmCatalog.DefInstance.Top = VB6.TwipsToPixelsY(Val(GetSetting(VB6.GetExeName(), "Type", "Top")))
		
		subPurView() '安装权限
		
		ImageList1.ListImages.Add(1, "Top", VB6.ImageToIPictureDisp(Picture1.Image))
		ListView1.View = ComctlLib.ListViewConstants.lvwIcon '图标形式浏览
		Dim ListIT As ComctlLib.ListItem
		Dim DB As DAO.Database
		Dim EF As DAO.Recordset
		DB = DAODBEngine_definst.OpenDatabase(ConData, False, False, ConStr)
		EF = DB.OpenRecordset("Catalog", DAO.RecordsetTypeEnum.dbOpenDynaset)
		Do Until EF.EOF
			ListIT = ListView1.ListItems.Add()
			ListIT.Text = EF.Fields("Name").Value
			ListIT.Icon = "Top"
			ListIT.Key = EF.Fields("Name").Value
			EF.MoveNext()
		Loop 
		DB.Close()
		GTN = ""
		NoChange = False
		
	End Sub
	
	'UPGRADE_WARNING: Form 事件 frmCatalog.Unload 具有新的行为。 单击以获得更多信息：'ms-help://MS.VSCC/commoner/redir/redirect.htm?keyword="vbup2065"'
	Private Sub frmCatalog_Closed(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.Closed
		
		SaveSetting(VB6.GetExeName(), "Type", "Left", CStr(VB6.PixelsToTwipsX(Me.Left)))
		SaveSetting(VB6.GetExeName(), "Type", "Top", CStr(VB6.PixelsToTwipsY(Me.Top)))
		
	End Sub
	
	Private Sub ListView1_ItemClick(ByVal eventSender As System.Object, ByVal eventArgs As AxComctlLib.ListViewEvents_ItemClickEvent) Handles ListView1.ItemClick
		GTN = eventArgs.Item.Text
	End Sub
	
	
	Private Sub ListView1_MouseMoveEvent(ByVal eventSender As System.Object, ByVal eventArgs As AxComctlLib.ListViewEvents_MouseMoveEvent) Handles ListView1.MouseMoveEvent
		GetStatus("已经定义的档案类型")
	End Sub
	
	'UPGRADE_WARNING: 初始化窗体时可能激发事件 NewTypeName.TextChanged。 单击以获得更多信息：'ms-help://MS.VSCC/commoner/redir/redirect.htm?keyword="vbup2075"'
	Private Sub NewTypeName_TextChanged(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles NewTypeName.TextChanged
		
		If Trim(NewTypeName.Text) = "" Then
			SaveRecord.Enabled = False
		Else
			SaveRecord.Enabled = True
		End If
		
	End Sub
	
	Private Sub NewTypeName_MouseMove(ByVal eventSender As System.Object, ByVal eventArgs As System.Windows.Forms.MouseEventArgs) Handles NewTypeName.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)
		GetStatus("请输入新的档案类型")
	End Sub
	
	Private Sub SaveRecord_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles SaveRecord.Click
		Dim ListIT As Object
		
		'Save Data
		If InStr(1, NewTypeName.Text, "'", CompareMethod.Text) Then
			MsgBox("该项目之中有特殊字符" & "<'>,请删除。", MsgBoxStyle.OKOnly + 48, "提示：")
			NewTypeName.Focus()
			Exit Sub
		End If
		
		Dim DB As DAO.Database
		Dim tempStr As String
		Dim EF As DAO.Recordset
		DB = DAODBEngine_definst.OpenDatabase(ConData, False, False, ConStr)
		
		'IF add then
		If Label1.Text = "请输入新的档案类型" Then
			tempStr = "Select * From Catalog Where Name='" & Trim(NewTypeName.Text) & "'"
			
			DAODBEngine_definst.BeginTrans()
			
			EF = DB.OpenRecordset(tempStr, DAO.RecordsetTypeEnum.dbOpenDynaset)
			If EF.EOF And EF.BOF Then
				tempStr = "Insert into Catalog (Name) Values('" & Trim(NewTypeName.Text) & "')"
				DB.Execute(tempStr)
				EF.Close()
				DB.Close()
				DAODBEngine_definst.CommitTrans()
			Else
				MsgBox("该档案类型已经存在，请重新列入。    ", MsgBoxStyle.OKOnly + 48, "提示：")
				NewTypeName.Focus()
				EF.Close()
				DB.Close()
				DAODBEngine_definst.CommitTrans()
				Exit Sub
			End If
			
			'Else Modify
		Else
			If Trim(NewTypeName.Text) = GTN Then
				DB.Close()
				NewTypeName.Text = ""
				AddPicture.Visible = False
				picDraw.Visible = True
				cmdModify.Enabled = True
				DeleteB.Enabled = True
				ExitB.Enabled = True
				AddB.Enabled = True
				subPurView() '安装权限
				cmdModify.Focus()
				Exit Sub
			Else
				tempStr = "Select * From Catalog Where Name='" & Trim(NewTypeName.Text) & "'"
				
				DAODBEngine_definst.BeginTrans()
				
				EF = DB.OpenRecordset(tempStr, DAO.RecordsetTypeEnum.dbOpenDynaset)
				If EF.EOF And EF.BOF Then
					tempStr = "Update Catalog Set Name='" & Trim(NewTypeName.Text) & "' Where Name='" & GTN & "'"
					DB.Execute(tempStr)
					tempStr = "Update Detail Set Name='" & Trim(NewTypeName.Text) & "' Where Name='" & GTN & "'"
					DB.Execute(tempStr)
					EF.Close()
					DB.Close()
					DAODBEngine_definst.CommitTrans()
					GTN = ""
				Else
					MsgBox("该档案类型已经存在，请重新列入。    ", MsgBoxStyle.OKOnly + 48, "提示：")
					NewTypeName.Focus()
					EF.Close()
					DB.Close()
					DAODBEngine_definst.CommitTrans()
					Exit Sub
				End If
			End If
		End If
		'Refresh Data
		ListView1.Visible = False
		ListView1.ListItems.Clear()
		DAODBEngine_definst.BeginTrans()
		DB = DAODBEngine_definst.OpenDatabase(ConData, False, False, ConStr)
		EF = DB.OpenRecordset("Catalog", DAO.RecordsetTypeEnum.dbOpenDynaset)
		Do Until EF.EOF
			ListIT = ListView1.ListItems.Add()
			'UPGRADE_WARNING: 未能解析对象 ListIT.Text 的默认属性。 单击以获得更多信息：'ms-help://MS.VSCC/commoner/redir/redirect.htm?keyword="vbup1037"'
			ListIT.Text = EF.Fields("Name").Value
			'UPGRADE_WARNING: 未能解析对象 ListIT.Icon 的默认属性。 单击以获得更多信息：'ms-help://MS.VSCC/commoner/redir/redirect.htm?keyword="vbup1037"'
			ListIT.Icon = "Top"
			'UPGRADE_WARNING: 未能解析对象 ListIT.Key 的默认属性。 单击以获得更多信息：'ms-help://MS.VSCC/commoner/redir/redirect.htm?keyword="vbup1037"'
			ListIT.Key = EF.Fields("Name").Value
			EF.MoveNext()
		Loop 
		DB.Close()
		DAODBEngine_definst.CommitTrans()
		ListView1.Visible = True
		NewTypeName.Text = ""
		NewTypeName.Focus()
		NoChange = True
		
		If Label1.Text = "输入修改的档案类型" Then
			'Finish then
			GTN = ""
			NewTypeName.Text = ""
			AddPicture.Visible = False
			picDraw.Visible = True
			cmdModify.Enabled = True
			DeleteB.Enabled = True
			ExitB.Enabled = True
			AddB.Enabled = True
			cmdModify.Focus()
		End If
		subPurView() '安装权限
		
	End Sub
	
	Private Sub SaveRecord_MouseMove(ByVal eventSender As System.Object, ByVal eventArgs As System.Windows.Forms.MouseEventArgs) Handles SaveRecord.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)
		
		GetStatus("保存新类型并返回")
		
	End Sub
	
	Private Sub subPurView()
		
		'权限控制
		Select Case PurView
			Case "只能添加"
				cmdModify.Enabled = False
				DeleteB.Enabled = False
			Case "不能修改"
				cmdModify.Enabled = False
				DeleteB.Enabled = False
			Case "可以修改"
				'没有
			Case "超级权限"
				'没有权限限制
		End Select
		
	End Sub
End Class