Code:
Module mdlConvertCode
Public Function ExtendedSplit(ByVal strInputString As String) As String()
Dim i As Integer
Dim objRegExp
Dim objMatch
Dim colMatches
Dim strOldValue As String
Dim strNewValue As String
Dim tempArr() As String
' Create a regular expression object.
objRegExp = CreateObject("VBScript.RegExp")
'Set the pattern.
objRegExp.Pattern = "\"".*?\"""
'Set global applicability.
objRegExp.Global = True
'Test whether the String can be compared.
If (objRegExp.Test(strInputString) = True) Then
'Get the matches.
colMatches = objRegExp.Execute(strInputString)
' Iterate Matches collection.
For Each objMatch In colMatches
strOldValue = objMatch.Value
strNewValue = Replace(strOldValue, Chr(34), Chr(128))
strNewValue = Replace(strNewValue, Chr(32), Chr(129))
'Debug.Print objMatch.Value
strInputString = Replace(strInputString, strOldValue, strNewValue)
Next
End If
For i = 1 To 127
Select Case i
Case 1 To 47, 59 To 64, 91 To 96, 123 To 127
strInputString = Replace(strInputString, Chr(i), " " & Chr(i) & " ")
End Select
Next i
Do While InStr(strInputString, Space(2))
strInputString = Replace(strInputString, Space(2), Space(1))
Loop
strInputString = Trim(strInputString)
tempArr = Split(strInputString, " ")
For i = 0 To UBound(tempArr)
tempArr(i) = Replace(tempArr(i), Chr(128), Chr(34))
tempArr(i) = Replace(tempArr(i), Chr(129), Chr(32))
Next i
ExtendedSplit = tempArr
End Function
Public Sub ConvertCode(ByVal Destination As RichTextBox, ByVal source As RichTextBox)
Dim lngLineCount As Long
Dim lngLinePos As Long
Dim strLineText As String
Dim strLineTextTemp As String
Dim lngWordPos As Long
Dim wrdWords() As String
Dim lngTextPos As Long
Dim blnMain As Boolean
Dim strFunctionName As String
Dim strHeaderPart As String
Dim strHeaderFunction As String
Dim strLastTart As String
Dim lngDestinationHeaderLen As Long
Dim lngDestinationHeaderPos As Long
Dim lngDestinationActualPos As Long
On Error Resume Next
If source.Text = "" Then Exit Sub
Destination.Text = ""
Destination.SelectedText = "#include <conio.h>" & vbNewLine
Destination.SelectedText = "#include <string.h>" & vbNewLine
Destination.SelectedText = "#include <iostream>" & vbNewLine
Destination.SelectedText = "#include <windows.h>" & vbNewLine
Destination.SelectedText = "using namespace std;" & vbNewLine
lngDestinationHeaderLen = Len(Destination.Text)
lngLineCount = source.Lines.Length 'diz-me o numero de linhas
strFunctionName = ""
For lngLinePos = 0 To lngLineCount - 1
strLineText = source.Lines(lngLinePos) 'da-me o texto de 1 linha
If strLineText = "" Then Continue For
wrdWords = ExtendedSplit(strLineText)
Debug.Print(wrdWords(0))
If wrdWords(0) = "End" Then
If blnMain = True Then
Destination.SelectedText = "return 0;" & vbNewLine
blnMain = False
End If
Destination.SelectedText = "}"
If lngLinePos < (lngLineCount - 1) Then Destination.SelectedText = vbNewLine
strFunctionName = ""
ElseIf wrdWords(0) <> "" And wrdWords(1) = "=" Then
If wrdWords(0) = strFunctionName Then
strLineTextTemp = Replace(strLineText, strFunctionName, "return ")
strLineTextTemp = Replace(strLineTextTemp, "=", " ")
Else
strLineTextTemp = strLineText
End If
Destination.SelectedText = strLineTextTemp & ";" & vbNewLine
ElseIf wrdWords(0) = "Write" = True Then
strLineTextTemp = Replace(strLineText, "Write", "cout << ")
strLineTextTemp = Replace(strLineTextTemp, "+", " << ")
strLineTextTemp = Replace(strLineTextTemp, ")", " ")
strLineTextTemp = Replace(strLineTextTemp, "(", " ")
strLineTextTemp = Replace(strLineTextTemp, """""", "\""")
strLineTextTemp = Replace(strLineTextTemp, "&", " << ")
strLineTextTemp = Replace(strLineTextTemp, "é", """ << (char) 130 << """)
strLineTextTemp = Replace(strLineTextTemp, "è", """ << (char) 138 << """)
strLineTextTemp = Replace(strLineTextTemp, "à", """ << (char) 133 << """)
strLineTextTemp = Replace(strLineTextTemp, "á", """ << (char) 160 << """)
strLineTextTemp = Replace(strLineTextTemp, "NewLine", " endl ")
Destination.SelectedText = strLineTextTemp & ";" & vbNewLine
ElseIf wrdWords(0) = "Int" = True Then
strLineTextTemp = strLineText
If wrdWords(2) = "=" Then
Destination.SelectedText = strLineTextTemp & ";" & vbNewLine
ElseIf wrdWords(2) = "(" And IsKeyWord(wrdWords(3)) = True And strFunctionName = "" Then
strHeaderPart = Mid(Destination.Text, 1, lngDestinationHeaderLen)
strHeaderFunction = strLineTextTemp & ";"
strLastTart = Mid(Destination.Text, lngDestinationHeaderLen, Len(Destination.Text) - lngDestinationHeaderLen + 2)
Destination.Text = strHeaderPart & strHeaderFunction & strLastTart
Destination.SelectionStart = Len(Destination.Text)
Destination.SelectedText = strLineTextTemp & vbNewLine & "{" & vbNewLine
strFunctionName = wrdWords(1)
End If
ElseIf wrdWords(0) = "String" = True Then
strLineTextTemp = strLineText
If wrdWords(2) = "=" Then
Destination.SelectedText = strLineTextTemp & ";" & vbNewLine
ElseIf wrdWords(2) = "(" And IsKeyWord(wrdWords(3)) = True And strFunctionName = "" Then
strHeaderPart = Mid(Destination.Text, 1, lngDestinationHeaderLen)
strHeaderFunction = strLineTextTemp & ";"
strLastTart = Mid(Destination.Text, lngDestinationHeaderLen, Len(Destination.Text) - lngDestinationHeaderLen + 2)
Destination.Text = strHeaderPart & strHeaderFunction & strLastTart
Destination.SelectionStart = Len(Destination.Text)
Destination.SelectedText = strLineTextTemp & vbNewLine & "{" & vbNewLine
strFunctionName = wrdWords(1)
End If
ElseIf wrdWords(0) = "Read" And wrdWords(1) = "(" And wrdWords(2) = ")" Then
strLineTextTemp = Replace(strLineText, "Read()", "getch()")
Destination.SelectedText = strLineTextTemp & ";" & vbNewLine
ElseIf wrdWords(0) = "Read" Then
strLineTextTemp = Replace(strLineText, "Read", "cin >> ")
strLineTextTemp = Replace(strLineTextTemp, "(", " ")
strLineTextTemp = Replace(strLineTextTemp, ")", " ")
Destination.SelectedText = strLineTextTemp & ";" & vbNewLine
ElseIf wrdWords(0) = "Boolean" Then
strLineTextTemp = Replace(strLineText, "Boolean", "bool")
If wrdWords(2) = "(" Then
strHeaderPart = Mid(Destination.Text, 1, lngDestinationHeaderLen)
strHeaderFunction = strLineTextTemp & ";"
strLastTart = Mid(Destination.Text, lngDestinationHeaderLen, Len(Destination.Text) - lngDestinationHeaderLen + 2)
Destination.Text = strHeaderPart & strHeaderFunction & strLastTart
Destination.SelectionStart = Len(Destination.Text)
Destination.SelectedText = strLineTextTemp & vbNewLine & "{" & vbNewLine
strFunctionName = wrdWords(1)
Else
Destination.SelectedText = strLineTextTemp & ";" & vbNewLine
End If
ElseIf wrdWords(0) = "Char" = True Then
strLineTextTemp = strLineText
If wrdWords(2) = "=" Then
Destination.SelectedText = strLineTextTemp & ";" & vbNewLine
ElseIf wrdWords(2) = "(" And IsKeyWord(wrdWords(3)) = True And strFunctionName = "" Then
lngDestinationActualPos = Destination.SelectedText
Destination.SelectionStart = lngDestinationHeaderPos
Destination.SelectedText = strLineTextTemp & ";" & vbNewLine
lngDestinationHeaderPos = Destination.SelectionStart
Destination.SelectionStart = lngDestinationActualPos
Destination.SelectedText = strLineTextTemp & vbNewLine & "{" & vbNewLine
strFunctionName = wrdWords(1)
End If
ElseIf wrdWords(0) = "Float" = True Then
strLineTextTemp = strLineText
If wrdWords(2) = "=" Then
Destination.SelectedText = strLineTextTemp & ";" & vbNewLine
ElseIf wrdWords(2) = "(" And IsKeyWord(wrdWords(3)) = True And strFunctionName = "" Then
strHeaderPart = Mid(Destination.Text, 1, lngDestinationHeaderLen)
strHeaderFunction = strLineTextTemp & ";"
strLastTart = Mid(Destination.Text, lngDestinationHeaderLen, Len(Destination.Text) - lngDestinationHeaderLen + 2)
Destination.Text = strHeaderPart & strHeaderFunction & strLastTart
Destination.SelectionStart = Len(Destination.Text)
Destination.SelectedText = strLineTextTemp & vbNewLine & "{" & vbNewLine
strFunctionName = wrdWords(1)
End If
ElseIf wrdWords(0) = "Double" = True Then
strLineTextTemp = strLineText
If wrdWords(2) = "=" Then
Destination.SelectedText = strLineTextTemp & ";" & vbNewLine
ElseIf wrdWords(2) = "(" And IsKeyWord(wrdWords(3)) = True And strFunctionName = "" Then
strHeaderPart = Mid(Destination.Text, 1, lngDestinationHeaderLen)
strHeaderFunction = strLineTextTemp & ";"
strLastTart = Mid(Destination.Text, lngDestinationHeaderLen, Len(Destination.Text) - lngDestinationHeaderLen + 2)
Destination.Text = strHeaderPart & strHeaderFunction & strLastTart
Destination.SelectionStart = Len(Destination.Text)
Destination.SelectedText = strLineTextTemp & vbNewLine & "{" & vbNewLine
strFunctionName = wrdWords(1)
End If
ElseIf wrdWords(0) = "Byte" = True Then
strLineTextTemp = Replace(strLineText, "Byte", "unsigned char")
If wrdWords(2) = "=" Then
Destination.SelectedText = strLineTextTemp & ";" & vbNewLine
ElseIf wrdWords(2) = "(" And IsKeyWord(wrdWords(3)) = True And strFunctionName = "" Then
strHeaderPart = Mid(Destination.Text, 1, lngDestinationHeaderLen)
strHeaderFunction = strLineTextTemp & ";"
strLastTart = Mid(Destination.Text, lngDestinationHeaderLen, Len(Destination.Text) - lngDestinationHeaderLen + 2)
Destination.Text = strHeaderPart & strHeaderFunction & strLastTart
Destination.SelectionStart = Len(Destination.Text)
Destination.SelectedText = strLineTextTemp & vbNewLine & "{" & vbNewLine
strFunctionName = wrdWords(1)
End If
ElseIf wrdWords(0) = "Sub" = True Then
If wrdWords(1) = "Main" = True Then
blnMain = True
strLineTextTemp = Replace(strLineText, "Sub Main", "int main")
Destination.SelectedText = strLineTextTemp & vbNewLine & "{" & vbNewLine
strFunctionName = "main"
Else
strLineTextTemp = Replace(strLineText, "Sub", "void")
Destination.SelectedText = strLineTextTemp & vbNewLine
Destination.SelectedText = "{" & vbNewLine
End If
Else
If strLineText <> "" Then
'strLineTextTemp = Replace(strLineText, "&", "+")
strLineTextTemp = Replace(strLineText, """""", "\""")
Destination.SelectedText = strLineTextTemp & ";" & vbNewLine
Else
Destination.SelectedText = vbNewLine
End If
End If
Next lngLinePos
End Sub
Public Function IsKeyWord(ByVal sWord As String) As Boolean
Dim sWordList() As String
Dim lnglenWord As Long
sWordList = Split("main end write short long byte string read char float double int sub")
' We put the delimiter character "|" at the start and end of the word list
' So that Instr$() Will not accidentally find a sub word, such as "end" in "spend"
IsKeyWord = False
For lnglenWord = 0 To UBound(sWordList)
If LCase(sWord) = sWordList(lnglenWord) Then
IsKeyWord = True
Exit Function
End If
Next lnglenWord
End Function
End ModuleCode:
ElseIf wrdWords(0) = "Read" Thenbut why the next ElseIf's aren't tested?:(
(these project have 2 richtextboxes and 1 button. in 1st richtextbox put(for example): "Sub Main". and you will see that these ElseIf isn't executed:(
Code:
ElseIf wrdWords(0) = "Sub" = True Then
If wrdWords(1) = "Main" = True Then
...and give me (only in Immediate window) the Index Out of Range Exception error.