frmrightgroup.frm

智能邮件管理信息系统

        If SaveCard Then                                                       
            InitCard                                                           
            txtGroup.SetFocus                                                  
        End If                                                                 
        Exit Sub                                                               
    End If                                                                     
    Unload Me                                                                  
End Sub                                                                        
                                                                               
Private Sub Form_Activate()                                                    
    txtGroup.SetFocus                                                          
End Sub                                                                        
                                                                               
Private Sub Form_KeyPress(KeyAscii As Integer)                                 
    If mblnIsList Then                                                         
        mblnIsList = False                                                     
        Exit Sub                                                               
    End If                                                                     
    If KeyAscii = vbKeyReturn Then                                             
        BKKEY Me.ActiveControl.hwnd, vbKeyTab                                  
    End If                                                                     
End Sub                                                                        
                                                                               
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)                   
    If KeyCode = vbKeyReturn And Shift = 2 Then                                
        cmdOK(0).Value = True                                                  
    End If                                                                     
End Sub                                                                        
                                                                               
Private Sub Form_Load()                                                        
    Dim edtErrReturn As ErrDealType                                            
                                                                               
    On Error GoTo ErrHandle                                                    
                                                                               
    cmdOK(0).Picture = LoadResPicture(1001, vbResBitmap)                       
    cmdOK(1).Picture = LoadResPicture(1002, vbResBitmap)                       
    cmdOK(2).Picture = LoadResPicture(1009, vbResBitmap)                       
    Me.Icon = LoadResPicture(3004, vbResIcon)                                  
    Exit Sub                                                                   
ErrHandle:                                                                     
End Sub                                                                        
                                                                               
Private Sub Form_Paint()                                                       
    FrameBox Me.hwnd, 120, 120, 3070, 1320                                     
End Sub                                                                        
                                                                               
Private Function SaveCard() As Boolean                                         
    Dim recGroup As rdoResultset, strSQL As String                             
                                                                               
    On Error GoTo ErrHandle                                                    
    gclsDatabase.BeginTrans                                                    
    SaveCard = False                                                           
    If Not mblnIsChanged Then                                                  
        SaveCard = True                                                        
        GoTo ErrHandle                                                         
    End If                                                                     
    If txtGroup.Text = "" Then                                               
        ShowMsg hwnd, "操作员组名不能为空！", vbExclamation, Me.Caption      
        txtGroup.SetFocus                                                      
        GoTo ErrHandle                                                         
    End If                                                                     
    If Not CodeCheck Then                                                      
        If mblnIsNew Then                                                      
            ShowMsg hwnd, "操作员组名不能为重复,请重新录入！", vbExclamation, Caption                          
            txtGroup.SetFocus                                                                                                                  
            txtGroup.SelStart = 0                                                                                                              
            txtGroup.SelLength = Len(txtGroup.Text)                                                                                            
            GoTo ErrHandle                                                                                                                     
        Else                                                                                                                                   
            If ShowMsg(hwnd, "是否将操作员组“" & mstrGroupName & "”与“" & txtGroup.Text _                                               
                & "”进行合并？", vbQuestion + vbYesNo, Caption) = vbNo Then                                                                 
                txtGroup.SetFocus                                                                                                              
                GoTo ErrHandle                                                                                                                 
            Else   '合并编码                                                                                                                   
                If Not DisplaceActivity("Operator", "lngOperatorGroupID", mlngDGroupID, mlngGroupID) Then                                  
                    GoTo ErrHandle                                                                                                             
                End If                                                                                                                         
                strSQL = "DELETE FROM OperatorGroup WHERE lngOperatorGroupID=" & mlngGroupID                                                 
                ExecSQL strSQL                                                                                                                 
            End If                                                                                                                             
        End If                                                                                                                                 
    Else                                                                                                                                       
        If mblnIsNew Then                                                                                                                      
            mlngGroupID = GetNewID("OperatorGroup")                                                                                          
            strSQL = "INSERT INTO OperatorGroup(lngOperatorGroupID,strOperatorGroupName) VALUES(" _                                          
                & mlngGroupID & ",'" & Trim(txtGroup.Text) & "')"                                                                          
            ExecSQL strSQL                                                                                                                     
        Else                                                                                                                                   
            strSQL = "UPDATE OperatorGroup SET strOperatorGroupName='" _                                                                     
                & Trim(txtGroup.Text) & "' WHERE strOperatorGroupName='" _                                                                   
                & mstrGroupName & "'"                                                                                                        
            ExecSQL strSQL                                                                                                                     
        End If                                                                                                                                 
    End If                                                                                                                                     
    gclsDatabase.CommitTrans                                                                                                                   
    mblnIsChanged = False                                                                                                                      
    SaveCard = True                                                                                                                            
    Exit Function                                                                                                                              
