mdimain.frm

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

    gCurAutoShut = IIf(mnuSet_AutoShut.Checked, 1, 0)
End Sub

Private Sub mnuSet_ComCollect_Click()
    mnuSet_ComCollect.Checked = True
    mnuSet_PCollect.Checked = False
    gCollectType = 1

    PORTC1_VAL = PORTC1_VAL Or &H4    'PC2置高
    temVal = OutBit(PortC_1, PORTC1_VAL)
    '总线一线制
    '修改日期2001.1.15
    'PORTC1_VAL = PORTC1_VAL And &HF7
    'PORTC1_VAL = PORTC1_VAL Or &H8
End Sub

Private Sub mnuSet_LateFee_Click()
    frmLateFeeSet.Show
End Sub

Private Sub mnuSet_MinFee_Click()
Dim temMinFee As String
    temMinFee = InputBox("请输入用户存款余额最低允许值:", "用户最低存款余额设置", gCurMinFee)
    If temMinFee <> "" Then
        If IsNumeric(temMinFee) Then
            gCurMinFee = Val(temMinFee)
        Else
            MsgBox "错误的数据格式,请输入一个有效的数值", vbInformation, "错误"
        End If
    End If
End Sub

Private Sub mnuSet_PCollect_Click()
    mnuSet_ComCollect.Checked = False
    mnuSet_PCollect.Checked = True
    gCollectType = 0
    
    PORTC1_VAL = PORTC1_VAL And &HFB    'PC2置低

    temVal = OutBit(PortC_1, PORTC1_VAL)
    '总线一线制
    '修改日期2001.1.15
    'PORTC1_VAL = PORTC1_VAL And &HF7
    'PORTC1_VAL = PORTC1_VAL Or &H8
End Sub

Private Sub mnuSet_ShutFee_Click()
Dim temShutFee As String
    temShutFee = InputBox("请输入用户关断金额值:", "用户关断金额设置", gCurShutFee)
    If temShutFee <> "" Then
        If IsNumeric(temShutFee) Then
            gCurShutFee = Val(temShutFee)
        Else
            MsgBox "错误的数据格式,请输入一个有效的数值", vbInformation, "错误"
        End If
    End If
End Sub

Private Sub mnuSetAuto_Click()
    frmAutoTimeSet.Show
End Sub

Private Sub mnuSetVide_Click()
    'frmMain.videoMain.DlgVideoProperty
    frmVideoSet.Show 1
End Sub

Private Sub mnuShutAlert_Click()
    mnuOpenAlert.Enabled = True
    mnuShutAlert.Enabled = False
    tlbMain.Buttons.Item(10).Value = tbrUnpressed
    QuitAlert = 1
    loadAlertPanel
    Unload frmCurAlert
End Sub

Private Sub mnuSuper_Click()
    OPThen = 2
    frmAskWho.Show 1
End Sub

Private Sub mnuSysHelp_Click()
    Dim hHandle1 As Long
    Dim hHandle2 As Long
    Dim HelpFile As String
    Dim word As Object
    Dim lLength As Long
    HelpFile = App.Path & "\" & "Help.doc"
    lLength = FileLen(HelpFile)
    If lLength = 0 Then
        MsgBox "帮助文件不存在，请重新安装！"
        Exit Sub
    End If
    Screen.MousePointer = vbHourglass
    Set word = CreateObject("word.basic")
    hHandle1 = findwindow(0&, "microsoft word")
    hHandle2 = ShowWindow(hHandle1, 0)
    word.fileopen HelpFile
    Screen.MousePointer = vbDefault
End Sub

Private Sub mnuUserOperate_Click()
    frmUserOperate.Show
End Sub

Private Sub mnuUserSet_Click()
    If f_frmGetSome_Visible Then
        MsgBox "请先退出'指定用户采集'界面!", 64, "用户设置"
        Exit Sub
    End If
    frmUserMap.Show
End Sub

'Private Sub mnuWaste_Click()
    'frmWaste.Show
'End Sub

