frmformprocess.frm

来自「本人用VB 6.0和ACCESS编写的水费管理系统」· FRM 代码 · 共 1,143 行 · 第 1/3 页

            Width           =   810
         End
         Begin VB.Label Label30 
            AutoSize        =   -1  'True
            Caption         =   "合计金额:"
            Height          =   180
            Left            =   6120
            TabIndex        =   70
            Top             =   5160
            Width           =   810
         End
         Begin VB.Label Label31 
            AutoSize        =   -1  'True
            Caption         =   "是否录单:"
            Height          =   180
            Left            =   6120
            TabIndex        =   72
            Top             =   5640
            Width           =   810
         End
      End
   End
End
Attribute VB_Name = "frmFormProcess"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim db As Database, rs As Recordset
Dim fso As New FileSystemObject
Dim curWaterPrice(5) As Currency, curWaterDirty(5) As Currency
Dim WaterMeter(9) As Long, WaterLimit(9) As Long
Dim InputIndex As Integer, RegionIndex As Integer

Private Sub cmdExit_Click(Index As Integer)
    Unload Me
End Sub

Private Sub cmdRefresh_Click()
    '只有多用户应用程序需要
    On Error GoTo RefreshErr
    Data1.Refresh
    Exit Sub
RefreshErr:
    MsgBox Err.Description
End Sub

Private Sub cmdUpdate_Click(Index As Integer)
    On Error GoTo UpdateErr
    Data1.UpdateRecord
    Exit Sub
UpdateErr:
    MsgBox Err.Description
End Sub

Private Sub comRegion_Click(Index As Integer)
    '根据分区号选择分区
    Dim RegionNumber As Integer, strSQL As String
    RegionNumber = comRegion(Index).ListIndex + 1
    RegionIndex = RegionNumber
    Select Case Index
    Case 0      '表单录入
        strSQL = "select * from 主库文件 where 分区=" & RegionNumber
    Case 1      '表单编辑
        Select Case InputIndex
        Case 0      '分区及已录单
            strSQL = "select * from 主库文件 where 分区=" & RegionNumber _
                & " and 录单=True"
        Case 1      '分区及未录单
             strSQL = "select * from 主库文件 where 分区=" & RegionNumber _
                & " and 录单=False"
        End Select
    End Select
    Data1.RecordSource = strSQL
    Data1.Refresh
End Sub

Private Sub Data1_Reposition()
    Data1.Caption = "记录:" & Data1.Recordset.AbsolutePosition + 1
End Sub

