'класс реализован для вывода отсортированных значений списком (в массив LS)
Class SortObj As ErrorHandlerWJ
Private SortListObj As JavaObject
Private SortListClass As JavaClass
Private fCount As Long
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub New()
Dim fail As Boolean
On Error Goto errorhandler
Set SortListClass = jSession.GetClass("SortList")
Set SortListObj = SortListClass.CreateObject
ExitFunction:
If fail Then
On Error Goto 0
Error ERRLS2JINIT, CS_ERRLS2JINIT
End If
Exit Sub
errorhandler:
Call Me.RaiseError()
fail=True
Resume ExitFunction
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub Delete()
If Not SortListObj Is Nothing Then
Delete SortListObj
End If
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub Add(s As String)
SortListObj.add(s)
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function Remove(s As String) As Boolean
Me.Remove=SortListObj.remove(s)
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GetIndex(s As String)
GetIndex=SortListObj.getindex(s)
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function Sort() As Variant
Sort=SortListObj.sort()
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Property Get Count As Long
Count=SortListObj.count()
End Property
End Class
'************************************
Class SorterObj As ErrorHandler
Private keyList List As String 'ключём явл. UNID, значением - ключ сортировки (для доступа по UNID)
Private docsHash List As NotesDocument 'для доступа к документу по индексу, из отсорт. массива
Private sortArr As Variant 'сюда попадают отсортированные ключи
Private Sorter As SortObj
Private keys As Variant
Private isChanged As Boolean
Private isDoctype As Boolean
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'docArr - массив NotesDocument, для сортировки
'xKeys - список имен полей, по кот. будет сортироваться, поля не д.б. многозначными (использует 1-е значение)
Sub New(docArr List As NotesDocument, xKeys As Variant)
On Error Goto ErrH
Set Sorter=New SortObj
keys=xKeys
If Not Isarray(keys) Then Dim tmp:tmp=Split({},{}):tmp(0)=keys:keys=tmp
Forall x In docArr
Call Add(x)
End Forall
isDoctype=True
Quit:
Exit Sub
ErrH:
Error Err, RaiseError
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function Add(doc As NotesDocument) As NotesDocument
On Error Goto ErrH
Dim s As String
s=doc.UniversalID
Set docsHash(s)=doc
Dim key As String
key=JoinKeys(doc)
keyList(s)=key
Sorter.Add(key &EL_SEP &s)
Set Me.Add=doc
isChanged=True
Quit:
Exit Function
ErrH:
Error Err, RaiseError
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function JoinKeys(xDoc As NotesDocument) As String
On Error Goto ErrH
Dim sKey
sKey=Split("","")
' DbgMsg({fields:} &Join(keys,{;}))
Forall k In keys
Dim s As String
'явное приведение к типу
s=Cstr(k)
If xDoc.HasItem(s) Then
Dim v
v=xDoc.GetItemValue(s)
Dim itm As NotesItem
Set itm=xDoc.GetFirstItem(s)
'преобразуем к виду, кот. "правильно" сортируется как строка
Select Case itm.Type
Case NUMBERS:
s=Format(v(0), {000000.00})
Case DATETIMES:
s=Format(v(0), {YYYYMMDD})
Case TEXT:
s=v(0)
Case Else
'генерим ошибку
Error ERRINCOMARTIBLE, CS_ERRINCOMARTIBLE & CS_INCOMPFIELD
End Select
sKey=Arrayappend(sKey, Ucase(s))
End If
End Forall
sKey=Join(sKey, SORT_SEP)
JoinKeys=sKey
Quit:
Exit Function
ErrH:
Error Err, RaiseError
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Property Get NthDocument(i As Long) As NotesDocument
On Error Goto ErrH
GetAll
Dim s As String
s=sortArr(i)
DbgMsg Cstr(i) &{;Sorted key:} &s
'вылетит по ошибке если индекс больше Count
Set NthDocument=docsHash(Strrightback(s, EL_SEP))
Quit:
Exit Property
ErrH:
Error Err, RaiseError
End Property
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Property Get Count As Long
Count=Sorter.Count
End Property
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Function GetAll As Variant
If isChanged Then
sortArr=Sorter.Sort()
isChanged=False
End If
GetAll=sortArr
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GetIndex(doc As NotesDocument) As Long
On Error Goto ErrH
GetAll 'сортировка если нужно
GetIndex=Sorter.GetIndex(keyList(doc.UniversalID) &EL_SEP &doc.UniversalID)
Quit:
Exit Function
ErrH:
Error Err, RaiseError
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function Remove(doc As NotesDocument) As Boolean
On Error Goto ErrH
If Sorter.Remove(keyList(doc.UniversalID) &EL_SEP &doc.UniversalID) Then
Erase docsHash(doc.UniversalID)
Erase keyList(doc.UniversalID)
isChanged=True
Me.Remove=True
End If
Quit:
Exit Function
ErrH:
Error Err, RaiseError
End Function
End Class
