CreateAboutDocument

[Stephane Maillard]

[syntax="ls"]Const wAPIModule = "NNOTES" ' Windows/32



Const NOTE_CLASS_ABOUT = &H8002



Const NOTE_INFO_DB = 0

Const NOTE_INFO_ID = 1

Const NOTE_INFO_OID = 2

Const NOTE_INFO_CLASS = 3

Const NOTE_INFO_FLAGS = 7



Const ITEM_SIGN = 1

Const ITEM_SUMMARY = 4



Const TYPE_TEXT = &H0500



Declare Private Function NSFDbOpen Lib wAPIModule Alias "NSFDbOpen" _

( Byval P As String, hDB As Long) As Integer

Declare Private Function NSFDbClose Lib wAPIModule Alias "NSFDbClose" _

( Byval hDB As Long) As Integer



Declare Private Function NSFNoteUpdate Lib wAPIModule Alias "NSFNoteUpdate" _

( Byval hNT As Long, Byval F As Integer) As Integer

Declare Private Function NSFNoteCreate Lib wAPIModule Alias "NSFNoteCreate" _

( Byval hDB As Long, hNT As Long) As Integer

Declare Private Function NSFNoteSetInfo Lib wAPIModule Alias "NSFNoteSetInfo" _

( Byval hNT As Long, Byval M As Integer, V As Any) As Integer

Declare Private Function NSFNoteSign Lib wAPIModule Alias "NSFNoteSign" _

( Byval hNT As Long) As Integer



Declare Private Function NSFItemSetTextSummary Lib wAPIModule Alias "NSFItemSetText" _

( Byval hNT As Long, Byval N As String, Byval T As String, Byval nT As Integer, Byval S As Integer) As Integer



Declare Private Function NSFItemAppend Lib wAPIModule Alias "NSFItemAppend" _

( Byval hNT As Long, Byval F As Integer, Byval N As String, Byval nN As Integer _

, Byval T As Integer, Byval V As String, Byval nV As Long) As Integer



Declare Private Function OSPathNetConstruct Lib wAPIModule Alias "OSPathNetConstruct" _

( Byval NullPort As Long, Byval Server As String, Byval FIle As String, Byval PathNet As String) As Integer



Declare Sub NEMDisplayError Lib "NNOTESWS" Alias "NEMDisplayError" _

( Byval E As Long)



Sub CreateAboutDocument(db As NotesDatabase)

Dim about As NotesDocument

Set about = db.GetDocumentByID("FFFF0002")

If about Is Nothing Then

np$ = Space(1024)

OSPathNetConstruct 0, db.Server, db.FilePath, np$

Dim hDB As Long

NSFDbOpen np$, hDB

Dim hNT As Long

NSFNoteCreate hDB, hNT

NSFNoteSetInfo hNT, NOTE_INFO_CLASS, NOTE_CLASS_ABOUT

NSFNoteUpdate hNT, 0

NSFDbClose hDB

Set about = db.GetDocumentByID("FFFF0002")

Else

about.RemoveItem "$Body"

End If



Dim session As New NotesSession



Dim title As NotesRichTextStyle

Set title = session.CreateRichTextStyle

With title

.Bold = True

.FontSize = 18

.NotesColor = COLOR_DARK_RED

.NotesFont = FONT_ROMAN

End With



Dim normal As NotesRichTextStyle

Set normal = session.CreateRichTextStyle

With normal

.Bold = False

.FontSize = 10

.NotesColor = COLOR_BLACK

.NotesFont = FONT_HELV

End With



Set body = about.CreateRichTextItem("$Body")

With body

.AppendStyle title

.AppendText "About " & db.Title

.AddNewLine 1, True

.AppendStyle normal

.AppendText "Rhubarb, rhubarb..."

.AddNewLine 1, True

.IsSigned = True

End With



about.Sign

about.Save True, False

End Sub[/syntax]