Option Public
Option Declare
Use "ErrorHandling"
Private Const ERR_BASE=1024
Const UNPROPER_CHAIN=ERR_BASE+1,CS_UNPROPER_CHAIN={Действие не соответствует типу в цепочке}
Const CS_ERR_UIDOC={не установлен объект NotesUIDocument}
Const CS_QUERYOPEN={QUERYOPEN}
Const CS_CALLER_SB={вызывающая ф-ция д.б.:}
Const ACT_TYPES={}
Private wks As NotesUIWorkspace
Private ses As NotesSession
Private source As NotesUIDocument
Private formObj As FormBase
Private gContinue As Boolean
%REM
Class FormBase
Description: InitObjectsUI нобходимо переопределить
%END REM
Private Class FormBase As ErrorHandler
Private actList List As ActionObject
%REM
Sub New
Description: Comments for Sub
%END REM
Sub New
End Sub
%REM
Function Regiter
Description: Comments for Function
%END REM
Function Register(act As ActionObject) As Boolean
On Error GoTo ErrH
If Not act Is Nothing Then
Dim s As String
s=act.Name
Dim obj As ActionObject
If Not IsElement(actList(s)) Then
Set actList(s)=act
Set obj=act
Else
Set obj=actList(s)
End If
Dim res As ActionObject
Set res=obj.ChainAction(act)
Call obj.Register()
End If
Quit:
Exit Function
ErrH:
Error ERR_BASE, RaiseError
Resume Quit
End Function
%REM
Sub InitObjectsUI
Description: ф-ция для примера, нужно переписывать для своей реализации
%END REM
Function InitObjectsUI(uidoc As NotesUIDocument, xMode As Integer, xIsnewdoc, Xcontinue)
On Error GoTo ErrH
'устанавливаем глобальную переменную (не д.б. Nothing)
Set source=uidoc
Dim act_QO As TemplQueryOpen, _
act_PO As TemplPostOpen, _
act_QS As TemplQuerySave
Set act_QO=New TemplQueryopen()
Set act_PO=New TemplPostOpen()
Set act_QS=New TemplQuerySave()
Call Me.Register(act_QO)
Call Me.Register(act_PO)
Dim tmp As New TemplQueryRecalc()
Call Me.Register(tmp)
Call Me.Register(act_QS)
Call act_QO.Action(uidoc, xMode, xIsnewdoc, Xcontinue)
Quit:
Exit Function
ErrH:
Error ERR_BASE, RaiseError
Resume Quit
End Function
End Class
%REM
Class ActionObject
Description: Comments for Class
%END REM
Class ActionObject As ErrorHandler
Private actName As String
Private actObj As Variant
Private actNext As ActionObject
Private isRegistred As Boolean
Sub New(obj, xName As String)
Me.actName=xName
Set Me.actObj=obj
End Sub
Public Property Get Name As String
Me.Name=actName
End Property
%REM
Property Get Object
Description: Comments for Property Get
%END REM
Public Property Get Object As Variant
Set Me.Object=actObj
End Property
%REM
Function ChainAction
Description: определяет цепочку обработки однотипных событий
%END REM
Public Function ChainAction(nxt As ActionObject) As ActionObject
If nxt Is actNext Or nxt Is Me Then Set ChainAction=actNext:Exit Function
If UCase(actName) <> nxt.Name Then Error UNPROPER_CHAIN,CS_UNPROPER_CHAIN
Set actNext=nxt
Set ChainAction=actNext
End Function
%REM
Sub Register
Description: Comments for Sub
%END REM
Sub Register
End Sub
End Class
%REM
Class FromAction
Description: Comments for Class
%END REM
Class FormAction As ActionObject
Sub New(uidoc As NotesUIDocument, xName As String), ActionObject(uidoc, xName)
If uidoc Is Nothing Then Error ERR_BASE, CS_ERR_UIDOC
Set source=uidoc
End Sub
End Class
%REM
Class ActionPostOpen
Description: Comments for Class
%END REM
Private Class TemplPostOpen As FormAction
Sub New(), FormAction(source, {PostOpen})
' Set source=uidoc
End Sub
Sub Action(uidoc As NotesUIDocument)
Print {Action:} &Me.actName
End Sub
Sub Register
On Error GoTo ErrH
If Not Me.IsRegistred Then
On Event PostOpen From source Call Action
Me.isRegistred=True
End If
Quit:
Exit Sub
ErrH:
Error ERR_BASE, RaiseError
Resume Quit
End Sub
End Class
Private Class TemplQueryopen As FormAction
Sub New(), FormAction(source, {Queryopen})
End Sub
Sub Action(uidoc As NotesUIDocument, xMode As Integer, xIsnewdoc, xContinue)
Print {Action:} &Me.actName
' xcontinue=False
End Sub
Sub Register
On Error GoTo ErrH
If Not Me.IsRegistred Then
On Event QueryOpen From source Call Action
Me.isRegistred=true
End If
Quit:
Exit Sub
ErrH:
Error ERR_BASE, RaiseError
Resume Quit
End Sub
End Class
%REM
Class QuerySave
Description: Comments for Class
%END REM
Private Class TemplQuerySave As FormAction
Sub New(), FormAction(source, {QuerySave})
End Sub
Sub Action(uidoc As NotesUIDocument, xContinue)
Print {Action:} &Me.actName
xContinue=False
End Sub
Sub Register
On Error GoTo ErrH
If Not Me.IsRegistred Then
On Event QuerySave From source Call Action
Me.isRegistred=True
End If
Quit:
Exit Sub
ErrH:
Error ERR_BASE, RaiseError
Resume Quit
End Sub
End Class
%REM
Class TemplQueryRecalc
Description: Comments for Class
%END REM
Private Class TemplQueryRecalc As FormAction
Sub New(), FormAction(source, {QueryRecalc})
End Sub
Sub Action(uidoc As NotesUIDocument, Continue)
Print {Action:} &Me.actName
Continue=False
End Sub
Sub Register
On Error GoTo ErrH
If Not Me.IsRegistred Then
On Event QueryRecalc From source Call Action
Me.isRegistred=True
End If
Quit:
Exit Sub
ErrH:
Error ERR_BASE, RaiseError
Resume Quit
End Sub
End Class
%REM
Class TemplPostSave
Description: Comments for Class
%END REM
Private Class TemplPostSave As FormAction
Sub New(), FormAction(source, {PostSave})
' Set source=uidoc
End Sub
Sub Action(uidoc As NotesUIDocument)
Print {Action:} &Me.actName
End Sub
Sub Register
On Error GoTo ErrH
If Not Me.IsRegistred Then
On Event PostSave From source Call Action
Me.isRegistred=True
End If
Quit:
Exit Sub
ErrH:
Error ERR_BASE, RaiseError
Resume Quit
End Sub
End Class
%REM
Class TemplPostRecalc
Description: Comments for Class
%END REM
Private Class TemplPostRecalc As FormAction
Sub New(), FormAction(source, {PostRecalc})
' Set source=uidoc
End Sub
Sub Action(uidoc As NotesUIDocument)
Print {Action:} &Me.actName
End Sub
Sub Register
On Error GoTo ErrH
If Not Me.IsRegistred Then
On Event PostRecalc From source Call Action
Me.isRegistred=True
End If
Quit:
Exit Sub
ErrH:
Error ERR_BASE, RaiseError
Resume Quit
End Sub
End Class
%REM
Class TemplQueryClose
Description: Comments for Class
%END REM
Private Class TemplQueryClose As FormAction
Sub New(), FormAction(source, {QueryClose})
End Sub
Sub Action(uidoc As NotesUIDocument, xContinue)
Print {Action:} &Me.actName
xContinue=False
End Sub
Sub Register
On Error GoTo ErrH
If Not Me.IsRegistred Then
On Event QueryClose From source Call Action
Me.isRegistred=True
End If
Quit:
Exit Sub
ErrH:
Error ERR_BASE, RaiseError
Resume Quit
End Sub
End Class
Sub Initialize
Set wks=New NotesUIWorkspace
Set ses=New NotesSession
Set formObj=New FormBase
gContinue=True
End Sub
%REM
Sub InitObjects
Description: Comments for Sub
%END REM
Sub InitObjects
On Error GoTo ErrH
Dim formObj As New FormBase
Dim act_QO As New TemplQueryopen()
Dim act_PO As New TemplPostOpen()
Call formObj.Register(act_QO)
Call formObj.Register(act_PO)
Quit:
Exit Sub
ErrH:
Error ERR_BASE, RaiseError()
Resume Quit
End Sub
%REM
Sub InitObjectsUI
Description: вызывать нужно из QueryOpen
%END REM
Sub InitObjectsUI(uidoc As NotesUIDocument, xMode As Integer, xIsnewdoc, Xcontinue)
On Error GoTo ErrH
If CStr(GetThreadInfo(LSI_THREAD_CALLPROC))<> CS_QUERYOPEN Then _
Error ERR_BASE, CS_CALLER_SB &CS_QUERYOPEN
If gContinue Then
Call formObj.InitObjectsUI(Uidoc, Xmode, Xisnewdoc, Xcontinue)
Else
xContinue=gcontinue
End if
Quit:
Exit Sub
ErrH:
gContinue=false
Error ERR_BASE, RaiseError()
Resume Quit
End Sub
)