frmpaymanage.frm

该软件非常适合学校小型数据管理

            Height          =   495
            Left            =   5520
            TabIndex        =   5
            Top             =   600
            Width           =   495
         End
      End
      Begin VB.TextBox Text3 
         Height          =   270
         Left            =   360
         TabIndex        =   39
         Text            =   "Text3"
         Top             =   1440
         Width           =   375
      End
   End
   Begin VB.CommandButton CmdOK 
      Caption         =   "确认(&O)"
      Default         =   -1  'True
      Height          =   375
      Left            =   2640
      TabIndex        =   1
      Top             =   4680
      Width           =   1215
   End
   Begin VB.CommandButton CmdRetrun 
      Caption         =   "返回(&C)"
      Height          =   375
      Left            =   5280
      TabIndex        =   0
      Top             =   4680
      Width           =   1215
   End
   Begin WinXPC_Engine.WindowsXPC WinXPPayManage 
      Left            =   1440
      Top             =   360
      _ExtentX        =   6588
      _ExtentY        =   1085
      ColorScheme     =   2
      Common_Dialog   =   0   'False
   End
   Begin VB.Label Label6 
      BackStyle       =   0  'Transparent
      Caption         =   "6"
      BeginProperty Font 
         Name            =   "Times New Roman"
         Size            =   14.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   1560
      TabIndex        =   29
      Top             =   4680
      Width           =   1215
   End
   Begin VB.Label Label5 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "成绩排名:"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   240
      Left            =   120
      TabIndex        =   28
      Top             =   4680
      Width           =   1080
   End
End
Attribute VB_Name = "FrmPayManage"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False



Private Sub CmbCode_Change()
If RstPayRecord.State = adStateOpen Then
RstPayRecord.Close              '//关闭记录集
End If
RstPayRecord.Open "select *from 会员档案 where 会员编号='" & CmbCode.Text & "' ", DBCON, adOpenKeyset, adLockOptimistic, adCmdText

   TxtName.Text = RstPayRecord.Fields(1).Value   '//给文本框赋值
   On Error Resume Next
    Label6.Caption = RstPayRecord.Fields(5).Value
   Label2.Caption = RstPayRecord.Fields(9).Value
   Call Change
End Sub

Function Danan() As Single

CmbCode.Text = RsModPay.Fields(0).Value
TxtName.Text = RsModPay.Fields(1).Value

Label2.Caption = RsModPay.Fields(9).Value
Label6.Caption = RsModPay.Fields(5).Value
'TxtAnnuities.Text = RsModPay.Fields(0).Value
'TxtBrach.Text = RsModPay.Fields(2).Value
'TxtPay.Text = RsModPay.Fields(3).Value
'TxtTimeOver.Text = RsModPay.Fields(4).Value
'TxtAllowance.Text = RsModPay.Fields(5).Value
'TxtRent.Text = RsModPay.Fields(6).Value
'TxtBonus.Text = RsModPay.Fields(7).Value
'TxtOther.Text = RsModPay.Fields(8).Value

'TxtSafety.Text = RsModPay.Fields(10).Value
'TxtVPay.Text = RsModPay.Fields(11).Value
'DTPicker1.Value = RsModPay.Fields(12).Value

End Function
Function Fenshu() As Single
'TxtBrach.Text = RsModPay.Fields(2).Value
'TxtPay.Text = RsModPay.Fields(3).Value
'TxtTimeOver.Text = RsModPay.Fields(4).Value
'TxtAllowance.Text = RsModPay.Fields(5).Value
'TxtRent.Text = RsModPay.Fields(6).Value
'TxtBonus.Text = RsModPay.Fields(7).Value
'TxtOther.Text = RsModPay.Fields(8).Value
'TxtSafety.Text = RsModPay.Fields(10).Value
'TxtVPay.Text = RsModPay.Fields(11).Value
'DTPicker1.Value = RsModPay.Fields(12).Value
End Function

Private Sub CmbCode_Click(Area As Integer)
Option2(0).Value = True
End Sub

'End Sub

Private Sub cmdOK_Click()

'If RsAddPay.State = adStateClosed Then
'   RsAddPay.Open "成绩表", DBCON, adOpenKeyset, adLockOptimistic, adCmdTable
'End If
'On Error GoTo ERRAdd            '//错误捕捉
'RsAddPay.AddNew
'Call AddPay
Call AddMark
If RSTxtNames.State = adStateOpen Then
 RSTxtNames.Close              '//关闭记录集
