frmquery.frm

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

    cmdView.Enabled = False
End Sub

Private Sub cmdStart_Click()
    If Not (curBrowLine >= 0 And curBrowCol >= 0) Then
        Exit Sub
    End If
    With timerJPG
    .Enabled = False
    .Interval = Val(txtSpeed) * 1000
    .Enabled = True
    End With
    cmdTranslate.Enabled = False
    cmdModify.Enabled = False
    cmdPause.Enabled = True
    cmdStart.Enabled = False
    cmdReStart.Enabled = False
    cmdView.Enabled = False
End Sub

Private Sub cmdTranslate_Click()
Dim temVal As Long
Dim sDevaddr As String
Dim nStart As Integer

    nStart = InStr(1, curJPGFile, "_")
    sDevaddr = Mid(curJPGFile, nStart + 1, 10)
    temVal = Recognize(curJPGFile, sDevaddr)
    txtJPG.Text = temVal
End Sub

Private Sub cmdView_Click()
Dim curViewDevData As Long
Dim userName As String
Dim userDoor As String
Dim DevName As String

    curBrowUserID = Val(txtStartUser)
    curBrowDevType = Val(txtStartDev)
    For i = 1 To lvwData1.ListItems.Count
        If Val(lvwData1.ListItems(i).Text) = curBrowUserID Then
            curBrowLine = i
            curBrowCol = curBrowDevType + 2
            curViewDevData = Val(lvwData1.ListItems(curBrowLine).SubItems(curBrowCol))
            Exit For
        End If
    Next i
    txtJPG.Text = curViewDevData
    fraJPG.Caption = "数据图像"
    If curBrowUserID <> -1 And curBrowDevType <> -1 And curViewData <> -1 Then
        userDoor = Trim(lvwData1.ListItems(curBrowLine).SubItems(1))
        userName = Trim(lvwData1.ListItems(curBrowLine).SubItems(2))
        DevName = Trim(lvwData1.ColumnHeaders(curBrowCol + 1).Text)
        fraJPG.Caption = "数据图像  <用户" & "[" & curBrowUserID & "]-门牌[" & userDoor & "]－" & DevName & "[" & curBrowDevType & "]>"
        
        curJPGDir = Format(DateLater, "yyyymmdd")
        sDevaddr = "0000000000"
        rcBrowUserDev.FindFirst "UserID=" & curBrowUserID & " and devType=" & curBrowDevType
        If Not rcBrowUserDev.NoMatch Then
            curBrowDevID = rcBrowUserDev!devID
            sDevaddr = Format(rcBrowUserDev!CardTermID, "00000000") & Format(rcBrowUserDev!CardUserID, "00")
        End If
        curJPGFile = App.Path & "\data\" & curJPGDir & "\" & curBrowUserID & "-" & curBrowDevID & "_" & sDevaddr & ".jpg"
        If Dir(curJPGFile, vbNormal) <> "" Then
            imgJPG.Picture = LoadPicture(curJPGFile)
        Else
            imgJPG.Picture = LoadPicture()
        End If
    End If
End Sub

Private Sub Form_Resize()
On Error Resume Next
treUserMap.Height = Me.Height - 1500
tabData.Width = Me.Width - 2320
tabData.Height = Me.Height - 1400
Picture1.Height = tabData.Height - 440
Picture1.Width = tabData.Width - 160
fraJPG.Width = tabData.Width - fraSet.Width - 540
fraJPG.Height = tabData.Height - 500
Frame1.Left = fraJPG.Width + 2360
Frame1.Height = fraJPG.Height
fraSet.Height = Frame1.Height - 2420
cmdView.Top = fraSet.Height - 520
End Sub

Private Sub lvwData1_DblClick()
    If Not gJPGShow Then
        gShowJPGFrom = 1
        frmJPG.Show
    End If
End Sub

Private Sub lvwData1_ItemClick(ByVal Item As MSComctlLib.ListItem)
    If Not gJPGShow Then
        gShowJPGFrom = 1
        frmJPG.Show
    End If
End Sub

Private Sub lvwData2_DblClick()
    If Not gJPGShow Then
        gShowJPGFrom = 2
        frmJPG.Show
    End If
End Sub

Private Sub lvwData2_ItemClick(ByVal Item As MSComctlLib.ListItem)
    If Not gJPGShow Then
        gShowJPGFrom = 2
        frmJPG.Show
    End If
End Sub








Private Sub Picture1_Resize()
On Error Resume Next
lvwData1.Width = Picture1.Width - 20
lvwData1.Height = Picture1.Height
lvwData2.Width = Picture1.Width - 20
lvwData2.Height = Picture1.Height
lvwUsed.Width = Picture1.Width - 20
lvwUsed.Height = Picture1.Height
lvwWaste.Width = Picture1.Width - 20
lvwWaste.Height = Picture1.Height
lvwFee.Width = Picture1.Width - 20
lvwFee.Height = Picture1.Height
End Sub