Private Sub pnlGas_Click()
'对应curAlert(3,x)
Dim rcUser As Recordset

    If pnlGas.BackColor = RED Then
        pnlGas.BackColor = GREEN
        Load curAlertForm(2)
        curAlertForm(2).Caption = "煤气泄漏报警"
        curAlertForm(2).lblUserID = curAlert(2)
        curAlertForm(2).lblUserName = ""
        curAlertForm(2).lblAddress = ""
        curAlertForm(2).lblDate = Format(curAlertDate(2), "yyyy/m/d")
        curAlertForm(2).lblTime = Format(curAlertTime(2), "h:n:s")
        curAlertForm(2).lblBuild = ""
        curAlertForm(2).lblUnit = ""
        curAlertForm(2).lblFloor = ""
        curAlertForm(2).lblDoor = ""
        curAlertForm(2).lblTel = ""
        
        Set rcUser = dbCbb.OpenRecordset("UserMap", dbOpenSnapshot)
        rcUser.FindFirst "UserID=" + Format(curAlert(2))
        If Not rcUser.NoMatch Then
            curAlertForm(2).lblUserName = rcUser!userName
            curAlertForm(2).lblAddress = rcUser!Address
            curAlertForm(2).lblBuild = rcUser!BuildID
            curAlertForm(2).lblUnit = rcUser!Unit
            curAlertForm(2).lblFloor = rcUser!Floor
            curAlertForm(2).lblDoor = rcUser!Door
            curAlertForm(2).lblTel = rcUser!Tel
        End If
        Set rcUser = Nothing
        
        curEchoAlert = ALERT_GAS
        MuteAlert (curEchoAlert)
        curAlertForm(2).Show 1
    End If
End Sub

Private Sub pnlLife_Click()
'对应curAlert(1,x)
Dim rcUser As Recordset

    If pnlLife.BackColor = RED Then
        pnlLife.BackColor = GREEN
        Load curAlertForm(4)
        curAlertForm(4).Caption = "救护报警"
        curAlertForm(4).lblUserID = curAlert(4)
        curAlertForm(4).lblUserName = ""
        curAlertForm(4).lblAddress = ""
        curAlertForm(4).lblDate = Format(curAlertDate(4), "yyyy/m/d")
        curAlertForm(4).lblTime = Format(curAlertTime(4), "h:n:s")
        curAlertForm(4).lblBuild = ""
        curAlertForm(4).lblUnit = ""
        curAlertForm(4).lblFloor = ""
        curAlertForm(4).lblDoor = ""
        curAlertForm(4).lblTel = ""
        
        Set rcUser = dbCbb.OpenRecordset("UserMap", dbOpenSnapshot)
        rcUser.FindFirst "UserID=" + Format(curAlert(4))
        If Not rcUser.NoMatch Then
            curAlertForm(4).lblUserName = rcUser!userName
            curAlertForm(4).lblAddress = rcUser!Address
            curAlertForm(4).lblBuild = rcUser!BuildID
            curAlertForm(4).lblUnit = rcUser!Unit
            curAlertForm(4).lblFloor = rcUser!Floor
            curAlertForm(4).lblDoor = rcUser!Door
            curAlertForm(4).lblTel = rcUser!Tel
        End If
        
        curEchoAlert = ALERT_LIFE
        MuteAlert (curEchoAlert)
        curAlertForm(4).Show 1
    End If
End Sub



Private Sub pnlRob_Click()
'对应curAlert(2,x)
Dim rcUser As Recordset

    If pnlRob.BackColor = RED Then
        pnlRob.BackColor = GREEN
        Load curAlertForm(3)
        curAlertForm(3).Caption = "防盗报警"
        curAlertForm(3).lblUserID = curAlert(3)
        curAlertForm(3).lblUserName = ""
        curAlertForm(3).lblAddress = ""
        curAlertForm(3).lblDate = Format(curAlertDate(3), "yyyy/m/d")
        curAlertForm(3).lblTime = Format(curAlertTime(3), "h:n:s")
        curAlertForm(3).lblBuild = ""
        curAlertForm(3).lblUnit = ""
        curAlertForm(3).lblFloor = ""
        curAlertForm(3).lblDoor = ""
        curAlertForm(3).lblTel = ""
        
        Set rcUser = dbCbb.OpenRecordset("UserMap", dbOpenSnapshot)
        rcUser.FindFirst "UserID=" + Format(curAlert(3))
        If Not rcUser.NoMatch Then
            curAlertForm(3).lblUserName = rcUser!userName
            curAlertForm(3).lblAddress = rcUser!Address
            curAlertForm(3).lblBuild = rcUser!BuildID
            curAlertForm(3).lblUnit = rcUser!Unit
            curAlertForm(3).lblFloor = rcUser!Floor
            curAlertForm(3).lblDoor = rcUser!Door
            curAlertForm(3).lblTel = rcUser!Tel
        End If
        Set rcUser = Nothing
        
        curEchoAlert = ALERT_ROB
        MuteAlert (curEchoAlert)
        curAlertForm(3).Show 1
    End If
End Sub



