[AccessD] Putting it all together

[John Colby]

The following is my class which puts it all together.  The reason I do it
as a class is that I want to be able to create parts of a line in the text
box which are formatted differently, then store the pieces in a collection
in a form (or another supervisor class in my case) in order to build up as
large a message in the text box as I desire.

This class allows me to create an instance for each word, phrase or
sentence where a common set of formatting is applied to that string.  Then
string the strings together in the next level up code.

BTW one can just make the variables in the header public and get rid of the
properties.  I prefer properties but it makes the code less verbose if the
properties go away.

Thanks again Stuart for your contribution!  Much appreciated.


Option Compare Database
Option Explicit

Private mstrToFormat As String 'The string to be formatted
Private mstrFormatted As String 'The string after formatting is applied
'
'The rest of this is format stuff to apply to the string above
'
Private mblnCRLF As Boolean
Private mblnBold As Boolean
Private mblnItalics As Boolean
Private mblnUnderline As Boolean
Private mintSize As Integer
Private mstrColor As String
Private mstrFace As String
Private mintStatus As enumVBColors
Private mstrFormatName As String

Function fInit(strToFormat As String, _
                Optional blnCRLF As Boolean = False, _
                Optional blnBold As Boolean = False, _
                Optional blnItalics As Boolean = False, _
                Optional blnUnderline As Boolean = False, _
                Optional intSize As Integer = -1, _
                Optional strColor As String = "Black", _
                Optional strFace As String = "Arial", _
                Optional intStatus As enumVBColors = enumVBColors.Black)
    mstrToFormat = strToFormat
    mblnCRLF = blnCRLF
    mblnBold = blnBold
    mblnItalics = blnItalics
    mblnUnderline = blnUnderline
    mintSize = intSize
    mstrColor = strColor
    mstrFace = strFace
    mintStatus = intStatus

    FormatString
End Function

Public Property Get pFormatted() As String
    pFormatted = mstrFormatted
End Property
Public Property Let pFormatted(ByVal sNewValue As String)
    mstrFormatted = sNewValue
End Property
Public Property Get pFormatName() As String
    pFormatName = mstrFormatName
End Property
Public Property Let pFormatName(ByVal sNewValue As String)
    mstrFormatName = sNewValue
End Property
Public Property Get pBold() As Boolean
    pBold = mblnBold
End Property
Public Property Let pBold(ByVal bNewValue As Boolean)
    mblnBold = bNewValue
End Property
Public Property Get pCRLF() As Boolean
    pCRLF = mblnCRLF
End Property
Public Property Let pCRLF(ByVal bNewValue As Boolean)
    mblnCRLF = bNewValue
End Property
Public Property Get pItalics() As Boolean
    pItalics = mblnItalics
End Property
Public Property Let pItalics(ByVal bNewValue As Boolean)
    mblnItalics = bNewValue
End Property
Public Property Get pUnderline() As Boolean
    pUnderline = mblnUnderline
End Property
Public Property Let pUnderline(ByVal bNewValue As Boolean)
    mblnUnderline = bNewValue
End Property
Public Property Get pSize() As Integer
    pSize = mintSize
End Property
Public Property Let pSize(ByVal iNewValue As Integer)
    mintSize = iNewValue
End Property
Public Property Get pColor() As String
    pColor = mstrColor
End Property
Public Property Let pColor(ByVal sNewValue As String)
    mstrColor = sNewValue
End Property
Public Property Get pFace() As String
    pFace = mstrFace
End Property
Public Property Let pFace(ByVal sNewValue As String)
    mstrFace = sNewValue
End Property
Public Property Get pStatus() As Integer
    pStatus = mintStatus
End Property
Public Property Let pStatus(ByVal iNewValue As Integer)
    mintStatus = iNewValue
End Property

Function FormatString()
    mstrFormatted = mstrToFormat
    Dim mstrFormattedClosingFontTag As String
    Const strInteriorQuotes As String = """"
    If mintStatus > 0 Then
        mstrFormatted = "<Font Color=" & strInteriorQuotes &
HTMLColour(mintStatus) & strInteriorQuotes & ">" & mstrFormatted
        mstrFormattedClosingFontTag = mstrFormattedClosingFontTag &
"</Font>"
    Else
        mstrFormatted = "<Font Color=" & strInteriorQuotes & mstrColor &
strInteriorQuotes & ">" & mstrFormatted
        mstrFormattedClosingFontTag = mstrFormattedClosingFontTag &
"</Font>"
    End If
    '
    'Get the three font pieces grouped
    '
    If mstrFace <> "" Then
        mstrFormatted = "<Font Face=" & strInteriorQuotes & mstrFace &
strInteriorQuotes & ">" & mstrFormatted
        mstrFormattedClosingFontTag = mstrFormattedClosingFontTag &
"</Font>"
    End If
    If mintSize <> -1 Then
        mstrFormatted = "<Font Size=" & CStr(mintSize) & ">" & mstrFormatted
        mstrFormattedClosingFontTag = mstrFormattedClosingFontTag &
"</Font>"
    End If
    mstrFormatted = mstrFormatted & mstrFormattedClosingFontTag
    'mstrFormatted = mstrFormatted & mstrFormattedClosingFontTag
    If mblnBold Then
        mstrFormatted = "<b>" & mstrFormatted & "</b>"
    End If
    If mblnItalics Then
        mstrFormatted = "<i>" & mstrFormatted & "</i>"
    End If
    If mblnUnderline Then
        mstrFormatted = "<u>" & mstrFormatted & "</u>"
    End If
    If mblnCRLF Then
        'mstrFormatted = "<br>" & mstrFormatted
        mstrFormatted = mstrFormatted & "<br>"
    End If

End Function
Function HTMLColour(VBAColor As Long) As String
Dim BGR As String
    BGR = Right$("000000" & Hex$(VBAColor), 6)
    HTMLColour = "#" & Right$(BGR, 2) & Mid$(BGR, 3, 2) & Left$(BGR, 2)
End Function
'
'HTML programming uses RRGGBB notation
'VBA uses BBGGRR notation
'
Function VBAColour(VBAColor As Long) As String
    VBAColour = "#" & Right$("000000" & Hex$(VBAColor), 6)
End Function
Function fColor(intColor As enumVBColors) As String
    Select Case intColor
    Case enumVBColors.Black
        fColor = "Black"
    Case enumVBColors.Red
        fColor = "Red"
    Case enumVBColors.Green
        fColor = "Green"
    Case enumVBColors.Yellow
        fColor = "Yellow"
    Case enumVBColors.Blue
        fColor = "Blue"
    Case enumVBColors.Magenta
        fColor = "Magenta"
    Case enumVBColors.Cyan
        fColor = "Cyan"
    Case enumVBColors.White
        fColor = "White"
    End Select
End Function



-- 
John W. Colby
Colby Consulting