Private Sub tabData_Click()
Select Case tabData.SelectedItem.Index
Case 1
fraJPG.Visible = False
Frame1.Visible = False
Picture1.Visible = True
lvwData1.Visible = True
lvwData2.Visible = False
lvwUsed.Visible = False
lvwWaste.Visible = False
lvwFee.Visible = False
Case 2
fraJPG.Visible = False
Frame1.Visible = False
Picture1.Visible = True
lvwData1.Visible = False
lvwData2.Visible = True
lvwUsed.Visible = False
lvwWaste.Visible = False
lvwFee.Visible = False
Case 3
fraJPG.Visible = False
Frame1.Visible = False
Picture1.Visible = True
lvwData1.Visible = False
lvwData2.Visible = False
lvwUsed.Visible = True
lvwWaste.Visible = False
lvwFee.Visible = False
Case 4
fraJPG.Visible = False
Frame1.Visible = False
Picture1.Visible = True
lvwData1.Visible = False
lvwData2.Visible = False
lvwUsed.Visible = False
lvwWaste.Visible = True
lvwFee.Visible = False
Case 5
fraJPG.Visible = False
Frame1.Visible = False
Picture1.Visible = True
lvwData1.Visible = False
lvwData2.Visible = False
lvwUsed.Visible = False
lvwWaste.Visible = False
lvwFee.Visible = True
Case 6
Picture1.Visible = False
fraJPG.Visible = True
Frame1.Visible = True
End Select
End Sub

Private Sub timerJPG_Timer()
Dim curDate As String
Dim curDevData As Long
Dim curBrowUserName As String
Dim curBrowUserDoor As String
Dim curBrowDevName As String

    txtJPG.Text = ""
    curBrowCol = curBrowCol + 1
    findNextDevData curBrowLine, curBrowCol, curBrowUserID, curBrowDevType, curBrowDevID, curDevData, curBrowUserName, curBrowDevName, curBrowUserDoor
    fraJPG.Caption = "数据图像"
    If curBrowUserID <> -1 And curBrowDevID <> -1 And curDevData <> -1 Then
        txtJPG.Text = curDevData
        fraJPG.Caption = "数据图像 <用户号" & "[" & curBrowUserID & "]-门牌[" & curBrowUserDoor & "]－" & curBrowDevName & "[" & curBrowDevID & "]>"
        curJPGDir = Format(DateLater, "yyyymmdd")
        rcBrowUserDev.FindFirst "UserID=" & curBrowUserID & " and devType=" & curBrowDevType
        sDevaddr = "0000000000"
        If Not rcBrowUserMap.NoMatch Then
            sDevaddr = Format(rcBrowUserDev!CardTermID, "00000000") & Format(rcBrowUserDev!CardUserID, "00")
        End If
        curJPGFile = App.Path & "\data\" & curJPGDir & "\" & curBrowUserID & "-" & curBrowDevID & "_" & sDevaddr & ".jpg"
        If Dir(curJPGFile, vbNormal) <> "" Then
            imgJPG.Picture = LoadPicture(curJPGFile)
        Else
            imgJPG.Picture = LoadPicture()
        End If
    Else
        timerJPG.Enabled = False
        timerJPG.Interval = 0
        cmdTranslate.Enabled = True
        cmdModify.Enabled = True
        cmdPause.Enabled = False
        cmdStart.Enabled = True
        cmdReStart.Enabled = True
        cmdView.Enabled = True
        imgJPG.Picture = LoadPicture()
    
        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
    End If
End Sub

Private Sub tlbQuery_ButtonClick(ByVal Button As MSComctlLib.Button)
    Select Case Button.Index
        Case 1
            PrePrint
        Case 2
            ImmPrint
        Case 3
            Unload Me
    End Select
        
End Sub

