[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