Newsgroup: it.comp.lang.visual-basic
Titolo: [?] Evidenziare il testo in una RichTextBox: come?

Salve a tutti, sto da poco usando il controllo richTextBox per realizzare un
visualizzatore di testo, non sono riuscito però a trovare il metodo per
evidenziare una porzione di testo (ovvero cambiarne il backcolor)...
qualcuno mi può aiutare ?
se al limite non è possibile farlo conoscete qualche altro controllo free
che permetta di farlo ?
GRAZIE

 ha
scritto: 

questo ti permette ti cambiare il colore del testo, non so se
però tu volevi cambiare il colore dello sfondo sotto il testo...
 With
richtextbox1
        .SelStart = 'posizione carattere da dove vuoi
iniziare a cambaire il colore
        .SelLength = quanti caratteri vuoi
colorare
        .SelColor = vbYellow ' colore, io ho messo giallo
End With
ciao
--------------------------------
Inviato via 
http://usenet.iol.it
 


se ti riferisci allo sfondo di una porzione di testo ho anchio lo stesso
problema da 1 settimana forse più se trovo qualcosa te la mando.

 problema da 1 settimana forse più se trovo qualcosa te la mando.
OK Grazie
CIAO

allora, quello che di seguito scrivo è il codice che usa il mio client in vb
per mostrarmi le scritte colorate di mirc,
se avete sottomano una stringa pura di un server sostituitela al posto di
msg e vedrete nel controllo rich che avrete messo sul vs. form quello che
succede
se non l'avete usate una di queste:
" 7NOI  3NON  7TRATTIAMO  3CAROTE"
"#linux-tech 5 :  2# 12linux-tech 2@AzzurraNET   4~ "
" 10I 11t 10A 11l 10i 11A 10m 11I 10c 11I "
al posto di nick mettete una stringa qualsiasi
query mettetelo come ""
In caso vi servano ulteriori chiarimenti ditelo... il source dell''ocx
completo lo trovate su 
http://vbios.cjb.net
 sezione internet XROOM.OCX
Questo codice può fare qualsiasi carattere di qualsiasi colore ed ogni
carattere con un suo colore di sfondo ed un' po' di altre cose....
ciao
                        _pixel_
p.i....@katamail.com
http://vbios.cjb.net
Sub QueryMsg(Nick As String, Query As String, Msg As String)
Dim t As Integer
Dim tt As Integer
Dim ttt As Integer
Dim strmirc As String
Dim zz As Integer
strmirc = Msg
sfondo_colore1:
zz = InStr(1, strmirc, " 10,", vbTextCompare)
If zz <> 0 Then
    If IsNumeric(Mid$(strmirc, zz + 4, 1)) Then
        strmirc = Left$(strmirc, zz - 1) + "\highlight4  " + Right$(strmirc,
Len(strmirc) - zz - 3)
    Else
        strmirc = Left$(strmirc, zz - 1) + "\cf4 " + Right$(strmirc,
Len(strmirc) - zz - 2)
    End If
  GoTo sfondo_colore1
End If
sfondo_colore2:
zz = InStr(1, strmirc, " 11,", vbTextCompare)
If zz <> 0 Then
    If IsNumeric(Mid$(strmirc, zz + 4, 1)) Then
        strmirc = Left$(strmirc, zz - 1) + "\highlight12  " +
Right$(strmirc, Len(strmirc) - zz - 3)
    Else
        strmirc = Left$(strmirc, zz - 1) + "\cf12 " + Right$(strmirc,
Len(strmirc) - zz - 2)
    End If
  GoTo sfondo_colore2
End If
sfondo_colore3:
zz = InStr(1, strmirc, " 12,", vbTextCompare)
If zz <> 0 Then
    If IsNumeric(Mid$(strmirc, zz + 4, 1)) Then
        strmirc = Left$(strmirc, zz - 1) + "\highlight10  " +
Right$(strmirc, Len(strmirc) - zz - 3)
    Else
        strmirc = Left$(strmirc, zz - 1) + "\cf10 " + Right$(strmirc,
Len(strmirc) - zz - 2)
    End If
  GoTo sfondo_colore3
