frminputp.frm

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

      MaxRecords      =   5
      BOFAction       =   0
      EOFAction       =   0
      ConnectStringType=   3
      Appearance      =   1
      BackColor       =   -2147483643
      ForeColor       =   -2147483640
      Orientation     =   0
      Enabled         =   -1
      Connect         =   "DSN=PmData"
      OLEDBString     =   ""
      OLEDBFile       =   ""
      DataSourceName  =   "PmData"
      OtherAttributes =   ""
      UserName        =   "Admin"
      Password        =   ""
      RecordSource    =   "DataP"
      Caption         =   "照片档案"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      _Version        =   393216
   End
End
Attribute VB_Name = "frmInputP"
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 As ADODB.Recordset
Dim P_Text(5) As String

Private Function ConfineInput(para_KeyAscii As Integer, para_ConfineStr As String)
  Dim sConfineStr As String
  sConfineStr = UCase(para_ConfineStr) + Chr(13) + Chr(8) + Chr(27)
  If InStr(1, sConfineStr, UCase(Chr(para_KeyAscii)), vbTextCompare) = 0 Then
     ConfineInput = 0
  Else
     ConfineInput = para_KeyAscii
  End If
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 cmdAddD_Click()
With adoRst
  .Filter = "档号 Like '" & txtDhD.Text & "'"
  If .EOF Or .BOF Then
     MsgBox "不存在相应档号的总说明"
     Exit Sub
  End If
  .MoveFirst
  .Find "顺序号=" & Val(txtOrderD.Text)
  If .EOF Or .BOF Then
     MsgBox "不存在相应顺序号的总说明"
     Exit Sub
  End If
  Call SetEnableD(True)
  TextD(0).Text = txtDhD.Text
End With
End Sub

Private Sub cmdAddG_Click()
Dim Msg
With adoRst
  If .RecordCount <> 0 Then
     .Filter = "档号 Like '" & txtDhG.Text & "'"
     If Not .EOF And Not .BOF Then
        .MoveFirst
        .Find "顺序号=" & Val(txtOrderG.Text)
        If Not .EOF And Not .BOF Then
           Msg = MsgBox("此总说明已经存在，是否替换？", vbOKCancel)
           If Msg = vbCancel Then
              'txtDhG.SetFocus
              .Filter = adFilterNone
              Exit Sub
           End If
        Else
           .AddNew
        End If
     Else
        .AddNew
     End If
  Else
     .AddNew
  End If
  Call SetEnableG(True)
End With
End Sub

Private Sub SetEnableD(para_Value As Boolean)
frameD.Enabled = para_Value
cmdAddD.Enabled = Not para_Value
End Sub

Private Sub SetEnableG(para_Value As Boolean)
frameG.Enabled = para_Value
cmdAddG.Enabled = Not para_Value
End Sub

Private Sub TextEmptyG()
TextG(0).Text = ""
TextG(1).Text = ""
cmdSaveG.Enabled = False
cmdClearG.Enabled = False
End Sub

Private Sub TextEmptyD()
Dim i As Integer
For i = 0 To 4
  TextD(i).Text = ""
Next
cmdSaveD.Enabled = False
cmdClearD.Enabled = False
TextD(0).SetFocus
End Sub

Private Sub cmdClearD_Click()
Call TextEmptyD
End Sub

Private Sub cmdClearG_Click()
Call TextEmptyG
End Sub

Private Sub cmdCopyD_Click()
Dim i As Integer
For i = 0 To 4
  TextD(i).Text = P_Text(i)
Next
TextD(0).SetFocus
End Sub

Private Sub cmdSaveD_Click()
Dim i, f_p, l_p, len_dh, p_no As Integer
len_dh = Len(txtDhD.Text)
If Left(TextD(0).Text, len_dh) <> Left(txtDhD.Text, len_dh) Then
   MsgBox "照片号与档号不匹配"
   TextD(0).SetFocus
   Exit Sub
End If
f_p = InStr(TextD(0).Text, "(")
l_p = InStr(TextD(0).Text, ")")
If f_p = 0 Or l_p = 0 Or f_p > l_p Then
   MsgBox "照片号输入错误"
   TextD(0).SetFocus
   Exit Sub
End If
p_no = Val(Mid(TextD(0).Text, f_p + 1, l_p - f_p - 1))
If p_no = 0 Then
   MsgBox "照片号输入错误"
   TextD(0).SetFocus
   Exit Sub
