Function isRTFNull (docUI4Process As NotesUIDocument, rtFieldName As String, isRTEmpty As Boolean) As Boolean
%REM
...
%END REM
On Error Goto errorHandler
isRTFNull = False
Dim doc4Process As NotesDocument
If Not (docUI4Process Is Nothing) Then
If docUI4Process.EditMode Then
Call isRTFNull_UI (docUI4Process, rtFieldName, isRTEmpty)
Else
Set doc4Process = docUI4Process.Document
Call isRTFNull_BG (doc4Process, rtFieldName, isRTEmpty)
End If
Else
Set doc4Process = session.DocumentContext
Call isRTFNull_BG (doc4Process, rtFieldName, isRTEmpty)
End If
isRTFNull = True
ex:
Exit Function
errorHandler:
Call ProcessError (MODULE_NAME, Err, Error, Erl, Lsi_info (2), Lsi_info (12))
Resume ex
End Function
Function isRTFNull_UI (docUI4Process As NotesUIDocument, rtFieldName As String, isRTEmpty As Boolean) As Integer
%REM
'This function tests a Rich Text field to see whether or not it is null. It returns TRUE if the field is null, and
'returns FALSE if the field is not null. It works even if the rich text field contains a file attachment,
'doclink, or OLE object but does not contain any text.
%END REM
On Error Goto errorHandler
isRTFNull_UI = False
isRTEmpty = True
Dim currentFieldName As String
'Store the name of the field that currently has focus. Note: if this function is being called from a form button,
'currentfield will be null (because the button has the focus, and not a field). If this function is called
'from an action button, and if the cursor is in a field, then currentfield will correctly store the name
'of the field that has focus.
currentFieldName = docUI4Process.CurrentField ()
Call docUI4Process.GotoField (rtFieldName)
Call docUI4Process.SelectAll ()
'The next line will generate a 4407 error message if the Rich Text Field is null
Call docUI4Process.DeselectAll ()
'Return the cursor the the field that had focus before this function ran. If the currentfield variable is null (because a button
'or hotspot had focus, then the cursor will actually wind up getting left in the rich text field.
If Len (currentFieldName) > 0 Then
Call docUI4Process.GotoField (currentFieldName)
End If
isRTEmpty = False
isRTFNull_UI = True
ex:
Exit Function
errorHandler:
Select Case Err
Case 4407
'the DeselectAll line generated an error message, indicating that the rich text field does not contain anything
If Len (currentFieldName) > 0 Then
Call uidoc.GotoField (currentFieldName)
End If
isRTFNull_UI = True
Resume ex
Case Else
'For any other error, force the same error to cause LotusScript to do the error handling
Call ProcessError (MODULE_NAME, Err, Error, Erl, Lsi_info (2), Lsi_info (12))
Resume ex
End Select
End Function
Function isRTFNull_BG (doc4Process As NotesDocument, rtFieldName As String, isRTEmpty As Boolean) As Boolean
%REM
...
%END REM
On Error Goto errorHandler
isRTFNull_BG = False
isRTEmpty = True
Dim dxle As NotesDXLExporter
Dim m_domp As NotesDOMParser
Dim imageElems As NotesDOMNodeList
Dim elPic As NotesDOMElementNode
Dim itemNode As NotesDOMElementNode
Dim rtItem As NotesRichTextItem
Dim rtNav As NotesRichTextNavigator
Dim tagName As String
Dim i As Long
If (doc4Process Is Nothing) Then
Error 1000, "Не передан документ-основание!"
End If
Set rtItem = doc4Process.GetFirstItem (rtFieldName)
If (rtItem Is Nothing) Then
isRTFNull_BG = True
isRTEmpty = True
Exit Function
End If
'//********************************************************************************
****
'//проверяю текст, линки, вложения, оле, секции, таблицы, параграфы
'//********************************************************************************
****
Set rtnav = rtItem.CreateNavigator ()
If Len (Trim (rtItem.Text)) > 0 _
Or rtNav.FindFirstElement (RTELEM_TYPE_DOCLINK) _
Or rtNav.FindFirstElement (RTELEM_TYPE_FILEATTACHMENT) _
Or rtNav.FindFirstElement (RTELEM_TYPE_OLE) _
Or rtNav.FindFirstElement (RTELEM_TYPE_SECTION) _
Or rtNav.FindFirstElement (RTELEM_TYPE_TABLE) _
Or rtNav.FindFirstElement (RTELEM_TYPE_TABLECELL) _
Or rtNav.FindFirstElement (RTELEM_TYPE_TEXTPARAGRAPH) _
Or rtNav.FindFirstElement (RTELEM_TYPE_TEXTRUN) Then
isRTFNull_BG = True
isRTEmpty = False
Exit Function
End If
'//********************************************************************************
****
'//********************************************************************************
****
'//проверяю in-line картинки
'//********************************************************************************
****
Set dxle = session.Createdxlexporter (doc4Process)
Set m_domp = session.Createdomparser(dxle)
dxle.Convertnotesbitmapstogif = False
dxle.Outputdoctype = False
dxle.Validationstyle = VALIDATIONSTYLE_NONE
Call dxle.Process ()
Set imageElems = m_domp.Document.GetElementsByTagname ("picture")
For i = 1 To imageElems.Numberofentries
Set elPic = imageElems.Getitem (i)
If Not elPic.ParentNode.isNull Then
If Not elPic.ParentNode.ParentNode.isNull Then
If Not elPic.ParentNode.ParentNode.ParentNode.isNull Then
Set itemNode = elPic.ParentNode.ParentNode.ParentNode
tagName = itemNode.GetAttribute ("name")
If Strcompare (rtFieldName, tagName, 5) = 0 Then
isRTFNull_BG = True
isRTEmpty = False
Exit Function
End If
End If
End If
End If
Next
'//********************************************************************************
****
isRTFNull_BG = True
ex:
Exit Function
errorHandler:
Call ProcessError (MODULE_NAME, Err, Error, Erl, Lsi_info (2), Lsi_info (12))
Resume ex
End Function