Private Sub Form_Load()
    '水表直径与起收底数
    WaterMeter(1) = 20: WaterMeter(2) = 25: WaterMeter(3) = 32
    WaterMeter(4) = 40: WaterMeter(5) = 50: WaterMeter(6) = 80
    WaterMeter(7) = 100: WaterMeter(8) = 150: WaterMeter(9) = 200
    WaterLimit(1) = 4: WaterLimit(2) = 8: WaterLimit(3) = 15
    WaterLimit(4) = 25: WaterLimit(5) = 40: WaterLimit(6) = 60
    WaterLimit(7) = 80: WaterLimit(8) = 200: WaterLimit(9) = 300
    Dim strOpenName As String
    strOpenName = App.Path & "\Main" & Year(Now) & Month(Now) & ".mdb"
    '设定数据控件属性
    Data1.DatabaseName = strOpenName
    Data1.RecordSource = "主库文件"
    '将表单录入字段加入
    txtFields1(0).DataField = "编号": txtFields1(1).DataField = "户型"
    txtFields1(2).DataField = "户名": txtFields1(3).DataField = "地址"
    txtFields1(4).DataField = "本月读数": txtFields1(5).DataField = "上月读数"
    txtFields1(6).DataField = "发票号": txtFields1(7).DataField = "新表止码"
    txtFields1(8).DataField = "新表起码": txtFields1(9).DataField = "实用水量"
    txtFields1(10).DataField = "排污费金额": txtFields1(11).DataField = "水费"
    txtFields1(12).DataField = "水费金额"
    txtFields1(13).DataField = "合计金额": txtFields1(14).DataField = "污水处理费"
    txtFields1(15).DataField = "金额大写": txtFields1(16).DataField = "污水处理费折扣"
    txtFields1(18).DataField = "分区"
    '将表单编辑字段加入
    txtFields2(0).DataField = "上月读数": txtFields2(1).DataField = "本月读数"
    txtFields2(2).DataField = "新表起码": txtFields2(3).DataField = "新表止码"
    txtFields2(4).DataField = "发票号": txtFields2(5).DataField = "实用水量"
    txtFields2(6).DataField = "排污费金额": txtFields2(7).DataField = "水费金额"
    txtFields2(8).DataField = "合计金额"
    Dim i As Integer
    For i = 0 To 1
        comStyle(i).DataField = "表单类型"
        comStyle(i).AddItem "正常表单": comStyle(i).AddItem "本月调表"
        comStyle(i).AddItem "临时录单": comStyle(i).AddItem "表黑暂开"
        comStyle(i).AddItem "表停暂开": comStyle(i).AddItem "表坏暂开"
    Next
    For i = 0 To 1
        chkInput(i).DataField = "录单"
    Next
    '加入分区数
    For i = 1 To RegionNumber
        comRegion(0).AddItem i
        comRegion(1).AddItem i
    Next
    '刷新数据控件
    Data1.Refresh
    '读取水费价格
    Set db = Workspaces(0).OpenDatabase(App.Path & "\水费标准库.mdb", False, True)
    Set rs = db.OpenRecordset("水费标准")
    rs.MoveFirst
    For i = 1 To 5
        curWaterPrice(i) = rs.Fields("收费标准")
        curWaterDirty(i) = rs.Fields("污水处理费")
        rs.MoveNext
        If rs.EOF Then rs.MoveLast
    Next
    rs.Close
    db.Close
    Set rs = Nothing
    Set db = Nothing
End Sub

Private Sub optInput_Click(Index As Integer)
    Dim strSQL As String
    Select Case Index
        Case 0          '已录单用户
            InputIndex = 0
            strSQL = "select * from 主库文件 where 分区=" & RegionIndex _
                & " and 录单=True"
        Case 1          '未录单用户
            InputIndex = 1
            strSQL = "select * from 主库文件 where 分区=" & RegionIndex _
                & " and 录单=False"
    End Select
    Data1.RecordSource = strSQL
    Data1.Refresh
End Sub