End If
sfondo_colore4: ' 13
zz = InStr(1, strmirc, " 13,", vbTextCompare)
If zz <> 0 Then
    If IsNumeric(Mid$(strmirc, zz + 4, 1)) Then
        strmirc = Left$(strmirc, zz - 1) + "\highlight14  " +
Right$(strmirc, Len(strmirc) - zz - 3)
    Else
        strmirc = Left$(strmirc, zz - 1) + "\cf14 " + Right$(strmirc,
Len(strmirc) - zz - 2)
    End If
  GoTo sfondo_colore4
End If
sfondo_colore5: ' 14
zz = InStr(1, strmirc, " 14,", vbTextCompare)
If zz <> 0 Then
    If IsNumeric(Mid$(strmirc, zz + 4, 1)) Then
        strmirc = Left$(strmirc, zz - 1) + "\highlight9  " + Right$(strmirc,
Len(strmirc) - zz - 3)
    Else
        strmirc = Left$(strmirc, zz - 1) + "\cf9 " + Right$(strmirc,
Len(strmirc) - zz - 2)
    End If
  GoTo sfondo_colore5
End If
sfondo_colore6: ' 15
zz = InStr(1, strmirc, " 15,", vbTextCompare)
If zz <> 0 Then
    If IsNumeric(Mid$(strmirc, zz + 4, 1)) Then
        strmirc = Left$(strmirc, zz - 1) + "\highlight8  " + Right$(strmirc,
Len(strmirc) - zz - 3)
    Else
        strmirc = Left$(strmirc, zz - 1) + "\cf8 " + Right$(strmirc,
Len(strmirc) - zz - 2)
    End If
  GoTo sfondo_colore6
End If
sfondo_colore7: ' 0
zz = InStr(1, strmirc, " 0,", vbTextCompare)
If zz <> 0 Then
    If IsNumeric(Mid$(strmirc, zz + 3, 1)) Then
        strmirc = Left$(strmirc, zz - 1) + "\highlight16  " +
Right$(strmirc, Len(strmirc) - zz - 2)
    Else
        strmirc = Left$(strmirc, zz - 1) + "\cf16 " + Right$(strmirc,
Len(strmirc) - zz - 2)
    End If
  GoTo sfondo_colore7
End If
sfondo_colore8: ' 1
zz = InStr(1, strmirc, " 1,", vbTextCompare)
If zz <> 0 Then
    If IsNumeric(Mid$(strmirc, zz + 3, 1)) Then
        strmirc = Left$(strmirc, zz - 1) + "\highlight1  " + Right$(strmirc,
Len(strmirc) - zz - 2)
    Else
        strmirc = Left$(strmirc, zz - 1) + "\cf1 " + Right$(strmirc,
Len(strmirc) - zz - 2)
    End If
  GoTo sfondo_colore8
End If
sfondo_colore9: ' 2
zz = InStr(1, strmirc, " 2,", vbTextCompare)
If zz <> 0 Then
    If IsNumeric(Mid$(strmirc, zz + 3, 1)) Then
        strmirc = Left$(strmirc, zz - 1) + "\highlight2  " + Right$(strmirc,
Len(strmirc) - zz - 2)
    Else
        strmirc = Left$(strmirc, zz - 1) + "\cf2 " + Right$(strmirc,
Len(strmirc) - zz - 2) 'aggiunta
    End If
GoTo sfondo_colore9
End If
sfondo_colore10: ' 3
zz = InStr(1, strmirc, " 3,", vbTextCompare)
If zz <> 0 Then
    If IsNumeric(Mid$(strmirc, zz + 3, 1)) Then
        strmirc = Left$(strmirc, zz - 1) + "\highlight3  " + Right$(strmirc,
Len(strmirc) - zz - 2)
    Else
        strmirc = Left$(strmirc, zz - 1) + "\cf3 " + Right$(strmirc,
Len(strmirc) - zz - 2) 'aggiunta
    End If
  GoTo sfondo_colore10
