[AccessD] Putting it all together

John Colby jwcolby at gmail.com
Mon Jul 18 20:58:21 CDT 2022


And this enum should logically go in this class as well.  Sorry I left it
out, it started in another place in my code and I hadn't moved it yet.

Public Enum enumVBColors
    Black = vbBlack
    Red = vbRed
    Green = vbGreen
    Yellow = vbYellow
    Blue = vbBlue
    Magenta = vbMagenta
    Cyan = vbCyan
    White = vbWhite
End Enum

On Mon, Jul 18, 2022 at 9:55 PM John Colby <jwcolby at gmail.com> wrote:

> 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
>


-- 
John W. Colby
Colby Consulting


More information about the AccessD mailing list