Título: [AYUDA][SOLUCIONADO] Richtextbox no acepta mayusculas
Publicado por: coku en 6 Diciembre 2007, 15:37 pm
buenas. m problema es el siguiente: Tengo un text1, el cual al pulsar enter escribe lo que teiene escrito en el rich textbox, este usa modulo para sobresaltar palabras escritar con colores. Mi problema esque si escribo en el textbox algo en mayusculas y le doy a enter se atasca y no lo envia. Codigos: module: Public currchar Public thisLine Public tstart Public tend Public holdtend Public holdtstart Public TopLine Public foundpos Public commentchar As String Public longvar As String
Public Declare Function LockWindowUpdate Lib "user32" _ (ByVal hwndLock As Long) As Long
Public Function ColorizeWord(Rich1 As RichTextBox, Word As String, color As OLE_COLOR)
Do Until Rich1.GetLineFromChar(tstart) <> thisLine tstart = tstart - 1 If tstart < 0 Then tstart = 0 Exit Do End If Loop
startline = Rich1.GetLineFromChar(Rich1.SelStart) If Rich1.SelLength > 0 Then Exit Function Rich1.Enabled = False
tstart = tstart If tstart = 0 Then tstart = 1 End If
tstart = tstart - Len(Word)
Do nowline = Rich1.GetLineFromChar(Rich1.SelStart) If nowline <> startline Then GoTo endx holdtstart = tstart + Len(Word) commentposx = InStr(holdtstart, Rich1.Text, commentchar, vbTextCompare) If holdtstart < 1 Then holdtstart = 1 End If
tstart = tstart + Len(Word) foundpos = InStr(tstart, Rich1.Text, Word, vbTextCompare) If foundpos > tend Then GoTo endx ''''''''''''''''''''' If foundpos < 1 Then GoTo endx If foundpos < 2 Then sletter = "" Else sletter = Mid(Rich1.Text, foundpos - 1, 1) End If eletter = Mid(Rich1.Text, foundpos + Len(Word), 1) If foundpos > 0 Then If foundpos = 1 Then tstart = tstart - 1 End If
Rich1.SelStart = foundpos - 1 Rich1.SelLength = Len(Word) '################################################### If Word = commentchar Then tend = Rich1.SelStart Do Until Rich1.GetLineFromChar(tend) <> thisLine tend = tend + 1 If tend > Len(Rich1.Text) Then tend = Len(Rich1.Text) + 1 Exit Do End If Loop Rich1.SelStart = foundpos - 1 Rich1.SelLength = tend - (foundpos - 1) Rich1.SelColor = color Rich1.SelLength = 0 Rich1.SelStart = currchar Rich1.SelColor = &H0& Exit Function Exit Do End If '''''''''''''''''''''''''''''' If Word = longvar Then tend = Rich1.SelStart Do Until Rich1.GetLineFromChar(tend) <> thisLine tend = tend + 1 If tend > Len(Rich1.Text) Then tend = Len(Rich1.Text) + 1 Exit Do End If Loop
pos = tstart Do foundpos = InStr(pos, Rich1.Text, longvar, vbTextCompare)
For i = foundpos To tend If foundpos < 1 Then Exit For If i = tend Then Exit For Rich1.SelStart = i - 1 Rich1.SelLength = 1 If Rich1.SelText = "" Then Exit For Select Case Asc(Rich1.SelText) Case 48 To 57 Rich1.SelColor = color Case 36 Rich1.SelColor = color Case 97 To 122 Rich1.SelColor = color Case 65 To 90 Rich1.SelColor = color Case 145 Rich1.SelColor = color Case 146 Rich1.SelColor = color Case 143 Rich1.SelColor = color Case 143 Rich1.SelColor = color Case Else Exit For End Select
Next
pos = foundpos + 2 Loop While foundpos > 0
GoTo endx End If
If tstart = 0 Then tstart = 1 End If commentposx = InStr(tstart, Rich1.Text, commentchar, vbTextCompare) If commentposx > 0 Then If Rich1.SelStart > commentposx Then GoTo endx End If
If Len(Word) = 1 Then Rich1.SelStart = foundpos - 1 Rich1.SelLength = Len(Word) Rich1.SelColor = color End If
If eletter = "" And sletter = "" Then theword = Rich1.SelText originaltext = Rich1.SelText theword = LCase(theword) firstchar = Mid(theword, 1, 1) rest = Mid(theword, 2, Len(theword)) Rich1.SelText = firstchar & rest Rich1.SelStart = foundpos - 1 Rich1.SelLength = Len(Word) Rich1.SelColor = color End If If eletter = "" And sletter = " " Then theword = Rich1.SelText originaltext = Rich1.SelText theword = LCase(theword) firstchar = Mid(theword, 1, 1) rest = Mid(theword, 2, Len(theword)) Rich1.SelText = firstchar & rest Rich1.SelStart = foundpos - 1 Rich1.SelLength = Len(Word) Rich1.SelColor = color End If If eletter = " " And sletter = "" Then theword = Rich1.SelText originaltext = Rich1.SelText theword = LCase(theword) firstchar = Mid(theword, 1, 1) rest = Mid(theword, 2, Len(theword)) Rich1.SelText = firstchar & rest Rich1.SelStart = foundpos - 1 Rich1.SelLength = Len(Word) Rich1.SelColor = color End If If eletter = " " And sletter = " " Then theword = Rich1.SelText originaltext = Rich1.SelText theword = LCase(theword) firstchar = Mid(theword, 1, 1) rest = Mid(theword, 2, Len(theword)) Rich1.SelText = firstchar & rest Rich1.SelStart = foundpos - 1 Rich1.SelLength = Len(Word) Rich1.SelColor = color End If If eletter = "" And sletter = Chr(10) Then theword = Rich1.SelText originaltext = Rich1.SelText theword = LCase(theword) firstchar = Mid(theword, 1, 1) rest = Mid(theword, 2, Len(theword)) Rich1.SelText = firstchar & rest Rich1.SelStart = foundpos - 1 Rich1.SelLength = Len(Word) Rich1.SelColor = color End If
If eletter = " " And sletter = Chr(10) Then theword = Rich1.SelText originaltext = Rich1.SelText theword = LCase(theword) firstchar = Mid(theword, 1, 1) rest = Mid(theword, 2, Len(theword)) Rich1.SelText = firstchar & rest Rich1.SelStart = foundpos - 1 Rich1.SelLength = Len(Word) Rich1.SelColor = color End If
If eletter = Chr(10) And sletter = "" Then theword = Rich1.SelText originaltext = Rich1.SelText theword = LCase(theword) firstchar = Mid(theword, 1, 1) rest = Mid(theword, 2, Len(theword)) Rich1.SelText = firstchar & rest Rich1.SelStart = foundpos - 1 Rich1.SelLength = Len(Word) Rich1.SelColor = color End If
If eletter = Chr(10) And sletter = " " Then theword = Rich1.SelText originaltext = Rich1.SelText theword = LCase(theword) firstchar = Mid(theword, 1, 1) rest = Mid(theword, 2, Len(theword)) Rich1.SelText = firstchar & rest Rich1.SelStart = foundpos - 1 Rich1.SelLength = Len(Word) Rich1.SelColor = color End If
If eletter = Chr(10) And sletter = Chr(10) Then theword = Rich1.SelText originaltext = Rich1.SelText theword = LCase(theword) firstchar = Mid(theword, 1, 1) rest = Mid(theword, 2, Len(theword)) Rich1.SelText = firstchar & rest Rich1.SelStart = foundpos - 1 Rich1.SelLength = Len(Word) Rich1.SelColor = color End If
If eletter = Chr(13) And sletter = Chr(10) Then theword = Rich1.SelText originaltext = Rich1.SelText theword = LCase(theword) firstchar = Mid(theword, 1, 1) rest = Mid(theword, 2, Len(theword)) Rich1.SelText = firstchar & rest Rich1.SelStart = foundpos - 1 Rich1.SelLength = Len(Word) Rich1.SelColor = color End If
If eletter = Chr(13) And sletter = "" Then theword = Rich1.SelText originaltext = Rich1.SelText theword = LCase(theword) firstchar = Mid(theword, 1, 1) rest = Mid(theword, 2, Len(theword)) Rich1.SelText = firstchar & rest Rich1.SelStart = foundpos - 1 Rich1.SelLength = Len(Word) Rich1.SelColor = color End If
If eletter = Chr(13) And sletter = " " Then theword = Rich1.SelText originaltext = Rich1.SelText theword = LCase(theword) firstchar = Mid(theword, 1, 1) rest = Mid(theword, 2, Len(theword)) Rich1.SelText = firstchar & rest Rich1.SelStart = foundpos - 1 Rich1.SelLength = Len(Word) Rich1.SelColor = color End If
Rich1.SelLength = 0 End If If foundpos = 1 Then tstart = tstart + 1 End If
Loop While foundpos > 0 endx:
Rich1.SelStart = currchar Rich1.SelColor = &H0& foundpos = 0 eletter = "" sletter = "" Rich1.Enabled = True
End Function
Public Function clearwordcolors(Rich1 As RichTextBox)
If Rich1.SelLength > 0 Then Exit Function Rich1.Enabled = False currchar = Rich1.SelStart
thisLine = Rich1.GetLineFromChar(Rich1.SelStart) 'Form1.Caption = KeyCode tstart = Rich1.SelStart tend = Rich1.SelStart With Rich1 Do Until .GetLineFromChar(tstart) <> thisLine tstart = tstart - 1 If tstart < 0 Then tstart = 0 Exit Do End If Loop
Do Until .GetLineFromChar(tend) <> thisLine tend = tend + 1 If tend > Len(.Text) Then tend = Len(.Text) + 1 Exit Do End If
Loop End With If tstart = 1 Then tend = tend - 2 End If If tstart > 1 Then tstart = tstart + 1 tend = tend - 1 End If holdtstart = tstart holdtend = tend Rich1.SelStart = tstart Rich1.SelLength = tend - tstart Rich1.SelColor = &H0& Rich1.SelLength = 0 Rich1.SelStart = currchar holdtend = tend Rich1.Enabled = True
End Function
Rich1: Private Sub Rich1_KeyUp(KeyCode As Integer, Shift As Integer) setcolors End Sub
Private Sub Rich1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single) setcolors End Sub
Public Sub setcolors() commentchar = "'" longvar = "$" If KeyCode = 13 Then Exit Sub LockWindowUpdate Me.hWnd clearwordcolors Rich1 ColorizeWord Rich1, "longvar", &H80& 'This is for vars with no fixed lenght e.g (in perl _ it could be $122434 0r $myvarx or $x ..... Always set this ($) as first word to colorize ColorizeWord Rich1, "", &H8000& 'This char is for comments like this ''''''''''''''''''''''''''''''''''''''''''''''''''''''' ColorizeWord Rich1, "mes", &H800000 ColorizeWord Rich1, "and", &H800000 ColorizeWord Rich1, "random", &H800000 ColorizeWord Rich1, "append", &H800000 ColorizeWord Rich1, "binary", &H800000 ColorizeWord Rich1, "exit", &H800000 ColorizeWord Rich1, "then", &H800000 ColorizeWord Rich1, "goto", &H800000 ColorizeWord Rich1, "case", &H800000 ColorizeWord Rich1, "select", &H800000 ColorizeWord Rich1, "end", &H800000 ColorizeWord Rich1, "Select Case", &H800000 ColorizeWord Rich1, "End select", &H800000 ColorizeWord Rich1, "for", &H800000 ColorizeWord Rich1, "each", &H800000 ColorizeWord Rich1, "loop", &H800000 ColorizeWord Rich1, "While", &H800000 ColorizeWord Rich1, "Until", &H800000 ColorizeWord Rich1, "for each", &H800000 ColorizeWord Rich1, "Next", &H800000 ColorizeWord Rich1, "True", &H800000 ColorizeWord Rich1, "False", &H800000 ColorizeWord Rich1, "sub", &H800000 ColorizeWord Rich1, "function", &H800000 ColorizeWord Rich1, "Integer", &H800000 ColorizeWord Rich1, "As", &H800000 ColorizeWord Rich1, "Private", &H800000 ColorizeWord Rich1, "Dim", &H800000 ColorizeWord Rich1, "else", &H800000 ColorizeWord Rich1, "else if", &H800000 ColorizeWord Rich1, "Public", &H800000 ColorizeWord Rich1, "Close", &H800000 ColorizeWord Rich1, "Open", &H800000 ColorizeWord Rich1, "End If", &H800000 ColorizeWord Rich1, "If", &H800000 ColorizeWord Rich1, "(", &H800000 ColorizeWord Rich1, ")", &H800000
LockWindowUpdate 0& Rich1.Enabled = True If Rich1.Visible = True Then Rich1.SetFocus End If End Sub
Text1: Private Sub Text2_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then SendKeys "{tab}", True KeyAscii = 0 Rich1 = Rich1.Text & vbCrLf & " mes " & """" & Text2 & """" Text2 = "" End If End Sub El rpoblema esque no me esplicaron bien el module y etnonces pormi solo nose nada sobre lo que esta mal en el module. Se agradece la ayuda de antemano^^
Título: Re: [AYUDA] Richtextbox no acepta mayusculas
Publicado por: SKL (orignal) en 7 Diciembre 2007, 06:10 am
fijate que estas usando la propiedad LCASE y eso pone las letras en minusculas
saludos
Título: Re: [AYUDA] Richtextbox no acepta mayusculas
Publicado por: coku en 7 Diciembre 2007, 10:48 am
Entonces quitando la opcion theword = LCASE(theword) me deberia aceptar ambas.
El problema esque no me esplicaron nada, muchas gracias por la ayuda^^
|