elhacker.net cabecera Bienvenido(a), Visitante. Por favor Ingresar o Registrarse
¿Perdiste tu email de activación?.

 

 


Tema destacado: Los 10 CVE más críticos (peligrosos) de 2020


+  Foro de elhacker.net
|-+  Programación
| |-+  Programación General
| | |-+  .NET (C#, VB.NET, ASP)
| | | |-+  Programación Visual Basic (Moderadores: LeandroA, seba123neo)
| | | | |-+  [AYUDA][SOLUCIONADO] Richtextbox no acepta mayusculas
0 Usuarios y 1 Visitante están viendo este tema.
Páginas: [1] Ir Abajo Respuesta Imprimir
Autor Tema: [AYUDA][SOLUCIONADO] Richtextbox no acepta mayusculas  (Leído 3,143 veces)
coku

Desconectado Desconectado

Mensajes: 17


Ver Perfil
[AYUDA][SOLUCIONADO] Richtextbox no acepta mayusculas
« 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:
Código:
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:
Código:
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:
Código:
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^^


« Última modificación: 7 Diciembre 2007, 13:17 pm por coku » En línea

SKL (orignal)

Desconectado Desconectado

Mensajes: 259


UpLoadSourceCode


Ver Perfil WWW
Re: [AYUDA] Richtextbox no acepta mayusculas
« Respuesta #1 en: 7 Diciembre 2007, 06:10 am »

fijate que estas usando la propiedad LCASE y eso pone las letras en minusculas

saludos


En línea

coku

Desconectado Desconectado

Mensajes: 17


Ver Perfil
Re: [AYUDA] Richtextbox no acepta mayusculas
« Respuesta #2 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^^
En línea

Páginas: [1] Ir Arriba Respuesta Imprimir 

Ir a:  

WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines