запретить ctrl+s

k85 · 19.05.2020

а можно запретить сохранение по ctrl+S в форме, чтобы сохранить можно было только по кнопке ?

garrick · 19.05.2020

Всё, что у вас там в кнопке, перенесите в событие QuerySave формы.

lmike · 19.05.2020

garrick сказал(а):
Всё, что у вас там в кнопке, перенесите в событие QuerySave формы.

ну если подходить глобально - еще надо перехватывать события, а обработчик для перехвата сделать на PostOpen (можно и на QureyOpen, но там нюансы)
я "это" делал через классы, причем еще создавал цепочки обработчиков (чтобы сабформы работали, со своими обработчиками)

k85 · 19.05.2020

по QuerySave ошибка attempt to execute nested form events

а на PostOpen обработчик для перехвата сохранения?

lmike · 19.05.2020

k85 сказал(а):
по QuerySave ошибка attempt to execute nested form events

а на PostOpen обработчик для перехвата сохранения?

угу, в либу вынести, я классы писал для этого
вот базовый класс с примерами наследников (Template...)

Visual Basic:

Option Public
Option Declare
Use "ErrorHandling"
Private Const ERR_BASE=1024
Const UNPROPER_CHAIN=ERR_BASE+1,CS_UNPROPER_CHAIN={Действие не соответствует типу в цепочке}
Const CS_ERR_ASSIGNEVT={ошибка при назначении событий}
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

Dim formObj As FormBase
Private gContinue As Boolean
%REM
    Class QuerySave
    Description: Comments for Class
%END REM
Const QUERYSAVE={QuerySave}
Const PostModeChange={PostModeChange}

%REM
    Class FormBase
    Description: InitObjectsUI нобходимо переопределить
%END REM
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
                Print TypeName(Me) { register obj:}TypeName(obj)
                'registrate only first object for chain
                Call obj.Register()
            Else
                Set obj=actList(s)
                Dim res As ActionObject
                'prevent to chain original object
                If Not obj Is act Then Set res=obj.ChainAction(act)
            End If
        End If
Quit:
        Exit Function
ErrH:
        Error ERR_BASE, RaiseError
        Resume Quit
    End Function
    %REM
        Sub InitObjectsUI
        Description: ф-ция для примера, нужно переписывать для своей реализации
    %END REM
    Function InitObjectsUI(xMode As Integer, xIsnewdoc, Xcontinue)
        On Error GoTo ErrH
        'устанавливаем глобальную переменную (не д.б. Nothing)
        Dim act_QO As FormActionQO
        Set act_QO=AssignEvents()
        If act_QO Is Nothing  Then Error ERR_BASE, CS_ERR_ASSIGNEVT
        Call act_QO.Action(source, xMode, xIsnewdoc, Xcontinue)
Quit:
        Exit Function
ErrH:
        Error ERR_BASE, RaiseError
        Resume Quit
    End Function
    %REM
        Function AssignEvents
        Description: Comments for Function
    %END REM
    Function AssignEvents() As FormActionQO
        On Error GoTo ErrH
        'устанавливаем глобальную переменную (не д.б. Nothing)
        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)
        Set AssignEvents=act_QO
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
        On Error GoTo ErrH
        If nxt Is Nothing Then _
            Print {actNext is Nothing}:Exit Function
        If UCase(Me.actName) <> UCase(nxt.Name) Then _
            Error UNPROPER_CHAIN,CS_UNPROPER_CHAIN &actName &{<>} &nxt.Name
        If nxt Is Me.actNext Or nxt Is Me Then _
            Print {existing action incl to chain}:Set ChainAction=nxt:Exit Function
        If Not actNext Is Nothing Then
            Set ChainAction=actNext.ChainAction(nxt)
        Else   
            Set actNext=nxt
            Set ChainAction=actNext
            Print {next action:} &typeName(actNext)
        End If
Quit:
        Exit Function
ErrH:
        Error ERR_BASE, Me.RaiseError
    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(xName As String), ActionObject(source, xName)
        If source Is Nothing Then Error ERR_BASE, CS_ERR_UIDOC
    End Sub
End Class

%REM
    Class ActionPostOpen
    Description: Comments for Class