End If
sfondo_colore11: ' 4
zz = InStr(1, strmirc, " 4,", vbTextCompare)
If zz <> 0 Then
    If IsNumeric(Mid$(strmirc, zz + 3, 1)) Then
          strmirc = Left$(strmirc, zz - 1) + "\highlight13  " +
Right$(strmirc, Len(strmirc) - zz - 2)
    Else
        strmirc = Left$(strmirc, zz - 1) + "\cf13 " + Right$(strmirc,
Len(strmirc) - zz - 2) 'aggiunta
    End If
  GoTo sfondo_colore11
End If
sfondo_colore12: ' 5
zz = InStr(1, strmirc, " 5,", vbTextCompare)
If zz <> 0 Then
    If IsNumeric(Mid$(strmirc, zz + 3, 1)) Then
        strmirc = Left$(strmirc, zz - 1) + "\highlight5  " + Right$(strmirc,
Len(strmirc) - zz - 2)
    Else
        strmirc = Left$(strmirc, zz - 1) + "\cf5 " + Right$(strmirc,
Len(strmirc) - zz - 2) 'aggiunta
    End If
  GoTo sfondo_colore12
End If
sfondo_colore13: ' 6
zz = InStr(1, strmirc, " 6,", vbTextCompare)
If zz <> 0 Then
    If IsNumeric(Mid$(strmirc, zz + 3, 1)) Then
        strmirc = Left$(strmirc, zz - 1) + "\highlight6  " + Right$(strmirc,
Len(strmirc) - zz - 2)
    Else
        strmirc = Left$(strmirc, zz - 1) + "\cf6 " + Right$(strmirc,
Len(strmirc) - zz - 2)
    End If
  GoTo sfondo_colore13
End If
sfondo_colore14: ' 7
zz = InStr(1, strmirc, " 7,", vbTextCompare)
If zz <> 0 Then
    If IsNumeric(Mid$(strmirc, zz + 3, 1)) Then
        strmirc = Left$(strmirc, zz - 1) + "\highlight7  " + Right$(strmirc,
Len(strmirc) - zz - 2)
    Else
        strmirc = Left$(strmirc, zz - 1) + "\cf7 " + Right$(strmirc,
Len(strmirc) - zz - 2)
    End If
  GoTo sfondo_colore14
End If
sfondo_colore15: ' 8
zz = InStr(1, strmirc, " 8,", vbTextCompare)
If zz <> 0 Then
    If IsNumeric(Mid$(strmirc, zz + 3, 1)) Then
        strmirc = Left$(strmirc, zz - 1) + "\highlight15  " +
Right$(strmirc, Len(strmirc) - zz - 2)
    Else
        strmirc = Left$(strmirc, zz - 1) + "\cf15 " + Right$(strmirc,
Len(strmirc) - zz - 2)
    End If
  GoTo sfondo_colore15
End If
sfondo_colore16: '  9
zz = InStr(1, strmirc, " 9,", vbTextCompare)
If zz <> 0 Then
    If IsNumeric(Mid$(strmirc, zz + 3, 1)) Then
        strmirc = Left$(strmirc, zz - 1) + "\highlight11  " +
Right$(strmirc, Len(strmirc) - zz - 2)
    Else
        strmirc = Left$(strmirc, zz - 1) + "\cf11 " + Right$(strmirc,
Len(strmirc) - zz - 2)
    End If
  GoTo sfondo_colore16