ErrHandle:                                                                                                                                     
    gclsDatabase.RollBacktrans                                                                                                                 
End Function                                                                                                                                   
Private Function CodeCheck() As Boolean                                                                                                        
    Dim recGroup As rdoResultset, strSQL As String                                                                                             
                                                                                                                                               
    strSQL = "SELECT * FROM OperatorGroup WHERE strOperatorGroupName='" _                                                                    
        & txtGroup.Text & "' AND lngOperatorGroupID<>" & mlngGroupID                                                                         
    Set recGroup = gclsDatabase.OpenResultset(strSQL, rdOpenStatic)                                                                            
    If Not recGroup.EOF Then                                                                                                                   
        CodeCheck = False                                                                                                                      
        mlngDGroupID = recGroup!lngOperatorGroupID                                                                                             
    Else                                                                                                                                       
        CodeCheck = True                                                                                                                       
    End If                                                                                                                                     
    recGroup.Close                                                                                                                             
End Function                                                                                                                                   
Private Sub InitCard(Optional strGroupName As String = "")                                                                                   
    Dim strSQL As String                                                                                                                       
    Dim recOperatorGp As rdoResultset                                                                                                          
                                                                                                                                               
    mblnIsInit = True                                                                                                                          
    If Not mblnIsNew Then                                                                                                                      
        strSQL = "SELECT strOperatorGroupName FROM OperatorGroup WHERE lngOperatorGroupID=" & mlngGroupID                                    
        Set recOperatorGp = gclsDatabase.OpenResultset(strSQL, rdOpenStatic)                                                                   
        txtGroup.Text = recOperatorGp!strOperatorGroupName                                                                                     
        recOperatorGp.Close                                                                                                                    
        mblnIsChanged = False                                                                                                                  
    Else                                                                                                                                       
        txtGroup.Text = strGroupName                                                                                                           
        mblnIsChanged = True                                                                                                                   
    End If                                                                                                                                     
    mblnIsInit = False                                                                                                                         
End Sub                                                                                                                                        
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)                                                                         
    If UnloadMode <> vbFormControlMenu Then Exit Sub                                                                                           
    If mblnIsChanged Then                                                                                                                      
        If mblnIsNew Then                                                                                                                      
            If ShowMsg(hwnd, "要保存新增的操作员组吗？", vbQuestion + vbYesNo, Caption) = vbYes Then                                         
                Cancel = Not SaveCard                                                                                                          
            End If                                                                                                                             
        Else                                                                                                                                   
            If ShowMsg(hwnd, "要保存对操作员组的修改吗？", vbQuestion + vbYesNo, Caption) = vbYes Then                                       
                Cancel = Not SaveCard                                                                                                          
            End If                                                                                                                             
        End If                                                                                                                                 
    End If                                                                                                                                     
End Sub                                                                                                                                        
Private Sub txtGroup_Change()                                                                                                                  
    If ContainErrorChar(txtGroup.Text) Then BKKEY txtGroup.hwnd                                                                                
    If Not mblnIsInit Then mblnIsChanged = True                                                                                                
End Sub