frmquery.frm

一个功能比较完善的远程抄表软件

Dim curValue As Single
Dim curDevID As Integer
Dim curQuan As Single

    Set rcData = dbCbb.OpenRecordset(QData, dbOpenSnapshot)
    Set rcUserDev = dbCbb.OpenRecordset("UserDev", dbOpenSnapshot)
    Set rcDevsMap = dbCbb.OpenRecordset("DevsMap", dbOpenDynaset)
    
    Call GetClientRect(lvwData2.hwnd, AreaLvwData2)
    rcQUser.MoveLast
    rcQUser.MoveFirst
    Do While Not rcQUser.EOF                '依次填充符合条件用户的数据
        DoEvents
        If CancelBrowse Then
            Call InvalidateRect(lvwData2.hwnd, AreaLvwData2, True)
            Exit Sub
        End If
        prgQuery.Visible = True
        Set itmXData2 = lvwData2.ListItems.Add(, , rcQUser!UserID)
        itmXData2.SubItems(1) = CStr(rcQUser!Door)
        itmXData2.SubItems(2) = CStr(rcQUser!userName)
        curUserID = rcQUser!UserID
        If DevName <> "所有" Then
            rcData.FindFirst "DevID=" + Format(DevIDQ) _
                & " and UserID=" + Format(curUserID) _
                & " and format(date,""yyyy-mm-dd"")=""" _
                & Format(DateFormer, "yyyy-mm-dd") + """"
        Else
            rcData.FindFirst "UserID=" + Format(curUserID) _
                & " and format(Date,""yyyy-mm-dd"")=""" _
                & Format(DateFormer, "yyyy-mm-dd") + """"
        End If
        'If Not rcData.NoMatch Then
            Do While Not rcData.NoMatch
                If DevName <> "所有" Then
                    curDevID = DevIDQ
                Else
                    curDevID = rcData!devID
                End If
                rcDevsMap.FindFirst "TypeID=" + Format(curDevID)
                If rcDevsMap.NoMatch Then
                    curQuan = 1
                Else
                    If IsNull(rcDevsMap!Quan) Then
                        curQuan = 1
                        rcDevsMap.Edit
                        rcDevsMap!Quan = 1
                        rcDevsMap.Update
                    Else
                        curQuan = rcDevsMap!Quan
                    End If
                End If
                curValue = Format(IIf(IsNull(rcData!Value), 0, rcData!Value) * curQuan)
                rcUserDev.FindFirst "UserID=" + Format(curUserID) + " and DevID=" + Format(curDevID)
                If Not rcUserDev.NoMatch Then
                    curDevType = rcUserDev!DevType
                    If DevName <> "所有" Then
                        itmXData2.SubItems(3) = Trim(curValue)
                    Else
                        itmXData2.SubItems(2 + curDevType) = Trim(curValue)
                    End If
                End If
                If DevName <> "所有" Then
                    rcData.FindNext "DevID=" + Format(DevIDQ) _
                        & " and UserID=" + Format(curUserID) _
                        & " and format(date,""yyyy-mm-dd"")=""" _
                        & Format(DateFormer, "yyyy-mm-dd") + """"
                Else
                    rcData.FindNext "UserID=" + Format(curUserID) _
                        & " and format(Date,""yyyy-mm-dd"")=""" _
                        & Format(DateFormer, "yyyy-mm-dd") + """"
                End If
            'DoEvents
            Loop
        'Else
            'If DevName <> "所有" Then
                'itmXData2.SubItems(3) = "0"
            'Else
                'itmXData2.SubItems(2 + curDevType) = "0"
            'End If
            'DoEvents
        'End If
        prgQuery.Value = Val(prgQuery.Value) + Val(prgQuery.Max / 5 / UserSum)
        Call ValidateRect(lvwData2.hwnd, AreaLvwData2)
        rcQUser.MoveNext
    Loop
    Call InvalidateRect(lvwData2.hwnd, AreaLvwData2, True)
    prgQuery.Value = Val(prgQuery.Max / 5)
    lvwData2.Refresh
End Sub


Sub FilllvwData1()
 Dim AreaLvwData1 As RECT
Dim curDevType As Integer
Dim rcData As Recordset
Dim rcUserDev As Recordset
Dim rcDevsMap As Recordset
Dim curUserID As Integer
Dim curValue As Single
Dim curDevID As Integer
Dim curQuan As Single

    Set rcData = dbCbb.OpenRecordset(QData, dbOpenSnapshot)
    Set rcUserDev = dbCbb.OpenRecordset("UserDev", dbOpenSnapshot)
    Set rcDevsMap = dbCbb.OpenRecordset("DevsMap", dbOpenDynaset)
    
    Call GetClientRect(lvwData1.hwnd, AreaLvwData1)
    rcQUser.MoveLast
    rcQUser.MoveFirst
    UserSum = rcQUser.RecordCount
    Do While Not rcQUser.EOF                '依次填充符合条件用户的数据
        DoEvents
        If CancelBrowse Then
            Call InvalidateRect(lvwData1.hwnd, AreaLvwData1, True)
            Exit Sub
        End If
        Set itmXData1 = lvwData1.ListItems.Add(, , rcQUser!UserID)
        itmXData1.SubItems(1) = CStr(rcQUser!Door)
        itmXData1.SubItems(2) = CStr(rcQUser!userName)
        curUserID = rcQUser!UserID
        If DevName <> "所有" Then
            rcData.FindFirst "DevID=" + Format(DevIDQ) _
                & " and UserID=" + Format(curUserID) _
                & " and format(date,""yyyy-mm-dd"")=""" _
                & Format(DateLater, "yyyy-mm-dd") + """"
        Else
            rcData.FindFirst "UserID=" + Format(curUserID) _
                & " and format(Date,""yyyy-mm-dd"")=""" _
                & Format(DateLater, "yyyy-mm-dd") & """"
        End If
        Do While Not rcData.NoMatch
            If DevName <> "所有" Then
                curDevID = DevIDQ
            Else
                curDevID = rcData!devID
            End If
            rcDevsMap.FindFirst "TypeID=" + Format(curDevID)
            If rcDevsMap.NoMatch Then
                curQuan = 1
            Else
                If IsNull(rcDevsMap!Quan) Then
                    curQuan = 1
                    rcDevsMap.Edit
                    rcDevsMap!Quan = 1
                    rcDevsMap.Update
                Else
                    curQuan = rcDevsMap!Quan
                End If
            End If
            curValue = Format(rcData!Value * curQuan)
            rcUserDev.FindFirst "UserID=" + Format(curUserID) + " and DevID=" + Format(curDevID)
            If Not rcUserDev.NoMatch Then
                curDevType = rcUserDev!DevType
                If DevName <> "所有" Then
                    itmXData1.SubItems(3) = Trim(curValue)
                Else
                    itmXData1.SubItems(2 + curDevType) = Trim(curValue)
                End If
            End If
            If DevName <> "所有" Then
                rcData.FindNext "DevID=" + Format(DevIDQ) _
                    & " and UserID=" + Format(curUserID) _
                    & " and format(date,""yyyy-mm-dd"")=""" _
                    & Format(DateLater, "yyyy-mm-dd") + """"
            Else
                rcData.FindNext "UserID=" + Format(curUserID) _
                    & " and format(Date,""yyyy-mm-dd"")=""" _
                    & Format(DateLater, "yyyy-mm-dd") & """"
            End If
            
        Loop
        prgQuery.Value = Val(prgQuery.Value) + Val(prgQuery.Max / 5 / UserSum)
        'Call ValidateRect(lvwData1.hwnd, AreaLvwData1)
        rcQUser.MoveNext
     Loop
     If lvwData1.ListItems.Count > 0 Then
        txtStartUser.Text = Val(lvwData1.ListItems(1).Text)
        txtStartDev.Text = 1
        curBrowStartUser = Val(txtStartUser)
        curBrowStartDev = Val(txtStartDev)
        curBrowLine = 1
        curBrowCol = 2
     Else
        txtStartUser.Text = ""
        txtStartDev.Text = ""
        curBrowStartUser = -1
        curBrowStartDev = -1
        curBrowLine = -1
        curBrowCol = -1
     End If
    'Call InvalidateRect(lvwData1.hwnd, AreaLvwData1, True)
    prgQuery.Value = Val(prgQuery.Max / 5) * 2
    lvwData1.Refresh
End Sub
Sub FilllvwUsed()
Dim AreaLvwUsed As RECT
Dim curDevType As Integer
Dim i As Integer
Dim j As Integer
   
'填充lvwUsed
    j = 1
    Call GetClientRect(lvwUsed.hwnd, AreaLvwUsed)
    rcQUser.MoveFirst
    Do While Not rcQUser.EOF                '依次填充符合条件用户的数据
        DoEvents
        If CancelBrowse Then
            Call InvalidateRect(lvwUsed.hwnd, AreaLvwUsed, True)
            Exit Sub
        End If
        Set itmXUsed = lvwUsed.ListItems.Add()
        itmXUsed.Text = CStr(rcQUser!UserID)
        itmXUsed.SubItems(1) = CStr(rcQUser!Door)
        itmXUsed.SubItems(2) = CStr(rcQUser!userName)
        If tabData.TabVisible(1) = True Then
            If DevName <> "所有" Then
                itmXUsed.SubItems(3) = Format(Val(Val(lvwData1.ListItems.Item(j).SubItems(3)) - Val(lvwData2.ListItems.Item(j).SubItems(3))), "##########.0")
            Else
                i = 1
                For i = 1 To cmbDevName.ListCount - 1
                    itmXUsed.SubItems(i + 2) = Format(Val(Val(lvwData1.ListItems.Item(j).SubItems(i + 2)) - Val(lvwData2.ListItems.Item(j).SubItems(i + 2))), "##########.0")
                Next i
            End If
        Else
            If DevName <> "所有" Then
                itmXUsed.SubItems(3) = Format(Val(Val(lvwData1.ListItems.Item(j).SubItems(3))), "##########.0")
            Else
                i = 1
                For i = 1 To cmbDevName.ListCount - 1
                    itmXUsed.SubItems(i + 2) = Format(Val(Val(lvwData1.ListItems.Item(j).SubItems(i + 2))), "##########.0")
                Next i
            End If
        End If
        prgQuery.Value = Val(prgQuery.Value) + Val(prgQuery.Max / 5 / UserSum)
        Call ValidateRect(lvwUsed.hwnd, AreaLvwUsed)
        rcQUser.MoveNext
        j = j + 1
    Loop
    Call InvalidateRect(lvwUsed.hwnd, AreaLvwUsed, True)
    prgQuery.Value = Val(prgQuery.Max / 5) * 3
    lvwUsed.Refresh
End Sub
Sub FilllvwWaste()
Dim AreaLvwWaste As RECT
Dim rcUserDev As Recordset
Dim rcDevsMap As Recordset
Dim curUserID As Integer
Dim curWaste As Single
Dim curDevID As Integer

    Set rcWaste = dbCbb.OpenRecordset("Waste", dbOpenDynaset)
    Set rcUserDev = dbCbb.OpenRecordset("UserDev", dbOpenSnapshot)
    Set rcDevsMap = dbCbb.OpenRecordset("DevsMap", dbOpenDynaset)
    
    Call GetClientRect(lvwWaste.hwnd, AreaLvwWaste)
    rcQUser.MoveFirst
    DoEvents
    Do While Not rcQUser.EOF
        If CancelBrowse Then
            Call InvalidateRect(lvwWaste.hwnd, AreaLvwWaste, True)
            Exit Sub
        End If
        
        Set itmXWaste = lvwWaste.ListItems.Add()
        itmXWaste.Text = CStr(rcQUser!UserID)
        itmXWaste.SubItems(1) = CStr(rcQUser!Door)
        itmXWaste.SubItems(2) = CStr(rcQUser!userName)
      
        curUserID = rcQUser!UserID
        i = 4
        For i = 4 To lvwData1.ColumnHeaders.Count
            If DevName <> "所有" Then
                curDevID = DevIDQ
            Else
                curDevID = i - 3
            End If
            rcUserDev.FindFirst "userID=" + Format(curUserID) + " and DevID=" + Format(curDevID)
            If Not rcUserDev.NoMatch Then
                curDevType = rcUserDev!DevType
                rcDevsMap.FindFirst "typeID=" + Format(curDevType)
                rcWaste.FindFirst "DevID=" + Format(Val(curDevID)) _
                    & " and UserID=" + Format(curUserID) _
                    & " and format(date1,""yyyy-mm-dd"")=""" _
                    & Format(DateLater, "yyyy-mm-dd") + """" _
                    & " and format(date2,""yyyy-mm-dd"")=""" _
                    & Format(DateFormer, "yyyy-mm-dd") + """"
                If Not rcWaste.NoMatch Then
                    curWaste = rcWaste!Value
                Else
                    curWaste = "0"
                End If
                If DevName <> "所有" Then
                    itmXWaste.SubItems(3) = Format(curWaste, "##########.0")
                Else
                    itmXWaste.SubItems(3 + curDevType - 1) = Format(curWaste, "##########.0")
                End If
            End If
        Next i
        prgQuery.Value = Val(prgQuery.Value) + Val(prgQuery.Max / 5 / UserSum)
        Call ValidateRect(lvwWaste.hwnd, AreaLvwWaste)
        rcQUser.MoveNext
    Loop
    Call InvalidateRect(lvwWaste.hwnd, AreaLvwWaste, True)
    prgQuery.Value = Val(prgQuery.Max / 5) * 4
    lvwWaste.Refresh
End Sub

Sub FilllvwFee()
Dim AreaLvwFee As RECT
Dim curDevType As Integer
Dim curDevName As String
Dim rowSum As Integer
Dim rcDevs As Recordset
Dim curPrice As Single
Dim i As Integer
Dim j As Integer

    Set rcDevs = dbCbb.OpenRecordset("DevsMap", dbOpenSnapshot)
    Call GetClientRect(lvwFee.hwnd, AreaLvwFee)
    j = 1
    rcQUser.MoveFirst
    Do While Not rcQUser.EOF                '依次填充符合条件用户的数据
        'DoEvents
        If CancelBrowse Then
            ' 刷 新ListView 的 内 容， 显 示 已 经 查 出 的 记 录 数。
            Call InvalidateRect(lvwFee.hwnd, AreaLvwFee, True)
            Exit Sub
        End If
        
        Set itmXFee = lvwFee.ListItems.Add()
        itmXFee.Text = CStr(rcQUser!UserID)
        itmXFee.SubItems(1) = CStr(rcQUser!Door)
        itmXFee.SubItems(2) = CStr(rcQUser!userName)

        If tabData.TabVisible(3) = True Then
            If DevName <> "所有" Then
                rcDevs.FindFirst "typeID=" + Format(DevIDQ)
                If Not rcDevs.NoMatch Then
                    curPrice = rcDevs!Price
                End If
                itmXFee.SubItems(3) = Format(Val(Val(lvwUsed.ListItems.Item(j).SubItems(3)) + Val(lvwWaste.ListItems.Item(j).SubItems(3))) * curPrice, "##########.00")
            Else
                i = 1
                For i = 1 To lvwFee.ColumnHeaders.Count - 3
                    rcDevs.FindFirst "typeID=" + Format(i)
                    If Not rcDevs.NoMatch Then
                        curPrice = rcDevs!Price
                    End If
                    itmXFee.SubItems(i + 2) = Format(Val(Val(lvwUsed.ListItems.Item(j).SubItems(i + 2)) + Val(lvwWaste.ListItems.Item(j).SubItems(i + 2))) * curPrice, "##########.00")
                Next i
            End If
        Else
            If DevName <> "所有" Then
                itmXFee.SubItems(3) = Format(Val(lvwUsed.ListItems.Item(j).SubItems(3)) * curPrice, "##########.00")
            Else
                i = 1
                For i = 1 To lvwFee.ColumnHeaders.Count - 3
                    rcDevs.FindFirst "typeID=" + Format(i)
                    If Not rcDevs.NoMatch Then
                        curPrice = rcDevs!Price
                    End If
                    itmXFee.SubItems(i + 2) = Format(Val(lvwUsed.ListItems.Item(j).SubItems(i + 2)) * curPrice, "##########.00")
                Next i
            End If
        End If
        If Val(Val(prgQuery.Max) - Val(prgQuery.Value)) > Val(prgQuery.Max / 5 / UserSum) Then
            prgQuery.Value = Val(prgQuery.Value) + Val(prgQuery.Max / 5 / UserSum)
        Else
            prgQuery.Value = prgQuery.Max
        End If
        ' 避 免 显 示 区 域 的 闪 动 现 象。
        Call ValidateRect(lvwFee.hwnd, AreaLvwFee)