End If
verde_acqua: ' 10
zz = InStr(1, strmirc, " 10", vbTextCompare)
If zz <> 0 Then
strmirc = Left$(strmirc, zz - 1) + "\cf4 " + Right$(strmirc, Len(strmirc) -
zz - 2)
GoTo verde_acqua
End If
azzurro: ' 11
zz = InStr(1, strmirc, " 11", vbTextCompare)
If zz <> 0 Then
strmirc = Left$(strmirc, zz - 1) + "\cf12 " + Right$(strmirc, Len(strmirc) -
zz - 2)
GoTo azzurro
End If
blu_chiaro: ' 12
zz = InStr(1, strmirc, " 12", vbTextCompare)
If zz <> 0 Then
strmirc = Left$(strmirc, zz - 1) + "\cf10 " + Right$(strmirc, Len(strmirc) -
zz - 2)
GoTo blu_chiaro
End If
fucsia: ' 13
zz = InStr(1, strmirc, " 13", vbTextCompare)
If zz <> 0 Then
strmirc = Left$(strmirc, zz - 1) + "\cf14 " + Right$(strmirc, Len(strmirc) -
zz - 2)
GoTo fucsia
End If
grigio: ' 14
zz = InStr(1, strmirc, " 14", vbTextCompare)
If zz <> 0 Then
strmirc = Left$(strmirc, zz - 1) + "\cf9 " + Right$(strmirc, Len(strmirc) -
zz - 2)
GoTo grigio
End If
grigio_chiaro: ' 15
zz = InStr(1, strmirc, " 15", vbTextCompare)
If zz <> 0 Then
strmirc = Left$(strmirc, zz - 1) + "\cf8 " + Right$(strmirc, Len(strmirc) -
zz - 2)
GoTo grigio_chiaro
End If
bianco: ' 0
zz = InStr(1, strmirc, " 0", vbTextCompare)
If zz <> 0 Then
strmirc = Left$(strmirc, zz - 1) + "\cf16 " + Right$(strmirc, Len(strmirc) -
zz - 1)
GoTo bianco
End If
nero: ' 1
zz = InStr(1, strmirc, " 1", vbTextCompare)
If zz <> 0 Then
strmirc = Left$(strmirc, zz - 1) + "\cf1 " + Right$(strmirc, Len(strmirc) -
zz - 1)
GoTo nero
End If
verdastro: ' 2
zz = InStr(1, strmirc, " 2", vbTextCompare)
If zz <> 0 Then
strmirc = Left$(strmirc, zz - 1) + "\cf2 " + Right$(strmirc, Len(strmirc) -
zz - 1)
GoTo verdastro
End If
blu_scuro: ' 3
zz = InStr(1, strmirc, " 3", vbTextCompare)
If zz <> 0 Then
strmirc = Left$(strmirc, zz - 1) + "\cf3 " + Right$(strmirc, Len(strmirc) -
zz - 1)
GoTo blu_scuro
End If
rosso: ' 4
zz = InStr(1, strmirc, " 4", vbTextCompare)
If zz <> 0 Then
strmirc = Left$(strmirc, zz - 1) + "\cf13 " + Right$(strmirc, Len(strmirc) -
zz - 1)
GoTo rosso
End If
marrone: ' 5
zz = InStr(1, strmirc, " 5", vbTextCompare)
If zz <> 0 Then
strmirc = Left$(strmirc, zz - 1) + "\cf5 " + Right$(strmirc, Len(strmirc) -
zz - 1)
GoTo marrone
End If
viola: ' 6
zz = InStr(1, strmirc, " 6", vbTextCompare)
If zz <> 0 Then
strmirc = Left$(strmirc, zz - 1) + "\cf6 " + Right$(strmirc, Len(strmirc) -
zz - 1)
GoTo viola
End If
arancio: ' 7
zz = InStr(1, strmirc, " 7", vbTextCompare)
If zz <> 0 Then
strmirc = Left$(strmirc, zz - 1) + "\cf7 " + Right$(strmirc, Len(strmirc) -
zz - 1)
GoTo arancio
End If
giallo: ' 8
zz = InStr(1, strmirc, " 8", vbTextCompare)
If zz <> 0 Then
strmirc = Left$(strmirc, zz - 1) + "\cf15 " + Right$(strmirc, Len(strmirc) -
zz - 1)
GoTo giallo
End If
verde_chiaro: '  9
zz = InStr(1, strmirc, " 9", vbTextCompare)
If zz <> 0 Then
strmirc = Left$(strmirc, zz - 1) + "\cf11 " + Right$(strmirc, Len(strmirc) -
zz - 1)
GoTo verde_chiaro
End If
grassetto:
zz = InStr(1, strmirc, " ", vbTextCompare)
If zz <> 0 Then
strmirc = Left$(strmirc, zz - 1) + "\b " + Right$(strmirc, Len(strmirc) -
zz)
GoTo grassetto
End If
sottolineato:
zz = InStr(1, strmirc, " ", vbTextCompare)
If zz <> 0 Then
strmirc = Left$(strmirc, zz - 1) + "\ul " + Right$(strmirc, Len(strmirc) -
zz)
GoTo sottolineato
End If
finecolori1:
zz = InStr(1, strmirc, " ", vbTextCompare)
If zz <> 0 Then
strmirc = Left$(strmirc, zz - 1) + "" + Right$(strmirc, Len(strmirc) - zz)
GoTo finecolori1
End If
finecolori2:
zz = InStr(1, strmirc, " ", vbTextCompare)
If zz <> 0 Then
strmirc = Left$(strmirc, zz - 1) + "" + Right$(strmirc, Len(strmirc) - zz)
GoTo finecolori2
End If
corsivo:
zz = InStr(1, strmirc, " ", vbTextCompare)
If zz <> 0 Then
strmirc = Left$(strmirc, zz - 1) + "\i " + Right$(strmirc, Len(strmirc) -
zz)
GoTo corsivo
End If
'impcolori(0, 0) = background
'impcolori(0, 1) = Foreground
'impcolori(0, 2) = Namechr
'impcolori(0, 3) = Sizechr
'impcolori(0, 4) = UserNickcolor
'impcolori(0, 5) = Nickcolor
  For t = 1 To 100
            If queryname(t) = Query Then
                Queryx(t).RichTextBox1.SelItalic = False
                Queryx(t).RichTextBox1.SelUnderline = False
                Queryx(t).RichTextBox1.SelBold = False
                Queryx(t).RichTextBox1.SelStart =
