frmjf3.frm

学生关系信息系统。并且有论文啊。供各位兄弟姐妹参考

      Height          =   255
      Left            =   2400
      TabIndex        =   2
      Top             =   105
      Width           =   615
   End
   Begin VB.Label Label7 
      Caption         =   "姓名："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   2400
      TabIndex        =   1
      Top             =   480
      Width           =   615
   End
End
Attribute VB_Name = "Frmjf3"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim i As Integer
Public Sub xxjfshowtitle()
MSF1.Clear
  Dim i As Integer
  With MSF1
    .Cols = 6
   
    .TextMatrix(0, 1) = "学期"
    .TextMatrix(0, 2) = "本次交费(元)"
    .TextMatrix(0, 3) = "本次欠费(元)"
    .TextMatrix(0, 4) = "日期"
    .TextMatrix(0, 5) = "操作员"
  
    .ColWidth(0) = 200
    .ColWidth(1) = 2200
    .ColWidth(2) = 1500
    .ColWidth(3) = 1500
    .ColWidth(4) = 1500
    .ColWidth(5) = 1200
 
    .FixedRows = 1
    For i = 1 To 5
      .ColAlignment(i) = 6
    Next i
  
    .FillStyle = flexFillSingle
    .Col = 0
    .Row = 0
    .RowSel = 1
    .ColSel = .Cols - 1
    .CellAlignment = 4
    .Row = 1
    End With
End Sub
Public Sub xxxuefeidata()
Dim mrc As ADODB.Recordset
Dim mrc1 As ADODB.Recordset
txtsql = "select jf.学号,xj.姓名,xj.班级,jf.学期,jf.交费,jf.欠费,jf.日期,jf.操作员 from jf inner join xj on jf.学号=xj.学号 where jf.学号='" & Trim(frmjf2.MSF1.TextMatrix(frmjf2.MSF1.Row, 1)) & "' order by jf.日期"
Set mrc = ExecuteSQL(txtsql)
txtsql = "select 学号,sum(交费),sum(欠费) from jf where 学号='" & Trim(frmjf2.MSF1.TextMatrix(frmjf2.MSF1.Row, 1)) & "' group by 学号 order by 学号"
Set mrc1 = ExecuteSQL(txtsql)
Dim j As Integer
Dim i As Integer
If mrc.EOF = True Then
 MSF1.Clear
 Exit Sub
End If
mrc.MoveFirst
With MSF1
 .Rows = 3
    .Row = 1
 Do While Not mrc.EOF
   .Rows = .Rows + 1
   For i = 0 To 2
  Text1(i) = mrc.Fields(i)
Next i
    .TextMatrix(.Row, 1) = mrc.Fields(3)
   .TextMatrix(.Row, 2) = "￥" & Format(mrc.Fields(4), "0.00")
   If Val(mrc.Fields(5)) >= 0 Then
    .TextMatrix(.Row, 3) = "￥" & Format(mrc.Fields(5), "0.00")
   Else
      .TextMatrix(.Row, 3) = "-￥" & Format(-Val(mrc.Fields(5)), "0.00")
   End If
       .TextMatrix(.Row, 4) = mrc.Fields(6)
        .TextMatrix(.Row, 5) = mrc.Fields(7)
     
   .Row = .Row + 1
        mrc.MoveNext
 Loop
' .MergeCells = flexMergeFree
 
' .MergeRow(6) = True
  '.MergeCol(1) = True
'.MergeCol(2) = True
' .MergeCol(3) = True
' .MergeCol(4) = True
  .Row = .Row + 1
  .Col = 1
   MSF1.CellForeColor = vbRed
   .TextMatrix(.Row, 1) = "累计交费："
   .Col = 2
     MSF1.CellForeColor = vbRed
     .TextMatrix(.Row, 2) = "￥" & Format(mrc1.Fields(1), "0.00") & " 元"
     .Col = 4
      MSF1.CellForeColor = vbRed
      .TextMatrix(.Row, 4) = "累计欠费："
       .Col = 5
     MSF1.CellForeColor = vbRed
      .TextMatrix(.Row, 5) = "￥" & Format(mrc1.Fields(2), "0.00") & " 元"
      
 End With
   
End Sub

Private Sub Form_Activate()
xxjfshowtitle
xxxuefeidata
End Sub

Private Sub MSF1_Click()
Text2.Visible = False
MSF1.SetFocus
End Sub