Private Sub pnlWater_Click()
'对应curAlert(4,x)
'警型:
'   8---老人救护
'   2---防盗
'   1---煤气泄漏
'   0---盗水,盗气
Dim rcUser As Recordset

    If pnlWater.BackColor = RED Then
        pnlWater.BackColor = GREEN
        Load curAlertForm(1)
        
        curAlertForm(1).Caption = "盗水,气报警"
        curAlertForm(1).lblUserID = curAlert(1)
        curAlertForm(1).lblUserName = ""
        curAlertForm(1).lblAddress = ""
        curAlertForm(1).lblDate = Format(curAlertDate(1), "yyyy/m/d")
        curAlertForm(1).lblTime = Format(curAlertTime(1), "h:n:s")
        curAlertForm(1).lblBuild = ""
        curAlertForm(1).lblUnit = ""
        curAlertForm(1).lblFloor = ""
        curAlertForm(1).lblDoor = ""
        curAlertForm(1).lblTel = ""
        
        Set rcUser = dbCbb.OpenRecordset("UserMap", dbOpenSnapshot)
        rcUser.FindFirst "UserID=" + Format(curAlert(1))
        If Not rcUser.NoMatch Then
            curAlertForm(1).lblUserName = rcUser!userName
            curAlertForm(1).lblAddress = rcUser!Address
            curAlertForm(1).lblBuild = rcUser!BuildID
            curAlertForm(1).lblUnit = rcUser!Unit
            curAlertForm(1).lblFloor = rcUser!Floor
            curAlertForm(1).lblDoor = rcUser!Door
            curAlertForm(1).lblTel = rcUser!Tel
        End If
        Set rcUser = Nothing
        
        curEchoAlert = ALERT_WATER
        MuteAlert (curEchoAlert)
        curAlertForm(1).Show 1
    End If
End Sub

Private Sub tlbMain_ButtonClick(ByVal Button As MSComctlLib.Button)
    Select Case Button.Index
        Case 1
            mnuCollectAll_Click
        Case 2
            mnuCollectSome_Click
        Case 3
            mnuCollect_Handup_Click
        Case 6
            mnuQuery_Click
        Case 8
            If tlbMain.Buttons.Item(8).Value = tbrUnpressed Then
                Unload frmMainInfo
            Else
                mnuBrow_Open_Click
            End If
        Case 10
            If tlbMain.Buttons.Item(10).Value = tbrUnpressed Then
                mnuShutAlert_Click
            Else
                mnuOpenAlert_Click
            End If
    End Select
End Sub

Private Sub Timer1_Timer()
    pubTimerCount1 = pubTimerCount1 + 1
    If pubTimerCount1 = 2147483647 Then
        pubTimerCount1 = 0
    End If
End Sub

Private Sub TimerDelay_Timer()
    pubTimerCountDelay = pubTimerCountDelay + 1
End Sub

Private Sub timerMain_Timer()
Dim curDate As String

    stbMain.Panels(2).Text = Format(Date, "yyyy-mm-dd") + " " + Format(Time, "hh:nn:ss")
    '保证lstStatus中的行数小于最大允许行数MaxLstLine
    If BrowInfo = True Then
        WrapLstStatus
    End If
    '标志当前用自动还是手工采集  TRUE---自动,FALSE---手工
    If Auto_Manual Then
       'AutoTime自动采集时间
       curDate = Trim(Format(Date, "yyyy-mm-d"))
        If Time < AutoTime Or temStrDate <> curDate Then
            fCollected = False
        ElseIf Not fCollected And Not fStillCollecting Then
            fCollected = True
            AutoCollect
        End If
    End If
    If gblnCollecting = False Then
        FreshUserStatus
    End If
End Sub

Private Sub ControlSize()
    PnlBaseW = pnlBase.Width
    PnlBaseL = pnlBase.Left

    PnlLifeW = pnlLife.Width
    PnlLifeL = pnlLife.Left

    PnlRobW = pnlRob.Width
    PnlRobL = pnlRob.Left
 
    PnlGasW = pnlGas.Width
    PnlGasL = pnlGas.Left

    PnlWaterW = pnlWater.Width
    PnlWaterL = pnlWater.Left
 
End Sub

Private Sub MakeFlat()
    Dim style As Long
    Dim hclbMain As Long
    Dim r As Long
    hToolbar = FindWindowEx(clbMain.hwnd, 0&, "ToolbarWindow32", vbNullString)
    style = SendMessageLong(hclbMain, TB_GETSTYLE, 0&, 0&)
    If style And TBSTYLE_FLAT Then
    style = style Xor TBSTYLE_FLAT
    Else: style = style Or TBSTYLE_FLAT
    End If
    r = SendMessageLong(hclbMain, TB_SETSTYLE, 0, style)
    tlbMain.Refresh
End Sub

Private Sub tlbMain_ButtonMenuClick(ByVal ButtonMenu As MSComctlLib.ButtonMenu)
    If ButtonMenu.Parent = "损耗" Then
        Select Case ButtonMenu.Index
            Case 1
                mnuAutoWaste_Click
            Case 2
                mnuManualWaste_Click
        End Select
    End If
End Sub