Len(Queryx(t).RichTextBox1.text)
                Queryx(t).RichTextBox1.SelFontName = impcolori(1, 2)
                Queryx(t).RichTextBox1.SelFontSize = impcolori(1, 3)
                If Nick = Usernick Then
                Queryx(t).RichTextBox1.SelColor = impcolori(1, 4)
                Queryx(t).RichTextBox1.SelBold = True
                Queryx(t).RichTextBox1.SelText = "<" & Nick & "> "
                    Else
                Queryx(t).RichTextBox1.SelColor = impcolori(1, 5)
                Queryx(t).RichTextBox1.SelBold = True
                Queryx(t).RichTextBox1.SelText = "<" & Nick & "> "
                End If
                Queryx(t).RichTextBox1.SelBold = False
                Queryx(t).RichTextBox1.SelColor = impcolori(1, 1)
                Queryx(t).RichTextBox1.SelRTF =
"{\rtf1\ansi\ansicpg1252\deff0\deflang1040{\fonttbl{\f0\fnil\fcharset0
Arial;}}{\colortbl
;\red0\green0\blue0;\red0\green0\blue128;\red0\green128\blue0;\red0\green128
\blue128;\red128\green0\blue0;\red128\green0\blue128;\red128\green128\blue0;
\red192\green192\blue192;\red128\green128\blue128;\red0\green0\blue255;\red0
\green255\blue0;\red0\green255\blue255;\red255\green0\blue0;\red255\green0\b
lue255;\red255\green255\blue0;\red255\green255\blue255;}\viewkind4\uc1\pard\
fs17" + strmirc + "\par}"
            Exit Sub
            End If
    Next t
End Sub

ah...dimenticavo...il sistema (cosě com'č) permette la sola visualizzazione
di stringhe colorate
ma come si puň vedere č aperto a notevoli modifiche... :-)
di nuovo ciao
                _pixel_
p.i....@katamail.com
http://vbios.cjb.net

 succede