End If
With adoRst
  .AddNew
  .Fields("档号") = ConvertNull(txtDhD.Text)
  .Fields("顺序号") = ConvertNull(Val(txtOrderD.Text))
  .Fields("照片号") = p_no
  .Fields("底片号") = ConvertNull(TextD(1).Text)
  .Fields("摄影者") = ConvertNull(TextD(2).Text)
  .Fields("拍摄时间") = ConvertNull(TextD(3).Text)
  .Fields("题名") = ConvertNull(TextD(4).Text)
  .Fields("FileType") = 0
  .Update
End With
For i = 0 To 4
  P_Text(i) = TextD(i).Text
Next
cmdCopyD.Enabled = True
Call TextEmptyD
End Sub

Private Sub cmdSaveG_Click()
With adoRst
  .Fields("档号") = ConvertNull(txtDhG.Text)
  .Fields("顺序号") = ConvertNull(Val(txtOrderG.Text))
  .Fields("题名") = ConvertNull(TextG(0).Text)
  .Fields("张数") = ConvertNull(Val(TextG(1).Text))
  .Fields("FileType") = -1
  .Update
End With
Call TextEmptyG
Call SetEnableG(False)
txtOrderG.Text = txtOrderG.Text + 1
txtDhG.SetFocus
End Sub

Private Sub Form_Load()
  Set adoCon = New ADODB.Connection
  adoCon.Open "PmData", "Admin"

  Set adoRst = New ADODB.Recordset
  Set adoRst.ActiveConnection = adoCon
  adoRst.CursorType = adOpenKeyset
  adoRst.LockType = adLockOptimistic
  
  adoRst.Open "Select * From DataP"
  
  sstPhoto.Tab = 0
End Sub

Private Sub TextD_Change(Index As Integer)
If TextD(0).Text = "" Then
   cmdSaveD.Enabled = False
   cmdClearD.Enabled = False
Else
   cmdSaveD.Enabled = True
   cmdClearD.Enabled = True
End If
End Sub

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

Private Sub TextD_LostFocus(Index As Integer)
Dim i, dotNum, dotLoc(10), lenDate As Integer
Dim iDate As String
If Index <> 3 Or TextD(3).Text = "" Then Exit Sub
dotNum = 0
iDate = LTrim(Trim(TextD(3).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
                  TextD(3).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
                  TextD(3).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
                     TextD(3).SetFocus
                     Exit Sub
                  End If
               Else
                  TextD(3).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
               TextD(3).SetFocus
               Exit Sub
            End If
       Case Else
            TextD(3).SetFocus
            Exit Sub
End Select
If Right(iDate, 1) = "." Then
   TextD(3).Text = Left(iDate, lenDate - 1)
Else
   TextD(3).Text = iDate
End If
End Sub

Private Sub TextG_Change(Index As Integer)
If TextG(0).Text = "" Then
   cmdSaveG.Enabled = False
   cmdClearG.Enabled = False
Else
   cmdSaveG.Enabled = True
   cmdClearG.Enabled = True
End If
End Sub

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

Private Sub txtDhD_Change()
If txtDhD.Text = "" Then
   cmdAddD.Enabled = False
Else
   If txtOrderD.Text <> "" Then
      cmdAddD.Enabled = True
   End If
End If
End Sub

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

Private Sub txtDhG_Change()
If txtDhG.Text = "" Then
   cmdAddG.Enabled = False
Else
   If txtOrderG.Text <> "" Then
      cmdAddG.Enabled = True
   End If
End If
End Sub

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

Private Sub txtOrderD_Change()
If txtOrderD.Text = "" Then
   cmdAddD.Enabled = False
Else
   If txtDhD.Text <> "" Then
      cmdAddD.Enabled = True
   End If
End If
End Sub

Private Sub txtOrderD_KeyPress(KeyAscii As Integer)
KeyAscii = ConfineInput(KeyAscii, "1234567890")
If KeyAscii = 13 Then
SendKeys "{tab}"
KeyAscii = 0
End If
End Sub

Private Sub txtOrderG_Change()
If txtOrderG.Text = "" Then
   cmdAddG.Enabled = False
Else
   If txtDhG.Text <> "" Then
      cmdAddG.Enabled = True
   End If
End If
End Sub

Private Sub txtOrderG_KeyPress(KeyAscii As Integer)
KeyAscii = ConfineInput(KeyAscii, "1234567890")
If KeyAscii = 13 Then
SendKeys "{tab}"
KeyAscii = 0
End If
End Sub