clsSimpleMarkdown.cls

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "cls_SimpleMarkdown"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False

Option Explicit
' ==========================================================================
' Class Name        : clsSimpleMarkdown
' Module Type       : Class
' --------------------------------------------------------------------------
' Description       :
'  --------------------------------------------------------------------------
' EXAMPLE
'   # Header Test||
'   ---||
'   * Unordered List 1||
'   * Unordered List 2||
'   TESTING of stuff I don't how this works. Spelling is diffuclt but something something something.
' ==========================================================================

' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Consumed Events
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Defined Events
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Enumerations & Types
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Class Variables
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Private ufBaseForm As MSForms.Frame
Private ufMarkDown As MSForms.Frame

Private Const ELM_LEFT As Double = 16
Private Const ELM_OL_LEFT As Double = 30
Private Const ELM_GAP As Double = 10
Private Const ELM_HR_GAP As Double = 5

'Private cComponents As Collection
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Class: Initialization & Termination
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Private Sub Class_Initialize()
End Sub
' ------------------
Private Sub Class_Terminate()
End Sub

' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Class Properties
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Using Events
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Public Subroutines
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Public Sub Clear()
    

End Sub
Public Sub Build(parentObj As Object, compName As String, dleft As Double, dTop As Double, dHeight As Double, dWidth As Double)
    Call Create_ufBaseForm(parentObj, compName, dleft, dTop, dHeight, dWidth)
    Call BuildAboveBan(ufBaseForm)
End Sub
' ------------------
Public Sub AddMarkdown(ByVal sContents As String)
    ' // Remove inner-frame, which clears all data
    If Not ufMarkDown Is Nothing Then
        UserForm1.Controls.Remove ufMarkDown.name
        Set ufMarkDown = Nothing
    End If
    ' // Reset collections to empty it
    'Set cComponents = New Collection
    Call Build_Markdown(sContents)
    
End Sub
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Private Subroutines
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Private Sub Build_Markdown(ByVal sContents As String)
    Dim dataArr As Variant: dataArr = Split(sContents, "||")
    Dim current_top As Double: current_top = 0
    Dim i As Long
    
    ' // Build container for parsed text
    Call Create_ufMarkDown(ufBaseForm)
    
    For i = LBound(dataArr) To UBound(dataArr)
        ' // Creates random number to ensure no elements are named the same
        Dim sClean_Data As String: sClean_Data = Clean_N_Trim(dataArr(i))
        Dim randomNum As Integer:  randomNum = Int((300 - 200 + 1) * Rnd + 200)
        Dim sLeft_Two As String:   sLeft_Two = Left(sClean_Data, 2)
        
        
        If sLeft_Two = "# " Then
            sClean_Data = Right(sClean_Data, Len(sClean_Data) - 2)
            current_top = Create_Header(ufMarkDown, oConcat("_", sClean_Data, randomNum), current_top, sClean_Data)
        ElseIf sLeft_Two = "* " Then
            sClean_Data = Right(sClean_Data, Len(sClean_Data) - 2)
            current_top = Create_OL(ufMarkDown, oConcat("_", sClean_Data, randomNum), current_top, sClean_Data)
        ElseIf sLeft_Two = "--" Then
            sClean_Data = Right(sClean_Data, Len(sClean_Data) - 2)
            current_top = Create_HR(ufMarkDown, oConcat("_", sClean_Data, randomNum), current_top)
        Else
            current_top = Create_StdTxt(ufMarkDown, oConcat("_", sClean_Data, randomNum), current_top, sClean_Data)
        End If
        ufMarkDown.ScrollHeight = current_top + 20
    Next i
    
    
End Sub
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Public Functions
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Private Functions
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Private Function Clean_N_Trim(vinput As Variant) As String
    Clean_N_Trim = Application.WorksheetFunction.Trim(Application.WorksheetFunction.Clean(vinput))
End Function
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' UserForm Builder Subroutines / Functions
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Private Sub Create_ufBaseForm(parentObj As Object, compName As String, dleft As Double, dTop As Double, dHeight As Double, dWidth As Double)
    Set ufBaseForm = parentObj.Controls.Add("Forms.Frame.1", oConcat("_", compName, "ufBaseForm"))
    With ufBaseForm
        .Width = dWidth
        .Height = dHeight
        .Top = dTop
        .Left = dleft
        .SpecialEffect = 0 'Flat
        .BorderStyle = fmBorderStyleNone
        .backColor = parentObj.backColor 'RGB(255, 255, 255)
        
    End With
