frminputa.frm

档案管理系统,使用vb6+access数据库开发

      Top             =   1500
      Width           =   864
   End
   Begin VB.Label LabelW 
      AutoSize        =   -1  'True
      Caption         =   "档案室代号"
      Height          =   216
      Index           =   4
      Left            =   4080
      TabIndex        =   10
      Top             =   780
      Width           =   1080
   End
   Begin VB.Label LabelW 
      AutoSize        =   -1  'True
      Caption         =   "档  号"
      Height          =   216
      Index           =   5
      Left            =   360
      TabIndex        =   8
      Top             =   780
      Width           =   648
   End
   Begin VB.Label LabelW 
      AutoSize        =   -1  'True
      Caption         =   "分类名"
      Height          =   216
      Index           =   6
      Left            =   6720
      TabIndex        =   12
      Top             =   780
      Width           =   648
   End
   Begin VB.Label LabelW 
      AutoSize        =   -1  'True
      Caption         =   "案卷年度"
      Height          =   216
      Index           =   3
      Left            =   7920
      TabIndex        =   6
      Top             =   300
      Width           =   864
   End
   Begin VB.Label LabelW 
      AutoSize        =   -1  'True
      Caption         =   "分类号"
      Height          =   216
      Index           =   0
      Left            =   360
      TabIndex        =   0
      Top             =   300
      Width           =   648
   End
   Begin VB.Label LabelW 
      AutoSize        =   -1  'True
      Caption         =   "目录号"
      Height          =   216
      Index           =   2
      Left            =   5400
      TabIndex        =   4
      Top             =   300
      Width           =   648
   End
   Begin VB.Label LabelW 
      AutoSize        =   -1  'True
      Caption         =   "全宗号"
      Height          =   216
      Index           =   1
      Left            =   3240
      TabIndex        =   2
      Top             =   300
      Width           =   648
   End
   Begin VB.Menu File 
      Caption         =   "文件(&F)"
      Begin VB.Menu F_Add 
         Caption         =   "添加档案(&A)"
         Shortcut        =   ^A
      End
      Begin VB.Menu F_Save 
         Caption         =   "保存数据(&V)"
         Shortcut        =   ^O
      End
      Begin VB.Menu F_Cut 
         Caption         =   "-"
      End
      Begin VB.Menu F_Exit 
         Caption         =   "退出(&X)"
         Shortcut        =   ^Q
      End
   End
   Begin VB.Menu Edit 
      Caption         =   "编辑(&E)"
      Begin VB.Menu E_Copy 
         Caption         =   "复制上份内容(&C)"
         Shortcut        =   ^C
      End
      Begin VB.Menu E_Clear 
         Caption         =   "清除当前内容(&L)"
         Shortcut        =   ^L
      End
   End
   Begin VB.Menu Data 
      Caption         =   "数据(&D)"
      Begin VB.Menu D_Seek 
         Caption         =   "查询相关档案(&S)"
         Shortcut        =   ^S
      End
      Begin VB.Menu D_Modify 
         Caption         =   "修改相关档案(&M)"
         Shortcut        =   ^N
      End
   End
End
Attribute VB_Name = "frmInputA"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim adoCon As ADODB.Connection
Dim adoRst, adoZrRst, adoZtcRst As ADODB.Recordset
Dim L_Text(23) As String
Dim ZZID(7) As Integer

Private Function AutoAdd(txtDh As String) As String     '档号自动加1的函数
Dim i, loc_dh, re_no, new_no, len_no, l1, l2 As Integer
Dim dh_no, new_dh, re_dh As String
Dim en_txt As Boolean
re_dh = StrReverse(txtDh)       '颠倒档号字串
en_txt = False
If Val(re_dh) = 0 Then
   l1 = InStr(txtDh, "(")
   l2 = InStr(txtDh, ")")
   If l1 < l2 And l1 <> 0 And l2 <> 0 Then
      dh_no = Mid(txtDh, l1 + 1, l2 - l1 - 1)
      If Val(dh_no) <> 0 Then en_txt = True
   End If
   If Not en_txt Then
      AutoAdd = txtDh           '不符合条件，返回原值
      Exit Function
   End If
Else
   re_no = Val(re_dh)
   For i = 0 To Len(re_dh)      '统计序号位数
     If Val(Left(re_dh, i)) = re_no Then Exit For
   Next
   dh_no = StrReverse(Left(re_dh, i))       '返回档号原有的顺序号(字符型)
End If
new_no = Val(dh_no) + 1                  '顺序号加1，返回新的顺序号(数值型)
len_no = Len(LTrim(Str(new_no)))         '统计新顺序号的位数
len_no = IIf(len_no < Len(dh_no), Len(dh_no), len_no)
new_dh = Right(Str(new_no + 10 ^ len_no), len_no)    '返回档号的顺序号(字符型)
loc_dh = InStrRev(txtDh, dh_no)          '返回要替换的顺序号的位置
AutoAdd = Left(txtDh, loc_dh - 1) & Replace(txtDh, dh_no, new_dh, loc_dh, 1)
End Function

