frmaccountedit.frm

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

    End If
    mbAddNewFlag = True
    If Not (.BOF And .EOF) Then
     .MoveLast
     End If
    
    If LastAccountCode <> "0000" Then
    Dim rs As ADODB.Recordset
'    Set rs = New ADODB.Recordset
    Set rs = adoAccountInfoRS.Clone
    rs.Requery
    rs.MoveLast
    LastAccountCode = rs![FAccountId]
    rs.Close
    Set rs = Nothing
   ' LastAccountCode = String(4 - Len(LastAccountCode), "0") & LastAccountCode
    LastAccountCode = GetNextCode(LastAccountCode)
    Else
    LastAccountCode = "0001"
    End If
    .AddNew "FAccountID", LastAccountCode
    lblStatus.Caption = "添加记录"
    ComboAlarmType.ListIndex = 1
    txtInstallDate.Text = Date   '安装日期文本框
    mbAddNewFlag = False
    .MoveLast
    
  End With

  Exit Sub
AddErr:
  MsgBox Err.Description
End Sub

Private Sub cmdBrowseAccount_Click()
Unload Me
Dim TempForm As Form
For Each TempForm In Forms
If TempForm.Caption = frmBrowseAccount.Caption Then
frmBrowseAccount.DataBrowseAccount.Refresh
frmBrowseAccount.RefushGrid
End If
Next
frmBrowseAccount.Show

End Sub



Private Sub cmdDefault_Click()
Dim strSQLChange As String

Dim cmdchange As ADODB.Command

strSQLChange = "DELETE * From ZOneArea WHERE FAccountId = '" & m_CurAccountCode & "'"
Set cmdchange = New ADODB.Command
Set cmdchange.ActiveConnection = m_gCnAlarm
   cmdchange.CommandText = strSQLChange
   
   Dim errLoop As Error      ' 运行指定的 Command 对象。捕获错误，必要时检查 Errors 集合。
   On Error GoTo Err_Execute
   cmdchange.Execute
   strSQLChange = "INSERT INTO zonearea ( FAccountId, FZoneCode, FZOneDescribe, FsignCode, FsignNAMe, FnoticeNO )" & _
                   " SELECT '" & m_CurAccountCode & "', FZoneCode, FZOneDescribe, FsignCode, FsignNAMe, FnoticeNO From DefaultZone"
   cmdchange.CommandText = strSQLChange
   cmdchange.Execute
   adoZoneInfoRS.Requery
   FillZoneGrid ""
   On Error GoTo 0
   '通过再查询记录集检索当前数据。
   Exit Sub
Err_Execute:
   ' 将任何由执行查询引起的错误通知用户。
'   If Errors.count > 0 Then
'      For Each errLoop In Errors
'         MsgBox "Error number: " & errLoop.Number & vbCr & _
'            errLoop.Description
'      Next errLoop
'   End If
   Resume Next
End Sub

Private Sub cmdDelete_Click()
 On Error GoTo DeleteErr
  With adoZoneInfoRS
    If .EOF Or .BOF Then
    Exit Sub
    End If
    .Delete
    .MoveNext
    If .EOF And .RecordCount > 0 Then
    .MoveLast
    ElseIf .EOF And .RecordCount = 0 Then
    .Requery
    FillZoneGrid ""
    End If
    
    
  End With
  Exit Sub
DeleteErr:
  MsgBox Err.Description
End Sub

Private Sub cmdDeleteAccount_Click()
  On Error GoTo DeleteErr
   Dim cmddeleteSQL As ADODB.Command
   Set cmddeleteSQL = New ADODB.Command
   cmddeleteSQL.ActiveConnection = m_gCnAlarm
  With adoAccountInfoRS
  If .EOF And .BOF Then
    Exit Sub
    End If
    cmddeleteSQL.CommandText = "delete * from ZOnearea where FaccountID = '" & m_CurAccountCode & "'"
    cmddeleteSQL.Execute
    cmddeleteSQL.CommandText = "delete * from noticeman where FaccountID = '" & m_CurAccountCode & "'"
    cmddeleteSQL.Execute
    .Delete
    .MoveNext
    If .EOF And .RecordCount > 0 Then .MoveLast
    If .EOF And .RecordCount = 0 Then .Requery
    
  End With
  Exit Sub
DeleteErr:
  MsgBox Err.Description