Private Sub txtFields1_LostFocus(Index As Integer)
Select Case Index
    Case 4                      '本月读数
        Dim WI As Long, i As Integer, WJ As Integer
        WI = Data1.Recordset.Fields("水表直径")
        For i = 1 To 9
            If WaterMeter(i) = WI Then WJ = i
        Next
        If Val(txtFields1(Index)) < WaterLimit(WJ) Then
            MsgBox "起收底数为" & WaterLimit(WJ) & "吨!", vbExclamation + vbOKOnly, "表单录入"
            txtFields1(Index).SetFocus
            SendKeys "{Home}+{End}"
            Exit Sub
        End If
        Dim strAppName As String, CYear As Integer, CMonth As Integer
        CYear = Year(Now)
        CMonth = Month(Now)     '当月月份
        If CMonth = 1 Then
            CYear = CYear - 1   '上一年
            CMonth = 12         '12月
        Else
            CMonth = CMonth - 1     '上一月
        End If
        strAppName = App.Path & "\Main" & CYear & CMonth & ".mdb"
        If fso.FileExists(strAppName) Then
            Set db = Workspaces(0).OpenDatabase(strAppName, False, True)
            Set rs = db.OpenRecordset("主库文件")
            rs.MoveFirst
            rs.Move Data1.Recordset.AbsolutePosition
            txtFields1(5).Text = Str(rs.Fields("本月读数"))
            rs.Close
            db.Close
            Set rs = Nothing
            Set db = Nothing
        Else
            txtFields1(5).Text = Str(0)
        End If
        '计算实用水量
        Dim lngWaterQuantity As Long
        lngWaterQuantity = Val(txtFields1(4)) - Val(txtFields1(5))
        If lngWaterQuantity < 0 Then
            MsgBox "本月读数小于上月读数!", vbExclamation + vbOKOnly, "表单录入"
            txtFields1(4).SetFocus
            SendKeys "{Home}+{End}"
            Exit Sub
        End If
        txtFields1(9).Text = Str(lngWaterQuantity)
        '读取户型
        Dim intUserType As Integer
        intUserType = Val(Right(txtFields1(1), 2))
        '计算金额
        Dim WaterPrice As Currency, WaterDirty As Currency
        Dim WaterTotal As Currency
        WaterPrice = lngWaterQuantity * curWaterPrice(intUserType)
        WaterDirty = lngWaterQuantity * curWaterDirty(intUserType)
        WaterTotal = WaterPrice + WaterDirty
        '写入字段
        txtFields1(10).Text = Str(WaterDirty)
        txtFields1(11).Text = Str(WaterPrice)
        txtFields1(12).Text = Str(WaterPrice)
        txtFields1(13).Text = Str(WaterTotal)
        txtFields1(14).Text = Str(WaterDirty)
        txtFields1(16).Text = "1"
        '转换为金额大写
        Dim strNumber As String, WaterTotalCopy As Currency
        Dim MaxNum As Integer, PerNum As Long
        Dim lngI As Long
        WaterTotalCopy = Int(WaterTotal)
        MaxNum = Len(Str(WaterTotalCopy)) - 1
        strNumber = ""
        If WaterTotalCopy = 0 Then strNumber = strNumber & ShiftPrice(0)
        For i = MaxNum To 1 Step -1
            lngI = 10 ^ (i - 1)
            PerNum = WaterTotalCopy \ lngI
            If PerNum <> 0 Then
                strNumber = strNumber & ShiftPrice(PerNum)
                If i > 1 Then
                    strNumber = strNumber & ShiftPrice(lngI)
                End If
            End If
            WaterTotalCopy = WaterTotalCopy - PerNum * lngI
            If PerNum = 0 And WaterTotalCopy <> 0 Then
                strNumber = strNumber & ShiftPrice(0)
            End If
        Next
        strNumber = strNumber & "元"
        '转换小数
        WaterTotalCopy = WaterTotal - Int(WaterTotal)
        If WaterTotalCopy = 0 Then strNumber = strNumber & "整"
        PerNum = Int(WaterTotalCopy * 10)
        If PerNum <> 0 Then
            strNumber = strNumber & ShiftPrice(PerNum)
            strNumber = strNumber & "角"
        End If
        WaterTotalCopy = WaterTotalCopy - PerNum / 10
        PerNum = WaterTotalCopy * 100
        If PerNum <> 0 Then
            strNumber = strNumber & ShiftPrice(PerNum)
            strNumber = strNumber & "分"
        End If
        txtFields1(15).Text = strNumber
End Select
End Sub

Private Function ShiftPrice(PriceNum As Long) As String
    Select Case PriceNum
        Case 0
            ShiftPrice = "零"
        Case 1
            ShiftPrice = "壹"
        Case 2
            ShiftPrice = "贰"
        Case 3
            ShiftPrice = "叁"
        Case 4
            ShiftPrice = "肆"
        Case 5
            ShiftPrice = "伍"
        Case 6
            ShiftPrice = "陆"
        Case 7
            ShiftPrice = "柒"
        Case 8
            ShiftPrice = "捌"
        Case 9
            ShiftPrice = "玖"
        Case 10
            ShiftPrice = "拾"
        Case 100
            ShiftPrice = "佰"
        Case 1000
            ShiftPrice = "仟"
        Case 10000
            ShiftPrice = "万"
        Case 100000
            ShiftPrice = "十万"
    End Select