Private Sub MSF1_DblClick()
With MSF1
Dim c As Integer
Dim r As Integer
r = .Row
c = .Col
If c = 1 Or r = .Rows - 1 Or r = .Rows - 2 Then
Dim ss As String
ss = MsgBox("该项不能修改！", vbExclamation + vbOKOnly, " 警告")
Exit Sub
End If
qxstr = Executeqx(3)
  If qxstr = "readonly" Then
  ss = MsgBox("对不起，你是只读用户不能修改记录，请与管理员联系！", vbInformation + vbOKOnly, " 警告")
  Exit Sub
   End If
Text2.Top = .Top + .RowPos(r) + 15
Text2.Left = .Left + .ColPos(c) + 25
Text2.Width = .ColWidth(c)
Text2.Height = .RowHeight(r) - 15
Text2.Text = .Text
    Text2.SelStart = 0
   Text2.SelLength = Len(Text2.Text)
Text2.Visible = True
Text2.SetFocus

End With
End Sub



Private Sub Text2_KeyPress(KeyAscii As Integer)
Dim shao As Integer
Dim zs As String
If KeyAscii <> 8 And KeyAscii <> 13 Then
shao = InStr(Trim(Text1(Index).Text), ".")
If shao <> 0 Then
zs = Right(Trim(Text1(Index).Text), Len(Trim(Text1(Index).Text)) - shao)
If Len(zs) > 1 Then KeyAscii = 0
End If
End If
Select Case MSF1.Col
        Case 2
         If KeyAscii = 13 Or KeyAscii = 46 Or KeyAscii > 47 And KeyAscii < 58 Or KeyAscii = 8 Then
           Else
           KeyAscii = 0
          Exit Sub
         End If
         Case 3
          If KeyAscii = 13 Or KeyAscii = 46 Or KeyAscii > 47 And KeyAscii < 58 Or KeyAscii = 8 Then
            Else
            KeyAscii = 0
              Exit Sub
            End If
         Case 4
           If KeyAscii = 13 Or KeyAscii > 47 And KeyAscii < 58 Or KeyAscii = 8 Or KeyAscii = 47 Or KeyAscii = 45 Then
                Else
              KeyAscii = 0
                Exit Sub
                End If
        End Select
If KeyAscii = 13 Then
Dim str As String
Dim mrc As ADODB.Recordset
Select Case MSF1.Col
        Case 2
        If InStr(Text2.Text, "￥") Then
        str = "update jf set 交费=" & Right(Trim(Text2.Text), Len(Trim(Text2.Text)) - 1) & " where 学号='" & Trim(Text1(0).Text) & "' and 学期='" & Trim(Me.MSF1.TextMatrix(MSF1.Row, 1)) & "'"
        Else
        str = "update jf set 交费=" & Text2.Text & " where 学号='" & Trim(Text1(0).Text) & "' and 学期='" & Trim(Me.MSF1.TextMatrix(MSF1.Row, 1)) & "'"
        End If
         Set mrc = ExecuteSQL(str)
         Case 3
         If InStr(Text2.Text, "￥") Then
         str = "update jf set 欠费=" & Right(Trim(Text2.Text), Len(Trim(Text2.Text)) - 1) & " where 学号='" & Trim(Text1(0).Text) & "' and 学期='" & Trim(Me.MSF1.TextMatrix(MSF1.Row, 1)) & "'"
         Else
         str = "update jf set 欠费=" & Text2.Text & " where 学号='" & Trim(Text1(0).Text) & "' and 学期='" & Trim(Me.MSF1.TextMatrix(MSF1.Row, 1)) & "'"
         End If
        Set mrc = ExecuteSQL(str)
        Case 4
           If Not IsDate(Text2.Text) Then '判断是否日期格式
     ss = MsgBox("应输入日期 mm-dd-yy", vbInformation + vbOKOnly, "警告")
      Text2.SetFocus
      Text2.SelStart = 0
      Text2.SelLength = Len(Text2.Text)
       Exit Sub
      End If
       str = "update jf set  日期=#" & Trim(Text2.Text) & "# where 学号='" & Trim(Text1(0).Text) & "' and 学期='" & Trim(Me.MSF1.TextMatrix(MSF1.Row, 1)) & "'"
        Set mrc = ExecuteSQL(str)
     Case 5
      str = "update jf set  操作员='" & Trim(Text2.Text) & "' where 学号='" & Trim(Text1(0).Text) & "' and 学期='" & Trim(Me.MSF1.TextMatrix(MSF1.Row, 1)) & "'"
      Set mrc = ExecuteSQL(str)
End Select
Text2.Visible = False
xxxuefeidata
End If

End Sub