www.pudn.com > 档案管理系统源码VB.zip > frmNewForm.frm
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form frmNewForm
BackColor = &H00C0C0C0&
BorderStyle = 1 'Fixed Single
Caption = "添加新档案"
ClientHeight = 3885
ClientLeft = 1095
ClientTop = 330
ClientWidth = 7650
Icon = "frmNewForm.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3885
ScaleWidth = 7650
Begin VB.Frame Frame1
BackColor = &H00C0C0C0&
ForeColor = &H00C0E0FF&
Height = 3630
Left = 165
TabIndex = 7
Top = 75
Width = 7305
Begin VB.PictureBox picScan
AutoSize = -1 'True
BackColor = &H00C0C0C0&
BorderStyle = 0 'None
Height = 240
Left = 5565
Picture = "frmNewForm.frx":27A2
ScaleHeight = 240
ScaleWidth = 240
TabIndex = 16
ToolTipText = "扫描文件"
Top = 1155
Width = 240
End
Begin VB.CommandButton SaveAdd
BackColor = &H000000C0&
Caption = "保存记录"
Height = 405
Left = 4320
TabIndex = 5
Top = 405
Width = 1230
End
Begin VB.CommandButton ExitB
BackColor = &H000000C0&
Cancel = -1 'True
Caption = "关闭返回"
Height = 405
Left = 5580
TabIndex = 6
Top = 405
Width = 1230
End
Begin VB.PictureBox Picture1
BackColor = &H00404040&
BorderStyle = 0 'None
Height = 225
Left = 5535
ScaleHeight = 225
ScaleWidth = 1215
TabIndex = 14
Top = 3030
Width = 1215
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "==>>禁止修改!"
ForeColor = &H0000FF00&
Height = 180
Left = 30
MousePointer = 99 'Custom
TabIndex = 15
Top = 30
Width = 1170
End
End
Begin MSComDlg.CommonDialog OpenDialog
Left = -45
Top = 1770
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.TextBox txtFields
BackColor = &H00FFFFFF&
DataField = "参考说明"
DataSource = "Data1"
ForeColor = &H00000000&
Height = 675
Index = 3
Left = 1650
MaxLength = 50
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 3
Top = 2250
Width = 5115
End
Begin VB.TextBox txtFields
BackColor = &H00FFFFFF&
DataField = "name"
DataSource = "Data1"
ForeColor = &H00000000&
Height = 285
Index = 4
Left = 1665
Locked = -1 'True
MaxLength = 25
TabIndex = 4
ToolTipText = "此项不能修改"
Top = 3000
Width = 5115
End
Begin VB.TextBox txtFields
BackColor = &H00FFFFFF&
DataField = "文件说明"
DataSource = "Data1"
ForeColor = &H00000000&
Height = 675
Index = 2
Left = 1650
MaxLength = 100
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 2
Top = 1500
Width = 5100
End
Begin VB.TextBox txtFields
BackColor = &H00FFFFFF&
DataField = "文件名"
DataSource = "Data1"
ForeColor = &H00000000&
Height = 285
Index = 1
Left = 1650
MaxLength = 50
TabIndex = 1
Top = 1125
Width = 3375
End
Begin VB.TextBox txtFields
BackColor = &H00FFFFFF&
DataField = "档案号"
DataSource = "Data1"
ForeColor = &H00000000&
Height = 285
Index = 0
Left = 1650
MaxLength = 50
TabIndex = 0
Top = 465
Width = 2160
End
Begin VB.PictureBox picEditFile
AutoSize = -1 'True
BackColor = &H00C0C0C0&
BorderStyle = 0 'None
Height = 240
Left = 5145
Picture = "frmNewForm.frx":28EC
ScaleHeight = 240
ScaleWidth = 240
TabIndex = 13
ToolTipText = "请选择文件"
Top = 1125
Width = 240
End
Begin VB.Line lBottom_1
BorderColor = &H00808080&
Visible = 0 'False
X1 = 5535
X2 = 5835
Y1 = 1410
Y2 = 1410
End
Begin VB.Line lRight_1
BorderColor = &H00FFFFFF&
Visible = 0 'False
X1 = 5835
X2 = 5835
Y1 = 1095
Y2 = 1410
End
Begin VB.Line lTop_1
BorderColor = &H00FFFFFF&
Visible = 0 'False
X1 = 5520
X2 = 5835
Y1 = 1095
Y2 = 1095
End
Begin VB.Line lLeft_1
BorderColor = &H00808080&
Visible = 0 'False
X1 = 5520
X2 = 5520
Y1 = 1095
Y2 = 1425
End
Begin VB.Line lLeft
BorderColor = &H00808080&
Visible = 0 'False
X1 = 5100
X2 = 5100
Y1 = 1095
Y2 = 1425
End
Begin VB.Line lTop
BorderColor = &H00FFFFFF&
Visible = 0 'False
X1 = 5100
X2 = 5415
Y1 = 1095
Y2 = 1095
End
Begin VB.Line lRight
BorderColor = &H00FFFFFF&
Visible = 0 'False
X1 = 5415
X2 = 5415
Y1 = 1095
Y2 = 1410
End
Begin VB.Line lBottom
BorderColor = &H00808080&
Visible = 0 'False
X1 = 5115
X2 = 5415
Y1 = 1410
Y2 = 1410
End
Begin VB.Label lblLabels
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "参考说明:"
ForeColor = &H00000000&
Height = 180
Index = 3
Left = 540
TabIndex = 12
Top = 2295
Width = 810
End
Begin VB.Label lblLabels
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "档案类型:"
ForeColor = &H00000000&
Height = 180
Index = 7
Left = 555
TabIndex = 11
Top = 3045
Width = 810
End
Begin VB.Label lblLabels
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "档案说明:"
ForeColor = &H00000000&
Height = 180
Index = 2
Left = 540
TabIndex = 10
Top = 1545
Width = 810
End
Begin VB.Label lblLabels
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "文件名称:"
ForeColor = &H00000000&
Height = 180
Index = 1
Left = 540
TabIndex = 9
Top = 1170
Width = 810
End
Begin VB.Label lblLabels
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "档案名称:"
ForeColor = &H000000C0&
Height = 180
Index = 0
Left = 540
TabIndex = 8
Top = 525
Width = 810
End
End
Begin VB.Line Line2
BorderColor = &H00808080&
Index = 0
X1 = 30
X2 = 30
Y1 = 0
Y2 = 3855
End
Begin VB.Line Line1
BorderColor = &H00808080&
Index = 0
X1 = 30
X2 = 7620
Y1 = 0
Y2 = 0
End
Begin VB.Line Line1
BorderColor = &H00E0E0E0&
Index = 1
X1 = 60
X2 = 7620
Y1 = 15
Y2 = 15
End
Begin VB.Line Line1
BorderColor = &H00E0E0E0&
Index = 2
X1 = 45
X2 = 7695
Y1 = 3855
Y2 = 3855
End
Begin VB.Line Line1
BorderColor = &H00808080&
Index = 3
X1 = 60
X2 = 7605
Y1 = 3840
Y2 = 3840
End
Begin VB.Line Line3
BorderColor = &H00E0E0E0&
Index = 0
X1 = 45
X2 = 45
Y1 = 15
Y2 = 3840
End
Begin VB.Line Line2
BorderColor = &H00808080&
Index = 1
X1 = 7605
X2 = 7605
Y1 = 0
Y2 = 3870
End
Begin VB.Line Line3
BorderColor = &H00E0E0E0&
Index = 1
X1 = 7620
X2 = 7620
Y1 = 0
Y2 = 3885
End
End
Attribute VB_Name = "frmNewForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim ChangeTrue As Boolean
Dim NoChange As Boolean, lShow As Boolean, lShowS As Boolean
Private Sub ExitB_Click()
Unload Me
End Sub
Private Sub Form_Load()
On Error Resume Next
Me.Left = Val(GetSetting(App.EXEName, "AddNew", "Left"))
Me.Top = Val(GetSetting(App.EXEName, "AddNew", "Top"))
txtFields(4).Text = strFileType
ChangeTrue = False
Me.Caption = "正在 [ " & strFileType & " ] 区，添加新文件"
NoChange = False: lShow = False: lShowS = False
End Sub
Private Sub Form_Unload(Cancel As Integer)
SaveSetting App.EXEName, "AddNew", "Left", Me.Left
SaveSetting App.EXEName, "AddNew", "Top", Me.Top
If ChangeTrue = True Then
Dim OK As Integer
OK = MsgBox("有添加记录，需要保存码？(Y/N)", vbYesNo + 32, "未保存")
If OK = 7 Then
If IT = True And NoChange = True Then
Call frmManager.cmdLoad_Click
End If
Unload Me
Exit Sub
Else
'保存记录代码
Call SaveAdd_Click
If IT = True And NoChange = True Then
Call frmManager.cmdLoad_Click
End If
Exit Sub
End If
Else
If IT = True And NoChange = True Then
Call frmManager.cmdLoad_Click
End If
Unload Me
End If
End Sub
Private Sub Frame1_MouseMove(Button As Integer, Shift As Integer, X As Single, 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()
MsgBox "此项不能修改，请注意！", vbOKOnly + 64, "提示:"
End Sub
Private Sub picEditFile_Click()
On Error Resume Next
OpenDialog.CancelError = True
OpenDialog.Flags = cdlOFNFileMustExist + cdlOFNHideReadOnly
OpenDialog.Filter = "所有文件(*.*)|*.*|"
OpenDialog.DialogTitle = "请选择文件"
OpenDialog.FileName = GetSetting(App.EXEName, "Config", "Add")
OpenDialog.ShowOpen
If Err.Number = 32755 Then
If Trim(txtFields(1).Text) <> "" Then
txtFields(2).SetFocus
Else
txtFields(1).SetFocus
End If
Exit Sub
End If
txtFields(1).Text = OpenDialog.FileName
'保存最后一次打开的文件
SaveSetting App.EXEName, "Config", "Add", OpenDialog.FileName
txtFields(2).SetFocus
End Sub
Private Sub picEditFile_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
lTop.BorderColor = &H808080
lBottom.BorderColor = &HFFFFFF
End Sub
Private Sub picEditFile_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 picEditFile_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
lTop.BorderColor = &HFFFFFF
lBottom.BorderColor = &H808080
End Sub
Private Sub picScan_Click()
ScanFileName = ""
Me.MousePointer = 11
frmScan.Show 1
Me.MousePointer = 0
If ScanFileName = "" Then
If Trim(txtFields(1).Text) = "" Then
txtFields(1).SetFocus
Else
txtFields(2).SetFocus
End If
Exit Sub
Else
txtFields(1).Text = ScanFileName
txtFields(2).SetFocus
End If
End Sub
Private Sub picScan_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
lTop_1.BorderColor = &H808080
lBottom_1.BorderColor = &HFFFFFF
End Sub
Private Sub picScan_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
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(Button As Integer, Shift As Integer, X As Single, Y As Single)
lTop_1.BorderColor = &HFFFFFF
lBottom_1.BorderColor = &H808080
End Sub
Private Sub SaveAdd_Click()
If Trim(txtFields(0).Text) = "" Then
MsgBox "档案名不能空，且不能重复,不能保存!", vbOKOnly + 64, "档案名有错误"
txtFields(0).SetFocus
Exit Sub
End If
'Save Data
'**************** 开始 *****************
DBEngine.BeginTrans
Dim DB As Database, EF As Recordset, X As Integer, 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
Set DB = OpenDatabase(ConData, False, False, ConStr)
DB.Execute tempStr
DB.Close
DBEngine.CommitTrans
'Recommand set null value
For X = 0 To 4
txtFields(X).Text = ""
Next
'指针调回编号
txtFields(0).SetFocus
'**************** 结束 *****************
txtFields(4).Text = strFileType
ChangeTrue = False
NoChange = True
End Sub
Private Sub txtFields_Change(Index As Integer)
ChangeTrue = True
End Sub
Private Sub txtFields_DblClick(Index As Integer)
If Index = 1 Then
Call picEditFile_Click
End If
End Sub
Private Sub txtFields_GotFocus(Index As Integer)
txtFields(Index).BackColor = &HFF0000
txtFields(Index).ForeColor = &HFFFFFF
txtFields(Index).SelStart = 0
txtFields(Index).SelLength = Len(Trim(txtFields(Index).Text))
End Sub
Private Sub txtFields_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
If Index < 2 Then
If KeyCode = 38 Then
If Index > 0 Then
txtFields(Index - 1).SetFocus
End If
End If
If KeyCode = 40 Then
If Index < 4 Then
txtFields(Index + 1).SetFocus
End If
End If
End If
End Sub
Private Sub txtFields_KeyPress(Index As Integer, KeyAscii As Integer)
If KeyAscii = 13 And Index = 0 Then
SendKeys "{tab}"
Exit Sub
End If
If KeyAscii = 13 And Index = 1 Then
Call picEditFile_Click
End If
End Sub
Private Sub txtFields_LostFocus(Index As Integer)
txtFields(Index).BackColor = &HFFFFFF
txtFields(Index).ForeColor = &H0
If InStr(1, txtFields(Index).Text, "'", vbTextCompare) Then
MsgBox "该项目之中有特殊字符" + "<'>,请删除。", vbOKOnly + 48, "提示："
txtFields(Index).SetFocus
Exit Sub
End If
'较对有无重复的编号
If Index = 0 Then
Dim DB As Database, EF As Recordset, tempStr As String
Set DB = OpenDatabase(ConData, False, False, ConStr)
Set EF = DB.OpenRecordset("Detail", dbOpenDynaset)
tempStr = "档案号='" & txtFields(0).Text & "'"
EF.FindFirst tempStr
If Not EF.NoMatch Then
MsgBox "重复的档案号,请修改!", vbOKOnly + 48, "警告!"
DB.Close
txtFields(0).Text = ""
txtFields(0).SetFocus
Exit Sub
Else
DB.Close
End If
End If
End Sub
Private Sub txtFields_MouseMove(Index As Integer, 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