frmreader.frm

来自「本人自己编写的!!!!!看看这样做的怎么样」· FRM 代码 · 共 552 行 · 第 1/2 页

            End If
         
            MsgBox "数据已保存！", vbOKOnly + vbExclamation, "提示"
            Combo1.Text = ""
            For icount = 1 To 2
              txtItem(icount).Text = ""
             Next icount
        End If
    Case 2                             '对于修改操作的处理
         If Not IsDate(Trim(txtItem(3))) Then
               MsgBox "请输入日期！", vbOKOnly + vbExclamation, "警告"
               Exit Sub
         Else
              txtItem(3) = Format(txtItem(3), "yyyy-mm-dd")
         End If
         jszh1 = Combo1.Text
         If Trim(jszh) <> Trim(jszh1) Then
             MsgBox "借书证号不能修改", vbOKOnly + vbExclamation, "警告"
             Exit Sub
        End If
        
          xm = txtItem(1).Text
          zym = txtItem(2).Text
          cssj = CDate(txtItem(3).Text)
          jss = CInt(Label1.Caption)
          If Option1(1) 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
             If ImageChang = 1 Then
               cnn.Execute "exec xs_update0 '" & jszh & "','" & xm & "','" & zym & "'," & xb & ",'" & cssj & "'," & jss
               ImageChang = 0
              End If
              cnn.Close
              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, 8, 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 = 1 To 3
                  txtItem(icount).Text = ""
              Next icount
              Label1.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.Visible = False
       End If
       If (flagadd = 2 Or flagadd = 3 Or flagadd = 4) Then
             strtext = Combo1.Text
             jszh = Combo1.Text
             txtsql = "select * from xs where 借书证号='" & strtext & "'"
             Set mrc = ExecuteSQL(txtsql, msgtext)
             If Not mrc.EOF Then
                   txtItem(1).Text = mrc.Fields(1)
                   txtItem(2).Text = mrc.Fields(2)
                   txtItem(3).Text = mrc.Fields(4)
                   Label1.Caption = CStr(mrc.Fields(5))
                   If mrc.Fields(3) Then
                       Option1(1).Value = True
                   Else
                       Option1(0).Value = True
                   End If
                   If Not IsNull(mrc.Fields(7)) And mrc.Fields(7) > 0 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
       Dim strtext As String
       Dim jszh1 As String
       Dim tempfile As String
        If KeyAscii = 13 And flagadd = 1 Then            '添加读者操作
           txtsql = "select * from xs where 借书证号='" & Trim(Combo1.Text) & "'"
           Set mrc = ExecuteSQL(txtsql, msgtext)
           If mrc.EOF = False Then
                  MsgBox "此读者的借书证号已存在！", vbOKOnly + vbExclamation, "警告"
                  Combo1.SetFocus
                  mrc.Close
              Else
                  txtItem(1).SetFocus
              End If
         End If
         If KeyAscii = 13 And (flagadd = 2 Or flagadd = 3 Or flagadd = 4) Then
             strtext = Combo1.Text
             jszh = Combo1.Text
             txtsql = "select * from xs where 借书证号='" & strtext & "'"
            Set mrc = ExecuteSQL(txtsql, msgtext)
             If Not mrc.EOF Then
                   txtItem(1).Text = mrc.Fields(1)
                   txtItem(2).Text = mrc.Fields(2)
                   txtItem(3).Text = mrc.Fields(4)
                   Label1.Caption = CStr(mrc.Fields(5))
                   If mrc.Fields(3) Then
                       Option1(1).Value = True
                   Else
                       Option1(0).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
         End Sub

Private Sub Command1_Click()
 If Check1.Value Then
       cdlg.Filter = "图片文件*.bmp;*.ico;*.jpg;*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 xs"
   Set mrc = ExecuteSQL(txtsql, msgtext)           '执行由变量txtsql中的查询语句
   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 'flagadd=2,3,4分别表示操作为修改，删除，查询
               ftag = 1                                      'ftag=0表示当前为第1条记录
                                                             '如下语句读取第1条记录的内容
               Combo1.Text = mrc.Fields(0)
               jszh = Combo1.Text
               txtItem(1).Text = mrc.Fields(1)
               txtItem(2).Text = mrc.Fields(2)
               txtItem(3).Text = mrc.Fields(4)
               Label1.Caption = CStr(mrc.Fields(5))
               If mrc.Fields(3) Then
                   Option1(1).Value = True               '表示女
               Else
                   Option1(0).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(0).Value = True
  Select Case flagadd
     Case 1
          Me.Caption = Me.Caption & "添加"
          cmd.Visible = True
          cmd.Enabled = True
          cmd.Caption = "保存(&S)"
          Label2(1).Visible = True
          Label1.Visible = True
     Case 2
          ImageChang = 0
          Me.Caption = Me.Caption & "修改"
          cmd.Visible = True
          cmd.Enabled = True
          cmd.Caption = "更新(&U)"
          Label2(1).Visible = True
          Label1.Visible = True
      Case 3
          Me.Caption = Me.Caption & "删除"
          cmd.Visible = True
          cmd.Enabled = True
          cmd.Caption = "删除(&D)"
          Label2(1).Visible = True
          Label1.Visible = True
      Case 4
         Me.Caption = Me.Caption & "查询"
          cmd.Visible = False
          cmd.Enabled = False
          Label2(1).Visible = True
          Label1.Visible = True
   End Select
End Sub


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