ProgressBar

На днях, решил приукрасить подготовку отчетов "прогрессом"
Особенность от стандартного использования - это, конвертация ascii в читабельный вид

Вот что получилось

'функции преобразования строк
Const OS_TRANSLATE_NATIVE_TO_LMBCS = 0 'Translate platform-specific to LMBCS */
Const OS_TRANSLATE_LMBCS_TO_NATIVE = 1 'Translate LMBCS to platform-specific */
Const OS_TRANSLATE_LOWER_TO_UPPER = 3 'current int'l case table */
Const OS_TRANSLATE_UPPER_TO_LOWER = 4 'current int'l case table */
Const OS_TRANSLATE_UNACCENT = 5 'int'l unaccenting table */
Const OS_TRANSLATE_LMBCS_TO_ASCII_DOS = 11
Const OS_TRANSLATE_LMBCS_TO_ASCII = 13
Declare Sub OSTranslate Lib "nnotes.dll" Alias "OSTranslate"( ByVal mode As Integer, ByVal strIn As String, ByVal lenIn As Integer, ByVal strOut As String, ByVal lenOut As Integer )
Declare Function NEMProgressBegin Lib "nnotesws.dll" ( ByVal wFlags As Integer ) As Long
Declare Sub NEMProgressEnd Lib "nnotesws.dll" ( ByVal hwnd As Long )
Declare Sub NEMProgressSetBarPos Lib "nnotesws.dll" ( ByVal hwnd As Long, ByVal dwPos As Long)
Declare Sub NEMProgressSetBarRange Lib "nnotesws.dll" ( ByVal hwnd As Long, ByVal dwMax As Long )
Declare Sub NEMProgressSetText Lib "nnotesws.dll" ( ByVal hwnd As Long, ByVal pcszLine1 As String, _
ByVal pcszLine2 As String )
Const NPB_TWOLINE% = 1

Class ProgressBar
Private hwnd As Long

Sub New (BarRange As Long)
On Error GoTo ErrorHandler

Me.hwnd = NEMProgressBegin (NPB_TWOLINE)

Call NEMProgressSetBarRange (Me.hwnd, BarRange)

Exit Sub
ErrorHandler:
strErrMessage_rep = "Ошибка " & Error$ & " выполняемая процедура " & GetThreadInfo(10) &" текущая процедура " & GetThreadInfo(1) & ", в строке " & CStr(Erl)
Print strErrMessage_rep

End Sub

Код как использовать

Dim s As New NotesSession
Dim db As NotesDatabase
Dim doc As NotesDocument
Dim server
Dim view_adr As NotesView
Set db = s.Currentdatabase
If Not ( db.IsFTIndexed ) Then
Call db.UpdateFTIndex( True )
End If
If ( db.LastModified > db.LastFTIndexed ) Then
Call db.UpdateFTIndex( True )
End If
Set view_adr = db.GetView("view_object")
Dim i As Long
Set doc = view_adr.Getfirstdocument()
a = view_adr.Allentries.Count
Dim RefreshProgress As New ProgressBar (view_adr.Allentries.Count) 'отображение рогрес-бара
Dim BarMsg As String
Dim UpdMsg As String
Let BMsg = "Обработка окументов..."
Let tmp0=Len(BMsg)
Let tmp1=Len(BMsg)*2
Let BarMsg = Space(Len(BMsg)*2)
Call OSTranslate( OS_TRANSLATE_NATIVE_TO_LMBCS, BMsg, tmp0, BarMsg, tmp1 )
For i = 1 To a
Call plan_nachislenie(doc)
Call RefreshProgress.UpdatePosition (i)
Let ascii = doc.address(0)
Let tmp0=Len(ascii)
Let tmp1=Len(ascii)*2
Let UpdMsg = Space(Len(ascii)*2)
Call OSTranslate( OS_TRANSLATE_NATIVE_TO_LMBCS, ascii, tmp0, UpdMsg, tmp1 )
Call RefreshProgress.UpdateProgressText(BarMsg, UpdMsg)

Set doc = view_adr.GetNextdocument(doc)
Next
Print "Готово"