purtroppo vedo colorarsi solo il carattere e non il suo sfondo :-(
ho sbagliato qualcosa?

no
non hai sbagliato, evidentemente le stringhe che ti ho pastato non
contenevano sfondi diversi...
prova queste stringhe
(la seconda funziona di sicuro)
" QUIT :QUIT:   0,7 mScript  0,2 "
" _pixel_ : 15,4  l o o k s h a r p   1,0  3.0   15,15  14,14  15,1 
http:// 
0www.looksharp.com.ar
   14,14  15,15  14,0 IRC/IRCX Default theme
for mIRC  15,15  14,14  "


 qualcuno mi può aiutare ?
[CUT]
Premetto che questo codice e molte altre funzioni io
l'ho trovato in 
http://vbaccelerator.com/
 scaricando il sorgente di RichEdit
2.0
quindi cutto&pasto...
ah, funziona solo con la versione 2.0 e 3.0 del controllo RichEdit
-----
Ciao :)
Prova così...
-------In un modulo:
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal
hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As
Long
Public Declare Function OleTranslateColor Lib "oleaut32.dll" (ByVal
lOleColor As Long, ByVal lHPalette As Long, lColorRef As Long) As Long
Public Const WM_USER = &H400
Public Const CFM_BACKCOLOR = &H4000000
Public Const CFE_AUTOBACKCOLOR = CFM_BACKCOLOR
Public Const EM_SETCHARFORMAT = (WM_USER + 68)
Public Const LF_FACESIZE = 32
Public Const SCF_SELECTION = &H1&
Public Const SCF_ALL = &H4&
Public Type CHARFORMAT2
    cbSize As Integer '2
    wPad1 As Integer  '4
    dwMask As Long    '8
    dwEffects As Long '12
    yHeight As Long   '16
    yOffset As Long   '20
    crTextColor As Long '24
    bCharSet As Byte    '25
    bPitchAndFamily As Byte '26
    szFaceName(0 To LF_FACESIZE - 1) As Byte ' 58
    wPad2 As Integer ' 60
    ' Additional stuff supported by RICHEDIT20
    wWeight As Integer            ' /* Font weight (LOGFONT value)      */
    sSpacing As Integer           ' /* Amount to space between letters  */
    crBackColor As Long        ' /* Background color                 */
    lLCID As Long               ' /* Locale ID                        */
    dwReserved As Long         ' /* Reserved. Must be 0              */
    sStyle As Integer            ' /* Style handle                     */
    wKerning As Integer            ' /* Twip size above which to kern char
pair*/
    bUnderlineType As Byte     ' /* Underline type                   */
    bAnimation As Byte         ' /* Animated text like marching ants */
    bRevAuthor As Byte         ' /* Revision author index            */
    bReserved1 As Byte
End Type
Public Function TranslateColor(ByVal clr As OLE_COLOR, Optional hPal As Long
= 0) As Long
    If OleTranslateColor(clr, hPal, TranslateColor) Then
        TranslateColor = -1
    End If
End Function
--------In un Form :
metti una RichTextBox un CommonDialog e un bottone
Private Sub Command1_Click()
Dim oColor As OLE_COLOR
Dim tCF2 As CHARFORMAT2
Dim lR As Long
oColor = CommonDialog1.Color
      If oColor = -1 Then
         tCF2.dwMask = CFM_BACKCOLOR
         tCF2.dwEffects = CFE_AUTOBACKCOLOR
         tCF2.crBackColor = -1
      Else
         tCF2.dwMask = CFM_BACKCOLOR
         tCF2.crBackColor = TranslateColor(oColor)
      End If
      tCF2.cbSize = Len(tCF2)
      lR = SendMessage(RichTextBox1.hwnd, EM_SETCHARFORMAT, SCF_SELECTION,
tCF2)
End Sub
Private Sub Form_Load()
CommonDialog1.ShowColor
End Sub
----------------------------
nel SendMessage
se usi SCF_ALL al posto di SCF_SELECTION te lo fa su tutto il testo
----------------------


no purtroppo ancora non mi funziona ti ringrazio tantissimo per l'email
purtroppo lo potuta vedere solo ora (comincio a lavorare alle 9:00)