frmmodifyw.frm

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

  Text0.Text = ConvertNull(.Fields!分类号)
  Text1.Text = ConvertNull(.Fields!目录号)
  Text2.Text = ConvertNull(.Fields!全宗号)
  Text3.Text = ConvertNull(.Fields!缩微号)
  Text4.Text = ConvertNull(.Fields!顺序号)
  Text5.Text = ConvertNull(.Fields!档号)
  Text6.Text = ConvertNull(.Fields!文件编号)
  Text7.Text = ConvertNull(.Fields!形成日期)
  Text8.Text = ConvertNull(.Fields!备注)
  Text9.Text = ConvertNull(LTrim(.Fields!规格))
  Text10.Text = ConvertNull(.Fields!份数)
  Text11.Text = ConvertNull(.Fields!页号)
  Text12.Text = ConvertNull(.Fields!最后张次)
  Text13.Text = ConvertNull(.Fields!页数)
  Text14.Text = ConvertNull(.Fields!题名)
  Text15.Text = ConvertNull(.Fields!摘要)
  Combo1.Text = ConvertNull(.Fields!保管期限)
  Combo2.Text = ConvertNull(.Fields!文本类别)
  Combo3.Text = ConvertNull(.Fields!密级)
  Combo4.Text = ConvertNull(.Fields!存档情况)
End With

With adoZrRst
  Zr = adoRst.Fields!责任者1
  .MoveFirst
  .Find "ZrID=" & Zr
  If .EOF Or .BOF Then
     dcZR(0).Text = ""
  Else
     dcZR(0).Text = .Fields!Zr
  End If

  Zr = adoRst.Fields!责任者2
  .MoveFirst
  .Find "ZrID=" & Zr
  If .EOF Or .BOF Then
     dcZR(1).Text = ""
  Else
     dcZR(1).Text = .Fields!Zr
  End If

  Zr = adoRst.Fields!责任者3
  .MoveFirst
  .Find "ZrID=" & Zr
  If .EOF Or .BOF Then
     dcZR(2).Text = ""
  Else
     dcZR(2).Text = .Fields!Zr
  End If
End With

With adoZtcRst
  Ztc = adoRst.Fields!主题词1
  .MoveFirst
  .Find "ZtcID=" & Ztc
  If .EOF Or .BOF Then
     dcZTC(0).Text = ""
  Else
     dcZTC(0).Text = .Fields!Ztc
  End If

  Ztc = adoRst.Fields!主题词2
  .MoveFirst
  .Find "ZtcID=" & Ztc
  If .EOF Or .BOF Then
     dcZTC(1).Text = ""
  Else
     dcZTC(1).Text = .Fields!Ztc
  End If

  Ztc = adoRst.Fields!主题词3
  .MoveFirst
  .Find "ZtcID=" & Ztc
  If .EOF Or .BOF Then
     dcZTC(2).Text = ""
  Else
     dcZTC(2).Text = .Fields!Ztc
  End If

  Ztc = adoRst.Fields!主题词4
  .MoveFirst
  .Find "ZtcID=" & Ztc
  If .EOF Or .BOF Then
     dcZTC(3).Text = ""
  Else
     dcZTC(3).Text = .Fields!Ztc
  End If

  Ztc = adoRst.Fields!主题词5
  .MoveFirst
  .Find "ZtcID=" & Ztc
  If .EOF Or .BOF Then
     dcZTC(4).Text = ""
  Else
     dcZTC(4).Text = .Fields!Ztc
  End If
End With

For i = 0 To 2
  ZZID(i) = Val(dcZR(i).BoundText)
  ZZID(i + 3) = Val(dcZTC(i).BoundText)
Next
ZZID(6) = Val(dcZTC(3).BoundText)
ZZID(7) = Val(dcZTC(4).BoundText)
End Sub

Private Sub ListDH()    '档号列表
With adoRst
  Do Until .EOF
     ListDW.AddItem adoRst!档号
     .MoveNext
  Loop
  If ListDW.ListCount = 0 Then
  'If .RecordCount = 0 Then
     MsgBox "此档案不存在！"
  Else
     .MoveFirst
     ListDW.Text = ListDW.List(0)
     LastItem = ListDW.ListIndex
     ThisItem = ListDW.ListIndex
  End If
End With
End Sub

Private Sub ListDW_Click()
Dim SkipNum, i As Integer
ThisItem = ListDW.ListIndex
SkipNum = ThisItem - LastItem
If SkipNum <> 0 Then
   If SkipNum > 0 Then
      For i = 1 To SkipNum
        adoRst.MoveNext
      Next
   Else
      For i = 1 To -SkipNum
        adoRst.MovePrevious
      Next
   End If
End If
LastItem = ThisItem
Call SetEnable(False)
Call ListRecord
End Sub

Private Sub SetEnable(T_F As Boolean)
Dim Cntl As Control
For Each Cntl In frmModifyW
  If TypeOf Cntl Is TextBox Or TypeOf Cntl Is ComboBox Or TypeOf Cntl Is DataCombo Then
     Cntl.Locked = Not T_F
  End If
  If TypeOf Cntl Is UpDown Then
     Cntl.Enabled = T_F
  End If