End Sub
Private Sub Refushdata()
 '得到当前的用户号,没有时用'0000'代替
 If adoAccountInfoRS.EOF Or adoAccountInfoRS.BOF Then
 m_CurAccountCode = "0000"
 Else
  If Not IsNull(adoAccountInfoRS!FAccountId) Then ' 'not Empty
  m_CurAccountCode = adoAccountInfoRS!FAccountId
  End If
  End If
  '防区信息栏
  adoZoneInfoRS.Close
  Dim strSQl As String
  strSQl = "Select FAccountID,FZOneCode,FZOneDescribe,FsignCode,FsignName,FNoticeNo from ZoneArea  where FAccountID ='" & m_CurAccountCode & "' order by FZoneCode"
  adoZoneInfoRS.Open strSQl, m_gCnAlarm, adOpenStatic, adLockOptimistic
  adoZoneInfoRS.PageSize = 10
  Set zoneGrid.DataSource = adoZoneInfoRS
  FillZoneGrid ""
  '警情通知人表
  
  adoNoticeRs.Close
   Dim strNoticeSQL As String
   strNoticeSQL = "select FAccountID,Fname,ForderNo,FBusiness,Ftelephone,FHometelePhone,FMobileTelephone,Fbp from NoticeMan where FaccountId ='" & m_CurAccountCode & "' and FOrderNo =1 order by Fname "
   adoNoticeRs.Open strNoticeSQL, m_gCnAlarm, adOpenStatic, adLockOptimistic
   adoNoticeRs.PageSize = 10
   Set NoticeGrid.DataSource = adoNoticeRs
   FillNoticeGrid
   '报警器基本信息
    FillAlarmType
   FillAlarmDeviceInfo
End Sub



Private Sub Combo1_Click()
 If Not (adoNoticeRs.EOF Or adoNoticeRs.BOF) Then
  If adoNoticeRs.EditMode = adEditInProgress Then
     adoNoticeRs.Update
  End If
 End If
adoNoticeRs.Close
    Dim strNoticeSQL As String
   strNoticeSQL = "select * from NoticeMan where FaccountId ='" & m_CurAccountCode & "' and FOrderNo =" & Combo1.ListIndex + 1
   adoNoticeRs.Open strNoticeSQL, m_gCnAlarm, adOpenStatic, adLockOptimistic
   Set NoticeGrid.DataSource = adoNoticeRs
   FillNoticeGrid
   'NoticeGrid.SetFocus
End Sub





Private Sub Combo2_DropDown()
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
    rs.CursorLocation = adUseClient
    rs.Open "SELECT DISTINCT AccountInfo.FAccountType FROM AccountInfo", m_gCnAlarm, adOpenStatic, adLockOptimistic
Combo2.Clear
If Not rs.BOF Then
    Do While Not rs.EOF
        If Not IsNull(rs!FAccountType) Then
           Combo2.AddItem rs!FAccountType
        End If
        rs.MoveNext
    Loop
End If
rs.Close
End Sub





Private Sub DTPInstallDate_LostFocus()
txtInstallDate.Text = DTPInstallDate.Value
txtInstallDate.DataChanged = True
End Sub

Private Sub Form_Load()
 ' Load frmBrowseAccount
'm_gCnAlarm
 '打开绑定的记录集
 mbFormLoadComplete = False
 'Set adoAccountInfoRS = frmBrowseAccount.DataBrowseAccount.Recordset
  Set adoAccountInfoRS = New ADODB.Recordset
 adoAccountInfoRS.CursorLocation = adUseClient
 adoAccountInfoRS.Open "select FAccountID,FAccountName,FAccountType,FAddress,FAlarmType, Finstalldate,FManager,FTelephone,FRoadline from AccountInfo order by FAccountID", m_gCnAlarm, adOpenStatic, adLockOptimistic
 If Len(m_CurAccountCode) = 4 Then
  adoAccountInfoRS.Find "FAccountID = '" & m_CurAccountCode & "'"
  End If
  '绑定文本框到数据提供者  基本信息栏
   Dim oText As TextBox
  For Each oText In Me.txtFields
    Set oText.DataSource = adoAccountInfoRS
    
  Next
  
  Set Combo2.DataSource = adoAccountInfoRS
  
   Set ComboAlarmType.DataSource = adoAccountInfoRS
    ComboAlarmType.DataField = "FalarmType"
    
  'Set Me.DTPInstallDate.DataSource = adoAccountInfoRS
  ' DTPInstallDate.DataField = "Installdate"
  Set txtInstallDate.DataSource = adoAccountInfoRS
  txtInstallDate.DataField = "FInstalldate"
  '得到当前的用户号,没有时用'0000'代替
  If Not (adoAccountInfoRS.EOF And adoAccountInfoRS.BOF) Then  'not Empty
  m_CurAccountCode = adoAccountInfoRS!FAccountId
  Else
  m_CurAccountCode = "0000"
  End If
  
  '防区信息栏
  Set adoZoneInfoRS = New ADODB.Recordset
  adoZoneInfoRS.CursorLocation = adUseClient
  Dim strSQl As String
  strSQl = "Select FAccountID,FZOneCode,FZOneDescribe,FsignCode,FsignName,FNoticeNo from ZoneArea  where FAccountID ='" & m_CurAccountCode & "' order by FZoneCode"
  adoZoneInfoRS.Open strSQl, m_gCnAlarm, adOpenStatic, adLockOptimistic
  adoZoneInfoRS.PageSize = 10
  Set zoneGrid.DataSource = adoZoneInfoRS
  FillZoneGrid ""
  
  '警情通知人表
   Set adoNoticeRs = New ADODB.Recordset
   adoNoticeRs.CursorLocation = adUseClient
    Dim strNoticeSQL As String
   strNoticeSQL = "select FAccountID,Fname,ForderNo,FBusiness,Ftelephone,FHometelePhone,FMobileTelephone,Fbp from NoticeMan where FaccountId ='" & m_CurAccountCode & "' and FOrderNo =1 order by Fname "
   adoNoticeRs.Open strNoticeSQL, m_gCnAlarm, adOpenStatic, adLockOptimistic
   adoNoticeRs.PageSize = 10
   Set NoticeGrid.DataSource = adoNoticeRs
   FillNoticeGrid
   
   Dim i As Integer
   For i = 1 To 3
   Combo1.AddItem i
   Next i
   Combo1.ListIndex = 0
   SSTab1.Tab = 0
   FillCobAlarmtype cobAlarmType
   FillAlarmType
   FillAlarmDeviceInfo
  mbDataChanged = False
  mbFormLoadComplete = True
