frmquery.frm

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

        rcQUser.MoveNext
        DoEvents
        j = j + 1
    Loop
    '刷 新ListView 的 内 容。 显 示 所 有 查 出 的 记 录 数。
    Call InvalidateRect(lvwFee.hwnd, AreaLvwFee, True)
    prgQuery.Value = prgQuery.Max
    prgQuery.Visible = False
    lvwFee.Refresh
End Sub


Sub fillUserRpt() '生成用户数据报表库
Dim rcUserRpt As Recordset

    SQL = "delete * from UserRpt"
    dbCbb.Execute SQL
    
    Set rcUserRpt = dbCbb.OpenRecordset("UserRpt", dbOpenDynaset)
    rcQUser.MoveFirst
    Do While Not rcQUser.EOF
        If CancelBrowse Then
            Exit Sub
        End If
        
        rcUserRpt.AddNew
        rcUserRpt!UserID = rcQUser!UserID
        rcUserRpt!Date1 = DateLater
        If DateFormer <> 0 Then
            rcUserRpt!Date2 = DateFormer
        End If
        rcUserRpt.Update
        rcQUser.MoveNext
        DoEvents
    Loop
End Sub


Private Sub PrePrint()
 'On Error GoTo ProcError
    If Printers.Count = 0 Then
        MsgBox "没有安装打印机,不能继续打印！", 16, "打印"
        Exit Sub
    End If
    If Dir$(App.Path & "\data\userdata.rpt", 0) = "" Then
'status
        AppendStatusInfo "找不到系统报表文件""DATA\USERDATA.RPT"",无法进行打印预览", icoRED
        SaveLog "找不到系统报表文件""DATA\USERDATA.RPT"",无法进行打印预览", 1
        MsgBox "找不到系统报表文件""DATA\USERDATA.RPT""" + Chr(10) + "无法进行打印预览", 48, "打印预览"
        Exit Sub
    End If
'status
    AppendStatusInfo "生成CBB系统计费结算预览", icoBLUE
    SaveLog "生成CBB系统计费结算预览", 0
    rptUserData.ReportFileName = App.Path & "\data\userdata.rpt"
    rptUserData.DataFiles(0) = App.Path & "\data\cbb.mdb"
    rptUserData.WindowTitle = "CBB系统计费结算预览"
    rptUserData.Destination = 0
    If DevName <> "所有" Then
        rptUserData.SelectionFormula = "{DevsMap.Name}='" & DevName & "'"
    Else
        rptUserData.SelectionFormula = ""
    End If
    rptUserData.Action = 1
    DoEvents
    Exit Sub
ProcError:
    ProcErr
End Sub

Private Sub ImmPrint()
'On Error GoTo ProcError
    If Printers.Count = 0 Then
        MsgBox "没有安装打印机,不能继续打印！", 16, "打印"
        Exit Sub
    End If
    
    If Dir$(App.Path & "\data\userdata.rpt", 0) = "" Then
'status
        AppendStatusInfo "找不到系统报表文件""DATA\USERDATA.RPT"",无法进行打印", icoRED
        SaveLog "找不到叩统报表文件""DATA\USERDATA.RPT"",无法进行打印", 1
        MsgBox "找不到系统报表文件""DATA\USERDATA.RPT""" + Chr(10) + "无法进行打印", 48, "打印"
        Exit Sub
    End If
'status
    AppendStatusInfo "打印CBB系统计费结算", icoBLUE
    SaveLog "打印CBB系统计费结算", 0
    rptUserData.ReportFileName = App.Path & "\data\userdata.rpt"
    rptUserData.DataFiles(0) = App.Path & "\data\cbb.mdb"
    rptUserData.WindowTitle = "CBB系统计费结算预览"
    rptUserData.Destination = 1
    If DevName <> "所有" Then
        rptUserData.SelectionFormula = "{DevsMap.Name}='" & DevName & "'"
    Else
        rptUserData.SelectionFormula = ""
    End If
    rptUserData.Action = 1
    DoEvents
    Exit Sub
ProcError:
    ProcErr
End Sub



Private Sub Form_Unload(Cancel As Integer)
    ReDim Preserve curForm(UBound(curForm) - 1)
    If UBound(curForm) > 0 Then
        curForm(UBound(curForm)).Enabled = True
    End If
    If gJPGShow Then
        Unload frmJPG
    End If
End Sub




