frmreader1.frm

有读者和图书信息的添加查询,借还书等,先建立数据库和ODBC数据源

         mrcc.Close
     Else
         Set cnn = New ADODB.Connection
   cnn.Open ConnectString
   cnn.Execute "exec xs_insert '" & jszh & "','" & xm & "','" & zym & "'," & xb & ",'" & cssj & "'"
   cnn.Close
  
   If Check1.Value = 1 Then
      jszh1 = jszh
      Call SavetoDB(filename, jszh1)
   End If
    MsgBox "数据已保存！", vbOKOnly + vbExclamation, "提示"
     Combo1.Text = ""
       For iCount = 0 To 2
        Text1(iCount).Text = ""
       Next iCount
End If
 Case 2
        If Not IsDate(Trim(Text1(2))) Then
        MsgBox "请输入日期！", vbOKOnly + vbExclamation, "警告"
     Exit Sub
   Else
        Text1(2) = Format(Text1(2), "yyyy-mm-dd")
  End If
    jszh1 = Combo1.Text
  If Trim(jszh) <> Trim(jszh1) Then
  MsgBox "借书证号不能修改", vbOKOnly + vbExclamation, "警告"
     Exit Sub
  End If
     xm = Text1(0).Text
     zym = Text1(1).Text
   cssj = CDate(Text1(2).Text)
   jss = CInt(Label6.Caption)
    If Option2 Then
       xb = 1
    End If
         Set cnn = New ADODB.Connection
   cnn.Open ConnectString
   If imagechang = 0 And Check1 = 1 Then
      cnn.Execute "exec xs_update '" & jszh & "','" & xm & "','" & zym & "'," & xb & ",'" & cssj & "'," & jss
   Else
      cnn.Execute "exec xs_update0 '" & jszh & "','" & xm & "','" & zym & "'," & xb & ",'" & cssj & "'," & jss
      jszh1 = jszh
    If imagechang = 1 Then
      Call SavetoDB(filename, jszh1)
      imagechang = 0
    End If
   End If
   cnn.Close
   If Check1.Value = 1 Then
      jszh1 = jszh
      Call SavetoDB(filename, jszh1)
   End If
        MsgBox "数据已更新！", vbOKOnly + vbExclamation, "提示"
       
   Case 3
       jszh1 = Combo1.Text
       Set cnn = New ADODB.Connection
       cnn.Open ConnectString
       Set cmddele.ActiveConnection = cnn
   cmddele.CommandText = "xs_delete"
   cmddele.CommandType = adCmdStoredProc
   cmddele.Parameters.Append cmddele.CreateParameter("jszh", adChar, adParamInput, 16, jszh1)
   
   cmddele.Parameters.Append cmddele.CreateParameter("flag", adInteger, adParamOutput)
   cmddele.Execute
       
   If cmddele("flag") = 0 Then
      MsgBox "记录已被删除！", vbOKOnly + vbExclamation, "提示"
      For iCount = 0 To Combo1.ListCount - 1
       If Combo1.List(iCount) = Combo1.Text And Combo1.Text <> "" Then
         Combo1.RemoveItem iCount
         Combo1.Text = ""
       End If
      Next iCount
       For iCount = 0 To 2
           Text1(iCount).Text = ""
       Next iCount
       Label6.Caption = ""
    Else
        MsgBox "记录不能删除，还有书未还！", vbOKOnly + vbExclamation, "提示"
    End If
    cnn.Close
    
End Select
            
End Sub

Private Sub cmdExit_Click()
            Unload Me
End Sub

Private Sub Combo1_Click()
            Dim strText, msgtext As String
            Dim jszh1 As String
            Dim tempfile As String
            If flagadd = 3 Or flagadd = 4 Then
               Command1.Value = False
            End If
            If (flagadd = 2 Or flagadd = 3 Or flagadd = 4) Then
               strText = Combo1.Text
               jszh = Combo1.Text
               txtSQL = "select* from zzyxs where 借书证号='" & strText & "'"
               Set mrc = ExecuteSQL(txtSQL, msgtext)
               If Not mrc.EOF Then
                    Text1(0).Text = mrc.Fields(1)
                    Text1(1).Text = mrc.Fields(2)
                    Text1(2).Text = mrc.Fields(4)
                    Label6.Caption = CStr(mrc.Fields(5))
                    If mrc.Fields(3) Then
                       Option2.Value = True
                    Else
                       Option1.Value = True
                    End If
                    If Not IsNull(mrc.Fields(7)) Then
                      jszh1 = Combo1.Text
                      tempfile = "\temp.dat"
                      Call getfromDB(tempfile, jszh1)
                      Image1.Picture = LoadPicture(tempfile)
                      Kill (tempfile)
                      Check1.Value = 1
                    Else
                      Image1.Picture = Nothing
                      Check1.Value = 0
                    End If
                 End If
                 mrc.Close
             End If
             Combo1.SetFocus
