Forum Project - All users contribute (1 Viewer)

[modest]

Just wanted to start something for everyone to contribute to. Thought this would be fun.

Create a code-formatter that is able to take your VBA source code and format it for color and spacing to place in the forums. I've begun by loading in the reserved words into a table, with the color "blue".

Problems so far:
- Updates any part of the word (e.g. Color turns into Col[ color=blue]Or[ /color])
- The case is not saved throughout (e.g. look at the "or" in the above example. It changed from "or" to "Or")
- The last word is not formatted, even if it is a reserved word
- Author comments are not converted to a green color


I could do it all myself, but what fun would that be!? I would like more than one user to contribute to this so we don't waste our time, but still have some fun in making it.

You can test it with the following code:

[color=Blue]Private [/color][color=Blue]Sub [/color]cmdUpdate_Click()
    [color=Blue]Dim [/color]rs          [color=Blue]As [/color]DAO.Recordset
    [color=Blue]Dim [/color]db          [color=Blue]As [/color]DAO.Database
    
    [color=Blue]Dim [/color]sKeyword    [color=Blue]As [/color][color=Blue]String[/color]
    [color=Blue]Dim [/color]sColor      [color=Blue]As [/color][color=blue]String[/color]

 

[RuralGuy]

We're looking at it Modest. Just doing some thinking first. Interesting project. We'll need some way to say "I've got the source checked out right now" without delaying the updates if possible.

 

[modest]

The fun thing about this is that there are no time constraints. Feel free to manipulate the forms, add modules, maybe even add a login feature to retrieve and post to the forum through the database.

 

[ByteMyzer]

The following function will format Visual Basic code for color display, using IMG code. The function was used on itself for this post, to demonstrate how it works.

[color=Blue]Public Function[/color] FormatCode([color=Blue]ByVal[/color] sCode [color=Blue]As String[/color]) [color=Blue]As String[/color]

[color=Green]' comparison string to test for Alphabetic characters[/color]
[color=Blue]Const[/color] sAlpha [color=Blue]As String[/color] _
    = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"

[color=Blue]Dim[/color] bQuote [color=Blue]As Boolean[/color]           [color=Green]' quoteable text indicator[/color]
[color=Blue]Dim[/color] sComment [color=Blue]As String[/color]          [color=Green]' temporary comment storage[/color]
[color=Blue]Dim[/color] sLine() [color=Blue]As String[/color]           [color=Green]' code line array[/color]
[color=Blue]Dim[/color] sReservedWords [color=Blue]As String[/color]    [color=Green]' reserved word comparison string[/color]
[color=Blue]Dim[/color] X [color=Blue]As Long[/color], Y [color=Blue]As Long[/color], Z [color=Blue]As Long[/color]

[color=Green]' Set the reserved word list, using a Chr(1) for[/color]
[color=Green]' the beginning and ending delimiter for each word[/color]
sReservedWords = Replace(",AddressOf,Alias,And,Any,As,Base,Binary," _
    & "Boolean,ByRef,Byte,ByVal,Call,Case,CBool,CByte,CCur,CDate,CDbl," _
    & "CInt,CLng,Close,Compare,Const,CSng,CStr,Currency,CVar,CVErr," _
    & "Database,Date,Debug,Declare,DefBool,DefByte,DefCur,DefDate," _
    & "DefDbl,DefInt,DefLng,DefObj,DefSng,DefStr,DefVar,Dim,Do,Double," _
    & "Each,Else,End,Enum,Eqv,Erase,Error,Event,Exit,Explicit,For," _
    & "Friend,Function,Get,Global,GoSub,GoTo,If,Imp,Implements,In," _
    & "Input,Integer,Is,LBound,Len,Let,Lib,Like,Line,Lock,Long,Loop," _
    & "LSet,Mod,Module,Name,New,Next,Not,Nothing,Null,Object,On,Open," _
    & "Option,Optional,Or,Output,ParamArray,Preserve,Print,Private," _
    & "Property,Public,Put,RaiseEvent,Random,Read,ReDim,Resume,Return," _
    & "RSet,Seek,Select,Set,Single,Spc,Static,Step,Stop,String,Sub," _
    & "Tab,Text,Then,To,Type,UBound,Unlock,Variant,Wend,While,With," _
    & "WithEvents,Write,Xor,", ",", Chr(1))

[color=Green]' Allow the "[b][/b][[b][/b]" character to be printed[/color]
sCode = Replace(sCode, "[b][/b][[b][/b]", "[b][/b][[b][/b]b][b][/b][[b][/b]/b][b][/b][[b][/b][b][/b][[b][/b]b][b][/b][[b][/b]/b]")

[color=Green]' Populate the code line array[/color]
sLine = Split(sCode, vbNewLine)