Private Function ConvertNull(para_Value As Variant) As Variant
If IsNull(para_Value) = True Then
   ConvertNull = ""
Else
   ConvertNull = para_Value
End If
End Function

Private Sub cmdClear_Click()
Call TextEmpty
End Sub

Private Sub cmdAdd_Click()
Call SetEnable(True)
Text9.Text = "    16开"
Text14.Text = frmMain.FileType
adoRst.AddNew
Text0.SetFocus
End Sub

Private Sub cmdCopy_Click()
  Dim i As Integer
  Text0.Text = L_Text(0)
  Text1.Text = L_Text(1)
  Text2.Text = L_Text(2)
  Text3.Text = L_Text(3)
  Text4.Text = L_Text(4)
  Text5.Text = L_Text(5)
  Text6.Text = L_Text(6)
  dcZR(0).Text = L_Text(7)
  dcZR(1).Text = L_Text(8)
  Text7.Text = L_Text(9)
  Text8.Text = L_Text(10)
  Combo1.Text = L_Text(11)
  Combo2.Text = L_Text(12)
  Combo3.Text = L_Text(13)
  Text9.Text = L_Text(14)
  Text10.Text = L_Text(15)
  Text11.Text = L_Text(16)
  Text12.Text = L_Text(17)
  Text13.Text = L_Text(23)
  For i = 0 To 4
    dcZTC(i).Text = L_Text(i + 18)
  Next
End Sub

Private Sub TextEmpty()
  Dim i As Integer
  Text0.Text = ""
  Text1.Text = ""
  Text2.Text = ""
  Text3.Text = ""
  Text4.Text = ""
  Text5.Text = ""
  Text6.Text = ""
  dcZR(0).Text = ""
  dcZR(1).Text = ""
  Text7.Text = ""
  Text8.Text = ""
  Combo1.Text = ""
  Combo2.Text = ""
  Combo3.Text = ""
  Text9.Text = ""
  Text10.Text = ""
  Text11.Text = ""
  Text12.Text = ""
  Text13.Text = ""
  For i = 0 To 4
    dcZTC(i).Text = ""
  Next
End Sub

Private Sub SaveText()
  Dim i As Integer
  L_Text(0) = Text0.Text
  L_Text(1) = Text1.Text
  L_Text(2) = Text2.Text
  L_Text(3) = Text3.Text
  L_Text(4) = AutoAdd(Text4.Text)
  L_Text(5) = Text5.Text
  L_Text(6) = Text6.Text
  L_Text(7) = dcZR(0).Text
  L_Text(8) = dcZR(1).Text
  L_Text(9) = Text7.Text
  L_Text(10) = Text8.Text
  L_Text(11) = Combo1.Text
  L_Text(12) = Combo2.Text
  L_Text(13) = Combo3.Text
  L_Text(14) = Text9.Text
  L_Text(15) = Text10.Text
  L_Text(16) = Text11.Text
  L_Text(17) = Text12.Text
  L_Text(23) = Text13.Text
  For i = 0 To 4
    L_Text(i + 18) = dcZTC(i).Text
  Next
End Sub

Private Sub cmdModify_Click()
Load frmModifyA
frmModifyA.Show
End Sub

Private Sub cmdOK_Click()
  With adoRst
    .Fields("分类号") = ConvertNull(Text0.Text)
    .Fields("全宗号") = ConvertNull(Val(Text1.Text))
    .Fields("目录号") = ConvertNull(Text2.Text)
    .Fields("年度") = ConvertNull(Text3.Text)
    .Fields("档号") = ConvertNull(Text4.Text)
    .Fields("档案室代号") = ConvertNull(Val(Text5.Text))
    .Fields("分类名") = ConvertNull(Text6.Text)
    .Fields("开始日期") = ConvertNull(Text7.Text)
    .Fields("最后日期") = ConvertNull(Text8.Text)
    .Fields("规格") = ConvertNull(Text9.Text)
    .Fields("份数") = ConvertNull(Val(Text10.Text))
    .Fields("页数") = ConvertNull(Val(Text11.Text))
    .Fields("正题名") = ConvertNull(Text12.Text)
    .Fields("摘要") = ConvertNull(Text13.Text)
    .Fields("FileType") = ConvertNull(Text14.Text)
    .Fields("保管期限") = ConvertNull(Combo1.Text)
    .Fields("密级") = ConvertNull(Combo2.Text)
    .Fields("存档情况") = ConvertNull(Combo3.Text)
    .Fields("全宗名称") = ConvertNull(IIf(dcZR(0).Text = "", -1, ZZID(0)))
    .Fields("归档单位") = ConvertNull(IIf(dcZR(1).Text = "", -1, ZZID(1)))
    .Fields("主题词1") = ConvertNull(IIf(dcZTC(0).Text = "", -1, ZZID(2)))
    .Fields("主题词2") = ConvertNull(IIf(dcZTC(1).Text = "", -1, ZZID(3)))
    .Fields("主题词3") = ConvertNull(IIf(dcZTC(2).Text = "", -1, ZZID(4)))
    .Fields("主题词4") = ConvertNull(IIf(dcZTC(3).Text = "", -1, ZZID(5)))
    .Fields("主题词5") = ConvertNull(IIf(dcZTC(4).Text = "", -1, ZZID(6)))
    
