www.pudn.com > 档案管理系统源码VB.zip > frmModifyForm.frm
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form frmModifyForm
BackColor = &H00C0C0C0&
BorderStyle = 3 'Fixed Dialog
ClientHeight = 3885
ClientLeft = 45
ClientTop = 330
ClientWidth = 7365
Icon = "frmModifyForm.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3885
ScaleWidth = 7365
ShowInTaskbar = 0 'False
StartUpPosition = 3 '窗口缺省
Begin VB.Frame Frame1
BackColor = &H00C0C0C0&
ForeColor = &H00C0E0FF&
Height = 3630
Left = 150
TabIndex = 7
Top = 105
Width = 7050
Begin VB.PictureBox picScan
AutoSize = -1 'True
BackColor = &H00C0C0C0&
BorderStyle = 0 'None
Height = 240
Left = 5445
Picture = "frmModifyForm.frx":0442
ScaleHeight = 240
ScaleWidth = 240
TabIndex = 16
ToolTipText = "扫描文件"
Top = 1140
Width = 240
End
Begin VB.PictureBox picEditFile
AutoSize = -1 'True
BackColor = &H00C0C0C0&
BorderStyle = 0 'None
Height = 240
Left = 5025
Picture = "frmModifyForm.frx":058C
ScaleHeight = 240
ScaleWidth = 240
TabIndex = 15
ToolTipText = "请选择文件"
Top = 1110
Width = 240
End
Begin VB.CommandButton ExitB
BackColor = &H000000C0&
Cancel = -1 'True
Caption = "关闭返回"
Height = 405
Left = 5385
TabIndex = 6
Top = 405
Width = 1365
End
Begin VB.CommandButton SaveAdd
BackColor = &H000000C0&
Caption = "保存记录"
Height = 405
Left = 3960
TabIndex = 5
Top = 405
Width = 1365
End
Begin VB.TextBox txtFields
BackColor = &H00FFFFFF&
DataField = "档案号"
DataSource = "Data1"
ForeColor = &H00000000&
Height = 285
Index = 0
Left = 1545
MaxLength = 50
TabIndex = 0
Top = 450
Width = 2160
End
Begin VB.TextBox txtFields
BackColor = &H00FFFFFF&
DataField = "文件名"
DataSource = "Data1"
ForeColor = &H00000000&
Height = 285
Index = 1
Left = 1545
MaxLength = 50
TabIndex = 1
Top = 1110
Width = 3375
End
Begin VB.TextBox txtFields
BackColor = &H00FFFFFF&
DataField = "文件说明"
DataSource = "Data1"
ForeColor = &H00000000&
Height = 675
Index = 2
Left = 1545
MaxLength = 100
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 2
Top = 1485
Width = 5205
End
Begin VB.TextBox txtFields
BackColor = &H00FFFFFF&
DataField = "参考说明"
DataSource = "Data1"
ForeColor = &H00000000&
Height = 675
Index = 3
Left = 1545
MaxLength = 50
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 3
Top = 2235
Width = 5220
End
Begin VB.PictureBox Picture1
BackColor = &H000000C0&
BorderStyle = 0 'None
Height = 225
Left = 5520
ScaleHeight = 225
ScaleWidth = 1215
TabIndex = 8
Top = 3015
Width = 1215
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "==>>禁止修改!"
ForeColor = &H00FFFFFF&
Height = 180
Left = 30
MousePointer = 99 'Custom
TabIndex = 9
Top = 15
Width = 1170
End
End
Begin MSComDlg.CommonDialog OpenDialog
Left = 120
Top = 2010
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.TextBox txtFields
BackColor = &H00FFFFFF&
DataField = "name"
DataSource = "Data1"
ForeColor = &H00000000&
Height = 285
Index = 4
Left = 1545
Locked = -1 'True
MaxLength = 25
TabIndex = 4
ToolTipText = "此项不能修改"
Top = 2985
Width = 5220
End
Begin VB.Line lLeft_1
BorderColor = &H00808080&
Visible = 0 'False
X1 = 5400
X2 = 5400
Y1 = 1080
Y2 = 1410
End
Begin VB.Line lTop_1
BorderColor = &H00FFFFFF&
Visible = 0 'False
X1 = 5400
X2 = 5715
Y1 = 1080
Y2 = 1080
End
Begin VB.Line lRight_1
BorderColor = &H00FFFFFF&
Visible = 0 'False
X1 = 5715
X2 = 5715
Y1 = 1080
Y2 = 1395
End
Begin VB.Line lBottom_1
BorderColor = &H00808080&
Visible = 0 'False
X1 = 5415
X2 = 5715
Y1 = 1395
Y2 = 1395
End
Begin VB.Line lBottom
BorderColor = &H00808080&
Visible = 0 'False
X1 = 4995
X2 = 5295
Y1 = 1395
Y2 = 1395
End
Begin VB.Line lRight
BorderColor = &H00FFFFFF&
Visible = 0 'False
X1 = 5295
X2 = 5295
Y1 = 1080
Y2 = 1395
End
Begin VB.Line lTop
BorderColor = &H00FFFFFF&
Visible = 0 'False
X1 = 4980
X2 = 5295
Y1 = 1080
Y2 = 1080
End
Begin VB.Line lLeft
BorderColor = &H00808080&
Visible = 0 'False
X1 = 4980
X2 = 4980
Y1 = 1080
Y2 = 1410
End
Begin VB.Label lblLabels
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "档案名称:"
ForeColor = &H000000C0&
Height = 180
Index = 0
Left = 435
TabIndex = 14
Top = 510
Width = 810
End
Begin VB.Label lblLabels
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "文件名称:"
ForeColor = &H00000000&
Height = 180
Index = 1
Left = 435
TabIndex = 13
Top = 1155
Width = 810
End
Begin VB.Label lblLabels
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "档案说明:"
ForeColor = &H00000000&
Height = 180
Index = 2
Left = 435
TabIndex = 12
Top = 1530
Width = 810
End
Begin VB.Label lblLabels
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "档案类型:"
ForeColor = &H00000000&
Height = 180
Index = 7
Left = 450
TabIndex = 11
Top = 3030
Width = 810
End
Begin VB.Label lblLabels
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "参考说明:"
ForeColor = &H00000000&
Height = 180
Index = 3
Left = 435
TabIndex = 10
Top = 2280
Width = 810
End
End
Begin VB.Line Line2
BorderColor = &H00E0E0E0&
Index = 2
X1 = 30
X2 = 30
Y1 = 30
Y2 = 3870
End
Begin VB.Line Line3
BorderColor = &H00E0E0E0&
Index = 1
X1 = 7350
X2 = 7350
Y1 = 15
Y2 = 3840
End
Begin VB.Line Line2
BorderColor = &H00808080&
Index = 1
X1 = 7335
X2 = 7335
Y1 = 15
Y2 = 3870
End
Begin VB.Line Line1
BorderColor = &H00808080&
Index = 3
X1 = 45
X2 = 7350
Y1 = 3855
Y2 = 3855
End
Begin VB.Line Line1
BorderColor = &H00E0E0E0&
Index = 2
X1 = 30
X2 = 7335
Y1 = 3870
Y2 = 3870
End
Begin VB.Line Line1
BorderColor = &H00E0E0E0&
Index = 1
X1 = 30
X2 = 7320
Y1 = 30
Y2 = 30
End
Begin VB.Line Line1
BorderColor = &H00808080&
Index = 0
X1 = 15
X2 = 7350
Y1 = 15
Y2 = 15
End
Begin VB.Line Line2
BorderColor = &H00808080&
Index = 0
X1 = 15
X2 = 15
Y1 = 15
Y2 = 3870
End
End
Attribute VB_Name = "frmModifyForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim ChangeTrue 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, "Modify", "Left"))
Me.Top = Val(GetSetting(App.EXEName, "Modify", "Top"))
txtFields(4).Text = strFileType
ChangeTrue = False
Me.Caption = "正在 [ " & strFileType & " ] 区，修改 [ " & strFileID & " ] 档案"
'代入数据
txtFields(0).Text = strFileID
txtFields(1).Text = frmManager.txtFields(1).Text
txtFields(2).Text = frmManager.txtFields(2).Text
txtFields(3).Text = frmManager.txtFields(3).Text
ChangeTrue = False: lShow = False: lShowS = False
End Sub
Private Sub Form_Unload(Cancel As Integer)
SaveSetting App.EXEName, "Modify", "Left", Me.Left
SaveSetting App.EXEName, "Modify", "Top", Me.Top
If ChangeTrue = True Then
Dim OK As Integer
OK = MsgBox("有修改记录，需要保存码？(Y/N)", vbYesNo + 32, "未保存")
If OK = 7 Then
Unload Me
Exit Sub
Else
'保存记录代码
Call SaveAdd_Click
If IT = True Then
Call frmManager.cmdLoad_Click
End If
Exit Sub
End If
Else
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
'**************** 开始 *****************
Dim DB As Database, EF As Recordset, X As Integer, tempStr As String
'删除原有的
DBEngine.BeginTrans
Set DB = OpenDatabase(ConData, False, False, ConStr)
tempStr = "Delete * From Detail Where Name='" & strFileType & "' And 档案号='" & strFileID & "'"
DB.Execute tempStr
tempStr = ""
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.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 = GuestTypeName
ChangeTrue = False
'卸载
Unload Me
'刷新
Call frmManager.cmdLoad_Click
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}"
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 Trim(txtFields(0).Text = strFileID) Then Exit Sub '为原来档案名时
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