如何使指定的文本框中的文字高亮显示？在先等~~~

Question

我练习写了一个记事本程序，涉及到查找，我用的是instr()函数，要将查找到的结果以高亮显示，请大虾指教

Answer 1

参考：
用 RichTextBox 做 vb 语法高亮处理:Private Const vbKeyWords As String = "And,Call,Case,Const,Dim,Do,Each,Else,ElseIf,Empty,End,Eqv,Erase,Error,Exit,Explicit,False,For,Function,Imp," _
        & "In,Is,Loop,Mod,Next,Not,Nothing,Null,On,Option,Or,Private,Property,Public,Randomize,ReDim,Resume,Select,Set,Step," _
        & "Sub,Then,To,True,Until,Wend,While,With,Xor,Anchor,Array,Asc,Atn,CBool,CByte,CCur,CDate,CDbl,Chr,CInt," _
        & "CLng,Cos,CreateObject,CSng,CStr,DateAdd,DateDiff,DatePart,DateSerial,DateValue,Day,Dictionary,Document,Element,Err,Exp,FileSystemObject,Filter,Fix,Form," _
        & "FormatCurrency,FormatDateTime,FormatNumber,FormatPercent,GetObject,Hex,History,Hour,IIf,InputBox,InStr,InstrRev,IsArray,IsDate,IsEmpty,IsNull,IsNumeric,IsObject,Join,LBound," _
        & "LCase,Left,Len,Link,LoadPicture,Location,Log,LTrim,RTrim,Mid,Minute,Month,MonthName,MsgBox,Navigator,Now,Oct,Replace,Right,Rnd," _
        & "Round,ScriptEngine,ScriptEngineBuildVersion,ScriptEngineMajorVersion,ScriptEngineMinorVersion,Second,Sgn,Sin,Space,Split," _
        & "Sqr,StrComp,String,StrReverse,Tan,TextStream,TimeSerial,TimeValue,TypeName,UBound,UCase,VarType,Weekday,WeekDayName,Window,Year,Let,New,Static,Module," _
        & "Variant,IsError,IsMissing,Me,Deftype,Like,Clear,Raise,CVErr,Collection,Remove,Item,DDB,SLN,SYD,FV,Rate,IRR,MIRR,NPer," _
        & "IPmt,PPmt,NPV,GoSub,GoTo,Return,DoEvents,Stop,Choose,Switch,Get,ChDir,ChDrive,FileCopy,MkDir,RmDir,CurDir,FileDateTime,GetAttr,FileLen," _
        & "SetAttr,Timer,Open,Close,Reset,Format,Print,PrintSpc,Tab,Width,EOF,FileAttr,FreeFile,Loc,LOF,Seek,Kill,Lock,Unlock,Input," _
        & "InputLine,PrintPut,Write,CDec,CVar,Boolean,Double,Integer,Long,Single,Abs,Base,AppActivate,Shell,SendKeys,Beep,Environ,Command,MacID,MacScript," _
        & "QBColor,RGB,DeleteSetting,GetSetting,GetAllSettings,SaveSetting,Val,StrConv,LSet,RSet,Compare,Enum,Declare,Alias,Lib,AddressOf,VarPtr,Any,Load,LoadResData," _
        & "LoadResPicture,LoadResString,Access,Append,Binary,Output,Random,Read,Shared,As,If,ByRef,ByVal,Optional,Enum,Type"-----------------------------------------------------------------------------------------
'(接上)Private Const KeyWordColor As Long = &H800000   '关键字颜色
Private Const NotesColor As Long = &H8000&      '注释颜色Sub vbCodeSTX(ByRef RTF1 As RichTextBox)
    
    Dim vks() As String
    Dim i As Long, l As Long
    Dim mloc As Long, mloc2 As Long
    Dim oloc As Long, olen As Long
    
    l = LenB(RTF1.Text)
    If l = 0 Then Exit Sub
    
    oloc = RTF1.SelStart
    olen = RTF1.SelLength
    RTF1.Visible = False
    
    '处理vb关键字
    vks = Split(vbKeyWords, ",")
    For i = 0 To UBound(vks)
        mloc = RTF1.Find(vks(i), 0, , rtfWholeWord)
        Do While mloc >= 0
            With RTF1
                .SelStart = mloc
                .SelLength = Len(vks(i))
                .SelColor = KeyWordColor
                .SelStart = mloc + Len(vks(i)) + 1
            End With
            mloc = RTF1.Find(vks(i), , l, rtfWholeWord)
        Loop
    Next
    
    '处理注释
    mloc = RTF1.Find("'", 0)
    Do While mloc >= 0
        RTF1.SelStart = mloc + 1
        mloc2 = RTF1.Find(vbCrLf, , l)
        If mloc2 > mloc Then
            With RTF1
                .SelStart = mloc
                .SelLength = mloc2 - mloc
                If InStr(RTF1.SelText, Chr(34)) = 0 Then
                    .SelColor = NotesColor  '是注释行
                End If
                .SelStart = mloc2 + 1
            End With
        End If
        mloc = RTF1.Find("'", , l)
    Loop
    
    RTF1.SelStart = oloc
    RTF1.SelLength = olen
    RTF1.Visible = True
    
End Sub(用法)：
在窗体上放一个 RichTextBox1，然后调用：
vbCodeSTX RichTextBox1

Answer 2

Dim s
    Dim n
    s = InputBox("String", "Find")
    n = InStr(1, Text1.Text, s)
    Text1.SetFocus
    Text1.SelStart = n
    Text1.SelLength = Len(s)