frmnewform.vb

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

				Me.Close()
				Exit Sub
			Else
				'保存记录代码
				Call SaveAdd_Click(SaveAdd, New System.EventArgs())
				If IT = True And NoChange = True Then
					Call frmManager.DefInstance.cmdLoad_Click()
				End If
				Exit Sub
			End If
		Else
			If IT = True And NoChange = True Then
				Call frmManager.DefInstance.cmdLoad_Click()
			End If
			Me.Close()
		End If
		
	End Sub
	
	'UPGRADE_WARNING: Frame 事件 Frame1.MouseMove 未升级。 单击以获得更多信息：'ms-help://MS.VSCC/commoner/redir/redirect.htm?keyword="vbup2050"'
	Private Sub Frame1_MouseMove(ByRef Button As Short, ByRef Shift As Short, ByRef X As Single, ByRef Y As Single)
		
		If lShow = True Then '已经隐藏时退出
			lLeft.Visible = False
			lRight.Visible = False
			lTop.Visible = False
			lBottom.Visible = False
			lShow = False
		End If
		If lShowS = True Then '已经隐藏时退出
			lLeft_1.Visible = False
			lRight_1.Visible = False
			lTop_1.Visible = False
			lBottom_1.Visible = False
			lShowS = False
		End If
		
	End Sub
	
	Private Sub Label1_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles Label1.Click
		MsgBox("此项不能修改，请注意！", MsgBoxStyle.OKOnly + 64, "提示:")
	End Sub
	
	Private Sub picEditFile_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles picEditFile.Click
		
		On Error Resume Next
		OpenDialog.CancelError = True
		OpenDialog.Flags = MSComDlg.FileOpenConstants.cdlOFNFileMustExist + MSComDlg.FileOpenConstants.cdlOFNHideReadOnly
		OpenDialog.Filter = "所有文件(*.*)|*.*|"
		OpenDialog.DialogTitle = "请选择文件"
		OpenDialog.FileName = GetSetting(VB6.GetExeName(), "Config", "Add")
		OpenDialog.ShowOpen()
		
		If Err.Number = 32755 Then
			If Trim(txtFields(1).Text) <> "" Then
				txtFields(2).Focus()
			Else
				txtFields(1).Focus()
			End If
			Exit Sub
		End If
		
		txtFields(1).Text = OpenDialog.FileName
		'保存最后一次打开的文件
		SaveSetting(VB6.GetExeName(), "Config", "Add", OpenDialog.FileName)
		txtFields(2).Focus()
		
	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 picScan_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles picScan.Click
		
		ScanFileName = ""
		Me.Cursor = System.Windows.Forms.Cursors.WaitCursor
		frmScan.DefInstance.ShowDialog()
		Me.Cursor = System.Windows.Forms.Cursors.Default
		
		If ScanFileName = "" Then
			If Trim(txtFields(1).Text) = "" Then
				txtFields(1).Focus()
			Else
				txtFields(2).Focus()
			End If
			Exit Sub
		Else
			txtFields(1).Text = ScanFileName
			txtFields(2).Focus()
		End If
		
	End Sub
	
	Private Sub picScan_MouseDown(ByVal eventSender As System.Object, ByVal eventArgs As System.Windows.Forms.MouseEventArgs) Handles picScan.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_1.BackColor = System.Drawing.ColorTranslator.FromOle(&H808080)
		lBottom_1.BackColor = System.Drawing.ColorTranslator.FromOle(&HFFFFFF)
		
	End Sub
	
	Private Sub picScan_MouseMove(ByVal eventSender As System.Object, ByVal eventArgs As System.Windows.Forms.MouseEventArgs) Handles picScan.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 lShowS = True Then Exit Sub '已经显示时退出
		
		lLeft_1.Visible = True
		lRight_1.Visible = True
		lTop_1.Visible = True
		lBottom_1.Visible = True
		lShowS = True
		
	End Sub
	
	Private Sub picScan_MouseUp(ByVal eventSender As System.Object, ByVal eventArgs As System.Windows.Forms.MouseEventArgs) Handles picScan.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_1.BackColor = System.Drawing.ColorTranslator.FromOle(&HFFFFFF)
		lBottom_1.BackColor = System.Drawing.ColorTranslator.FromOle(&H808080)
		
	End Sub
	
	Private Sub SaveAdd_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles SaveAdd.Click
		
		If Trim(txtFields(0).Text) = "" Then
			MsgBox("档案名不能空，且不能重复,不能保存!", MsgBoxStyle.OKOnly + 64, "档案名有错误")
			txtFields(0).Focus()
			Exit Sub
		End If
		'Save Data
		'**************** 开始 *****************
		DAODBEngine_definst.BeginTrans()
		Dim DB As DAO.Database
		Dim EF As DAO.Recordset
		Dim X As Short
		Dim tempStr As String
		X = 0
		For X = 0 To 4
			If X < 4 Then
				tempStr = tempStr & "'" & txtFields(X).Text & "',"
			Else
				tempStr = tempStr & "'" & txtFields(X).Text & "'"
			End If
		Next 
		tempStr = " Values (" & tempStr & ")"
		tempStr = "Insert into Detail (档案号,文件名,文件说明,参考说明,Name)" & tempStr
		DB = DAODBEngine_definst.OpenDatabase(ConData, False, False, ConStr)
		DB.Execute(tempStr)
		DB.Close()
		DAODBEngine_definst.CommitTrans()
		'Recommand set null value
		For X = 0 To 4
			txtFields(X).Text = ""
		Next 
		'指针调回编号
		txtFields(0).Focus()
		'**************** 结束 *****************
		txtFields(4).Text = strFileType
		ChangeTrue = False
		NoChange = True
		
	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)
		ChangeTrue = True
	End Sub
	
	Private Sub txtFields_DoubleClick(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles txtFields.DoubleClick
		Dim Index As Short = txtFields.GetIndex(eventSender)
		
		If Index = 1 Then
			Call picEditFile_Click(picEditFile, New System.EventArgs())
		End If
		
	End Sub
	
	Private Sub txtFields_Enter(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles txtFields.Enter
		Dim Index As Short = txtFields.GetIndex(eventSender)
		
		txtFields(Index).BackColor = System.Drawing.ColorTranslator.FromOle(&HFF0000)
		txtFields(Index).ForeColor = System.Drawing.ColorTranslator.FromOle(&HFFFFFF)
		txtFields(Index).SelectionStart = 0
		txtFields(Index).SelectionLength = Len(Trim(txtFields(Index).Text))
		
	End Sub
	
	Private Sub txtFields_KeyDown(ByVal eventSender As System.Object, ByVal eventArgs As System.Windows.Forms.KeyEventArgs) Handles txtFields.KeyDown
		Dim KeyCode As Short = eventArgs.KeyCode
		Dim Shift As Short = eventArgs.KeyData \ &H10000
		Dim Index As Short = txtFields.GetIndex(eventSender)
		
		If Index < 2 Then
			If KeyCode = 38 Then
				If Index > 0 Then
					txtFields(Index - 1).Focus()
				End If
			End If
			If KeyCode = 40 Then
				If Index < 4 Then
					txtFields(Index + 1).Focus()
				End If
			End If
		End If
		
	End Sub
	
	Private Sub txtFields_KeyPress(ByVal eventSender As System.Object, ByVal eventArgs As System.Windows.Forms.KeyPressEventArgs) Handles txtFields.KeyPress
		Dim KeyAscii As Short = Asc(eventArgs.KeyChar)
		Dim Index As Short = txtFields.GetIndex(eventSender)
		
		If KeyAscii = 13 And Index = 0 Then
			System.Windows.Forms.SendKeys.Send("{tab}")
			GoTo EventExitSub
		End If
		If KeyAscii = 13 And Index = 1 Then
			Call picEditFile_Click(picEditFile, New System.EventArgs())
		End If
		
EventExitSub: 
		If KeyAscii = 0 Then
			eventArgs.Handled = True
		End If
	End Sub
	
	Private Sub txtFields_Leave(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles txtFields.Leave
		Dim Index As Short = txtFields.GetIndex(eventSender)
		
		txtFields(Index).BackColor = System.Drawing.ColorTranslator.FromOle(&HFFFFFF)
		txtFields(Index).ForeColor = System.Drawing.ColorTranslator.FromOle(&H0s)
		If InStr(1, txtFields(Index).Text, "'", CompareMethod.Text) Then
			MsgBox("该项目之中有特殊字符" & "<'>,请删除。", MsgBoxStyle.OKOnly + 48, "提示：")
			txtFields(Index).Focus()
			Exit Sub
		End If
		'较对有无重复的编号
		Dim DB As DAO.Database
		Dim EF As DAO.Recordset
		Dim tempStr As String
		If Index = 0 Then
			DB = DAODBEngine_definst.OpenDatabase(ConData, False, False, ConStr)
			EF = DB.OpenRecordset("Detail", DAO.RecordsetTypeEnum.dbOpenDynaset)
			tempStr = "档案号='" & txtFields(0).Text & "'"
			EF.FindFirst(tempStr)
			If Not EF.NoMatch Then
				MsgBox("重复的档案号,请修改!", MsgBoxStyle.OKOnly + 48, "警告!")
				DB.Close()
				txtFields(0).Text = ""
				txtFields(0).Focus()
				Exit Sub
			Else
				DB.Close()
			End If
		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
End Class