End Sub

Private Sub Form_Unload(Cancel As Integer)
If Not (adoAccountInfoRS.EOF And adoAccountInfoRS.BOF) Then
    adoAccountInfoRS.MoveLast
End If
UpdateRecorset adoZoneInfoRS
UpdateRecorset adoNoticeRs
UpdateRecorset adoAccountInfoRS
adoZoneInfoRS.Close
adoNoticeRs.Close
'adoAccountInfoRS.Close
Screen.MousePointer = vbDefault
End Sub






Private Sub NoticeGrid_BeforeColUpdate(ByVal ColIndex As Integer, OldValue As Variant, Cancel As Integer)
'colindex =1 为通知人姓名
If ColIndex = 1 Then
    Dim strTemp As String
    strTemp = NoticeGrid.Text
    If UCase(strTemp) = UCase(OldValue) Then
        Exit Sub  '新旧一样则不处理
    End If
    Dim rs As ADODB.Recordset
    Set rs = adoNoticeRs.Clone
    rs.Find "FName = '" & strTemp & "'"
    If Not rs.EOF Then
        MsgBox "通知人姓名重复！，请重新输入"
        Cancel = True
    End If
    rs.Close
End If
End Sub

Private Sub NoticeGrid_ColResize(ByVal ColIndex As Integer, Cancel As Integer)
SaveGridColWidth Me.Caption & "Notice", NoticeGrid
End Sub

Private Sub NoticeGrid_Error(ByVal DataError As Integer, Response As Integer)
Response = 0
End Sub



Private Sub NoticeGrid_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
     If NoticeGrid.Col = NoticeGrid.Columns.Count - 1 Then
        SendKeys "{DOWN}"
        SendKeys "{HOME}"
    Else
        SendKeys "{TAB}"
    End If
End If
End Sub

Private Sub NoticeGrid_LostFocus()
 UpdateRecorset adoNoticeRs
End Sub

Private Sub NoticeGrid_RowResize(Cancel As Integer)
SavePrivateSetting Me.Caption & "Notice", "GrdHeight", NoticeGrid.RowHeight
End Sub

Private Sub NoticeManAdd_Click()
Dim NewName As String
 On Error GoTo AddErr
  With adoNoticeRs
'     If Not (.EOF And .BOF) Then
'     '.MoveLast
'     End If
     .AddNew
     !FAccountId = m_CurAccountCode
     !FOrderNo = Combo1.ListIndex + 1
     !FName = "新通知人" & Format(.RecordCount + 1, "00")
     .Update
  End With
 NoticeGrid.SetFocus
  Exit Sub
AddErr:
  MsgBox Err.Description
End Sub

Private Sub NoticemanDelete_Click()
On Error GoTo DeleteErr

  With adoNoticeRs
  If .EOF Or .BOF Then
    Exit Sub
    End If
    .Delete
    .MoveNext
   If .EOF And adoNoticeRs.RecordCount > 0 Then .MoveLast