End Sub

Private Sub Combo1_KeyPress(KeyAscii As Integer)
            Dim msgtext As String
            If KeyAscii = 13 And flagadd = 1 Then
               txtSQL = "select* from zzyxs where 借书证号='" & Trim(Combo1.Text) & "'"
               Set mrc = ExecuteSQL(txtSQL, msgtext)
               If mrc.EOF = False Then
                   MsgBox "此读者的借书证号已存在！", vbOKOnly + vbExclamation, "警告"
                   Combo1.SetFocus
                   mrc.Close
               Else
                   Text1(0).SetFocus
               End If
             End If
               
End Sub

Private Sub Command1_Click()
        If Check1.Value Then
           cdlg.Filter = "图片文件|*.bmp;*.ico;*.jpg;*.jpeg;*.gif"
           cdlg.ShowOpen
           filename = cdlg.filename
           Image1.Picture = LoadPicture(filename)
           If flagadd = 2 Then
              imagechang = 1
           End If
        End If
End Sub

Private Sub Form_Activate()
            Dim msgtext As String
            Dim ftag As Integer
            Dim jszh1 As String
            Dim tempfile As String
            Command1.Visible = True
            If flagadd = 3 Or flagadd = 4 Then
               Command1.Visible = False
            End If
            txtSQL = "select* from zzyxs"
            Set mrc = ExecuteSQL(txtSQL, msgtext)
            ftag = 0
            If Not mrc.EOF Then
               Do While Not mrc.EOF
                  Combo1.AddItem Trim(mrc.Fields(0))
                  If (flagadd = 2 Or flagadd = 3 Or flagadd = 4) And ftag = 0 Then
                      ftag = 1
                      Combo1.Text = mrc.Fields(0)
                      jszh = Combo1.Text
                      Text1(0).Text = mrc.Fields(1)
                      Text1(1).Text = mrc.Fields(2)
                      Text1(2).Text = mrc.Fields(4)
                      Label6.Caption = CStr(mrc.Fields(5))
                      If mrc.Fields(3) Then
                          Option2.Value = True
                      Else
                          Option1.Value = True
                      End If
                   If Not IsNull(mrc.Fields(7)) Then
                      jszh1 = Combo1.Text
                      tempfile = "\temp.dat"
                      Call getfromDB(tempfile, jszh1)
                      Image1.Picture = LoadPicture(tempfile)
                      Check1.Value = 1
                    Else
                      Image1.Picture = Nothing
                      Check1.Value = 0
                    End If
                   End If
                   mrc.MoveNext
                  Loop
                End If
                mrc.Close
                Combo1.SetFocus
End Sub

Private Sub Form_Load()
        Option1.Value = True
        Select Case flagadd
               Case 1
                     Me.Caption = Me.Caption & "添加"
                     cmd.Visible = True
                     cmd.Enabled = True
                     cmd.Caption = "保存(&S)"
                     Label2.Visible = True
                     Label6.Visible = False
               Case 2
                     imagechang = 0
                     Me.Caption = Me.Caption & "修改"
                     cmd.Visible = True
                     cmd.Enabled = True
                     cmd.Caption = "更新(&U)"
                     Label2.Visible = True
                     Label6.Visible = True
               Case 3
                     Me.Caption = Me.Caption & "删除"
                     cmd.Visible = True
                     cmd.Enabled = True
                     cmd.Caption = "删除(&D)"
                     Label2.Visible = True
                     Label6.Visible = True
               Case 4
                     Me.Caption = Me.Caption & "查询"
                     cmd.Visible = False
                     cmd.Enabled = False
                     Label2.Visible = True
                   Label6.Visible = True
               End Select
End Sub



Private Sub Text1_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
            Select Case Index
            Case 0
                  If KeyCode = 13 Then
                     Text1(1).SetFocus
                  End If
            Case 1
                  If KeyCode = 13 Then
                     Text1(2).SetFocus
                  End If
            End Select
End Sub