End If
 RSTxtNames.Open "select *from 会员档案 where 会员姓名='" & TxtName.Text & "' ", DBCON, adOpenKeyset, adLockOptimistic, adCmdText

If RsModPay.State = adStateClosed Then
   RsModPay.Open "会员档案", DBCON, adOpenKeyset, adLockOptimistic, adCmdTable
End If

Call Command1_Click



'Label2.Caption = Empty
'Label6.Caption = Empty
'CmbCode.Text = Empty
'TxtName.Text = Empty
'TxtBrach.Text = Empty
'TxtPay(0).Text = Empty
'TxtPay(1).Text = Empty
'TxtPay(2).Text = Empty
'TxtPay(3).Text = Empty
'TxtPay(4).Text = Empty
'TxtPay(5).Text = Empty
TxtAnnuities.Text = "1"
'TxtSafety.Text = Empty
TxtVPay.Text = "0"
DTPicker1.Value = Date
MsgBox "数据已被保存,请继续添加下一个会员资料", , "保存成功"
Exit Sub
ERRAdd:
    Select Case Err.Number
        Case -2147217887
            MsgBox "编号不能为空", vbInformation + vbOKOnly, "输入错误"
            On Error Resume Next
            RsRecord.CancelUpdate
        Case -2147352571
            MsgBox "没选择编号或带 * 内容没填,若没有请输入 0 ", vbInformation + vbOKOnly, "输入错误"
            RsAddPay.CancelUpdate
        Case Else
            MsgBox "错误描述：" & Err.Description & vbCrLf & "错误代码：" & Err.Number, vbCritical + vbOKOnly, "非法操作"
    End Select
End Sub
Private Sub AddPay()
RsAddPay.Fields(1).Value = CmbCode.Text
RsAddPay.Fields(2).Value = TxtName.Text
RsAddPay.Fields(5).Value = TxtBrach.Text
RsAddPay.Fields(3).Value = Label2.Caption + TxtVPay.Text
RsAddPay.Fields(4).Value = TxtVPay.Text
RsAddPay.Fields(5).Value = Label6.Caption
RsAddPay.Fields(6).Value = TxtPay(0).Text
RsAddPay.Fields(7).Value = TxtPay(1).Text
RsAddPay.Fields(8).Value = TxtPay(2).Text
RsAddPay.Fields(9).Value = TxtPay(3).Text
RsAddPay.Fields(10).Value = TxtPay(4).Text
RsAddPay.Fields(11).Value = TxtPay(5).Text
RsAddPay.Fields(12).Value = TxtAnnuities.Text
RsAddPay.Fields(13).Value = TxtSafety.Text
RsAddPay.Fields(14).Value = DTPicker1.Value

End Sub


Private Sub CmdRetrun_Click()
Unload Me
End Sub

Private Sub Command1_Click()
If RsModPay.State = adStateClosed Then
   RsModPay.Open "会员档案", DBCON, adOpenKeyset, adLockOptimistic, adCmdTable
End If

If RsModPay.RecordCount <> 0 Then
    RsModPay.MoveNext           '//记录向下移一条
    If RsModPay.EOF Then
    MsgBox "已经到达数据尾部."
        RsModPay.MoveFirst      '//将记录移到第一行
    End If
Call Danan
End If
End Sub

Private Sub Form_Load()

WinXPPayManage.InitSubClassing

Me.Left = Frmmdimain.Width / 5
Me.Top = Frmmdimain.Height / 20

If RSTxtNamet.State = adStateClosed Then
RSTxtNamet.Open "会员档案", DBCON, adOpenKeyset, adLockOptimistic, adCmdTable
End If
Set TxtName.RowSource = RSTxtNamet
TxtName.BoundColumn = "会员姓名"
TxtName.ListField = "会员姓名"
If RsPayRecord.State = adStateClosed Then
RsPayRecord.Open "会员档案", DBCON, adOpenKeyset, adLockOptimistic, adCmdTable
End If
Set CmbCode.RowSource = RsPayRecord
CmbCode.BoundColumn = "会员编号"
CmbCode.ListField = "会员编号"

If RSTxtBrach.State = adStateClosed Then
RSTxtBrach.Open "考试信息", DBCON, adOpenKeyset, adLockOptimistic, adCmdTable
End If
Set TxtBrach.RowSource = RSTxtBrach
TxtBrach.BoundColumn = "试题编号"
TxtBrach.ListField = "试题编号"
End Sub


