frmaccountedit.frm

一个为公安系统接警中心控制软件,不错哦.

   
  End With
  NoticeGrid.SetFocus
 
  Exit Sub
DeleteErr:
  MsgBox Err.Description
End Sub

Private Sub SSTab1_Click(PreviousTab As Integer)
Select Case PreviousTab
 Case 1
 Case 2
 Case 3
 Case 4
End Select
Select Case SSTab1.Tab
 Case 0  ' 基本信息
 
 Case 1  ' 防区信息
    m_CurAccountCode = txtFields(0).Text
    If m_CurAccountCode <> "" Then
       FillZoneGrid m_CurAccountCode
    End If
 Case 2  ' 紧急通知表
 Case 3  ' 报警设备信息
End Select
End Sub
Sub FillZoneGrid(AccountCode As String)
   With zoneGrid
    .RowHeight = GetPrivateSetting(Me.Caption & "Zone", "grdheight", 275)
    .Columns(0).Caption = "用户编码"
    .Columns(1).Caption = "防区号"
    .Columns(2).Caption = "防区描述"
    .Columns(3).Caption = "报警类型"
    .Columns(4).Caption = "报警类型描述"
    .Columns(4).Locked = True
    .Columns(5).Caption = "紧急通知表号"
    .Columns(0).Visible = False
    .Columns(0).AllowSizing = False
    Dim widthstr As String
    widthstr = GetPrivateSetting(Me.Caption & "Zone", "grdwidth", "")
    SetColumnWidth widthstr, .Columns(0), 0
    SetColumnWidth widthstr, .Columns(1), 630
    SetColumnWidth widthstr, .Columns(2), 3950
    SetColumnWidth widthstr, .Columns(3), 800
    SetColumnWidth widthstr, .Columns(4), 1275
    SetColumnWidth widthstr, .Columns(5), 1275
   End With
End Sub
Sub FillNoticeGrid()

    With NoticeGrid
    
    .RowHeight = GetPrivateSetting(Me.Caption & "Notice", "grdheight", 275)
    .Columns(0).Caption = "用户编码"
    .Columns(1).Caption = "通知人姓名"
    .Columns(2).Caption = "序号"
    .Columns(3).Caption = "职务"
    .Columns(4).Caption = "单位电话"
    .Columns(5).Caption = "住宅电话"
    .Columns(6).Caption = "手机"
    .Columns(7).Caption = "Bp机"
    
    
    
    
    Dim widthstr As String
    widthstr = GetPrivateSetting(Me.Caption & "notice", "grdwidth", "")
    '0,1185,0,1230,1320,1605,1290
    
    SetColumnWidth widthstr, .Columns(0), 0
    SetColumnWidth widthstr, .Columns(1), 1185
    SetColumnWidth widthstr, .Columns(2), 0
    SetColumnWidth widthstr, .Columns(3), 1000
    SetColumnWidth widthstr, .Columns(4), 1320
    SetColumnWidth widthstr, .Columns(5), 1320
    SetColumnWidth widthstr, .Columns(6), 1605
    SetColumnWidth widthstr, .Columns(7), 1290
    .Columns(0).Visible = False
    .Columns(0).AllowSizing = False
    .Columns(0).Width = 0
    .Columns(2).Visible = False
    .Columns(2).AllowSizing = False
    .Columns(2).Width = 0
   End With
End Sub

Private Sub cmdFirst_Click()
  On Error GoTo GoFirstError

  adoAccountInfoRS.MoveFirst
  mbDataChanged = False

  Exit Sub

GoFirstError:
  MsgBox Err.Description
End Sub

Private Sub cmdLast_Click()
  On Error GoTo GoLastError

  adoAccountInfoRS.MoveLast
  mbDataChanged = False

  Exit Sub

GoLastError:
  MsgBox Err.Description
End Sub

Private Sub cmdNext_Click()
  On Error GoTo GoNextError

  If Not adoAccountInfoRS.EOF Then adoAccountInfoRS.MoveNext
  If adoAccountInfoRS.EOF And adoAccountInfoRS.RecordCount > 0 Then
    Beep
     '已到最后返回
    adoAccountInfoRS.MoveLast
  End If
  '显示当前记录
  mbDataChanged = False

  Exit Sub