Private Sub Form_Load()
Picture1.Left = 2250
Picture1.Top = 1280
'Frame1.Width=
fraJPG.Left = 2250
fraJPG.Top = 1320
'on Error GoTo ProcError
    If UBound(curForm) > 0 Then
        curForm(UBound(curForm)).Enabled = False
    End If
    ReDim Preserve curForm(UBound(curForm) + 1)
    Set curForm(UBound(curForm)) = Me
    
    'glbfrmInSizeX = &H7FFFFFFF
    
    'preQuery
    filltreUserMap
    fillcmbdate
    fillcmbDevName
    
    
    lvwData1.Sorted = False
    lvwData1.View = lvwReport
    lvwData2.Sorted = False
    lvwData2.View = lvwReport
    lvwUsed.Sorted = False
    lvwUsed.View = lvwReport
    lvwWaste.Sorted = False
    lvwWaste.View = lvwReport
    lvwFee.Sorted = False
    lvwFee.View = lvwReport

    Set rcBrowUserDev = dbCbb.OpenRecordset("UserDev", dbOpenSnapshot)
    Set rcBrowUserMap = dbCbb.OpenRecordset("UserMap", dbOpenSnapshot)
    Set rcBrowUserData = dbCbb.OpenRecordset("UserData", dbOpenDynaset)
    Set rcBrowUserData2 = dbCbb.OpenRecordset("UserData2", dbOpenDynaset)
    'iniToolBar
    Exit Sub
ProcError:
    ProcErr
End Sub
Sub iniToolBar()
    With clbQuery
    .Bands(1).style = cc3BandNormal
    .Bands(2).style = cc3BandNormal
    .Bands(3).style = cc3BandNormal
    .Bands(4).style = cc3BandNormal
    .Bands(5).style = cc3BandNormal
    .Bands(6).style = cc3BandNormal
    
    .Bands(1).Width = 2550
    .Bands(2).Width = 1710
    .Bands(3).Width = 2400
    .Bands(4).Width = 3360
    .Bands(5).Width = 0
    .Bands(6).Width = 9945
    
    .Bands(1).style = cc3BandFixedSize
    .Bands(2).style = cc3BandFixedSize
    .Bands(3).style = cc3BandFixedSize
    .Bands(4).style = cc3BandFixedSize
    .Bands(5).style = cc3BandFixedSize
    .Bands(6).style = cc3BandFixedSize
    End With
End Sub
'Private Sub Form_Resize()
    'Dim x1 As Integer
    'Dim y1 As Integer
    'Dim x2 As Integer
    'Dim y2 As Integer
    'Dim width1 As Integer
    'Dim width2 As Integer
    'Dim heigth1 As Integer
    'Dim hergth2 As Integer
            
    'x1 = 1
    'y1 = 1
    'x2 = x1 + treUserMap.Width + 3 - 1
    'height1 = ScaleHeight - clbQuery.Height - 2
    'width1 = treUserMap.Width
    'width2 = ScaleWidth - x2 - 1
    'treUserMap.Move x1 - 1, clbQuery.Height + 1, width1, height1
    'tabShowAll.Move x2, clbQuery.Height + 500, width2 + 1, heigth1
    'picSplit.Move x1 + treUserMap.Width - 1, y1, 3, height1
'End Sub


'Private Sub picSplit_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    'If Button = vbLeftButton Then
        'picSplit.BackColor = &H808080
        'glbfrmInSizeX = CLng(x)
    'Else
        'If glbfrmInSizeX <> &H7FFFFFFF Then
            'picSplit_MouseUp Button, Shift, x, y
        'End If
        'glbfrmInSizeX = &H7FFFFFFF
    'End If
'End Sub

'Private Sub picSplit_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    'If glbfrmInSizeX <> &H7FFFFFFF Then
        'If CLng(x) <> glbfrmInSizeX Then
            'picSplit.Move picSplit.Left + x, clbQuery.Height + 1, 3, Me.Height - clbQuery.Height - 2
            'glbfrmInSizeX = CLng(x)
        'End If
    'End If
'End Sub

'Private Sub picSplit_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)

    
    'If glbfrmInSizeX <> &H7FFFFFFF Then
        'If CLng(x) <> glbfrmInSizeX Then
            'picSplit.Move picSplit.Left + x, clbShowAll.Height + 1, 3, Me.Height - clbQuery.Height - 2
        'End If
        'glbfrmInSizeX = &H7FFFFFFF
        'picSplit.BackColor = &H8000000F
        'If picSplit.Left > 60 And picSplit.Left < (ScaleWidth - 60) Then
            'treUserMap.Width = picSplit.Left - treUserMap.Left
        'ElseIf picSplit.Left < 60 Then
            'treUserMap.Width = 60
        'Else
            'treUserMap.Width = ScaleWidth - 60
        'End If

    'End If
    'End Sub
    
