frmnewcase.frm

用vb6.0实现的一个可以通用的企业档案管理系统。

Private Sub cmdModify_Click()
    
    If txtCode.Text = vbNullString Then
        MsgBox "无当前纪录!", vbInformation
        Exit Sub
    End If
    
    OKButton.Visible = True
    CancelButton.Visible = True
    
    cmdAdd.Enabled = False
    cmdDelete.Enabled = False
    txtCode.Enabled = False
    txtCaseName.Enabled = True
    txtPage.Enabled = True
    chkIsRegister.Enabled = True
    
    '使 OK Cancel 按钮不可见
    OKButton.Tag = "Modify"
    OKButton.Visible = True
    CancelButton.Visible = True
    
End Sub

Private Sub Form_Load()

    Dim cw As Long
    Dim i As Integer
    Dim strSQL As String
    
    '设置初始行数和列数
    MSFlexGrid.Cols = InitCols
    MSFlexGrid.Rows = 120
    cw = MSFlexGrid.Width
    cw = cw - 150

    '设置初始列宽
    For i = 0 To InitCols - 1
        MSFlexGrid.ColWidth(i) = cw / InitCols
    Next i
    
    '设置列对齐方式
    For i = 0 To InitCols - 1
        MSFlexGrid.ColAlignment(i) = flexAlignLeftCenter
    Next i
    
    '设置标题
    MSFlexGrid.TextMatrix(0, 0) = "文书编码"
    MSFlexGrid.TextMatrix(0, 1) = "文书名称"
    MSFlexGrid.TextMatrix(0, 2) = "页    数"
    MSFlexGrid.TextMatrix(0, 3) = "是否登记类型"
    
    Set rstCase = New ADODB.Recordset
    
    strSQL = "SELECT * FROM sys_Case ORDER BY Case_Code"
    rstCase.Open strSQL, conCaseMain, adOpenStatic, adLockOptimistic, adCmdText
    
    With rstCase
        If Not .EOF Then .MoveLast
        If Not .BOF Then .MoveFirst
        
        '初始化列表框
        For i = 0 To rstCase.RecordCount - 1
            With MSFlexGrid
                .TextMatrix(i + 1, 0) = rstCase.Fields(0)
                .TextMatrix(i + 1, 1) = rstCase.Fields(1)
                .TextMatrix(i + 1, 2) = rstCase.Fields(2)
                .TextMatrix(i + 1, 3) = rstCase.Fields(3)
            End With
            rstCase.MoveNext
        Next i
    End With
    rstCase.Close
    
    '设置初始值
    CurrentRow = 1
    txtCaseName.Text = MSFlexGrid.TextMatrix(CurrentRow, 1)
    txtCode.Text = MSFlexGrid.TextMatrix(CurrentRow, 0)
    txtPage.Text = MSFlexGrid.TextMatrix(CurrentRow, 2)
    chkIsRegister.Value = Val(MSFlexGrid.TextMatrix(CurrentRow, 3))
    
    OKButton.Visible = False
    CancelButton.Visible = False
    txtCaseName.Enabled = False
    txtCode.Enabled = False
    txtPage.Enabled = False
    chkIsRegister.Enabled = False
    
End Sub


Private Sub MSFlexGrid_Click()

CurrentRow = MSFlexGrid.Row

txtCaseName.Text = MSFlexGrid.TextMatrix(CurrentRow, 1)
txtCode.Text = MSFlexGrid.TextMatrix(CurrentRow, 0)
txtPage.Text = MSFlexGrid.TextMatrix(CurrentRow, 2)
chkIsRegister.Value = Val(MSFlexGrid.TextMatrix(CurrentRow, 3))

End Sub

Private Sub OKButton_Click()

Dim rstCase As ADODB.Recordset
Dim strSQL As String
Dim CurrentRow As Integer

cmdAdd.Enabled = True
cmdModify.Enabled = True
cmdDelete.Enabled = True
    

'保证新纪录不能有空字段
If txtCaseName = vbNullString Then
    MsgBox "文书名称不能为空!", vbInformation
    txtCaseName.SetFocus
    Exit Sub
End If
If txtCode = vbNullString Then
    MsgBox "文书编码不能为空!", vbInformation
    txtCode.SetFocus
    Exit Sub
End If
If Len(Trim(txtCode)) < CaseCodeLength Then
    MsgBox "文书编码必须输满" & CaseCodeLength & "位!", vbInformation
    txtCode.SetFocus
    Exit Sub
End If
If Val(txtPage) = 0 Then
    MsgBox "页数不能为零!", vbInformation
    txtPage.SetFocus
    Exit Sub
End If

'设置MSFlexGrid_Business的当前行
CurrentRow = MSFlexGrid.Row