Do While False
    .Fields("全宗名称") = ConvertNull(IIf(dcZR(0).Text = "", -1, dcZR(0).BoundText))
    .Fields("归档单位") = ConvertNull(IIf(dcZR(1).Text = "", -1, dcZR(1).BoundText))
    .Fields("主题词1") = ConvertNull(IIf(dcZTC(0).Text = "", -1, dcZTC(0).BoundText))
    .Fields("主题词2") = ConvertNull(IIf(dcZTC(1).Text = "", -1, dcZTC(1).BoundText))
    .Fields("主题词3") = ConvertNull(IIf(dcZTC(2).Text = "", -1, dcZTC(2).BoundText))
    .Fields("主题词4") = ConvertNull(IIf(dcZTC(3).Text = "", -1, dcZTC(3).BoundText))
    .Fields("主题词5") = ConvertNull(IIf(dcZTC(4).Text = "", -1, dcZTC(4).BoundText))
Loop

    .Update
  End With
  Call SaveText
  Call TextEmpty
  Call SetEnable(False)
  cmdAdd.SetFocus
End Sub

Private Sub CmdReturn_Click()
adoRst.CancelUpdate
adoRst.Close
frmInputA.Hide
Unload frmInputA
End Sub

Private Sub SetEnable(para_Value As Boolean)
Dim Cntl As Control
For Each Cntl In frmInputA
  If TypeOf Cntl Is TextBox Then
     Cntl.Enabled = para_Value
  End If
  If TypeOf Cntl Is ComboBox Then
     Cntl.Enabled = para_Value
  End If
  If TypeOf Cntl Is DataCombo Then
     Cntl.Enabled = para_Value
  End If
  If TypeOf Cntl Is UpDown Then
     Cntl.Enabled = para_Value
  End If
Next
cmdAdd.Enabled = Not para_Value
cmdCopy.Enabled = para_Value
cmdClear.Enabled = para_Value
cmdOK.Enabled = para_Value
F_Add.Enabled = Not para_Value
F_Save.Enabled = para_Value
E_Copy.Enabled = para_Value
E_Clear.Enabled = para_Value

udFDate.Enabled = False
udLDate.Enabled = False
End Sub

Private Sub cmdSeek_Click()
Load frmSeekA
frmSeekA.Show
End Sub

Private Sub Combo1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{tab}"
KeyAscii = 0
End If
End Sub

Private Sub Combo2_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{tab}"
KeyAscii = 0
End If
End Sub

Private Sub Combo3_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{tab}"
KeyAscii = 0
End If
End Sub

Private Sub D_Modify_Click()
cmdModify_Click
End Sub

Private Sub D_Seek_Click()
cmdSeek_Click
End Sub

Private Sub dcZR_KeyPress(Index As Integer, KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{tab}"
KeyAscii = 0
End If
End Sub

Private Sub dcZR_LostFocus(Index As Integer)
Dim NewZr As Boolean
Dim NewID As Integer
If LTrim(Trim(dcZR(Index).Text)) = "" Then Exit Sub
NewZr = True
NewID = 0
With adoZrRst
  .Open "Select * From Zr Order By ZrID"
  .MoveFirst
  Do Until .EOF
     If Trim(.Fields("ZrID")) = NewID Then NewID = NewID + 1
     If Trim(.Fields("Zr")) = Trim(dcZR(Index).Text) Then
        NewZr = False
        ZZID(Index) = Val(dcZR(Index).BoundText)
        Exit Do
     End If
     .MoveNext
  Loop
  .MoveFirst
  If NewZr Then
     .AddNew
     .Fields("ZrID") = NewID
     .Fields("Zr") = dcZR(Index).Text
     .Update
     ZZID(Index) = NewID
  End If
  .Close
End With
End Sub

Private Sub dcZTC_KeyPress(Index As Integer, KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{tab}"
KeyAscii = 0
End If
End Sub

Private Sub dcZTC_LostFocus(Index As Integer)
Dim NewZtc As Boolean
Dim NewID As Integer
If LTrim(Trim(dcZTC(Index).Text)) = "" Then Exit Sub
NewZtc = True