Fet skrift i textbox

[Degeim]

Jeg har funnet diverse koder for å endre tekstfargen på begrensede områder i en textbox:

 

For I = 1 To Len(Buff)

  For n = LBound(Ord) To UBound(Ord)
      If Mid(Buff, I, Len(Ord(n).Text)) = Ord(n).Text Then
          rtb.SelStart = I - 1
          rtb.SelLength = Len(Ord(n).Text)
          rtb.SelColor = Ord(n).Color
          
          I = I + Len(Ord(n).Text) - 1
          
          rtb.SelStart = I
          rtb.SelLength = 1
          rtb.SelColor = vbBlack
          
          Exit For
      End If
  Next
Next

 

Men hvordan utnytter jeg denne - eller deler av denne - koden til å gjøre feks alle "hallo"'er til fet skrift?

 

Takk

 

EDIT: Jeg får ikke "selColor" til å virke i hele tatt, jeg får opp "No such data or member" (eller lignende)

Endret 2. mai 2005 av Degeim

[aadnk]

Koden du sikter til er for RichTextBoxer, ikke sedvanlige tekstbokser som er inkludert i VB-prosjektet automatisk. For å legge inn slike tekstbokser, må du først velge Project -> Components, hvorpå du skal markere Microsoft Rich Text Box Control i listeboksen. Klikk dernest på OK for å oppdatere endringen.

 

Når alt dette er gjort, skulle et ektra ikon dukke opp i verktøyvinduet. Klikk på den og legg kontrollen inn; den originale tekstboksen bør så slettes. Ved dette tidspunktet skulle alt være pakket og klart for å endre skrifttype og -farge på forskjellige testksegmenter av en tekstboks.

 

Ettersom søking i strenger med Mid()-kommandoen er SÆRDELES ineffektiv, især når søkeprosessen beror på å sakse ut en viss lengde av strengen på hver eneste posisjon, for å så komparere utsnittet med søkestrengen. En bør heller benytte en Integer-array eller Byte-array som man enten fyller opp med en angitte tekst ved hjelp av CopyMemory (RtlMoveMemory), eller ved å referere en array til strengens minneposisjon med VarPtrArray og SafeArray-strukturen. Dette er dog litt vel overflødig når en kun skal søke etter en såpass enkel streng, når en simpelthen kan benytte den innebyggede søkemotoren:

 

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private Const WM_SETREDRAW = &HB

Private Type Ord
   Text As String
   Color As Long
   Bold As Boolean
End Type

Private Sub cmdSearch_Click()

   Dim Ord() As Ord, Tell As Long, lngPos As Long

   ' Realloker array
   ReDim Ord(2)
   
   ' Sett elementene
   Ord(0).Text = "hallo"
   Ord(0).Color = vbRed
   
   Ord(1).Text = "hei"
   Ord(1).Color = vbBlue
   
   Ord(2).Text = "ses"
   Ord(2).Bold = True

   ' Ikke oppdater tekstboksen mens vi ordner skrifttypen på de forskjellige ordene
   SendMessage richTextBox.hwnd, WM_SETREDRAW, 0, ByVal 0&

   For Tell = LBound(Ord) To UBound(Ord)
   
       ' Start med denne posisjonen
       lngPos = 0
   
       ' Let etter alle forekomster av ordet i tekstboksen
       Do Until lngPos < 0
       
           ' Søk etter streng
           lngPos = richTextBox.Find(Ord(Tell).Text, lngPos)
           
           If lngPos >= 0 Then

               ' Set fargen samt hvorvidt den skal være bold
               richTextBox.SelStart = lngPos
               richTextBox.SelLength = Len(Ord(Tell).Text)
               richTextBox.SelColor = Ord(Tell).Color
               richTextBox.SelBold = Ord(Tell).Bold
               
               ' Søk etter den foregående forekomstposisjonen
               lngPos = lngPos + Len(Ord(Tell).Text)
           End If
           
       Loop
       
   Next
   
   ' Tillat oppdatering av tekstboks
   SendMessage richTextBox.hwnd, WM_SETREDRAW, 1, ByVal 0&
   
   ' Oppdater tekstboks
   richTextBox.Refresh

End Sub

 

I eksempelet ovenfor heter tekstboksen richTextBox.

Endret 2. mai 2005 av aadnk