'检查该纪录在数据库中是否已存在
If OKButton.Tag = "Add" Then
        
    '打开表:Sys_Case
    strSQL = "SELECT * FROM Sys_Case ORDER BY Case_Code"
    Set rstCase = New ADODB.Recordset
    rstCase.Open strSQL, conCaseMain, adOpenStatic, adLockOptimistic, adCmdText
            
    If Not rstCase.BOF Then rstCase.MoveFirst
    rstCase.Find "Case_Code='" & txtCode & "'"
    If Not rstCase.EOF Then
        MsgBox "该编码在数据库中已存在!", vbInformation
        Call CancelButton_Click
        Exit Sub
    End If
    
    '在数据库里编辑当前记录
    rstCase.MoveLast
    rstCase.AddNew
    rstCase!Case_Code = txtCode
    rstCase!Case_Name = txtCaseName
    rstCase!Case_Pages = txtPage
    rstCase!IsRegister = chkIsRegister
    rstCase.Update
                             
    '在 MSFlexGrid 里增加显示行
    rstCase.Requery
    CurrentRow = rstCase.RecordCount + 1
    With MSFlexGrid
        .TextMatrix(CurrentRow, 0) = rstCase!Case_Code
        .TextMatrix(CurrentRow, 1) = rstCase!Case_Name
        .TextMatrix(CurrentRow, 2) = rstCase!Case_Pages
        .TextMatrix(CurrentRow, 3) = rstCase!IsRegister
    End With
End If
        
If OKButton.Tag = "Modify" Then
        
    '打开表:Sys_Case
    strSQL = "SELECT * FROM Sys_Case " & _
            "WHERE Case_Code='" & MSFlexGrid.TextMatrix(CurrentRow, 0) & "'"
    Set rstCase = New ADODB.Recordset
    rstCase.Open strSQL, conCaseMain, adOpenStatic, adLockOptimistic, adCmdText
            
    '在数据库里编辑当前记录
    rstCase!Case_Code = txtCode
    rstCase!Case_Name = txtCaseName
    rstCase!Case_Pages = txtPage
    rstCase!IsRegister = chkIsRegister
    rstCase.Update
    
    '在 MSFlexGrid 里更新显示行
    With MSFlexGrid
        .TextMatrix(CurrentRow, 0) = rstCase!Case_Code
        .TextMatrix(CurrentRow, 1) = rstCase!Case_Name
        .TextMatrix(CurrentRow, 2) = rstCase!Case_Pages
        .TextMatrix(CurrentRow, 3) = rstCase!IsRegister
    End With
    
    '刷新数据库中所有该类型的文书纪录
    ReplaceSameCase MSFlexGrid.TextMatrix(CurrentRow, 0), txtCaseName, txtPage
    
End If
                        
'使添加的当前记录可见
MSFlexGrid.Row = CurrentRow
MSFlexGrid.TopRow = CurrentRow
       
       
'使 txt* 不可编辑
txtCode.Enabled = False
txtCaseName.Enabled = False
txtPage.Enabled = False
chkIsRegister.Enabled = False
        
'使 OK Cancel 按钮不可见
OKButton.Visible = False
CancelButton.Visible = False

rstCase.Close

End Sub

Private Sub txtPage_KeyPress(KeyAscii As Integer)
    If KeyAscii < 48 Or KeyAscii > 57 And KeyAscii <> vbKeyBack Then
        KeyAscii = 0
    End If
End Sub

Public Sub ReplaceSameCase(Case_Code As String, Case_Name As String, Case_Page As Integer)
'************************************************************
'功能: 更新数据库中的文书信息
'调用: OKButton_Click
'************************************************************
On Error GoTo ErrorHandler

Dim strTemp As String
Dim rstCase As ADODB.Recordset

'更新自定义方式表中的相应文书信息
strTemp = "UPDATE Operation_UserDefined_Rules " & _
        "SET Ope_Case_Name='" & Case_Name & "' " & _
        "WHERE Ope_Case_Code='" & Case_Code & "'"
conCaseMain.Execute strTemp

'删除图片表中的多余纪录,这里可能不妥!
conCaseMain.Execute "DELETE FROM sys_Image WHERE Img_Page>'" & Case_Page & "' AND Img_Case_Code='" & Case_Code & "'"

'更新图片表中的文书信息
strTemp = "UPDATE sys_Image " & _
        "SET Img_Case_Name='" & Case_Name & "'"
conCaseMain.Execute strTemp

MsgBox "更新完成!", vbInformation

Exit Sub
ErrorHandler:
    If Err Then
        MsgBox Err.Description, vbCritical
        Err.Clear
    End If
End Sub