frmsell.frm

一个很全的书店的图书管理系统 做的很好希望和大家分享~！ 是用VB+ACCE

    MsgBox "检索数据库出错!", vbOKOnly + vbExclamation, "检索错误"
    GetDingJia = "未知"
End Function

Public Function HYShengJi(HYKaHao As String) As Boolean
On Error GoTo errEnd
Dim BiaoZhun As Integer
Dim SUMBook As Integer

If HYKaHao = "Guest" Then
    HYShengJi = False
    Exit Function
End If

BeginTrans

Adodc1.CommandType = adCmdText
Adodc1.RecordSource = "select sum([实收金额]) as [总金额] from [售书记录] where [会员卡号]=""" & HYKaHao & """"
Adodc1.Refresh
If Adodc1.Recordset.RecordCount > 0 Then
    Adodc1.Recordset.MoveFirst
    SUMBook = CInt(Adodc1.Recordset!总金额)
Else
    SUMBook = 0
End If

Adodc1.CommandType = adCmdText
Adodc1.RecordSource = "select [会员标准] from [会员政策] where [会员级别]='★☆☆☆☆'"
Adodc1.Refresh
Adodc1.Recordset.MoveFirst
BiaoZhun = CInt(Adodc1.Recordset!会员标准)

If SUMBook >= BiaoZhun Then
    Adodc1.CommandType = adCmdText
    Adodc1.RecordSource = "select * from [会员表] where [会员卡号]=""" & HYKaHao & """"
    Adodc1.Refresh
    If Adodc1.Recordset.RecordCount > 0 Then
        Adodc1.Recordset.MoveFirst
        Adodc1.Recordset!会员等级 = "★☆☆☆☆"
        Adodc1.Recordset.Update
    End If
End If

Adodc1.CommandType = adCmdText
Adodc1.RecordSource = "select [会员标准] from [会员政策] where [会员级别]='★★☆☆☆'"
Adodc1.Refresh
Adodc1.Recordset.MoveFirst
BiaoZhun = CInt(Adodc1.Recordset!会员标准)

If SUMBook >= BiaoZhun Then
    Adodc1.CommandType = adCmdText
    Adodc1.RecordSource = "select * from [会员表] where [会员卡号]=""" & HYKaHao & """"
    Adodc1.Refresh
    If Adodc1.Recordset.RecordCount > 0 Then
        Adodc1.Recordset.MoveFirst
        Adodc1.Recordset!会员等级 = "★★☆☆☆"
        Adodc1.Recordset.Update
    End If
End If

Adodc1.CommandType = adCmdText
Adodc1.RecordSource = "select [会员标准] from [会员政策] where [会员级别]='★★★☆☆'"
Adodc1.Refresh
Adodc1.Recordset.MoveFirst
BiaoZhun = CInt(Adodc1.Recordset!会员标准)

If SUMBook >= BiaoZhun Then
    Adodc1.CommandType = adCmdText
    Adodc1.RecordSource = "select * from [会员表] where [会员卡号]=""" & HYKaHao & """"
    Adodc1.Refresh
    If Adodc1.Recordset.RecordCount > 0 Then
        Adodc1.Recordset.MoveFirst
        Adodc1.Recordset!会员等级 = "★★★☆☆"
        Adodc1.Recordset.Update
    End If
End If

Adodc1.CommandType = adCmdText
Adodc1.RecordSource = "select [会员标准] from [会员政策] where [会员级别]='★★★★☆'"
Adodc1.Refresh
Adodc1.Recordset.MoveFirst
BiaoZhun = CInt(Adodc1.Recordset!会员标准)

If SUMBook >= BiaoZhun Then
    Adodc1.CommandType = adCmdText
    Adodc1.RecordSource = "select * from [会员表] where [会员卡号]=""" & HYKaHao & """"
    Adodc1.Refresh
    If Adodc1.Recordset.RecordCount > 0 Then
        Adodc1.Recordset.MoveFirst
        Adodc1.Recordset!会员等级 = "★★★★☆"
        Adodc1.Recordset.Update
    End If
End If

Adodc1.CommandType = adCmdText
Adodc1.RecordSource = "select [会员标准] from [会员政策] where [会员级别]='★★★★★'"
Adodc1.Refresh
Adodc1.Recordset.MoveFirst
BiaoZhun = CInt(Adodc1.Recordset!会员标准)

If SUMBook >= BiaoZhun Then
    Adodc1.CommandType = adCmdText
    Adodc1.RecordSource = "select * from [会员表] where [会员卡号]=""" & HYKaHao & """"
    Adodc1.Refresh
    If Adodc1.Recordset.RecordCount > 0 Then
        Adodc1.Recordset.MoveFirst
        Adodc1.Recordset!会员等级 = "★★★★★"
        Adodc1.Recordset.Update
    End If
End If

CommitTrans
HYShengJi = False

Exit Function
errEnd:
    Rollback
    HYShengJi = True
    Screen.MousePointer = vbDefault
    MsgBox "检查会员是否应升级时操作失败！", vbOKOnly + vbExclamation, "图书销售"
    CmdOK.Enabled = True
End Function

Private Sub CmdCancel_Click()
Unload Me
End Sub

Private Sub cmdOK_Click()
On Error GoTo errEnd
Dim QD As Integer

CmdOK.Enabled = False

If TxtShuLiang.Text = "" Then
    MsgBox "请输入交易的数量!", vbOKOnly + vbExclamation, "填写数量"
    TxtShuLiang.SetFocus
    CmdOK.Enabled = True
    Exit Sub
End If
If GetKuCun(TuShuBianHao) <= 0 Or GetKuCun(TuShuBianHao) < TxtShuLiang.Text Then
    MsgBox "该类图书库存量不足,请与仓库管理员联系!", vbOKOnly + vbExclamation, "库存不足"
    TxtShuLiang.SetFocus
    CmdOK.Enabled = True
    Exit Sub
End If
If TxtZheKou.Text = "" Then
    MsgBox "请输入交易的实际折扣率!", vbOKOnly + vbExclamation, "填写折扣"
    TxtZheKou.SetFocus
    CmdOK.Enabled = True
    Exit Sub
End If
If TxtZheKou.Text <= 0 Or TxtZheKou.Text > 1 Then
    MsgBox "实际折扣率填写错误!请在 0 与 1 之间选择.", vbOKOnly + vbExclamation, "填写折扣"
    TxtZheKou.SetFocus
    CmdOK.Enabled = True
    Exit Sub
End If
If TxtSJJinE.Text = "" Then
    MsgBox "请输入交易的实际金额!", vbOKOnly + vbExclamation, "填写金额"
    TxtSJJinE.SetFocus
    CmdOK.Enabled = True
    Exit Sub
End If
If TxtMemo.Text = "" Then TxtMemo.Text = "无"

QD = MsgBox("确定入帐吗?", vbOKCancel + vbQuestion, "确认入帐")
If QD = vbCancel Then
    'Unload Me
    CmdOK.Enabled = True
    Exit Sub
End If
'售书入帐
Screen.MousePointer = 11
BeginTrans

Adodc1.CommandType = adCmdTable
Adodc1.RecordSource = "售书记录"
Adodc1.Refresh

Adodc1.Recordset.AddNew
Adodc1.Recordset!图书编号 = TuShuBianHao
Adodc1.Recordset!数量 = TxtShuLiang.Text
Adodc1.Recordset!会员卡号 = HuiYuanKaHao
Adodc1.Recordset!实际打折 = TxtZheKou.Text
Adodc1.Recordset!实收金额 = TxtSJJinE.Text
Adodc1.Recordset!日期 = Year(Now) & "-" & Month(Now) & "-" & Day(Now) & "."
Adodc1.Recordset!备注 = TxtMemo.Text
Adodc1.Recordset.Update

Adodc1.CommandType = adCmdText
Adodc1.RecordSource = "select * from [Book] where [图书编号]=""" & TuShuBianHao & """"
Adodc1.Refresh

If Adodc1.Recordset.RecordCount > 0 Then
    Adodc1.Recordset.MoveFirst
    Adodc1.Recordset!库存量 = Adodc1.Recordset!库存量 - TxtShuLiang.Text
    Adodc1.Recordset.Update
Else
    Rollback
    Screen.MousePointer = vbDefault
    MsgBox "图书资料丢失，请与仓库管理员联系！", vbOKOnly + vbExclamation, "交易失败"
    CmdOK.Enabled = True
    Exit Sub
End If

If HYShengJi(HuiYuanKaHao) Then Rollback

CommitTrans

Screen.MousePointer = vbDefault
MsgBox "恭喜您,交易成功!", vbOKOnly + vbInformation, "交易成功"
Unload Me

Exit Sub

errEnd:
    Rollback
    Screen.MousePointer = vbDefault
    MsgBox Err.Description, vbOKOnly + vbExclamation, "操作数据库出错 交易失败"
    CmdOK.Enabled = True
End Sub

Private Sub Form_Activate()
TxtShuMing.Text = ShuMing
TxtHYXingMing = HYXingMing
TxtHYDengJi.Text = HYDengJi
TxtDingJia.Text = DingJia
TxtYouHui.Text = GetHYDaZhe(HYDengJi)

End Sub

Private Sub Form_Load()
Dim dbName As String
Dim connSTR As String

On Error GoTo errEnd

dbName = App.Path
If Right(dbName, 1) <> "\" Then dbName = dbName + "\"
dbName = dbName + "DataBase\WFSSDataBase.mdb"

connSTR = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbName & ";Persist Security Info=False"
Adodc1.ConnectionString = connSTR

Exit Sub

errEnd:
    MsgBox Err.Description, vbOKOnly + vbExclamation, "打开数据库出错"
End Sub

Private Sub TxtShuLiang_KeyUp(KeyCode As Integer, Shift As Integer)
If Not (KeyCode >= 48 And KeyCode <= 57) Then
    If Not (KeyCode >= 96 And KeyCode <= 105) Then
        If KeyCode <> 13 And KeyCode <> 8 And KeyCode <> 46 Then
            MsgBox "图书数量填写错误!", vbOKOnly + vbExclamation, "填写错误"
            TxtShuLiang.Text = ""
            TxtShuLiang.SetFocus
        End If
    End If
End If
End Sub

Private Sub TxtShuLiang_LostFocus()
If TxtShuLiang.Text <> "" Then
    TxtJinE.Text = TxtDingJia.Text * TxtShuLiang.Text * TxtYouHui.Text
End If
End Sub

Private Sub TxtSJJinE_KeyUp(KeyCode As Integer, Shift As Integer)
If Not (KeyCode >= 48 And KeyCode <= 57) Then
    If Not (KeyCode >= 96 And KeyCode <= 105) Then
        If KeyCode <> 13 And KeyCode <> 190 And KeyCode <> 110 And KeyCode <> 8 And KeyCode <> 46 Then
            MsgBox "图书金额填写错误!", vbOKOnly + vbExclamation, "填写错误"
            TxtSJJinE.Text = ""
            TxtSJJinE.SetFocus
        End If
    End If
End If
End Sub

Private Sub TxtZheKou_KeyUp(KeyCode As Integer, Shift As Integer)
If Not (KeyCode >= 48 And KeyCode <= 57) Then
    If Not (KeyCode >= 96 And KeyCode <= 105) Then
        If KeyCode <> 13 And KeyCode <> 190 And KeyCode <> 110 And KeyCode <> 8 And KeyCode <> 46 Then
            MsgBox "图书优惠打折率填写错误!", vbOKOnly + vbExclamation, "填写错误"
            TxtZheKou.Text = ""
            TxtZheKou.SetFocus
        End If
    End If
End If
End Sub

Private Sub TxtZheKou_LostFocus()
If TxtZheKou.Text <> "" Then
    TxtSJJinE.Text = TxtDingJia.Text * TxtShuLiang.Text * TxtZheKou.Text
End If
End Sub