Next
cmdModify.Enabled = Not T_F
cmdDelete.Enabled = Not T_F
cmdUpdate.Enabled = T_F
cmdRevert.Enabled = T_F
Text13.Locked = True
End Sub

Private Sub ListDW_DblClick()
Call cmdModify_Click
End Sub

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

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

Private Sub Text14_LostFocus()
Dim i, j, k As Integer
Dim ZT(10, 3), ZT1 As String
Dim Swap
i = 0
With adoZtcRst
  '.Open "Select * From Ztc Order By ZtcID"
  .MoveFirst
  Do While Not .EOF And i < 10
     ZT1 = LTrim(Trim(.Fields!Ztc))
     ZT(i, 2) = InStr(Text14.Text, ZT1)
     If ZT(i, 2) Then
        ZT(i, 0) = ZT1
        ZT(i, 1) = .Fields!ZtcID
        i = i + 1
     End If
     .MoveNext
  Loop
  i = i - 1
  For j = 0 To i - 1
    For k = j + 1 To i
      If ZT(j, 2) > ZT(k, 2) Then
         Swap = ZT(j, 0)
         ZT(j, 0) = ZT(k, 0)
         ZT(k, 0) = Swap
         Swap = ZT(j, 1)
         ZT(j, 1) = ZT(k, 1)
         ZT(k, 1) = Swap
         Swap = ZT(j, 2)
         ZT(j, 2) = ZT(k, 2)
         ZT(k, 2) = Swap
      End If
    Next k
  Next j
  For i = 0 To 4
    dcZTC(i).Text = ZT(i, 0)
    dcZTC(i).BoundText = ZT(i, 1)
  Next
  '.Close
End With
End Sub

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

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

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

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

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

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

Private Sub Text7_LostFocus()
Dim i, dotNum, dotLoc(10), lenDate As Integer
Dim iDate As String
If Text7.Text = "" Then Exit Sub
dotNum = 0
iDate = LTrim(Trim(Text7.Text))
lenDate = Len(iDate)
For i = 1 To lenDate
  If Mid(iDate, i, 1) = "." Then
     dotNum = dotNum + 1
     dotLoc(dotNum) = i
  End If
Next
Select Case dotNum
       Case Is = 0
            If lenDate = 2 Then
               iDate = "19" & iDate
            Else
               If lenDate <> 4 Then
                  Text7.SetFocus
                  Exit Sub
               End If
            End If
       Case Is = 1
            If dotLoc(1) = 3 And lenDate > 3 Then
               iDate = "19" & iDate
               lenDate = lenDate + 2
               If lenDate = 6 Then
                  iDate = Left(iDate, 5) & "0" & Right(iDate, 1)
                  lenDate = lenDate + 1
               End If
               If lenDate <> 7 Then
                  Text7.SetFocus
                  Exit Sub
               End If
            Else
               If dotLoc(1) = 5 Then
                  If lenDate = 6 Then
                     iDate = Left(iDate, 5) & "0" & Right(iDate, 1)
                     lenDate = lenDate + 1
                  End If
                  If lenDate <> 7 Then
                     Text7.SetFocus
                     Exit Sub
                  End If
               Else
                  Text7.SetFocus
                  Exit Sub
               End If
            End If
       Case Is = 2
            Select Case dotLoc(1)
                   Case 3
                        Select Case dotLoc(2)
                               Case 5
                                    Select Case lenDate
                                           Case 6
                                                iDate = "19" & Left(iDate, 3) & _
                                                     "0" & Mid(iDate, 4, 2) & _
                                                     "0" & Right(iDate, 1)
                                           Case 7
                                                iDate = "19" & Left(iDate, 3) & _
                                                     "0" & Right(iDate, 4)
                                    End Select
                               Case 6
                                    Select Case lenDate
                                           Case 7
                                                iDate = "19" & Left(iDate, 6) & _
                                                     "0" & Right(iDate, 1)
                                           Case 8
                                                iDate = "19" & iDate
                                    End Select
                        End Select
                   Case 5
                        Select Case dotLoc(2)
                               Case 7
                                    Select Case lenDate
                                           Case 8
                                                iDate = Left(iDate, 5) & "0" & _
                                                      Mid(iDate, 6, 2) & "0" & _
                                                      Right(iDate, 1)
                                           Case 9
                                                iDate = Left(iDate, 5) & "0" & _
                                                      Right(iDate, 4)
                                    End Select
                               Case 8 And lenDate = 9
                                    iDate = Left(iDate, 8) & "0" & Right(iDate, 1)
                        End Select
            End Select
            lenDate = Len(iDate)
            If lenDate <> 10 Or Mid(iDate, 5, 1) <> "." Or Mid(iDate, 8, 1) <> "." Then
               Text7.SetFocus
               Exit Sub
            End If
       Case Else
            Text7.SetFocus
            Exit Sub
End Select
If Right(iDate, 1) = "." Then
   Text7.Text = Left(iDate, lenDate - 1)
Else
   Text7.Text = iDate
End If
End Sub

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

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

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

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

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

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

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

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