[AccessD] MSAccess HTML text box - my solution
John Colby
jwcolby at gmail.com
Tue Jul 26 00:39:01 CDT 2022
I'm about ready to discuss my solution to using the so-called "Rich Text"
TextBox. AFAICT it is not "Rich text" but rather a very limited subset of
HTML, only parts which deal with formatting text. As I often do I
developed this with the waterfall model, I got something working, then
started moving it into a more "Normalized" schema. I brok the original
into a handful of classes.I will use individual emails to hold each class
1) clsHTMLFormat- this class holds only the parts having to do with
formatting as string
2) clsHTMLTextBox - This class holds the parts which wrap and manipulate
the text box.
There are other classes but these two are the core of the process.
clsHTMLTextBox will come in the next email.
Option Compare Database
Option Explicit
'.=========================================================================
'.Copyright 2022 Colby Consulting. All rights reserved.
'.Phone :
'.E-mail : jcolby at colbyconsulting.com
'.=========================================================================
' DO NOT DELETE THE COMMENTS ABOVE. All other comments in this module
' may be deleted from production code, but lines above must remain.
'--------------------------------------------------------------------------
'.Description :
'.
'.Written By : John W. Colby
'.Date Created : 07/04/2022
' Rev. History :
'
' Comments : This class holds a string to be formatted. This string may
' be a word, sentence or phrase. Anything that needs a
common
' format.
'.-------------------------------------------------------------------------
'.
' ADDITIONAL NOTES:
'
'
https://support.microsoft.com/en-us/office/create-or-delete-a-rich-text-field-9f86237d-dbbc-4a85-b12c-9d8dca824630
'
'--------------------------------------------------------------------------
'
' INSTRUCTIONS:
'.--------------------------------------------------------------------------
'.
'.
' BEHAVIORS:
'
'--------------------------------------------------------------------------
'THESE CONSTANTS AND VARIABLES ARE USED INTERNALLY TO THE CLASS
'*+ Class constant declaration
Private Const DebugPrint As Boolean = False
Private Const mcstrModuleName As String = "clsHTMLFormat"
Public Enum enumAlign
eLeft = 1
eCenter = 2
eRight = 3
End Enum
Public Enum enumVBColors
Black = vbBlack
Red = vbRed
Green = vbGreen
Yellow = vbYellow
Blue = vbBlue
Magenta = vbMagenta
Cyan = vbCyan
White = vbWhite
End Enum
'*- Class constants declaration
'*+ Class variables declarations
'*+ Class variables declarations
'Private mclsGlobalInterface As clsGlobalInterface
'*- Class variables declarations
'.-------------------------------------------------------------------------
'THESE CONSTANTS AND VARIABLES ARE USED BY THE CLASS TO IMPLEMENT CLASS
FUNCTIONALITY
'*+ custom constants declaration
'
'*- Custom constants declaration
'*+ custom variables declarations
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
Private mintAlign As enumAlign
'
'*- custom variables declarations
'
'Define any events this class will raise here
'*+ custom events Declarations
'Public Event MyEvent(Status As Integer)
'*- custom events declarations
'.-------------------------------------------------------------------------
'THESE FUNCTIONS / SUBS ARE USED INTERNALLY TO THE CLASS
'*+ Private Init/Terminate Interface
'*- Private Init/Terminate Interface
'*+ Public Init/Terminate interface
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, _
Optional intAlign As enumAlign = 1)
mstrToFormat = strToFormat
mblnCRLF = blnCRLF
mblnBold = blnBold
mblnItalics = blnItalics
mblnUnderline = blnUnderline
mintSize = intSize
mstrColor = strColor
mstrFace = strFace
mintStatus = intStatus
mintAlign = intAlign
FormatString
End Function
'*- Public Init/Terminate interface
'*+ Class Property interface
Public Property Get pToFormat() As String
pToFormat = mstrToFormat
End Property
Public Property Let pToFormat(lstrToFormat As String)
mstrToFormat = lstrToFormat
End Property
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
'*- Class Property interface
'*+ Class WithEvent interface
'*- Class WithEvent interface
'THESE FUNCTIONS / SUBS ARE USED TO IMPLEMENT CLASS FUNCTIONALITY
'*+PRIVATE Class function / sub declaration
'*-PRIVATE Class function / sub declaration
'*+PUBLIC Class function / sub declaration
'
'
https://support.microsoft.com/en-us/office/create-or-delete-a-rich-text-field-9f86237d-dbbc-4a85-b12c-9d8dca824630
'
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
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 = mstrFormatted & "<br>"
End If
' Select Case mintAlign
' Case enumAlign.eCenter
' mstrFormatted = "<div align=center>" & mstrFormatted
' 'mstrFormatted = "<div align=" & strInteriorQuotes & "center"
& strInteriorQuotes & ">" & mstrFormatted & "</div>"
' Case enumAlign.eLeft
' mstrFormatted = "<div align=left>" & mstrFormatted
' 'mstrFormatted = "<div align=" & strInteriorQuotes & "left" &
strInteriorQuotes & ">" & mstrFormatted & "</div>"
' Case enumAlign.eRight
' mstrFormatted = "<div align=right>" & mstrFormatted
' 'mstrFormatted = "<div align=" & strInteriorQuotes & "right>"
& mstrFormatted & "</div>"
' End Select
' mstrFormatted = mstrFormatted & "</div>"
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
'*-PUBLIC Class function / sub declaration
--
John W. Colby
Colby Consulting
More information about the AccessD
mailing list