GoNextError:
  MsgBox Err.Description
End Sub

Private Sub cmdPrevious_Click()
  On Error GoTo GoPrevError

  If Not adoAccountInfoRS.BOF Then adoAccountInfoRS.MovePrevious
  If adoAccountInfoRS.BOF And adoAccountInfoRS.RecordCount > 0 Then
    Beep
    '已到最后返回
    adoAccountInfoRS.MoveFirst
  End If
  '显示当前记录
  mbDataChanged = False

  Exit Sub

GoPrevError:
  MsgBox Err.Description
End Sub

Private Sub txtInstallDate_Change()
If IsDate(txtInstallDate.Text) Then
  DTPInstallDate.Value = txtInstallDate.Text
Else
  DTPInstallDate.Value = Date
End If
End Sub



Private Sub txtFields_Validate(Index As Integer, Cancel As Boolean)
If Index = 0 Then 'input accountid
    Dim nOldPos As Long
    Dim FindPos As Long
    nOldPos = adoAccountInfoRS.AbsolutePosition
    Dim rs As ADODB.Recordset
    
    Set rs = adoAccountInfoRS.Clone
    rs.Find "FAccountId = '" & txtFields(0).Text & "'"
    
    If Not rs.EOF Then
        FindPos = rs.AbsolutePosition
        If FindPos <> nOldPos Then
            MsgBox "用户编码重复,请输入一个新号!"
            Cancel = True
        End If
    End If
End If
End Sub

Private Sub zoneGrid_ColResize(ByVal ColIndex As Integer, Cancel As Integer)
SaveGridColWidth Me.Caption & "zone", zoneGrid
End Sub

Private Sub zoneGrid_Error(ByVal DataError As Integer, Response As Integer)
If DataError = 6153 Then
MsgBox "防区号重复，请重新输入!"
Response = 0
End If
Response = 0

End Sub

Private Sub zoneGrid_LostFocus()
  UpdateRecorset adoZoneInfoRS
End Sub
Sub UpdateRecorset(rs As ADODB.Recordset)
    On Error GoTo ErrorDealwith
    If rs.EOF Or rs.BOF Then
      Exit Sub
    End If
    'If rs.EditMode = adEditInProgress Then
    
    rs.UpdateBatch adAffectAllChapters
    'End If
    Exit Sub
ErrorDealwith:
     rs.CancelUpdate
 
End Sub


Private Sub zoneGrid_RowResize(Cancel As Integer)
SavePrivateSetting Me.Caption & "zone", "GrdHeight", zoneGrid.RowHeight

End Sub
Private Sub cobAlarmType_LostFocus()
On Error GoTo Err1
    If Me.cobAlarmType.Visible Then
         cobAlarmType.Visible = False
         
         zoneGrid.SetFocus
         zoneGrid.Col = 3
         zoneGrid.Text = Left(cobAlarmType.Text, 3)
         zoneGrid.Col = 4
         zoneGrid.Text = Mid(cobAlarmType.Text, 5)
         zoneGrid.Col = 3
         
         'zoneGrid.SetFocus
         SendKeys "{ENTER}"
    End If
    Exit Sub
Err1:
    MsgBox Err.Description
End Sub
Private Sub cobAlarmType_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
    If Me.cobAlarmType.Visible Then
    cobAlarmType.Visible = False
     zoneGrid.SetFocus
     zoneGrid.Text = Left(cobAlarmType.Text, 3)
     zoneGrid.Col = 4
     zoneGrid.Text = Mid(cobAlarmType.Text, 5)
     zoneGrid.Col = 3
     SendKeys "{ENTER}"
     SendKeys "{RIGHT}"
    
    End If
End If
End Sub

Private Sub zoneGrid_AfterColEdit(ByVal ColIndex As Integer)
'如果是输入报警码，自动添加报警描述
If ColIndex = 3 Then
    Dim sTemp As String
    sTemp = zoneGrid.Text
    If Len(sTemp) <> 3 Then
        MsgBox "报警码有误!"
        Exit Sub
    End If
    sTemp = ComboFindData(cobAlarmType, sTemp)
    If sTemp <> "" Then
        zoneGrid.Col = 4
        zoneGrid.Text = sTemp
    Else
        MsgBox "没有该报警码!,请按空格键选择."
    End If
