📄 form_photof.frm
字号:
BackStyle = 0 'Transparent
Caption = "备注"
Height = 180
Left = 570
TabIndex = 28
Top = 5265
Width = 360
End
Begin VB.Label Label7
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "密级"
Height = 180
Left = 4530
TabIndex = 27
Top = 1500
Width = 360
End
Begin VB.Label Label6
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "其它责任者"
Height = 180
Left = 4530
TabIndex = 26
Top = 2265
Width = 900
End
Begin VB.Label Label5
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "题名"
ForeColor = &H000000C0&
Height = 180
Left = 570
TabIndex = 25
Top = 1061
Width = 360
End
Begin VB.Label Label4
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "（第一）责任者"
ForeColor = &H000000C0&
Height = 180
Left = 120
TabIndex = 24
Top = 2265
Width = 1260
End
Begin VB.Label Label3
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "照片号"
ForeColor = &H00000000&
Height = 180
Left = 6240
TabIndex = 23
Top = 645
Width = 540
End
Begin VB.Label Label2
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "室编档号"
ForeColor = &H000000C0&
Height = 180
Left = 570
TabIndex = 22
Top = 660
Width = 720
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
BeginProperty Font
Name = "隶书"
Size = 18
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 360
Left = 1500
TabIndex = 21
Top = 180
Width = 180
End
End
Attribute VB_Name = "form_photoF"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim strfile As String
Dim strpage As String
Private Sub Combo1_KeyPress(KeyAscii As Integer)
KeyAscii = 0
End Sub
Private Sub Combo2_KeyPress(KeyAscii As Integer)
KeyAscii = 0
End Sub
Private Sub Command1_Click()
On Error GoTo e:
If Text6.text = "" Then
Text6.text = 0
End If
If Text7.text = "" Or Text7.text = " " Then
MsgBox "请输入责任者！", vbExclamation, ""
Exit Sub
End If
If fandss("T_ARCHIVE_0202_FILE", Text1.text, Text3.text) > 0 Then
If flag = "Insert" Then
MsgBox "在室编档号重复的情况下,照片号不可重复，请核查!", vbExclamation, ""
Exit Sub
ElseIf Not (strfile = Text1.text + Text3.text) Then
MsgBox "在室编档号重复的情况下,照片号不可重复，请核查!", vbExclamation, ""
Exit Sub
End If
End If
If flag = "Insert" Then
If Text1.text = "" Or Text1.text = " " Then
MsgBox "请输入室编档号！", vbExclamation, ""
Exit Sub
End If
If Text2.text = "" Or Text2.text = " " Then
MsgBox "请输入题名！", vbExclamation, ""
Exit Sub
End If
' If fond("T_ARCHIVE_0202_FILE", Text1.Text, Text3.Text) > 0 Then
' MsgBox "在室编档号重复的情况下,件号不可重复，请核查!", vbExclamation, ""
' Exit Sub
' End If
num = id("T_ARCHIVE_0202_FILE")
strSql = "insert into T_ARCHIVE_0202_FILE ("
strSql = strSql + "RECORD_SEQUENCE_NUMBER,REFERENCE_CODE_OF_FILE_OFFICE,TITLE_PROPER,STARTING_PHOTO_CODE,MEDIUM_type"
strSql = strSql + ",SECRET_LEVEL_FOR_DOCUMENTS,RETENTION_PERIOD"
strSql = strSql + ",DISCRIPTOR,DOCUMENT_CODE,PRIMARY_CREATOR,SUBORDINATE_CREATOR"
strSql = strSql + ",ELECTRONIC_RECORD_CODE,NEGATIVE_CODE,TAKE_PHOTO_PERSON,DATE_BEGUN"
strSql = strSql + ",LOCATION,NOTES_OF_ARCHIVIST,REMARK"
strSql = strSql + ",flag,CLASS_CODE,referenced_code,IS_SHARING"
strSql = strSql + ")values("
strSql = strSql + "" & num & ",'" & Text1.text & "' ,'" & Text2.text & "','" & Text3.text & "','" & Text4.text & "'"
strSql = strSql + ",'" & Combo1.text & "','" & Combo2.text & "','" & Text5.text & "','" & Text6.text & "'"
strSql = strSql + ",'" & Text7.text & "','" & Text8.text & "','" & Text9.text & "','" & Text10.text & "'"
strSql = strSql + ",'" & Text11.text & "','" & Format(DTPicker1.Value, "yyyy-mm-dd") & "','" & Text12.text & "','" & Text13.text & "','" & Text14.text & "'"
strSql = strSql + ",0,'" & form_AnJuan.List1.ListIndex & "','" & Text16.text & "','" & Check1.Value & "'"
strSql = strSql + ")"
ElseIf flag = "Modify" Then
If Text1.text = "" Or Text1.text = " " Then
MsgBox "请输入室编档号！", vbExclamation, ""
Exit Sub
End If
If Text2.text = "" Or Text2.text = " " Then
MsgBox "请输入题名！", vbExclamation, ""
Exit Sub
End If
strSql = "update T_ARCHIVE_0202_file set "
strSql = strSql + "REFERENCE_CODE_OF_FILE_OFFICE='" & Text1.text & "' ,TITLE_PROPER ='" & Text2.text & "' ,STARTING_PHOTO_CODE ='" & Text3.text & "' ,MEDIUM_type ='" & Text4.text & "' "
strSql = strSql + ",SECRET_LEVEL_FOR_DOCUMENTS ='" & Combo1.text & "' ,RETENTION_PERIOD ='" & Combo2.text & "' ,DISCRIPTOR ='" & Text5.text & "' ,DOCUMENT_CODE ='" & Text6.text & "' "
strSql = strSql + ",PRIMARY_CREATOR ='" & Text7.text & "' ,SUBORDINATE_CREATOR ='" & Text8.text & "' ,ELECTRONIC_RECORD_CODE ='" & Text9.text & "' ,NEGATIVE_CODE ='" & Text10.text & "' "
strSql = strSql + ",TAKE_PHOTO_PERSON ='" & Text11.text & "' ,DATE_BEGUN ='" & Format(DTPicker1.Value, "yyyy-mm-dd") & "',LOCATION ='" & Text12.text & "' ,NOTES_OF_ARCHIVIST ='" & Text13.text & "' ,REMARK ='" & Text14.text & "' "
strSql = strSql + ",referenced_code='" & Text16.text & "',IS_SHARING='" & Check1.Value & "'"
strSql = strSql + " where RECORD_SEQUENCE_NUMBER=" & num & ""
End If
'MsgBox strSql
rs.Open strSql, conn
MsgBox "保存成功！", vbInformation, ""
lblState.Caption = returnInputState(Label2, Text1, Label3, Text3)
If flag = "Insert" Then
Text3.text = numberPage3("t_archive_0202_file", Text1.text)
Dim itmX As ListItem
Set itmX = form_AnJuan.ListView2.ListItems.Add(, , form_AnJuan.ListView2.ListItems.Count + 1)
itmX.SubItems(1) = num
itmX.SubItems(2) = Text1.text
itmX.SubItems(3) = Text2.text
itmX.SubItems(4) = Text7.text
itmX.SubItems(5) = Format(DTPicker1.Value, "yyyy-mm-dd")
End If
If flag = "Insert" Then Text6.text = "0"
If flag = "Modify" Then
form_AnJuan.Refresh
End If
Exit Sub
e:
'MsgBox Err.Number & Err.Description, vbExclamation, ""
MsgBox "请输入正确数据格式", vbExclamation, ""
If rs.State = 1 Then
rs.Close
End If
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{tab}"
KeyAscii = 0
End If
End Sub
Private Sub Form_Load()
backColor = bgColor
Label1.Caption = form_AnJuan.Label4.Caption + "卷内文件信息"
Label1.backColor = bgColor
Combo1.AddItem "公开"
Combo1.AddItem "限制"
Combo1.AddItem "秘密"
Combo1.AddItem "机密"
Combo1.ListIndex = 1
Combo2.AddItem "永久"
Combo2.AddItem "长期"
Combo2.AddItem "短期"
Combo2.ListIndex = 0
Text1.text = ""
Text2.text = ""
Text3.text = 0
Text4.text = ""
Text5.text = ""
Text6.text = 0
Text7.text = ""
Text8.text = ""
Text9.text = ""
Text10.text = 0
Text11.text = ""
Text12.text = ""
Text13.text = ""
Text14.text = ""
Text15.text = ""
Text16.text = ""
Text16.MaxLength = 128
Text15.MaxLength = 5
DTPicker1.Value = Date
Text1.MaxLength = 24
Text2.MaxLength = 1000
Text3.MaxLength = 6
Text4.MaxLength = 20
Text5.MaxLength = 100
Text6.MaxLength = 9
Text7.MaxLength = 255
Text8.MaxLength = 255
Text9.MaxLength = 50
Text10.MaxLength = 6
Text11.MaxLength = 60
Text12.MaxLength = 100
Text13.MaxLength = 1000
Text14.MaxLength = 1000
If flag = "Modify" Then
rs.Open "select * from T_ARCHIVE_0202_FILE where RECORD_SEQUENCE_NUMBER=" & num & "", conn
If rs!REFERENCE_CODE_OF_FILE_OFFICE <> "" Then
Text1.text = rs!REFERENCE_CODE_OF_FILE_OFFICE
End If
If rs!TITLE_PROPER <> "" Then
Text2.text = rs!TITLE_PROPER
End If
If rs!STARTING_PHOTO_CODE <> "" Then
Text3.text = rs!STARTING_PHOTO_CODE
End If
If rs!MEDIUM_type <> "" Then
Text4.text = rs!MEDIUM_type
End If
If rs!SECRET_LEVEL_FOR_DOCUMENTS <> "" Then
Combo1.text = rs!SECRET_LEVEL_FOR_DOCUMENTS
End If
If rs!RETENTION_PERIOD <> "" Then
Combo2.text = rs!RETENTION_PERIOD
End If
If rs!DISCRIPTOR <> "" Then
Text5.text = rs!DISCRIPTOR
End If
' If rs!DOCUMENT_CODE <> "" Then
' Text6.Text = rs!DOCUMENT_CODE
' End If
Dim k As Integer
k = InStr(xml("DOCUMENT_CODE"), "-")
If k <> 0 Then
Text6.text = Mid(xml("DOCUMENT_CODE"), 1, k - 1)
Text15.text = Mid(xml("DOCUMENT_CODE"), k + 1)
Else
Text6.text = xml("DOCUMENT_CODE")
End If
'页号分段处理
If rs!PRIMARY_CREATOR <> "" Then
Text7.text = rs!PRIMARY_CREATOR
End If
If rs!SUBORDINATE_CREATOR <> "" Then
Text8.text = rs!SUBORDINATE_CREATOR
End If
If rs!ELECTRONIC_RECORD_CODE <> "" Then
Text9.text = rs!ELECTRONIC_RECORD_CODE
End If
If rs!NEGATIVE_CODE <> "" Then
Text10.text = rs!NEGATIVE_CODE
End If
If rs!TAKE_PHOTO_PERSON <> "" Then
Text11.text = rs!TAKE_PHOTO_PERSON
End If
If rs!DATE_BEGUN <> "" Then
DTPicker1.Value = rs!DATE_BEGUN
End If
If rs!Location <> "" Then
Text12.text = rs!Location
End If
If rs!NOTES_OF_ARCHIVIST <> "" Then
Text13.text = rs!NOTES_OF_ARCHIVIST
End If
If rs!REMARK <> "" Then
Text14.text = rs!REMARK
End If
Text16.text = xml("referenced_code")
If xml("IS_SHARING") <> "" Then
Check1.Value = xml("IS_SHARING")
End If
rs.Close
End If
strfile = Text1.text + Text3.text
End Sub
Private Sub Text1_Change()
If flag = "Insert" Then
Text3.text = numberPage3("t_archive_0202_file", Text1.text)
End If
End Sub
Private Sub Text6_KeyPress(KeyAscii As Integer)
If Not (KeyAscii > 47 And KeyAscii < 59) And KeyAscii <> 8 Then
KeyAscii = 0
MsgBox "请输入数字!", 48, ""
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -