[AccessD] Putting it all together
Stuart McLachlan
stuart at lexacorp.com.pg
Tue Jul 19 00:17:48 CDT 2022
Where do you actually use fColor() and the Enums?
On 18 Jul 2022 at 21:55, John Colby 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
> --
> AccessD mailing list
> AccessD at databaseadvisors.com
> https://databaseadvisors.com/mailman/listinfo/accessd
> Website: http://www.databaseadvisors.com
>
More information about the AccessD
mailing list