End If
End Sub

Private Sub zoneGrid_BeforeColUpdate(ByVal ColIndex As Integer, OldValue As Variant, Cancel As Integer)
'如果是输入报警码，自动添加报警描述
If ColIndex = 3 Then
    Dim sTemp As String
    sTemp = zoneGrid.Text
    If Len(sTemp) <> 3 Then
       MsgBox "报警码有误!请按空格键选择"
        Cancel = True
        SendKeys "{LEFT}"
        Exit Sub
    End If
    sTemp = ComboFindData(cobAlarmType, sTemp)
    If sTemp = "" Then
        MsgBox "没有该报警码!,请按空格键选择."
        Cancel = True
        SendKeys "{LEFT}"
    End If
End If
End Sub
Private Sub zoneGrid_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
    If zoneGrid.Col = 5 Then
        SendKeys "{DOWN}"
        SendKeys "{HOME}"
    Else
        SendKeys "{TAB}"
    End If
End If
If KeyAscii = 32 Then
    With zoneGrid
        If .Col = 3 And .Row > -1 Then
            Me.cobAlarmType.Move .Columns(3).Left + .Left, .RowTop(.Row) + .Top, .Columns(3).Width + .Columns(4).Width ', .RowHeight
            Me.cobAlarmType.Visible = True
            cobAlarmType.SetFocus
            SendKeys "%{DOWN}"
        End If
    End With
End If



End Sub
Sub FillAlarmType()
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
rs.Open "select * from alarmtype", m_gCnAlarm, adOpenStatic, adLockOptimistic
If rs.EOF Or rs.BOF Then
Exit Sub
End If
ComboAlarmType.Clear
Do While Not rs.EOF
ComboAlarmType.AddItem rs!FTypeName
rs.MoveNext
Loop
End Sub
Sub FillAlarmDeviceInfo()
Dim strSQl As String
strSQl = "SELECT format(FAlarmDAte,'yyyy年mm月dd日') & FAlarmTime AS FAlarmDateTime, FEventtype From Alarm" & _
" WHERE FaccountId = '" & m_CurAccountCode & "' and (FEventtype = 'A' or FEventtype = 'O' or FEventtype = 'C' or (FEventTYpe='T' and left(FzoneCode,1)='0' ) ) " & _
"ORDER BY FalarmDAte DESC , FalarmTime DESC"
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
rs.Open strSQl, m_gCnAlarm, adOpenStatic, adLockOptimistic
With rs
If Not (.EOF And .BOF) Then
   .Find "FEventType='A'"
        If Not .EOF Then
        txtATime.Text = !FAlarmDateTime
        Else
        txtATime.Text = "尚未收到报警信号" 'Format(DTPInstallDate, "yyyy年mm月dd日") & "00:00:00"
        End If
        
    .MoveFirst
   .Find "FEventType='T'"
        If Not .EOF Then
        txtSelfTest.Text = !FAlarmDateTime
        Else
        txtSelfTest.Text = "尚未收到自检信号" 'Format(DTPInstallDate, "yyyy年mm月dd日") & "00:00:00"
        End If
    .MoveFirst
    Debug.Print .RecordCount
    .Filter = "FEventType= 'C' or FEventType= 'O'"
    .Requery
    Debug.Print .RecordCount
   '.Find "FEventType= 'C'"
        If Not (.EOF And .BOF) Then
         txtOCTime.Text = !FAlarmDateTime
         txtState.Text = IIf(!FEventType = "O", "布防", "撤防")
         Else
         txtOCTime.Text = "尚未收到撤布防信号" 'Format(DTPInstallDate, "yyyy年mm月dd日") & "00:00:00"
         txtState.Text = "未知状态 "
         End If
    .Close
Else
    txtATime.Text = "尚未收到报警信号" ' Format(DTPInstallDate, "yyyy年mm月dd日") & "00:00:00"
    txtOCTime.Text = "尚未收到撤布防信号" 'Format(DTPInstallDate, "yyyy年mm月dd日") & "00:00:00"
    txtState.Text = "未知状态 "
End If
End With
End Sub