End Function

Private Sub txtFields2_LostFocus(Index As Integer)
Select Case Index
    Case 1                  '本月读数
        Dim WI As Long, i As Integer, WJ As Integer
        WI = Data1.Recordset.Fields("水表直径")
        For i = 1 To 9
            If WaterMeter(i) = WI Then WJ = i
        Next
        If Val(txtFields2(Index)) < WaterLimit(WJ) Then
            MsgBox "起收底数为" & WaterLimit(WJ) & "吨!", vbExclamation + vbOKOnly, "表单录入"
            txtFields2(Index).SetFocus
            SendKeys "{Home}+{End}"
            Exit Sub
        End If
        txtFields2(0).Text = txtFields1(5).Text     '上月读数
        '计算实用水量
        Dim lngWaterQuantity As Long
        lngWaterQuantity = Val(txtFields2(1)) - Val(txtFields2(0))
        If lngWaterQuantity < 0 Then
            MsgBox "本月读数小于上月读数!", vbExclamation + vbOKOnly, "表单录入"
            txtFields2(1).SetFocus
            SendKeys "{Home}+{End}"
            Exit Sub
        End If
        txtFields2(5).Text = Str(lngWaterQuantity)
        '读取户型
        Dim intUserType As Integer
        intUserType = Val(Right(txtFields1(1), 2))
        '计算金额
        Dim WaterPrice As Currency, WaterDirty As Currency
        Dim WaterTotal As Currency
        WaterPrice = lngWaterQuantity * curWaterPrice(intUserType)
        WaterDirty = lngWaterQuantity * curWaterDirty(intUserType)
        WaterTotal = WaterPrice + WaterDirty
        '写入字段
        txtFields2(6).Text = Str(WaterDirty)
        txtFields2(7).Text = Str(WaterPrice)
        txtFields2(8).Text = Str(WaterTotal)
        txtFields1(11).Text = Str(WaterPrice)
        txtFields1(14).Text = Str(WaterDirty)
        '转换为金额大写
        Dim strNumber As String, WaterTotalCopy As Currency
        Dim MaxNum As Integer, PerNum As Long
        Dim lngI As Long
        WaterTotalCopy = Int(WaterTotal)
        MaxNum = Len(Str(WaterTotalCopy)) - 1
        strNumber = ""
        If WaterTotalCopy = 0 Then strNumber = strNumber & ShiftPrice(0)
        For i = MaxNum To 1 Step -1
            lngI = 10 ^ (i - 1)
            PerNum = WaterTotalCopy \ lngI
            If PerNum <> 0 Then
                strNumber = strNumber & ShiftPrice(PerNum)
                If i > 1 Then
                    strNumber = strNumber & ShiftPrice(lngI)
                End If
            End If
            WaterTotalCopy = WaterTotalCopy - PerNum * lngI
            If PerNum = 0 And WaterTotalCopy <> 0 Then
                strNumber = strNumber & ShiftPrice(0)
            End If
        Next
        strNumber = strNumber & "元"
        '转换小数
        WaterTotalCopy = WaterTotal - Int(WaterTotal)
        If WaterTotalCopy = 0 Then strNumber = strNumber & "整"
        PerNum = Int(WaterTotalCopy * 10)
        If PerNum <> 0 Then
            strNumber = strNumber & ShiftPrice(PerNum)
            strNumber = strNumber & "角"
        End If
        WaterTotalCopy = WaterTotalCopy - PerNum / 10
        PerNum = WaterTotalCopy * 100
        If PerNum <> 0 Then
            strNumber = strNumber & ShiftPrice(PerNum)
            strNumber = strNumber & "分"
        End If
        txtFields1(15).Text = strNumber
End Select
End Sub