frmserver.frm

基于VC++串口编程。经过好长时间的寻找

      End
   End
   Begin VB.Menu mnuHelp 
      Caption         =   "[&H]帮助"
      Begin VB.Menu mnuHelpS 
         Caption         =   "[&S]使用说明..."
      End
      Begin VB.Menu mnuSpac3 
         Caption         =   "-"
      End
      Begin VB.Menu mnuAbout 
         Caption         =   "[&A]关于SEP..."
      End
   End
End
Attribute VB_Name = "frmServer"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Public bPassWordOk As Boolean

Private Sub Form_Load()
        
    '初始化数据/库
    Call InitMdb
    '初始化列表
    Call InitLst
    '刷新工具条按钮状态
    Call RetBarState
    
'    Load frmPrint
    Load frmComServer
    
End Sub

Private Sub Form_Unload(Cancel As Integer)
Dim an As Integer

    an = MsgBox("确认退出本系统吗？", vbQuestion + vbYesNo)
    If an = vbNo Then
        Cancel = True
    Else
        Me.Hide
        If frmComServer.cmdGetData.Enabled = False Then
            frmWait.Show
            DoEvents
            Do While frmComServer.cmdGetData.Enabled = False
                DoEvents
            Loop
        End If
        Unload frmComServer
'        Unload frmPrint
        '关闭数据库
        Call CloseMdb
        End
    End If
End Sub

Private Sub Form_Resize()
    
    If Me.WindowState = vbMinimized Then
        Exit Sub
    End If
    
    labRecToHandle.Left = 1 * Screen.TwipsPerPixelX
    labRecToHandle.Top = tBar.Height + 2 * Screen.TwipsPerPixelX
    labRecToHandle.Width = 518 * Screen.TwipsPerPixelX
    
    lstViwCapture.Left = 1 * Screen.TwipsPerPixelX
    lstViwCapture.Top = labRecToHandle.Top + labRecToHandle.Height - 1 * Screen.TwipsPerPixelX
    lstViwCapture.Width = labRecToHandle.Width
    lstViwCapture.Height = Me.ScaleHeight - stdBar.Height - lstViwCapture.Top - 2 * Screen.TwipsPerPixelY
    
    Image1.Width = 498 * Screen.TwipsPerPixelX
    Image1.Height = 288 * Screen.TwipsPerPixelY
    Image1.Left = Me.ScaleWidth - Image1.Width - 2 * Screen.TwipsPerPixelX
    Image1.Top = Me.ScaleHeight - stdBar.Height - Image1.Height - 2 * Screen.TwipsPerPixelY
    
    labCapturePicture.Left = Image1.Left + 1 * Screen.TwipsPerPixelX
    labCapturePicture.Top = Image1.Top - labCapturePicture.Height '- 1 * Screen.TwipsPerPixelY
    labCapturePicture.Width = Image1.Width
    
    Line1.X1 = lstViwCapture.Left + lstViwCapture.Width
    Line1.X2 = Me.ScaleWidth
    Line1.Y1 = labCapturePicture.Top - 8 * Screen.TwipsPerPixelY
    Line1.Y2 = Line1.Y1
    
    Line2.X1 = Line1.X1
    Line2.X2 = Line1.X2
    Line2.Y1 = Line1.Y1 + 2 * Screen.TwipsPerPixelY
    Line2.Y2 = Line2.Y1
    
    lstViwClients.Left = Image1.Left
    lstViwClients.Top = lstViwCapture.Top
    lstViwClients.Width = Image1.Width
    lstViwClients.Height = lstViwCapture.Height - Image1.Height - 34 * Screen.TwipsPerPixelY
    
    labClients.Left = Image1.Left + 1 * Screen.TwipsPerPixelX
    labClients.Top = labRecToHandle.Top
    labClients.Width = Image1.Width
End Sub