[color=Green]' Loop through the code line array[/color]
[color=Blue]For[/color] Y = 0 [color=Blue]To UBound[/color](sLine)
    bQuote = False  [color=Green]' clear the quoteable text indicator[/color]
    sComment = ""   [color=Green]' clear the comment string[/color]
    [color=Blue]For[/color] X = 1 [color=Blue]To Len[/color](sLine(Y))
        [color=Green]' If the character is a double-quote, toggle the text indicator[/color]
        [color=Blue]If[/color] Mid(sLine(Y), X, 1) = Chr(34) [color=Blue]Then[/color] bQuote = [color=Blue]Not[/color] bQuote
        [color=Green]' If a single-quote appears outside of quoteable text, store[/color]
        [color=Green]' the right half of the line from this point in the comment[/color]
        [color=Green]' string and parse the remaining line for processing[/color]
        [color=Blue]If[/color] Mid(sLine(Y), X, 1) = "'" [color=Blue]And[/color] bQuote = False [color=Blue]Then[/color]
            sComment = Mid(sLine(Y), X)
            sLine(Y) = Left(sLine(Y), X - 1)
            [color=Blue]Exit For[/color]
        [color=Blue]End If[/color]
    [color=Blue]Next[/color] X
    [color=Green]' If the remaining line length is greater than 0, process the line[/color]
    [color=Blue]If Len[/color](sLine(Y)) > 0 [color=Blue]Then[/color]
        bQuote = False [color=Green]' clear the quoteable text indicator[/color]
        X = 1
        [color=Blue]Do[/color]
            [color=Green]' If the character is a double-quote, toggle the text indicator[/color]
            [color=Blue]If[/color] Mid(sLine(Y), X, 1) = Chr(34) [color=Blue]Then[/color] bQuote = [color=Blue]Not[/color] bQuote
            [color=Green]' If Alphabetic character is found outside of quoteable text[/color]
            [color=Blue]If[/color] InStr(1, sAlpha, Mid(sLine(Y), X, 1)) > 0 _
                [color=Blue]And[/color] bQuote = False [color=Blue]Then[/color]
                [color=Green]' Loop to find the end of the alphabetic string[/color]
                Z = X
                [color=Blue]Do[/color]
                    [color=Blue]If[/color] InStr(1, sAlpha, Mid(sLine(Y), Z, 1)) > 0 [color=Blue]Then[/color]
                        Z = Z + 1
                    [color=Blue]Else[/color]
                        [color=Blue]Exit Do[/color]
                    [color=Blue]End If[/color]
                [color=Blue]Loop[/color] Until Z > [color=Blue]Len[/color](sLine(Y))
                [color=Green]' If Alphabetic string is in the list of reserved words,[/color]
                [color=Green]' set the string color to Blue[/color]
                [color=Blue]If[/color] InStr(1, sReservedWords, _
                    Chr(1) & Mid(sLine(Y), X, Z - X) & Chr(1)) > 0 [color=Blue]Then[/color]
                        FormatCode = FormatCode _
                            & "[b][/b][[b][/b]color=Blue]" _
                            & Mid(sLine(Y), X, Z - X) _
                            & "[b][/b][[b][/b]/color]"
                        X = Z
                [color=Blue]Else[/color]
                        FormatCode = FormatCode & Mid(sLine(Y), X, Z - X)
                        X = Z
                [color=Blue]End If[/color]
            [color=Blue]Else[/color]
                FormatCode = FormatCode & Mid(sLine(Y), X, 1)
                X = X + 1
            [color=Blue]End If[/color]
        [color=Blue]Loop[/color] Until X > [color=Blue]Len[/color](sLine(Y))
    [color=Blue]End If[/color]
    [color=Green]' If line comment exists, set the comment[/color]
    [color=Green]' color to Green and append to the line[/color]
    [color=Blue]If Len[/color](sComment) > 0 [color=Blue]Then[/color]
        FormatCode = FormatCode & "[b][/b][[b][/b]color=Green]" & sComment & "[b][/b][[b][/b]/color]"
    [color=Blue]End If[/color]
    FormatCode = FormatCode & vbNewLine
[color=Blue]Next[/color] Y

[color=Green]' Remove extraneous in-line Blue color indicators[/color]
FormatCode = Replace(FormatCode, "[b][/b][[b][/b]/color] [b][/b][[b][/b]color=Blue]", " ")

[color=Blue]End Function[/color]

modest, to use it on your form, modify your cmdUpdate_Click code thus:

[color=Blue]Private Sub[/color] cmdUpdate_Click()

    Me.txtCode = FormatCode(Me.txtCode)

[color=Blue]End Sub[/color]

 

[modest]

Looks good, now we have to add "Until" and other "blue-words" to the reserved word list - just put it in the string of the other words.

What we need now:
- Fix minor bugs: Words such as "Database" that should not be blue in circumstances, like DAO.Database
- An indent system
- A table managed reserved list


Indent System
Someone should come up with a system to check if the next line is indented the correct number of spaces (possibly supplied as an input textbox on a form) and if it isn't, indent it. For instance, if you begin a For Loop, all sublines should be 4 spaces in until the Next statement, when the next statement is reached, the indent size should remove. This should exist for loops, functions, and if statements (and any nested ones of these).

I imagine the easiest way to do this is just to use the trim() function to remove all blanks at the start of the next line and put in the indent itself, which would replace having to write a function to check the next line.


Table Managed Reserved List
The purpose of having the original list table managed is that future versions will allow users to put their own colors in for certain words. For instance, maybe all loop keywords will be yellow and all function names will be red. This would help view other people's code.


Modest's Notes:
I am pleased with what has come so far. Byte, I really wasn't expecting people to invest so much time into this, but if you like to, then go right ahead I will do personal work expanding on the concepts later.

 

[ByteMyzer]

That was my contribution. I'll leave the rest for others to contribute.