在RTF TEXT中使用色彩

【 tulaoshi.com - 编程语言 】

*** Add VB code in a RTF control Call InitColorize CallColorizeWords(rtfVBCode)*** Now your VB code in your RTF control is colorized 　Source Code: 　#VBIDEUtils#*************************************************************Programmer Name : Waty Thierry* Web Site : www.geocities.com/ResearchTriangle/6311/* E-Mail : waty.thierry@usa.net* Date : 30/10/98* Time : 14:47* Module Name : Colorize_Module* Module Filename : Colorize.bas***********************************************************************Comments : Colorize in black, blue, green the VB keywords************************************************************************Option ExplicitPrivate gsBlackKeywords As StringPrivate gsBlueKeyWords As StringPublic Sub ColorizeWords(rtf As RichTextBox)#VBIDEUtils#************************************************************* Programmer Name : Waty Thierry* Web Site : www.geocities.com/ResearchTriangle/6311/* E-Mail : waty.thierry@usa.net* Date : 30/10/98* Time : 14:47* Module Name : Colorize_Module* Module Filename : Colorize.bas* Procedure Name : ColorizeWords* Parameters :* rtf As RichTextBox*********************************************************************** Comments : Colorize in black, blue, green the VB keywords************************************************************************Dim sBuffer As StringDim nI As LongDim nJ As LongDim sTmpWord As StringDim nStartPos As LongDim nSelLen As LongDim nWordPos As Long Dim cHourglass As class_HourglassSet cHourglass = New class_Hourglas br sBuffer = rtf.Text sTmpWord = "" With rtfFor nI = 1 To Len(sBuffer)Select Case Mid(sBuffer, nI, 1)Case "A" To "Z", "a" To "z", "_"If sTmpWord = "" Then nStartPos = nIsTmpWord = sTmpWord & Mid(sBuffer, nI, 1)Case Chr(34)nSelLen = 1For nJ = 1 To 9999999If Mid(sBuffer, nI + 1, 1) = Chr(34) Then nI = nI + 2Exit ForElsenSelLen = nSelLen + 1nI = nI + 1End IfNextCase Chr(39) .SelStart = nI - 1nSelLen = 0For nJ = 1 To 9999999If Mid(sBuffer, nI, 2) = vbCrLf ThenExit ForElsenSelLen = nSelLen + 1nI = nI + 1End IfNext.SelLength = nSelLen.SelColor = RGB(0, 127, 0)Case ElseIf Not (Len(sTmpWord) = 0) Then.SelStart = nStartPos - 1.SelLength = Len(sTmpWord)nWordPos = InStr(1, gsBlackKeywords, "*" & sTmpWord & "*", 1)If nWordPos  0 Then.SelColor = RGB(0, 0, 0).SelText = Mid(gsBlackKeywords, nWordPos + 1, Len(sTmpWord))End IfnWordPos = InStr(1, gsBlueKeyWords, "*" & sTmpWord & "*", 1)If nWordPos  0 Then.SelColor = RGB(0, 0, 127).SelText = Mid(gsBlueKeyWords, nWordPos + 1, Len(sTmpWord))End IfIf UCase(sTmpWord) = "REM" Then.SelStart = nI - 4.SelLength = 3For nJ = 1 To 9999999If Mid(sBuffer, nI, 2) = vbCrLf ThenExit ForElse.SelLength = .SelLength + 1nI = nI + 1End IfNext.SelColor = RGB(0, 127, 0).SelText = LCase(.SelText)End If End IfsTmpWord = ""End SelectNext.SelStart = 0End Withend subPublic Sub InitColorize()#VBIDEUtils#************************************************************* Programmer Name : Waty Thierry* Web Site : www.geocities.com/ResearchTriangle/6311/* E-Mail : waty.thierry@usa.net* Date : 30/10/98* Time : 14:47* Module Name : Colorize_Module* Module Filename : Colorize.bas* Procedure Name : InitColorize* Parameters :*********************************************************************** Comments : Initialize the VB keywords************************************************************************gsBlackKeywords ="*Abs*Add*AddItem*AppActivate*Array*Asc*Atn*"gsBlackKeywords =gsBlackKeywords+"Beep*Begin*BeginProperty*"gsBlackKeywords =gsBlackKeywords+"ChDir*ChDrive*Choose*"gsBlackKeywords =gsBlackKeywords+"Chr*Clear*Collection*Command*Cos*CreateObject*"gsBlackKeywords =gsBlackKeywords+"CurDir*DateAdd*DateDiff*DatePart*DateSerial*DateValue*"gsBlackKeywords =gsBlackKeywords+"Day*DDB*DeleteSetting*Dir*DoEvents"gsBlackKeywords =gsBlackKeywords+"*EndProperty*Environ*EOF*Err*"gsBlackKeywords =gsBlackKeywords+"Exp*FileAttr*FileCopy*FileDateTime*FileLen*Fix*Format*FVgsBlackKeywords =gsBlackKeywords+"*GetAllSettings*"GetAttr*GetObject*GetSetting*Hex*Hide*Hour*"gsBlackKeywords =gsBlackKeywords+"InputBox*InStr*Int*Int*IPmt*IRR*IsArray"gsBlackKeywords =gsBlackKeywords+"*IsDate*IsEmpty*IsError*"gsBlackKeywords =gsBlackKeywords+"IsMissing*IsNull*IsNumeric*IsObject*Item*Kill"gsBlackKeywords =gsBlackKeywords+"*LCase*Left*Len*Load*"gsBlackKeywords =gsBlackKeywords+"Loc*LOF*Log*LTrim*Me*Mid*Minute*"gsBlackKeywords =gsBlackKeywords+"MIRR*MkDir*Month*Now*NPer*NPV*Oct*"gsBlackKeywords =gsBlackKeywords+"Pmt*PPmt*PV*QBColor*Raise*Randomize"gsBlackKeywords =gsBlackKeywords+"*Rate*Remove*RemoveItem*Reset*RGB*"gsBlackKeywords =gsBlackKeywords+"Right*RmDir*Rnd*RTrim*SaveSetting"gsBlackKeywords =gsBlackKeywords+"*Second*SendKeys*SetAttr*Sgn*Shell*"gsBlackKeywords =gsBlackKeywords+"Sin*Sin*SLN*Space*Sqr*Str*StrComp"gsBlackKeywords =gsBlackKeywords+"*StrConv*Switch*SYD*Tan*Text*Time*Time*"gsBlackKeywords =gsBlackKeywords+"Timer*TimeSerial*TimeValue*Trim*TypeName"gsBlackKeywords =gsBlackKeywords+" *UCase*Unload*Val*VarType*WeekDay*"gsBlackKeywords =gsBlackKeywords+"Width*Year*"gsBlueKeyWords = "*#Const*#Else*#ElseIf*#End"gsBlueKeyWords = gsBlueKeyWords+"If*#If*Alias*Alias*And*As*Base"gsBlueKeyWords = gsBlueKeyWords+"*Binary*Boolean*Byte*B"End Sub