Private Sub treUserMap_DblClick()
'On Error GoTo ProcError
    Dim KeyBuildID As String
    Dim txtBuildID As String
    Dim KeyUnit As String
    Dim txtUnit As String
    Dim KeyDoor As String
    Dim txtDoor As String

    lvwData2.ListItems.Clear
    lvwData2.ColumnHeaders.Clear
    lvwData1.ListItems.Clear
    lvwData1.ColumnHeaders.Clear
    lvwUsed.ListItems.Clear
    lvwUsed.ColumnHeaders.Clear
    lvwWaste.ListItems.Clear
    lvwWaste.ColumnHeaders.Clear
    lvwFee.ListItems.Clear
    lvwFee.ColumnHeaders.Clear
    
    prgQuery.Value = 0
    DevName = cmbDevName.Text
    DevIDQ = Trim(cmbDevName.ListIndex)
    
    If Not IsDate(cmbDate1.List(cmbDate1.ListIndex)) And Not IsDate(cmbDate2.List(cmbDate2.ListIndex)) Then
        Exit Sub
    End If
    If IsDate(cmbDate1.List(cmbDate1.ListIndex)) Then
        QDate1 = CDate(cmbDate1.List(cmbDate1.ListIndex))
    Else
        QDate1 = 0
    End If
    If IsDate(cmbDate2.List(cmbDate2.ListIndex)) Then
        QDate2 = CDate(cmbDate2.List(cmbDate2.ListIndex))
    Else
        QDate2 = 0
    End If
    If QDate1 = 0 And QDate2 = 0 Then
        MsgBox "没有指定有效的数据日期", , "查询用户数据"
        Exit Sub
    End If
    DateLater = IIf(QDate1 >= QDate2, QDate1, QDate2)
    DateFormer = IIf(QDate1 = QDate2, 0, IIf(QDate1 < QDate2, QDate1, QDate2))
    Select Case chkAll.Value
        Case 0
            If Left$(treUserMap.SelectedItem.Key, 5) = "Build" Then
                KeyBuildID = Trim(treUserMap.SelectedItem.Key)
                txtBuildID = treUserMap.Nodes(KeyBuildID).Text
                txtBuildID = Left$(txtBuildID, Len(txtBuildID) - 1)
                SQL = "select * from UserMap "
                SQL = SQL + "where BuildID=""" & txtBuildID & """ and trim(userName)<>""总表"""
            
            ElseIf Left$(treUserMap.SelectedItem.Key, 4) = "Unit" Then
                KeyUnit = Trim(treUserMap.SelectedItem.Key)
                txtBuildID = treUserMap.Nodes(KeyUnit).Parent.Text
                txtBuildID = Left$(txtBuildID, Len(txtBuildID) - 1)
                txtUnit = treUserMap.Nodes(KeyUnit).Text
                txtUnit = Left$(txtUnit, Len(txtUnit) - 2)
                SQL = "select * from UserMap "
                SQL = SQL + "where BuildID=""" & txtBuildID & """ and Unit=""" & txtUnit & """and trim(userName)<>""总表"""
           
            ElseIf Left$(treUserMap.SelectedItem.Key, 4) = "Door" Then
                KeyDoor = Trim(treUserMap.SelectedItem.Key)
                txtDoor = treUserMap.Nodes(KeyDoor).Text
                txtDoor = Left$(txtDoor, Len(txtDoor) - 1)
                txtUnit = treUserMap.Nodes(KeyDoor).Parent.Text
                txtUnit = Left$(txtUnit, Len(txtUnit) - 2)
                txtBuildID = treUserMap.Nodes(KeyDoor).Parent.Parent.Text
                txtBuildID = Left$(txtBuildID, Len(txtBuildID) - 1)
                SQL = "select * from UserMap "
                SQL = SQL + "where BuildID=""" & txtBuildID & """ and Unit=""" & txtUnit & """ and Door=""" & txtDoor & """"
            Else
                Exit Sub
            End If
            '生成待查用户信息表rcQUser
            SQL = SQL + " order by BuildID ASC,Unit ASC,Floor ASC,Door ASC,UserID ASC "
            Set rcQUser = dbCbb.OpenRecordset(SQL)
            QData = "UserData"
        Case 1
            QAll = True
            SQL = "select * from userMap where trim(userName)<>""总表"" "
            SQL = SQL + " order by BuildID ASC,Unit ASC,Floor ASC,Door ASC,UserID ASC "
            Set rcQUser = dbCbb.OpenRecordset(SQL)
            QData = "UserData"
        Case 2
            Exit Sub
    End Select
    prePaint
    FilllvwData1
    If DateFormer <> 0 Then
        FilllvwData2
    End If
    FilllvwUsed
    FilllvwWaste
    FilllvwFee
    fillUserRpt
    
    timerJPG.Enabled = False
    cmdReStart.Enabled = True
    cmdStart.Enabled = True
    cmdPause.Enabled = False
    cmdTranslate.Enabled = True
    cmdModify.Enabled = True
    cmdView.Enabled = True
    
    Exit Sub
ProcError:
    ProcErr
End Sub

Sub FilllvwData2()
Dim AreaLvwData2 As RECT
Dim curDevType As Integer
Dim rcData As Recordset
Dim rcUserDev As Recordset
Dim rcDevsMap As Recordset
Dim curUserID As Integer