%END REM
Private Class TemplPostOpen As FormAction
    Sub New(), FormAction({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

%REM
    Class FormActionQO
    Description: Comments for Class
%END REM
Class FormActionQO As FormAction
    Sub New(), FormAction({Queryopen})
    End Sub

    Sub Action(uidoc As NotesUIDocument, xMode As Integer, xIsnewdoc, xContinue)
    End Sub
    
End Class
Private Class TemplQuerySave As FormAction
    Sub New(), FormAction(QUERYSAVE)
    End Sub
    Sub Action(uidoc As NotesUIDocument, xContinue)
        Print {Action:} &Me.actName
        Dim nxt
        'class casting
        Set nxt=Me.actNext
        If Not nxt Is Nothing Then _
        Call nxt.Action(uidoc,xContinue)
        xContinue=False
    End Sub

    Sub Register
        On Error GoTo ErrH
        Print {register } &TypeName(Me)
        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({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({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({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({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
%REM
    Class SubQuerySave
    Description: Comments for Class
%END REM
Class SubQuerySave As FormAction
    Sub New(), FormAction({QuerySave})
    End Sub
    Sub Action(uidoc As NotesUIDocument, xContinue)
        Print {Sub 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

Private Class TemplQueryopen As FormActionQO
    Sub Action(uidoc As NotesUIDocument, xMode As Integer, xIsnewdoc, xContinue)
        Print {Action:} &Me.actName
        Dim nxt As TemplQueryopen
        'class casting
        Set nxt=Me.actNext
        If Not nxt Is Nothing Then _
        Call nxt.Action(uidoc,xMode,xIsnewdoc,xContinue)
'        Call uidoc.Document.Computewithform(False, False)
'        Print {Form:} &uidoc.Document.Form(0)
'        xcontinue=False
    End Sub

    Sub Register
        On Error GoTo ErrH
        If Me.IsRegistred Then Exit Sub
        On Event QueryOpen From source Call Action
        Me.isRegistred=true
Quit:
        Exit Sub
ErrH:
        Error ERR_BASE, RaiseError
        Resume Quit
    End Sub
End Class
Sub Initialize
    Set ses=New NotesSession
    If Not ses.Isonserver Then Set wks=New NotesUIWorkspace
    Set formObj=New FormBase
    gContinue=True
End Sub

%REM
    Sub InitUIdoc
    Description: Comments for Sub
%END REM
Sub InitUIdoc(uidoc As NotesUIDocument)
    Set source=uidoc
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
    InitUIDoc uidoc
    If gContinue Then
        Call formObj.InitObjectsUI(Xmode, Xisnewdoc, Xcontinue)
    Else
        xContinue=gcontinue
    End if
Quit:
    Exit Sub
ErrH:
    gContinue=false
    Error ERR_BASE, RaiseError()
    Resume Quit
End Sub






%REM
    Sub InitObjects
    Description: Comments for Sub
%END REM
Sub InitObjects(uidoc As NotesUIDocument)
    On Error GoTo ErrH
    Dim formObj As New FormBase
    Print CStr(GetThreadInfo(LSI_THREAD_PROC))
    Set source=uidoc
    Dim act_QO As New TemplQueryopen()
    Dim act_PO As New TemplPostOpen()
    Dim act_QS As New TemplQuerySave()
    Call formObj.Register(act_QO)
    Call formObj.Register(act_PO)
    Call formObj.Register(act_QS)
Quit:
    Exit Sub
ErrH:
    Error ERR_BASE, RaiseError()
    Resume Quit
End Sub

lmike · 19.05.2020

пример на QO (классы наследники, по виду как в шблонах):

Visual Basic:

Sub Queryopen(source As Notesuidocument, Mode As Integer, Isnewdoc As Variant, Continue As Variant)
    Continue=False
    On Error Goto ErrH
    InitUILoan source
    'инициализация PostRecalc
    Dim act_PR As New LoanPRPayment, act_QS As New PaymentQS, act_PS As New  PaymentPS
    Call formObj.Register(act_PR)
    Call formObj.Register(act_QS)
    Call formObj.Register(act_PS)
 
'    Call InitObjectsUILoan(PAYMENT_FRM, Source, Mode, Isnewdoc, Continue)
    Continue=True
Quit:
    Exit Sub
ErrH:
    Error 1024, RaiseError
    Resume Quit
End Sub

весь код событий в форме будет обрабатываться в классах библиотеки, в QO только регистрируем объекты с соответ. обработчиком в ф-ции Action объекта

lmike · 19.05.2020

весь "пирог" сделан с целью ничего не писать в событиях формы, кроме инициализации объектов и регистрации событий

VladSh · 19.05.2020

@lmike
Это с каждой формы и подформы всё вынести в библиотеки? Сколько ж это их получится?

oshmianski · 19.05.2020

Согласен с @Imike.
В свое время (лет 10 назад) вынес все из форм (тоже использую On Event) и с тех пор жить легче стало.

ToxaRat · 19.05.2020

создай поле SaveOptions="0"
и сохранить можно будет только через кнопку которая удаляет это поле

lmike · 20.05.2020

VladSh сказал(а):
@lmike
Это с каждой формы и подформы всё вынести в библиотеки? Сколько ж это их получится?

а когда в формах писать код - это разве меньше?

я больше скажу на формах делаю хотспоты с JS кот. нажимают кнопки с LS, чтобы в Меню экшн можно было использовать тот же подход
вот совсем не люблю копаться в дизайнере форм: нет поиска нормального, нет навигации по ф-циям (типа F3), нет нормальной подсветки/автоподстановки и автогенерации...

k85 · 20.05.2020

ToxaRat сказал(а):
создай поле SaveOptions="0"
и сохранить можно будет только через кнопку которая удаляет это поле

а сообщение про то что нет сохранения добавить на querysave?

VladSh · 20.05.2020

k85 сказал(а):
а сообщение про то что нет сохранения добавить на querysave?

Самый правильный подход был во втором сообщении этой темы, но Вы продолжаете изобретать что-то... эдакое))
Но и это можно, правда с оговорками - убрать поле SaveOptions, на QuerySave поставить сообщение, что нет сохранения, и там же поставить Continue = False. На кнопке сохранять не NotesUIDocument, а NotesDocument, но тут как раз те оговорки...

Все сервисы Codeby

Поиск

Поиск

запретить ctrl+s

k85

garrick

lmike

нет, пердело совершенство

k85

lmike

нет, пердело совершенство

lmike

нет, пердело совершенство

lmike

нет, пердело совершенство

VladSh

начинающий

oshmianski

Достойный программист

ToxaRat

Чёрный маг

lmike

нет, пердело совершенство

k85

VladSh

начинающий