End Sub
' ------------------
Private Sub Create_ufMarkDown(parentObj As Object)
    Set ufMarkDown = parentObj.Controls.Add("Forms.Frame.1", oConcat("_", "ufMarkDown", "Frame_To_Del"))
    With ufMarkDown
        .Width = .parent.Width
        .Height = .parent.Height - 2
        .Top = 2
        .Left = 0
        .SpecialEffect = 0 'Flat
        .ScrollBars = fmScrollBarsVertical
        .KeepScrollBarsVisible = fmScrollBarsNone
        .BorderStyle = fmBorderStyleNone
    End With
End Sub
' ------------------
Private Function Create_Header(parentObj As Object, compName As String, ByVal dTop As String, ByVal sCaption As String) As Double
    Dim header As MSForms.Label
    
    Set header = parentObj.Controls.Add("Forms.Label.1", compName & "Header") 'oConcat("_", CompName, "Header"))
    With header
        .AutoSize = False
        
        .Top = dTop + ELM_GAP
        .Left = ELM_LEFT
        .Width = .parent.Width - (header.Left * 2)
        
        .Font.name = "Segoe UI SemiBold"
        .Font.size = 16
        .ForeColor = RGB(103, 106, 108)
        
        .caption = sCaption
        .WordWrap = True
        .AutoSize = True
    End With
    
    Create_Header = header.Top + header.Height
End Function
' ------------------
Private Function Create_HR(parentObj As Object, compName As String, ByVal dTop As Double) As Double
    Dim hr As MSForms.Label
    
    Set hr = parentObj.Controls.Add("Forms.Label.1", oConcat("_", compName, "HR"))
    With hr
        .backColor = RGB(103, 106, 108)
        .Height = 1.5
        .Left = ELM_LEFT
        .Width = .parent.Width - (ELM_LEFT * 2) - 2
        .Top = dTop + ELM_HR_GAP
    End With
    Create_HR = hr.Top + hr.Height
End Function
' ------------------
Private Function Create_OL(parentObj As Object, compName As String, ByVal dTop As String, ByVal sCaption As String) As Double
    Dim OL_Bullet As MSForms.Label
    Dim OL_Text As MSForms.Label
    
    Set OL_Bullet = parentObj.Controls.Add("Forms.Label.1", compName & "TESTSAA") 'oConcat("_", CompName, "OL_Bullet"))
    With OL_Bullet
        .Top = dTop + ELM_GAP
        .Left = ELM_OL_LEFT
        .Width = 9.75
        .Height = 9.75
        
        .Font.name = "Segoe UI SemiBold"
        .Font.size = 10
        .ForeColor = RGB(103, 106, 108)
        .caption = Application.WorksheetFunction.Unichar(8226)
    End With
    ' -----
    Set OL_Text = parentObj.Controls.Add("Forms.Label.1", oConcat("_", compName, "OL_Text"))
    With OL_Text
        .AutoSize = False
        
        .caption = sCaption
        .ForeColor = RGB(103, 106, 108)
        .Font.name = "Segoe UI"
        .Font.size = 10
        
        .Top = OL_Bullet.Top
        .Left = OL_Bullet.Left + OL_Bullet.Width + 2
        .Width = .parent.Width - .Left
        
        .WordWrap = True
        .AutoSize = True
    End With
    Create_OL = OL_Text.Top + OL_Text.Height
End Function
' ------------------
Private Function Create_StdTxt(parentObj As Object, compName As String, ByVal dTop As String, ByVal sCaption As String) As Double
    Dim StdTxt As MSForms.Label
    
    Set StdTxt = parentObj.Controls.Add("Forms.Label.1", oConcat("_", compName, "StdTxt"))
    With StdTxt
        .AutoSize = False
        
        .Top = dTop + ELM_GAP
        .Left = ELM_LEFT
        .Width = .parent.Width - (ELM_LEFT * 2)
        
        .Font.name = "Segoe UI"
        .Font.size = 10
        .ForeColor = RGB(103, 106, 108)
        
        .caption = sCaption
        .WordWrap = True
        .AutoSize = True
    End With
    Create_StdTxt = StdTxt.Top + StdTxt.Height
End Function
' ------------------
Private Sub BuildAboveBan(parentObject As Object)
    Dim ufHeaderUpperBan As MSForms.Label
    Set ufHeaderUpperBan = parentObject.Controls.Add("Forms.label.1", "Definitions_AboveBan")
    With ufHeaderUpperBan
        .Top = 0
        .Width = parentObject.parent.Width
        .Height = 2
        .Left = 0
        .BorderStyle = fmBorderStyleNone
        .backColor = RGB(216, 221, 224)
    End With
End Sub