⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄

📁 这是一个航空公司用来计算货物运价的系统。
💻
📖 第 1 页 / 共 3 页
字号:
            '数据库存储过程的调用
            '*********************************
            Dim x As Object
            Set x = CreateObject("db_yunjia.REC")
            If x.up0(Trim(Text3.Text), Trim(Text4.Text), Trim(Text5.Text), Trim(Text6.Text), Trim(Text7.Text), Trim(Text8.Text), Trim(Text9.Text), Trim(Text10.Text), Trim(Text11.Text), Trim(Text12.Text), Trim(Text13.Text), Trim(Text14.Text), Trim(Text17.Text), Trim(gtype)) Then
            '关闭窗口
            'Unload Form1
            Else
            MsgBox ("数据更新失败,请重新操作!!")
            End If
            cy = True '将存储标识变量置为真
            ey = False '将改动标识变量重新置为false
            End If
            End If
        End If
    End If
    End If
Else '取消则不作任何动作
End If
End If
End Sub

Private Sub Command3_Click()
    Dim cur1, cur2, cur3, cur4, cur5, cur6, cur7, cur8, cur9 As Currency 'cur1~cur9为M~3000九个级别的运价数据
    If ey Then '判断数据是否被修改过,如果被修改过,则要进行数据存储
    '首先对数据的合法性进行必要的验证,只有通过了验证的数据才能最终进行数据存储操作
    If IsNumeric(Text3.Text) <> True And Text3.Text <> "" Then
    MsgBox ("请在此输入正确的M运价!!")
    Text3.Text = ""
    Text3.SetFocus
    ElseIf IsNumeric(Text4.Text) <> True And Text4.Text <> "" Then
    MsgBox ("请在此输入正确的N运价!!")
    Text4.Text = ""
    Text4.SetFocus
    ElseIf IsNumeric(Text5.Text) <> True And Text5.Text <> "" Then
    MsgBox ("请在此输入正确的45Kg运价!!")
    Text5.Text = ""
    Text5.SetFocus
    ElseIf IsNumeric(Text6.Text) <> True And Text6.Text <> "" Then
    MsgBox ("请在此输入正确的100Kg运价!!")
    Text6.Text = ""
    Text6.SetFocus
    ElseIf IsNumeric(Text7.Text) <> True And Text7.Text <> "" Then
    MsgBox ("请在此输入正确的300Kg运价!!")
    Text7.Text = ""
    Text7.SetFocus
    ElseIf IsNumeric(Text8.Text) <> True And Text8.Text <> "" Then
    MsgBox ("请在此输入正确的500Kg运价!!")
    Text8.Text = ""
    Text8.SetFocus
    ElseIf IsNumeric(Text9.Text) <> True And Text9.Text <> "" Then
    MsgBox ("请在此输入正确的1000Kg运价!!")
    Text9.Text = ""
    Text9.SetFocus
    ElseIf IsNumeric(Text10.Text) <> True And Text10.Text <> "" Then
    MsgBox ("请在此输入正确的2000Kg运价!!")
    Text10.Text = ""
    Text10.SetFocus
    ElseIf IsNumeric(Text11.Text) <> True And Text11.Text <> "" Then
    MsgBox ("请在此输入正确的3000Kg运价!!")
    Text11.Text = ""
    Text11.SetFocus
    ElseIf IsNumeric(Text14.Text) <> True And Text14.Text <> "" Then
    MsgBox ("请在此输入正确等级附加率!!")
    Text14.Text = ""
    Text14.SetFocus
    Else '正确情况
    cur1 = Val(Text3.Text)
    cur2 = Val(Text4.Text)
    cur3 = Val(Text5.Text)
    cur4 = Val(Text6.Text)
    cur5 = Val(Text7.Text)
    cur6 = Val(Text8.Text)
    cur7 = Val(Text9.Text)
    cur8 = Val(Text10.Text)
    cur9 = Val(Text11.Text)
    '----------首先判断数据的合法性------------
    If Option5.Value Then '等级商品运价
        '等级商品运价的条件是M~3000九个等级数据均为空,只有等级百分比不为空
        If Text12.Text = "" Then
        MsgBox ("请在此输入货物编码!!")
        Text12.Text = ""
        Text12.SetFocus
        ElseIf Text14.Text = "" Or IsNumeric(Text14.Text) <> True Then
        MsgBox ("请在此输入正确的附加百分比!!")
        Text14.Text = ""
        Text14.SetFocus
        Else '输入的等级商品运价信息正确
        '**********进行数据更新操作***********
                Dim x0 As Object
                Set x0 = CreateObject("db_yunjia.REC")
                If x0.up0(Trim(Text3.Text), Trim(Text4.Text), Trim(Text5.Text), Trim(Text6.Text), Trim(Text7.Text), Trim(Text8.Text), Trim(Text9.Text), Trim(Text10.Text), Trim(Text11.Text), Trim(Text12.Text), Trim(Text13.Text), Trim(Text14.Text), Trim(Text17.Text), Trim(gtype)) Then
                MsgBox ("恭喜!!数据更新完成!!")
                Call Command1_Click
                Else
                MsgBox ("数据更新失败,请重新操作!!")
                End If
                cy = True '将存储标识变量置为真
                ey = False '将改动标识变量重新置为false
        End If
    Else '普通商品运价或指定商品运价
        '普货或指定商品的cur3~cur7均不为空
        If Text5.Text = "" Or Text6.Text = "" Or Text7.Text = "" Or Text8.Text = "" Or Text9.Text = "" Then '45~1000Kg级别之间有一项数据为空
        MsgBox ("45~1000Kg这几个等级数据不能为空!!")
        Text5.SetFocus
        ElseIf (Text10.Text = "" And Text11.Text <> "") Or (Text10.Text <> "" And Text11.Text = "") Then
        MsgBox ("2000,3000Kg这两个重量级别的运价只能同时为空或同事赋值!!")
        Text10.SetFocus
        Else
        '进一步判断这些数据的合法性,主要是cur2~cur9这几个数据是逐步缩小的
            If cur2 <> 0 And cur2 < cur3 Then 'N出错
            MsgBox ("您所输入的N运价有误!!")
            Text4.Text = ""
            Text4.SetFocus
            ElseIf (cur2 <> 0 And cur3 > cur2) Or cur3 < cur4 Then '45Kg出错了
            MsgBox ("您所输入的45Kg级运价有误!!")
            Text5.Text = ""
            Text5.SetFocus
            ElseIf cur4 > cur3 Or cur4 < cur5 Then '100Kg出错了
            MsgBox ("您所输入的100Kg级运价有误!!")
            Text6.Text = ""
            Text6.SetFocus
            ElseIf cur5 > cur4 Or cur5 < cur6 Then '300kg出错了
            MsgBox ("您所输入的300Kg级运价有误!!")
            Text7.Text = ""
            Text7.SetFocus
            ElseIf cur6 > cur5 Or cur6 < cur7 Then '500kg出错了
            MsgBox ("您所输入的500Kg级运价有误!!")
            Text8.Text = ""
            Text8.SetFocus
            ElseIf cur7 > cur6 Or cur7 < cur8 Then '1000kg出错了
            MsgBox ("您所输入的1000Kg级运价有误!!")
            Text9.Text = ""
            Text9.SetFocus
            ElseIf cur8 > cur7 Or cur8 < cur9 Then '2000kg出错了
            MsgBox ("您所输入的2000Kg级运价有误!!")
            Text10.Text = ""
            Text10.SetFocus
            ElseIf cur9 > cur8 Then '3000Kg出错了
            MsgBox ("您所输入的3000Kg级运价有误!!")
            Text11.Text = ""
            Text11.SetFocus
            ElseIf Text12.Text = "" Then
            MsgBox ("请在此输入货物编码!!")
            Text12.Text = ""
            Text12.SetFocus
            ElseIf Text13.Text = "" Then
            MsgBox ("请在此输入代理商编码!!")
            Text13.Text = ""
            Text13.SetFocus
            Else '输入的普货或指定商品运价信息正确
                '由于三项数据【货物编码、代理商、起始日期】均未作改动,因此不需要进行数据验证
                '调用存储过程存储数据。
                '*********************************
                '数据库存储过程的调用
                '*********************************
                Dim x As Object
                Set x = CreateObject("db_yunjia.REC")
                If x.up0(Trim(Text3.Text), Trim(Text4.Text), Trim(Text5.Text), Trim(Text6.Text), Trim(Text7.Text), Trim(Text8.Text), Trim(Text9.Text), Trim(Text10.Text), Trim(Text11.Text), Trim(Text12.Text), Trim(Text13.Text), Trim(Text14.Text), Trim(Text17.Text), Trim(gtype)) Then
                MsgBox ("恭喜!!数据更新完成!!")
                Call Command1_Click
                Else
                MsgBox ("数据更新失败,请重新操作!!")
                End If
                cy = True '将存储标识变量置为真
                ey = False '将改动标识变量重新置为false
            End If
            End If
        End If
    End If
    End If
