|
3#
楼主 |
发表于 2012-4-16 09:59:40
|
只看该作者
是不是函数在载入关闭后没有卸载掉,所以多开几次就会导致崩溃。请高手帮忙看看,谢谢!
'--------------------------------------------------------------------------------------------------
'类 名: ADOTransForm
'功 能: 应用于主子窗体(子可以是数据表或连续窗体),实现主子窗体所有数据修改的同步批量保存或取消,
' 可用于 ACCESS 2000 以上版本.
'
'方 法: InitForm 加载窗体和数据
' UndoAll 取消所有数据更改
' SaveAll 保存所有数据更改,成功返回真
'
'属 性: FormDataMode 返回窗体的允许添加属性, 添加:true 修改:false
'
'事 件: BeforeUnload 主窗体卸载前发生,可确定是否保存记录和关闭窗体
' BeforeSaveAll 保存所有数据之前发生,可确定是否允许保存记录
' AfterSaveAll 保存所有数据之后发生
'
'使用注意: 指定给主窗体的记录不要超过1条.
' 将窗体的模式属性设为是,因为启动事务之后会影响其它打开的记录集.
'
'相关说明: 这个类使用了DAO事务.
'
'作 者: t小雨 (tcl013@126.com)
'创建日期: 2009-7-22
'--------------------------------------------------------------------------------------------------
Option Compare Database
Option Explicit
Public Event BeforeUnload(ByVal Dirty As Boolean, Cancel As VbMsgBoxResult) ' 窗体卸载前
Public Event BeforeSaveAll(Cancel As Boolean, Response As Integer) ' 保存前
Public Event AfterSaveAll(ByVal DataMode As Boolean) ' 保存后
Dim WithEvents frmMain As Form ' 主窗体
Dim WithEvents frmChild As Form ' 子窗体
Dim mblDataMode As Boolean ' 数据模式,添加:true 修改:false
Dim mblBeginTrans As Boolean ' 是否已开启事务
Dim mblDataChange As Boolean ' 数据是否已更改
Dim mblChildDel As Boolean ' 用于判断子窗体取消删除
'===========================================================
' 加载窗体和数据
'===========================================================
Public Sub InitForm(Main As Form, MainRcSource As String, Child As SubForm, ChildRcSource As String)
Set frmMain = Main
Set frmChild = Child.Form
With frmMain
.AllowDeletions = False ' 强制主窗体不能删除记录
.AfterInsert = "[Event Procedure]"
.AfterUpdate = "[Event Procedure]"
.OnUnload = "[Event Procedure]"
End With
With frmChild
.AfterUpdate = "[Event Procedure]"
.AfterDelConfirm = "[Event Procedure]"
.OnDelete = "[Event Procedure]"
End With
mblDataMode = (CreateFormRst(frmMain, MainRcSource) = 0)
frmMain.AllowAdditions = mblDataMode
CreateFormRst frmChild, ChildRcSource
DBEngine.BeginTrans ' 开启事务
mblBeginTrans = True
End Sub
'===========================================================
' 主窗体 事件
'===========================================================
Private Sub frmMain_AfterInsert()
frmMain.AllowAdditions = False ' 一次只能添加一条记录
End Sub
Private Sub frmMain_AfterUpdate()
If mblDataChange = False Then mblDataChange = True
End Sub
Private Sub frmMain_Unload(Cancel As Integer)
' 卸载前提示
Dim msg As VbMsgBoxResult
msg = vbNo ' 默认不保存
RaiseEvent BeforeUnload(mblDataChange, msg)
Cancel = (msg = vbCancel)
If mblDataChange Then
If msg = vbNo Then
UndoAll
ElseIf msg <> vbCancel Then
SaveAll
End If
ElseIf mblBeginTrans Then
If msg <> vbCancel Then DBEngine.Rollback
End If
End Sub
'===========================================================
' 子窗体 事件
'===========================================================
Private Sub frmChild_AfterDelConfirm(Status As Integer)
If Status = acDeleteOK Then
If mblDataChange = False Then mblDataChange = True
Else
If mblChildDel Then
' 如删除不成功且是第一次更改窗体数据
mblDataChange = False
mblChildDel = False
End If
End If
End Sub
Private Sub frmChild_AfterUpdate()
If mblDataChange = False Then mblDataChange = True
End Sub
Private Sub frmChild_Delete(Cancel As Integer)
If mblDataChange = False Then
' 第一次更改窗体数据
mblDataChange = True
mblChildDel = True
End If
End Sub
'===========================================================
' 取消所有数据更改
'===========================================================
Public Sub UndoAll()
If mblDataMode Then frmMain.AllowAdditions = True
If frmMain.Dirty Or frmChild.Dirty Then DoCmd.RunCommand acCmdUndo
DBEngine.Rollback
mblBeginTrans = False
mblDataChange = False
End Sub
'===========================================================
' 保存所有数据更改
'===========================================================
Public Function SaveAll() As Boolean
Dim b As Boolean, i As Integer
If frmMain.Dirty Or frmChild.Dirty Then DoCmd.RunCommand acCmdSaveRecord
If mblDataChange Then
RaiseEvent BeforeSaveAll(b, i)
If b Then
If i = 0 Then MsgBox "无法保存数据!", vbExclamation, "系统提示"
Exit Function
End If
DBEngine.CommitTrans
RaiseEvent AfterSaveAll(mblDataMode)
mblDataMode = False
mblDataChange = False
Else
DBEngine.Rollback
End If
mblBeginTrans = False
SaveAll = True
End Function
'===========================================================
' 主窗体数据模式 添加或修改
'===========================================================
Public Property Get FormDataMode() As Boolean
FormDataMode = mblDataMode
End Property
'===========================================================
' 子函数 设置窗体记录集
'===========================================================
Private Function CreateFormRst(frm As Form, RecSource As String) As Integer
Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset(RecSource, dbOpenDynaset)
Set frm.Recordset = rs
CreateFormRst = rs.RecordCount
Set rs = Nothing
End Function
|
|