Private Sub Change()
Dim a, b, c
For a = 0 To 5
If Option1.Item(a).Value = True Then
b = Val(TxtPay.Item(a).Text)
End If
Next
c = Val(TxtAnnuities.Text) * Val(TxtSafety.Text) * b
TxtVPay = c

End Sub
Private Sub Bisai()
Dim a, b, c
For a = 0 To 5
If Option1.Item(a).Value = True Then
Select Case a
Case 0
Label8.Caption = "常规比赛"
Case 1
Label8.Caption = "省级比赛"
Case 2
Label8.Caption = "亚洲级比赛"
Case 3
Label8.Caption = "校级比赛"
Case 4
Label8.Caption = "国家级比赛"
Case 5
Label8.Caption = "其他比赛"
End Select
End If
Next
End Sub


Private Sub AddMark()
If RSAddMark.State = adStateClosed Then
   RSAddMark.Open "成绩表", DBCON, adOpenKeyset, adLockOptimistic, adCmdTable
End If
'On Error Resume Next
RSAddMark.AddNew
RSAddMark.Fields(0).Value = TxtAnnuities.Text
RSAddMark.Fields(1).Value = CmbCode.Text
RSAddMark.Fields(2).Value = TxtName.Text
RSAddMark.Fields(4).Value = TxtBrach.Text
RSAddMark.Fields(3).Value = Label2.Caption + TxtVPay.Text
RSAddMark.Fields(5).Value = Label8.Caption
RSAddMark.Fields(6).Value = DTPicker1.Value
RSAddMark.Fields(9).Value = TxtSafety
'RSAddMark.Update


End Sub
Private Sub AddTell()
If RSAddTell.State = adStateClosed Then
   RSAddTell.Open "学生档案", DBCON, adOpenKeyset, adLockOptimistic, adCmdTable
End If
RSAddTell.AddNew
RSAddTell.Fields(0).Value = TxtVPay.Text
RSAddTell.Fields(1).Value = CmbCode.Text
RSAddTell.Fields(2).Value = TxtName.Text
RSAddTell.Fields(4).Value = TxtBrach.Text
RSAddTell.Fields(3).Value = Label2.Caption + TxtVPay.Text
RSAddTell.Fields(5).Value = Label8.Caption
RSAddTell.Fields(6).Value = DTPicker1.Value
RSAddTell.Update


End Sub

Private Sub Option1_Click(Index As Integer)
Call Bisai
Call Change
End Sub

Private Sub TxtAllowance_Change()
End Sub

Private Sub Option2_Click(Index As Integer)
'If Option2(0).Value Then
'TxtName.Visible = False
'CmbCode.Visible = True
'Else
'TxtName.Visible = True
'CmbCode.Visible = False
'End If
End Sub

Private Sub TxtAnnuities_Change()
Call Change
End Sub

Private Sub TxtBonus_Change()
End Sub

Private Sub TxtOther_Change()
End Sub

Private Sub TxtRent_Change()
Call Change
End Sub

Private Sub TxtAnnuities_Click()
Call Change
End Sub

Private Sub TxtBrach_Change()
Call Change

End Sub



Private Sub TxtName_Change()
If RSTxtNames.State = adStateOpen Then
 RSTxtNames.Close              '//关闭记录集
End If
 RSTxtNames.Open "select *from 会员档案 where 会员姓名='" & TxtName.Text & "' ", DBCON, adOpenKeyset, adLockOptimistic, adCmdText
 On Error Resume Next
    CmbCode.Text = RSTxtNames.Fields(0).Value      '//给文本框赋值
    Label6.Caption = RstPayRecord.Fields(5).Value
   Label2.Caption = RstPayRecord.Fields(9).Value
   Call Change
End Sub

Private Sub TxtName_Click(Area As Integer)
Option2(1).Value = True

End Sub




Private Sub TxtPay_Change(Index As Integer)
Call Bisai
Call Change
End Sub

Private Sub TxtPay_Click(Index As Integer)
Call Bisai
Call Change
End Sub

Private Sub TxtSafety_Change()
Call Change
End Sub

Private Sub TxtTimeOver_Change()
Call Change
End Sub

Private Sub TxtSafety_Click()
Call Change
End Sub