Private Sub filltreUserMap()


    Dim rcBuildMap As Recordset
    Dim SQLBuild As String
    Dim rcBuildID As Recordset
    Dim BuildKey As String
    
    Dim rcUserMap As Recordset
    Dim SQLUnit As String
    Dim rcUnit As Recordset
    Dim UnitKey As String
    Dim rcDoor As Recordset
    Dim SQLDoor As String
    
    
  
    treUserMap.LineStyle = 1
    Set rcBuildMap = dbCbb.OpenRecordset("BuildMap", dbOpenDynaset)
    SQLBuild = "select BuildMap.BuildID "
    SQLBuild = SQLBuild + "from BuildMap"
    Set rcBuildID = dbCbb.OpenRecordset(SQLBuild)
    
    Set rcUserMap = dbCbb.OpenRecordset("UserMap", dbOpenDynaset)
    
    'rcBuildID.MoveLast
    'rcBuildID.MoveFirst
    If rcBuildID.RecordCount > 0 Then
        BuildKey = 1
        UnitKey = 1
        DoorKey = 1
        rcBuildID.MoveFirst
        Do While Not rcBuildID.EOF
            Set nodBuild = treUserMap.Nodes.Add(, , "Build" & BuildKey, Trim(rcBuildID!BuildID) & "楼", 1, 2)
            nodBuild.Sorted = True
            SQLUnit = "select distinct Unit "
            SQLUnit = SQLUnit + "from UserMap "
            If IsNull(rcBuildID!BuildID) Then
                Exit Sub
            End If
            SQLUnit = SQLUnit + "Where BuildID=""" + Trim(rcBuildID!BuildID) + """ and trim(UserName)<>""总表"""
            Set rcUnit = dbCbb.OpenRecordset(SQLUnit)
            'rcUnit.MoveLast
            'rcUnit.MoveFirst
            If rcUnit.RecordCount > 0 Then
                rcUnit.MoveFirst
                Do While Not rcUnit.EOF
                    Set nodUnit = treUserMap.Nodes.Add(nodBuild, tvwChild, "Unit" & UnitKey, Trim(rcUnit!Unit) & "单元", 3, 4)
                    nodUnit.Sorted = True
                    SQLDoor = "select distinct Door "
                    SQLDoor = SQLDoor + "from UserMap "
                    If IsNull(rcBuildID!BuildID) Or IsNull(rcUnit!Unit) Then
                        Exit Sub
                    End If
                    SQLDoor = SQLDoor + "where buildID=""" + Trim(rcBuildID!BuildID) + """ "
                    SQLDoor = SQLDoor + "and Unit=""" + Trim(rcUnit!Unit) + """ "
                    SQLDoor = SQLDoor + "and trim(UserName)<>""总表"""
                    Set rcDoor = dbCbb.OpenRecordset(SQLDoor)
                    'rcDoor.MoveLast
                    'rcDoor.MoveFirst
                    If rcDoor.RecordCount > 0 Then
                        rcDoor.MoveFirst
                        Do While Not rcDoor.EOF
                            Set nodDoor = treUserMap.Nodes.Add(nodUnit, tvwChild, "Door" & DoorKey, Trim(rcDoor!Door) & "号", 5, 6)
                            nodDoor.Sorted = True
                            DoorKey = DoorKey + 1
                            rcDoor.MoveNext
                        Loop
                    End If
                    UnitKey = UnitKey + 1
                    rcUnit.MoveNext
                Loop
            End If
            BuildKey = BuildKey + 1
            rcBuildID.MoveNext
        Loop
    'Else
        'MsgBox "当前数据库没有用户信息，" + Chr(10) + "请先在系统设置中设置用户信息！", 64, "查询用户数据"
        'Exit Sub
    End If
End Sub

Private Sub fillcmbDevName()
    cmbDevName.Clear
    cmbDevName.AddItem "所有"
    Set rcDevsMap = dbCbb.OpenRecordset("DevsMap", dbOpenDynaset)
    If rcDevsMap.RecordCount > 0 Then
        rcDevsMap.MoveFirst
        Do While Not rcDevsMap.EOF
            If rcDevsMap!collectType <= 1 Then
                cmbDevName.AddItem rcDevsMap!Name
                rcDevsMap.MoveNext
            End If
        Loop
    End If
    cmbDevName.Text = cmbDevName.List(0)
End Sub
Private Sub fillcmbdate()
    Dim rcDate As Recordset
    Dim SQL As String
    SQL = "select distinct format(date,""yyyy-mm-dd"") as sDate "
    SQL = SQL + "from userdata"
    Set rcDate = dbCbb.OpenRecordset(SQL)
    If rcDate.RecordCount > 0 Then
        rcDate.MoveFirst
        Do While Not rcDate.EOF
            cmbDate1.AddItem rcDate!sDate
            cmbDate2.AddItem rcDate!sDate
            rcDate.MoveNext
        Loop
    End If
    cmbDate1.AddItem ""         '添加一个空项,以可选则空日期(即不选)
    cmbDate2.AddItem ""
    rcDate.Close
End Sub

'Private Sub showAll()
'Dim rcData As Recordset

    'frmMainInfo.Enabled = False
    
'CancelBrowse = False

    'grdData2.H