Private Sub lstViwCapture_ItemClick(ByVal Item As MSComctlLib.ListItem)
    On Error Resume Next
    Image1.Picture = LoadPicture(GetAppPath & "Jpg\" & Item.SubItems(4))
    Set lstViwCapture.SelectedItem = Item
End Sub

Private Sub mnuAbout_Click()
    frmAbout.Show vbModal
End Sub

Private Sub mnuClientSet_Click()
    frmPassWord.Show vbModal
    If frmServer.bPassWordOk = True Then
        frmClientSet.Show vbModal
        Call GetClientSettings
        Call frmComServer.GetClientsSetting
    End If
End Sub

Private Sub mnuDelete_Click()
    frmPassWord.Show vbModal
    If frmServer.bPassWordOk = True Then
        frmDelete.Show vbModal
        If g_bDeleted = True Then
            Call GetRecToHandle
            Call RetBarState
        End If
    End If
End Sub

Private Sub mnuExit_Click()
    Unload Me
End Sub

Private Sub mnuGetData_Click()
    frmPassWord.Show vbModal
    If frmServer.bPassWordOk = True Then
        frmComServer.Show
    End If
End Sub

Private Sub mnuIntervalSet_Click()
    frmSetInterval.Show vbModal
End Sub

Private Sub mnuQuery_Click()
    frmSearch.Show vbModal
End Sub

Private Sub mnuSetPassWord_Click()
    frmPassWord.Show vbModal
    If frmServer.bPassWordOk = True Then
        frmSetPassWord.Show vbModal
    End If
End Sub

Private Sub tBar_ButtonClick(ByVal Button As MSComctlLib.Button)
Dim nYesNo As Integer, Ret As Long
Dim rs As Recordset, sFile As String

    Select Case UCase(Button.Key)
        Case "EXIT"
            Call mnuExit_Click
            
        Case "DELETE"   '删除不做处理的记录
            nYesNo = MsgBox("删除后将无法再恢复，确认删除吗？", vbYesNo + vbQuestion, "删除报警记录")
            If nYesNo = vbYes Then
                '数据库中删除相应记录
                Set rs = g_myDB.OpenRecordset("Select * from tabCaptureRec where fldID = " & Format(lstViwCapture.SelectedItem.Tag))
                If Not rs.EOF Then
                    sFile = GetAppPath & "Jpg\" & rs!fldJpgFile
                    Kill sFile
                    rs.Delete
                End If
                rs.Close
                     
                Call RemoveItem
            End If
            
        Case "MODI", "PRINT"
            g_bPrinted = False
            g_lCurRecID = lstViwCapture.SelectedItem.Tag
            frmModi.Show vbModal
            If g_bPrinted = True Then
                MsgBox "您已经打印了当前记录。" & vbCrLf & "该记录将从列表中删除，" & vbCrLf & "您可以通过查询功能从数" & vbCrLf & "据库中调出查看此条记录。"
                Call RemoveItem
            End If
        
        Case "FIND"
            frmSearch.Show vbModal
            
        Case "HELP"
            Ret = OSWinHelp(Me.hWnd, App.HelpFile, 0, 0)
        Case Else
    End Select
End Sub

Private Sub timDateTime_Timer()
    stdBar.Panels(2).Text = Format(Date, "Long Date")
    stdBar.Panels(3).Text = Format(Time, "Long Time")
End Sub

'初始化报警记录列表，并加载未打印过的记录
Private Sub InitLst()
Dim itemX As ListItem, i As Integer
Dim rs As Recordset

    lstViwCapture.View = lvwReport
    lstViwCapture.ColumnHeaders.Add , , "No", 360
    lstViwCapture.ColumnHeaders.Add , , "      记录来源", 2200
    lstViwCapture.ColumnHeaders.Add , , "行驶方向", 1050
    lstViwCapture.ColumnHeaders.Add , , "拍照时间", 2530
    lstViwCapture.ColumnHeaders.Add , , "图片名称", 0
    For i = 3 To lstViwCapture.ColumnHeaders.Count
        lstViwCapture.ColumnHeaders(i).Alignment = lvwColumnCenter
    Next i
    
'加载待处记录
    Call GetRecToHandle

    lstViwClients.View = lvwReport
    lstViwClients.ColumnHeaders.Add , , "状态", 650
    lstViwClients.ColumnHeaders.Add , , "      岗亭名称", 2550
    lstViwClients.ColumnHeaders.Add , , "网 络", 900
    lstViwClients.ColumnHeaders.Add , , "视频A", 900
    lstViwClients.ColumnHeaders.Add , , "视频B", 900
    For i = 3 To lstViwCapture.ColumnHeaders.Count
        lstViwClients.ColumnHeaders(i).Alignment = lvwColumnCenter
    Next i

'加载监视
    Call GetClientSettings
End Sub

'从列表中删除当前列表项
Private Sub RemoveItem()
Dim itemIndex As Integer

    itemIndex = lstViwCapture.SelectedItem.Index
    lstViwCapture.ListItems.Remove itemIndex
    If itemIndex > lstViwCapture.ListItems.Count Then
        itemIndex = lstViwCapture.ListItems.Count
    End If
    If itemIndex > 0 Then
        Call lstViwCapture_ItemClick(lstViwCapture.ListItems(itemIndex))
    End If
    Call RetBarState
End Sub

'刷新工具钮状态
Private Sub RetBarState()
    If lstViwCapture.ListItems.Count > 0 Then
        tBar.Buttons("DELETE").Enabled = True
        tBar.Buttons("MODI").Enabled = True
        tBar.Buttons("PRINT").Enabled = True
    Else
        tBar.Buttons("DELETE").Enabled = False
        tBar.Buttons("MODI").Enabled = False
        tBar.Buttons("PRINT").Enabled = False
    End If
    stdBar.Panels(1).Text = "当前记录数：" & Format(lstViwCapture.ListItems.Count)
End Sub

'初始化数据库
'打开数据库
'获得新纪录编号和打印开始编号
Private Sub InitMdb()
Dim rs As Recordset
    
    Set g_myDB = OpenDatabase(GetAppPath & "dbCaptureServer.mdb", False, False, ";PWD=111111")
    
    Set rs = g_myDB.OpenRecordset("Select max(fldID) as maxID from tabCaptureRec", dbOpenSnapshot)
    If IsNull(rs!maxID) = False Then
        g_nNewRecID = rs!maxID
    Else
        g_nNewRecID = 0
    End If
    rs.Close

    Set rs = g_myDB.OpenRecordset("Select max(fldPrintID) as maxPrintID from tabCaptureRec", dbOpenSnapshot)
    If IsNull(rs!maxPrintID) = False And rs!maxPrintID > 0 Then
        g_nNewPrintID = rs!maxPrintID
    End If
    rs.Close
End Sub

'关闭数据库
Private Sub CloseMdb()
    g_myDB.Close
End Sub

'获取待处记录
Private Sub GetRecToHandle()
Dim itemX As ListItem
Dim sSql As String, rs As Recordset
    
    lstViwCapture.ListItems.Clear
    sSql = "Select * from tabCaptureRec where fldPrinted = False"
    Set rs = g_myDB.OpenRecordset(sSql, dbOpenSnapshot)
    Do While Not rs.EOF
        Set itemX = lstViwCapture.ListItems.Add(, , Format(lstViwCapture.ListItems.Count + 1))
        itemX.SubItems(1) = rs!fldPostName
        itemX.SubItems(2) = rs!fldDirection
        itemX.SubItems(3) = Format(rs!fldCapDate, "Long Date") & Format(rs!fldCapTime, "Long Time")
        itemX.SubItems(4) = rs!fldJpgFile
        itemX.Tag = rs!fldID
        itemX.EnsureVisible
        Call lstViwCapture_ItemClick(itemX)
        rs.MoveNext
    Loop
    rs.Close
End Sub

'客户状态监视
Private Sub GetClientSettings()
Dim rs As Recordset
Dim itemX As ListItem
        
    lstViwClients.ListItems.Clear
    Set rs = g_myDB.OpenRecordset("Select * from tabPostSettings where fldWork = True", dbOpenSnapshot)
    Do While Not rs.EOF
        Set itemX = lstViwClients.ListItems.Add(, , "", 1, 1)
        itemX.SubItems(1) = rs!fldPostName
        itemX.SubItems(2) = "正常"
        itemX.SubItems(3) = "正常"
        itemX.SubItems(4) = "正常"
        rs.MoveNext
    Loop
    rs.Close
End Sub