[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