End Sub

Private Sub Command4_Click()
'首先判断是否有记录被选中
If Text17.Text <> "" Then '根据序号文本框中的数据是否为空从而得出是否有文本被选中
'首先提示用户是否确信要删除该记录
'是…写出SQL语句并执行
'否…不作任何改动
Dim Msg, Style, Title, Response As String
Msg = "您确信要删除此记录吗?"   ' 定义信息。
Style = vbYesNo + vbQuestion + vbDefaultButton2   ' 定义按钮。
Title = "系统提示"   ' 定义标题。
Response = MsgBox(Msg, Style, Title)
    If Response = vbYes Then '删除记录,调用删除存储过程
    '*********************************
    '数据删除过程的调用
    '*********************************
        Dim x As Object
        Set x = CreateObject("db_yunjia.REC")
        If x.del0(Trim(Text17.Text)) Then
        MsgBox ("恭喜!!数据成功删除!!")
        Call Command1_Click
        Else
        MsgBox ("数据删除失败,请重新操作!!")
        End If
    Else '取消则不作任何动作
    End If
End If
End Sub
Private Sub Form_Load()
Dim yjlx As Integer
Dim Rst As ADODB.Recordset
Dim x As Object
    ey = False
    cy = False
'得到运价类型数据
    If Option1.Value Then
    yjlx = 1
    End If
    If Option2.Value Then
    yjlx = 2
    End If
    If Option3.Value Then
    yjlx = 3
    End If
