Ir para conteúdo

POWERED BY:

Arquivado

Este tópico foi arquivado e está fechado para novas respostas.

cambalinho

[VB6] - 1 'for' infinito:(

Por , em Visual Basic

Recommended Posts

cambalinho    0

cambalinho
Postado

eu fiz 1 codigo para converter 1 linguagem para outra:

Option Explicit

Public Type Word
    SentenceWord As String
    Position As Long
    Size As Long
End Type

Public Type POINTAPI
    x As Long
    y As Long
End Type

Public Function GetLastWord(Text As String) As String
    Dim Words() As String
    Words = Split(Text, " ")
    GetLastWord = Words(UBound(Words))
End Function

Public Function IsKeyWord(ByVal sWord As String) As Boolean
    Dim sWordList() As String
    Dim lnglenWord As Long
    sWordList = Split("main end write")
    ' 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 sWord = sWordList(lnglenWord) Then
            IsKeyWord = True
            Exit Function
        End If
    Next lnglenWord
End Function

Public Function ExpertSplit(Sentence As String) As Word()
    Dim lngWord As Long
    Dim wrdWord() As Word
    Dim blnWordEnter As Boolean
    Dim lngSentencePos As Long
    Dim blnNoSpace As Boolean
        
    blnWordEnter = False
    blnNoSpace = True
    For lngSentencePos = 1 To Len(Sentence)
        If (Mid(Sentence, lngSentencePos, 1) <> " " Or lngSentencePos = Len(Sentence)) And blnWordEnter = False Then
            blnNoSpace = True
            blnWordEnter = True
            lngWord = lngWord + 1
            ReDim Preserve wrdWord(lngWord)
            wrdWord(lngWord).Position = lngSentencePos
        ElseIf Mid(Sentence, lngSentencePos, 1) = " " And blnWordEnter = True Then
            blnNoSpace = False
            blnWordEnter = False
            wrdWord(lngWord).Size = lngSentencePos - wrdWord(lngWord).Position
            wrdWord(lngWord).SentenceWord = Mid(Sentence, wrdWord(lngWord).Position, wrdWord(lngWord).Size)
        End If
    Next lngSentencePos
    If blnNoSpace = True Then
        ReDim wrdWord(1)
        wrdWord(0).SentenceWord = Sentence
        wrdWord(0).Position = 1
        wrdWord(0).Size = Len(Sentence)
    End If
    ExpertSplit = wrdWord()
    
End Function

Public Function GetTextLine(Text As String, LineNumber As Long) As String
    Dim strLines() As String
    If Len(Text) = 0 Or LineNumber < 1 Then
        GetTextLine = ""
        Exit Function
    End If
    strLines = Split(Text, Chr(13))
    
    If LineNumber > UBound(strLines) Then LineNumber = UBound(strLines)
    GetTextLine = strLines(LineNumber)
End Function

Public Function IsString(Text As String) As Boolean
    If Len(Text) = 0 Then
        IsString = False
        Exit Function
    End If
    If Mid(Text, 1, 1) = """" And Mid(Text, Len(Text), 1) = """" Then
        IsString = True
    Else
        IsString = False
    End If
End Function

Public Function LastChar(Text As String) As String
    LastChar = Right(Text, 1)
End Function

Public Function GetLineCount(Text As String) As Long
    Dim lngLineCount As Long
    Dim lngTextPos As Long
    
    If Len(Text) = 0 Then
        GetLineCount = 0
        Exit Function
    Else
        lngLineCount = 1
    End If
    
    For lngTextPos = 1 To Len(Text)
        If Mid(Text, lngTextPos, 2) = vbNewLine Then
            lngLineCount = lngLineCount + 1
        End If
    Next
    
    GetLineCount = lngLineCount
    
End Function

Public Sub ConvertCode(Destination As RichTextBox, Source As RichTextBox)
    Dim lngLineCount As Long
    Dim lngLinePos As Long
    Dim strLineText As String
    Dim lngWordPos As Long
    Dim wrdWords() As Word
    
    Destination.SelText = "#include <stdio.h>" & vbNewLine
    
    lngLineCount = GetLineCount(Source.Text) 'diz-me o numero de linhas
   
    For lngLinePos = 1 To lngLineCount
        strLineText = GetTextLine(Source.Text, lngLinePos) 'da-me o texto de 1 linha
        
        wrdWords() = ExpertSplit(strLineText) 'mete as palavras separadas em 1 array
        
        For lngWordPos = 0 To UBound(wrdWords) - 1
            If wrdWords(lngWordPos).SentenceWord = "main" Then
                Destination.SelText = "int main()" & vbNewLine & "{" & vbNewLine
            ElseIf wrdWords(lngWordPos).SentenceWord = "end" Then
                Destination.SelText = "return 0" & vbNewLine & "}" & vbNewLine
            End If
            DoEvents
        Next lngWordPos
    Next lngLinePos
End Sub

o procedimento ConvertCode() é que faz o serviço. mas por algum motivo, ele da-me 1 ciclo infinito:(

alguem me pode explicar o que estou a fazer mal?

Compartilhar este post

Link para o post
Compartilhar em outros sites

cambalinho    0

cambalinho
Postado

Um ciclo infinito? Ele nunca para de rodar?

sim.. mas ja consegui resolver isso... obrigado

Option Explicit

Public Type Word
    SentenceWord As String
    Position As Long
    Size As Long
End Type

Public Type POINTAPI
    x As Long
    y As Long
End Type

Public Function GetLastWord(ByVal Text As String) As String
    Dim Words() As String
    Words = Split(Text, " ")
    GetLastWord = Words(UBound(Words))
End Function

Public Function IsKeyWord(ByVal sWord As String) As Boolean
    Dim sWordList() As String
    Dim lnglenWord As Long
    sWordList = Split("main end write getanykey")
    ' 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 sWord = sWordList(lnglenWord) Then
            IsKeyWord = True
            Exit Function
        End If
    Next lnglenWord
End Function

Public Function ExpertSplit(ByVal Sentence As String) As Word()
    Dim lngWord As Long
    Dim wrdWord() As Word
    Dim blnWordEnter As Boolean
    Dim lngSentencePos As Long
    Dim blnNoSpace As Boolean
        
    blnWordEnter = False
    blnNoSpace = True
    For lngSentencePos = 1 To Len(Sentence)
        If (Mid(Sentence, lngSentencePos, 1) <> " " Or lngSentencePos = Len(Sentence)) And blnWordEnter = False Then
            blnNoSpace = True
            blnWordEnter = True
            lngWord = lngWord + 1
            ReDim Preserve wrdWord(lngWord)
            wrdWord(lngWord).Position = lngSentencePos
        ElseIf Mid(Sentence, lngSentencePos, 1) = " " And blnWordEnter = True Then
            blnNoSpace = False
            blnWordEnter = False
            wrdWord(lngWord).Size = lngSentencePos - wrdWord(lngWord).Position
            wrdWord(lngWord).SentenceWord = Mid(Sentence, wrdWord(lngWord).Position, wrdWord(lngWord).Size)
        End If
    Next lngSentencePos
    If blnNoSpace = True Then
        ReDim wrdWord(1)
        wrdWord(0).SentenceWord = Sentence
        wrdWord(0).Position = 1
        wrdWord(0).Size = Len(Sentence)
    End If
    ExpertSplit = wrdWord()
    
End Function

Public Function GetTextLine(ByVal Text As String, ByVal LineNumber As Long) As String
    Dim strLines() As String
    
    If Len(Text) = 0 Or LineNumber < 0 Then
        GetTextLine = ""
        Exit Function
    Else
        
    End If
    strLines() = Split(Text, vbNewLine)
    
    If LineNumber > UBound(strLines) Then LineNumber = UBound(strLines)
    GetTextLine = strLines(LineNumber)
End Function

Public Function IsString(ByVal Text As String) As Boolean
    If Len(Text) = 0 Then
        IsString = False
        Exit Function
    End If
    If Mid(Text, 1, 1) = """" And Mid(Text, Len(Text), 1) = """" Then
        IsString = True
    Else
        IsString = False
    End If
End Function

Public Function LastChar(ByVal Text As String) As String
    LastChar = Right(Text, 1)
End Function

Public Function GetLineCount(Text As String) As Long
    Dim lngLineCount As Long
    Dim lngCrLfPos As Long
    
    If Len(Text) <> 0 Then
        lngCrLfPos = 1
        Do
            lngCrLfPos = InStr(lngCrLfPos, Text, vbNewLine)
            If lngCrLfPos = 0 Then
                Exit Do
            Else
                lngLineCount = lngLineCount + 1
                lngCrLfPos = lngCrLfPos + 2
            End If
        Loop
    End If
    
    GetLineCount = lngLineCount
    
End Function

Public Sub ConvertCode(Destination As RichTextBox, Source As RichTextBox)
    Dim lngLineCount As Long
    Dim lngLinePos As Long
    Dim strLineText As String
    Dim lngWordPos As Long
    Dim wrdWords() As Word
    
    Destination.Text = ""
    Destination.SelText = "#include <stdio.h>" & vbNewLine
    Destination.SelText = "#include <conio.h>" & vbNewLine
    
    lngLineCount = GetLineCount(Source.Text) 'diz-me o numero de linhas
    For lngLinePos = 0 To lngLineCount
        strLineText = GetTextLine(Source.Text, lngLinePos) 'da-me o texto de 1 linha
        
        wrdWords() = ExpertSplit(strLineText) 'mete as palavras separadas em 1 array
        
        For lngWordPos = 0 To UBound(wrdWords)
            If wrdWords(lngWordPos).SentenceWord = "main" Then
                Destination.SelText = "int main()" & vbNewLine & "{" & vbNewLine
            ElseIf wrdWords(lngWordPos).SentenceWord Like "*write*" = True Then
                Destination.SelText = "printf" & Mid(wrdWords(lngWordPos).SentenceWord, 9, wrdWords(lngWordPos).Size - 8) & ";" & vbNewLine
            ElseIf wrdWords(lngWordPos).SentenceWord Like "*getanykey*" = True Then
                Destination.SelText = "getch();" & vbNewLine
            ElseIf wrdWords(lngWordPos).SentenceWord = "end" Then
                Destination.SelText = "return 0;" & vbNewLine & "}" & vbNewLine
            End If
            DoEvents
        Next lngWordPos
    Next lngLinePos
End Sub

tinha alguns erros nas funçoes\procedimentos;)

muito obrigado

 

Um ciclo infinito? Ele nunca para de rodar?

sim.. mas ja consegui resolver isso... obrigado

Option Explicit

Public Type Word
    SentenceWord As String
    Position As Long
    Size As Long
End Type

Public Type POINTAPI
    x As Long
    y As Long
End Type

Public Function GetLastWord(ByVal Text As String) As String
    Dim Words() As String
    Words = Split(Text, " ")
    GetLastWord = Words(UBound(Words))
End Function

Public Function IsKeyWord(ByVal sWord As String) As Boolean
    Dim sWordList() As String
    Dim lnglenWord As Long
    sWordList = Split("main end write getanykey")
    ' 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 sWord = sWordList(lnglenWord) Then
            IsKeyWord = True
            Exit Function
        End If
    Next lnglenWord
End Function

Public Function ExpertSplit(ByVal Sentence As String) As Word()
    Dim lngWord As Long
    Dim wrdWord() As Word
    Dim blnWordEnter As Boolean
    Dim lngSentencePos As Long
    Dim blnNoSpace As Boolean
        
    blnWordEnter = False
    blnNoSpace = True
    For lngSentencePos = 1 To Len(Sentence)
        If (Mid(Sentence, lngSentencePos, 1) <> " " Or lngSentencePos = Len(Sentence)) And blnWordEnter = False Then
            blnNoSpace = True
            blnWordEnter = True
            lngWord = lngWord + 1
            ReDim Preserve wrdWord(lngWord)
            wrdWord(lngWord).Position = lngSentencePos
        ElseIf Mid(Sentence, lngSentencePos, 1) = " " And blnWordEnter = True Then
            blnNoSpace = False
            blnWordEnter = False
            wrdWord(lngWord).Size = lngSentencePos - wrdWord(lngWord).Position
            wrdWord(lngWord).SentenceWord = Mid(Sentence, wrdWord(lngWord).Position, wrdWord(lngWord).Size)
        End If
    Next lngSentencePos
    If blnNoSpace = True Then
        ReDim wrdWord(1)
        wrdWord(0).SentenceWord = Sentence
        wrdWord(0).Position = 1
        wrdWord(0).Size = Len(Sentence)
    End If
    ExpertSplit = wrdWord()
    
End Function

Public Function GetTextLine(ByVal Text As String, ByVal LineNumber As Long) As String
    Dim strLines() As String
    
    If Len(Text) = 0 Or LineNumber < 0 Then
        GetTextLine = ""
        Exit Function
    Else
        
    End If
    strLines() = Split(Text, vbNewLine)
    
    If LineNumber > UBound(strLines) Then LineNumber = UBound(strLines)
    GetTextLine = strLines(LineNumber)
End Function

Public Function IsString(ByVal Text As String) As Boolean
    If Len(Text) = 0 Then
        IsString = False
        Exit Function
    End If
    If Mid(Text, 1, 1) = """" And Mid(Text, Len(Text), 1) = """" Then
        IsString = True
    Else
        IsString = False
    End If
End Function

Public Function LastChar(ByVal Text As String) As String
    LastChar = Right(Text, 1)
End Function

Public Function GetLineCount(Text As String) As Long
    Dim lngLineCount As Long
    Dim lngCrLfPos As Long
    
    If Len(Text) <> 0 Then
        lngCrLfPos = 1
        Do
            lngCrLfPos = InStr(lngCrLfPos, Text, vbNewLine)
            If lngCrLfPos = 0 Then
                Exit Do
            Else
                lngLineCount = lngLineCount + 1
                lngCrLfPos = lngCrLfPos + 2
            End If
        Loop
    End If
    
    GetLineCount = lngLineCount
    
End Function

Public Sub ConvertCode(Destination As RichTextBox, Source As RichTextBox)
    Dim lngLineCount As Long
    Dim lngLinePos As Long
    Dim strLineText As String
    Dim lngWordPos As Long
    Dim wrdWords() As Word
    
    Destination.Text = ""
    Destination.SelText = "#include <stdio.h>" & vbNewLine
    Destination.SelText = "#include <conio.h>" & vbNewLine
    
    lngLineCount = GetLineCount(Source.Text) 'diz-me o numero de linhas
    For lngLinePos = 0 To lngLineCount
        strLineText = GetTextLine(Source.Text, lngLinePos) 'da-me o texto de 1 linha
        
        wrdWords() = ExpertSplit(strLineText) 'mete as palavras separadas em 1 array
        
        For lngWordPos = 0 To UBound(wrdWords)
            If wrdWords(lngWordPos).SentenceWord = "main" Then
                Destination.SelText = "int main()" & vbNewLine & "{" & vbNewLine
            ElseIf wrdWords(lngWordPos).SentenceWord Like "*write*" = True Then
                Destination.SelText = "printf" & Mid(wrdWords(lngWordPos).SentenceWord, 9, wrdWords(lngWordPos).Size - 8) & ";" & vbNewLine
            ElseIf wrdWords(lngWordPos).SentenceWord Like "*getanykey*" = True Then
                Destination.SelText = "getch();" & vbNewLine
            ElseIf wrdWords(lngWordPos).SentenceWord = "end" Then
                Destination.SelText = "return 0;" & vbNewLine & "}" & vbNewLine
            End If
            DoEvents
        Next lngWordPos
    Next lngLinePos
End Sub

tinha alguns erros nas funçoes\procedimentos;)

muito obrigado

Compartilhar este post

Link para o post
Compartilhar em outros sites
Ir para a lista de tópicos Visual Basic
×

Informação importante

Ao usar o fórum, você concorda com nossos Termos e condições.

  Aceito