'定义初始化SQL语句,并将相关的记录显示到datagrid控件中,在下面的文本框中显示相应的记录
    
    Set x = CreateObject("db_yunjia.REC")
    Set Rst = x.sel0(Trim(Text1.Text), Str(yjlx), Trim(Text15.Text), Trim(Text16.Text), Trim(Text2.Text))
    Set x = Nothing
    If Rst Is Nothing Then Exit Sub
    If IsRstEmpty(Rst) Then
        Exit Sub
    End If
    
    ADOFillLvw Rst, Me.lvwPrice, True
'改变下面的文本框和按钮的属性
    Text3.Enabled = False
    Text4.Enabled = False
    Text5.Enabled = False
    Text6.Enabled = False
    Text7.Enabled = False
    Text8.Enabled = False
    Text9.Enabled = False
    Text10.Enabled = False
    Text11.Enabled = False
    Text12.Enabled = False
    Text13.Enabled = False
    Text14.Enabled = False
End Sub
'将数据结果显示在下面的文本框中
Private Sub lvwPrice_ItemClick(ByVal Item As MSComctlLib.ListItem)
'首先判断记录是否为空
If Me.lvwPrice.ListItems.Count = 0 Then Exit Sub
If Item Is Nothing Then Exit Sub
'给每一个文本框赋值
Me.Text12.Text = Item.SubItems(5)
Me.Text13.Text = Item.SubItems(3)
Me.Text17.Text = Trim(Item.Text)
Select Case Val(Item.SubItems(4))
    Case 1
        Option4.Value = True
        '改变相应一些文本框的属性
        gtype = "1"
        Text3.Enabled = True
        Text4.Enabled = True
        Text5.Enabled = True
        Text6.Enabled = True
        Text7.Enabled = True
        Text8.Enabled = True
        Text9.Enabled = True
        Text10.Enabled = True
        Text11.Enabled = True
        Text12.Enabled = True
        Text13.Enabled = True
        Text14.Enabled = False
        '为一些文本框赋值
        Me.Text14.Text = ""
    Case 2
        gtype = "2"
        Option5.Value = True
        '改变相应一些文本框的属性
        Text3.Enabled = False
        Text4.Enabled = False
        Text5.Enabled = False
        Text6.Enabled = False
        Text7.Enabled = False
        Text8.Enabled = False
        Text9.Enabled = False
        Text10.Enabled = False
        Text11.Enabled = False
        Text12.Enabled = True
        Text13.Enabled = True
        Text14.Enabled = True
        '为一些文本框赋值
        Me.Text14.Text = 100 * Val(Item.SubItems(8))
    Case 3
        gtype = "3"
        Option6.Value = True
        '改变相应一些文本框的属性
        Text3.Enabled = True
        Text4.Enabled = True
        Text5.Enabled = True
        Text6.Enabled = True
        Text7.Enabled = True
        Text8.Enabled = True
        Text9.Enabled = True
        Text10.Enabled = True
        Text11.Enabled = True
        Text12.Enabled = True
        Text13.Enabled = True
        Text14.Enabled = False
        '为一些文本框赋值
        Me.Text14.Text = ""
End Select
        '为其他相关文本框赋值
        Me.Text3.Text = Format(Item.SubItems(9), "###0.00")
        Me.Text4.Text = Format(Item.SubItems(10), "###0.00")
        Me.Text5.Text = Format(Item.SubItems(11), "###0.00")
        Me.Text6.Text = Format(Item.SubItems(12), "###0.00")
        Me.Text7.Text = Format(Item.SubItems(13), "###0.00")
        Me.Text8.Text = Format(Item.SubItems(14), "###0.00")
        Me.Text9.Text = Format(Item.SubItems(15), "###0.00")
        Me.Text10.Text = Format(Item.SubItems(16), "###0.00")
        Me.Text11.Text = Format(Item.SubItems(17), "###0.00")
        Me.DTPicker3.Value = Trim(Item.SubItems(6))
        Me.DTPicker4.Value = Trim(Item.SubItems(7))
'将编辑标识变量置为否
ey = False
End Sub

Private Sub Text10_Change()

ey = True
End Sub

Private Sub Text11_Change()
ey = True
End Sub

Private Sub Text12_Change()
ey = True
End Sub

Private Sub Text13_Change()
ey = True
End Sub

Private Sub Text14_Change()
ey = True
End Sub


Private Sub Text3_Change()
ey = True
End Sub

Private Sub Text4_Change()
ey = True
End Sub

Private Sub Text5_Change()
ey = True
End Sub

Private Sub Text6_Change()
ey = True
End Sub

Private Sub Text7_Change()
ey = True
End Sub

Private Sub Text8_Change()
ey = True
End Sub

Private Sub Text9_Change()
ey = True
End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -