Below is my wrapper for making RTF commands easier to understand and use in a RichEdit.
According to http://www.biblioscape.com/rtf15_spec.htm#Heading52
there is a TON of stuff to the RTF and I am only scratching the surface, but this will give users a leg up on learning RTF.
Discussion on the concept can be found at http://www.powerbasic.com/support/pb...ad.php?t=39482
The RichEdit window shows the resulting code, and the textbox shows how the code would appear if it were all text (with RTF commands)
Now for the fun stuff
StringAsRichTextFormat.inc
RichEditDemo.bas
According to http://www.biblioscape.com/rtf15_spec.htm#Heading52
there is a TON of stuff to the RTF and I am only scratching the surface, but this will give users a leg up on learning RTF.
Discussion on the concept can be found at http://www.powerbasic.com/support/pb...ad.php?t=39482
The RichEdit window shows the resulting code, and the textbox shows how the code would appear if it were all text (with RTF commands)
Now for the fun stuff
StringAsRichTextFormat.inc
Code:
'************************************************************************************************************* '*** Project: '*** StringAsRichTextFormat '*** Description: '*** Wrapper for formatting text to Rich Text Format to color and fonts '*** Programmer: '*** Cliff Nichols '*** Based from: '*** www.w3schools.com '*** Post Date: '*** 01-02-09 '*** Last Update: '*** 01-05-09 '*** Changes, Updates, Patches, etc.... '*** '*** OS Versions: '*** Should work on 95/98/ME, NT/2000/XP/VISTA '*** Tested On: '*** XP/VISTA '*** PB Versions: '*** 7, 8, 9 '*** Based From: '*** RTF Specifications (See http://www.biblioscape.com/rtf15_spec.htm#Heading52 for details) '************************************************************************************************************* #IF NOT %DEF(%STRINGASRICHTEXTFORMAT) %STRINGASRICHTEXTFORMAT = 1 GLOBAL gPos AS LONG, gPtr AS LONG, gTxt AS STRING '*** SET TEXT DECLARE FUNCTION RichEditStreamInString (BYVAL dwCookie AS DWORD, BYVAL pbBuff AS BYTE PTR, _ BYVAL cb AS LONG, pcb AS LONG) AS DWORD DECLARE FUNCTION RichEditAddTextStreamIn(HwndDialog AS LONG, HwndRichEdit AS LONG, FontType AS STRING, FontColor AS STRING, FontSize AS LONG, FontBold AS LONG, FontItalic AS LONG, FontUnderline AS LONG, TextToAdd AS STRING) AS STRING DECLARE FUNCTION TextBoxAddRtfText(HwndDialog AS LONG, HwndTextBox AS LONG, TextToAdd AS STRING) AS STRING DECLARE FUNCTION RtfHeader() AS STRING DECLARE FUNCTION RtfHeaderDeclareVersionLanguage() AS STRING DECLARE FUNCTION RtfHeaderDeclareFontBlock() AS STRING DECLARE FUNCTION RtfHeaderDeclareFontCourierNew() AS STRING DECLARE FUNCTION RtfHeaderDeclareFontTimesNewRoman() AS STRING DECLARE FUNCTION RtfHeaderDeclareFontAndale() AS STRING DECLARE FUNCTION RtfHeaderDeclareFontLucida() AS STRING DECLARE FUNCTION RtfHeaderDeclareFontGeorgia() AS STRING DECLARE FUNCTION RtfHeaderDeclareColors() AS STRING DECLARE FUNCTION RtfHeaderDeclareColorBlock() AS STRING DECLARE FUNCTION RtfHeaderDeclareColorMaroon() AS STRING DECLARE FUNCTION RtfHeaderDeclareColorTeal() AS STRING DECLARE FUNCTION RtfHeaderDeclareColorGreen() AS STRING DECLARE FUNCTION RtfHeaderDeclareColorNavy() AS STRING DECLARE FUNCTION RtfHeaderDeclareColorPurple() AS STRING DECLARE FUNCTION RtfHeaderDeclareColorTealSwatch() AS STRING DECLARE FUNCTION RtfHeaderDeclareColorGrey() AS STRING DECLARE FUNCTION RtfHeaderDeclareColorSilver() AS STRING DECLARE FUNCTION RtfHeaderDeclareColorRed() AS STRING DECLARE FUNCTION RtfHeaderDeclareColorLime() AS STRING DECLARE FUNCTION RtfHeaderDeclareColorYellow() AS STRING DECLARE FUNCTION RtfHeaderDeclareColorBlue() AS STRING DECLARE FUNCTION RtfHeaderDeclareColorPink() AS STRING DECLARE FUNCTION RtfHeaderDeclareColorAuqua() AS STRING DECLARE FUNCTION RtfHeaderDeclareColorWhite() AS STRING DECLARE FUNCTION RtfHeaderDeclareColorBlack() AS STRING DECLARE FUNCTION RtfCommandsEndOfLine() AS STRING DECLARE FUNCTION RtfReplaceCr(CommandString AS STRING) AS STRING '*** FONTS DECLARE FUNCTION RtfFontCourier() AS STRING DECLARE FUNCTION RtfFontTimesNewRoman() AS STRING DECLARE FUNCTION RtfFontAndale() AS STRING DECLARE FUNCTION RtfFontLucidia() AS STRING DECLARE FUNCTION RtfFontGeorgia() AS STRING '*** FONT TYPES DECLARE FUNCTION RtfFontBold() AS STRING DECLARE FUNCTION RtfFontUnBold() AS STRING DECLARE FUNCTION RtfFontItalic() AS STRING DECLARE FUNCTION RtfFontUnItalic() AS STRING DECLARE FUNCTION RtfFontUnderline() AS STRING DECLARE FUNCTION RtfFontUnUnderline() AS STRING '*** SIZES DECLARE FUNCTION RtfFontSize(SizeForFont AS LONG) AS STRING '*** COLORS DECLARE FUNCTION RtfFontMaroon() AS STRING DECLARE FUNCTION RtfFontGreen() AS STRING DECLARE FUNCTION RtfFontOlive() AS STRING DECLARE FUNCTION RtfFontNavy() AS STRING DECLARE FUNCTION RtfFontPurple() AS STRING DECLARE FUNCTION RtfFontTeal() AS STRING DECLARE FUNCTION RtfFontGrey() AS STRING DECLARE FUNCTION RtfFontSilver() AS STRING DECLARE FUNCTION RtfFontRed() AS STRING DECLARE FUNCTION RtfFontLime() AS STRING DECLARE FUNCTION RtfFontYellow() AS STRING DECLARE FUNCTION RtfFontBlue() AS STRING DECLARE FUNCTION RtfFontFuchsia() AS STRING DECLARE FUNCTION RtfFontAqua() AS STRING DECLARE FUNCTION RtfFontWhite() AS STRING DECLARE FUNCTION RtfFontBlack() AS STRING '*** Rtf commands that should be treated as actual text DECLARE FUNCTION RtfTextOpenParenthesis() AS STRING DECLARE FUNCTION RtfTextCloseParenthesis() AS STRING DECLARE FUNCTION RtfTextOpenCurlyBrace() AS STRING DECLARE FUNCTION RtfTextCloseCurlyBrace() AS STRING DECLARE FUNCTION RtfTextOpenBracket() AS STRING DECLARE FUNCTION RtfTextCloseBracket() AS STRING DECLARE FUNCTION RtfTextBackSlash() AS STRING DECLARE FUNCTION RichEditSetBackGroundColor(HwndDialog AS LONG, HwndRichEdit AS LONG, RedColor AS LONG, GreenColor AS LONG, BlueColor AS LONG) AS LONG '************************************************************************************************************* '*** CONTENTS OF AN RTF FILE '*** An RTF file has the following syntax: '*** <File> '*** '{' '*** <header> '*** <document> '*** '}' '*** '*** Note: skip over destinations marked with the \* control symbol. '************************************************************************************************************* '************************************************************************************************************* '*** Header has the following syntax: '*** <header> '*** \rtf <charset> '*** \deff? '<--- Must precede any text without an explicit reference to a font '*** <fonttbl> '<--- The font table must precede any reference to a font. '*** <filetbl>? '<--- File Table '*** <colortbl>? '<--- Color Table '*** <stylesheet>? '<--- Style Sheet '*** <listtables>? '<--- List Table '*** <revtbl>? '<--- Revision Table '************************************************************************************************************* FUNCTION RtfHeader() AS STRING LOCAL st$ st$ = st$ + "{" '<--- No characters allowed betwen openRTF and 1st command or RTF will NOT work '*** Start RTF Header st$ = st$ + RtfHeaderDeclareVersionLanguage '*** Start Font Selections st$ = st$ + RtfHeaderDeclareFontBlock '*** Courier New st$ = st$ + RtfHeaderDeclareFontCourierNew '*** Times New Roman st$ = st$ + RtfHeaderDeclareFontTimesNewRoman '*** Andale st$ = st$ + RtfHeaderDeclareFontAndale '*** Lucida st$ = st$ + RtfHeaderDeclareFontLucida '*** Georgia st$ = st$ + RtfHeaderDeclareFontGeorgia st$ = st$ + "}" '*** End Font Block FUNCTION = st$ END FUNCTION FUNCTION RtfHeaderDeclareVersionLanguage() AS STRING LOCAL st$ st$ = st$ + "\rtf1" 'RTF version 1 '<--- \rtfN control word must follow the opening brace, N = major version of the RTF Specification st$ = st$ + "\ansi" 'Ansi language '<--- Character Set (\ansi, \mac, \pc, or \pca) st$ = st$ + "\ansicpg1252" '\ansicpg1252 = U.S. Windows '<--- ANSI code page st$ = st$ + "\deff0" 'Default Font = Font 0 st$ = st$ + "\deflang1033" 'Default Language = English st$ = st$ + "\deflangfe1033" 'Default Language English FUNCTION = st$ END FUNCTION FUNCTION RtfHeaderDeclareFontBlock() AS STRING LOCAL st$ st$ = st$ + "{" st$ = st$ + "\fonttbl" 'Declare Font Block FUNCTION = st$ END FUNCTION FUNCTION RtfHeaderDeclareFontCourierNew() AS STRING LOCAL st$ st$ = st$ + "{" st$ = st$ + "\f0" 'Font 0 st$ = st$ + "\fmodern" st$ = st$ + "\fprq1" st$ = st$ + "\fcharset0 Courier New;" st$ = st$ + "}" FUNCTION = st$ END FUNCTION FUNCTION RtfHeaderDeclareFontTimesNewRoman() AS STRING LOCAL st$ st$ = st$ + "{" st$ = st$ + "\f1" 'Font 1 st$ = st$ + "\fnil st$ = st$ + "\fcharset0 Times New Roman;" st$ = st$ + "}" FUNCTION = st$ END FUNCTION FUNCTION RtfHeaderDeclareFontAndale() AS STRING LOCAL st$ st$ = st$ + "{" st$ = st$ + "\f2" 'Font 2 st$ = st$ + "\fmodern" st$ = st$ + "\fprq1" st$ = st$ + "\fcharset0 Andale Mono;" st$ = st$ + "}" FUNCTION = st$ END FUNCTION FUNCTION RtfHeaderDeclareFontLucida() AS STRING LOCAL st$ st$ = st$ + "{" st$ = st$ + "\f3" 'Font 3 st$ = st$ + "\fmodern" st$ = st$ + "\fprq1" st$ = st$ + "\fcharset0 Lucida CONSOLE; st$ = st$ + "}" FUNCTION = st$ END FUNCTION FUNCTION RtfHeaderDeclareFontGeorgia() AS STRING LOCAL st$ st$ = st$ + "{" st$ = st$ + "\f4" 'Font 4 st$ = st$ + "\froman" st$ = st$ + "\fprq2\fcharset0 Georgia;" st$ = st$ + "}" FUNCTION = st$ END FUNCTION '************************************************************************************************************* '*** '************************************************************************************************************* FUNCTION RtfHeaderDeclareColors() AS STRING LOCAL st$ st$ = st$ + RtfHeaderDeclareColorBlock 'Declare Color Block st$ = st$ + RtfHeaderDeclareColorMaroon 'cf1 = MAROON Brownish Red = ";\red128\green0\blue0" st$ = st$ + RtfHeaderDeclareColorTeal 'cf2 = TEAL Dark Green = ";\red0\green128\blue0" st$ = st$ + RtfHeaderDeclareColorGreen 'cf3 = GREEN Cammo Green = ";\red128\green128\blue0" st$ = st$ + RtfHeaderDeclareColorNavy 'cf4 = NAVY Dark Purple = ";\red0\green0\blue128" st$ = st$ + RtfHeaderDeclareColorPurple 'cf5 = PURPLE Purple = ";\red128\green0\blue128" st$ = st$ + RtfHeaderDeclareColorTealSwatch 'cf6 = TEAL Swatch Green = ";\red0\green128\blue128" st$ = st$ + RtfHeaderDeclareColorGrey 'cf7 = GREY Dark Grey = ";\red128\green128\blue128" st$ = st$ + RtfHeaderDeclareColorSilver 'cf8 = SILVER Light Grey = ";\red192\green192\blue192" st$ = st$ + RtfHeaderDeclareColorRed 'cf9 = RED Bright Red = ";\red255\green0\blue0" st$ = st$ + RtfHeaderDeclareColorLime 'cf10 = LIME Bright Green = ";\red0\green255\blue0" st$ = st$ + RtfHeaderDeclareColorYellow 'cf11 = YELLOW Bright Yellow = ";\red255\green255\blue0" st$ = st$ + RtfHeaderDeclareColorBlue 'cf12 = BLUE Bright Blue = ";\red0\green0\blue255" st$ = st$ + RtfHeaderDeclareColorPink 'cf13 = PINK Bright Pink = ";\red255\green0\blue255" st$ = st$ + RtfHeaderDeclareColorAuqua 'cf14 = AQUA Blue Green = ";\red0\green255\blue255" st$ = st$ + RtfHeaderDeclareColorWhite 'cf15 = WHITE White = ";\red255\green255\blue255" st$ = st$ + RtfHeaderDeclareColorBlack 'cf16 = BLACK Black = ";\red0\green0\blue0" st$ = st$ + "}" 'End Declare Colors FUNCTION = st$ END FUNCTION FUNCTION RtfHeaderDeclareColorBlock() AS STRING LOCAL st$ st$ = st$ + "{" st$ = st$ + "\colortbl " 'Start Declare Colors FUNCTION = st$ END FUNCTION FUNCTION RtfHeaderDeclareColorMaroon() AS STRING LOCAL st$ st$ = st$ + ";\red128\green0\blue0" 'MAROON Brownish Red FUNCTION = st$ END FUNCTION FUNCTION RtfHeaderDeclareColorTeal() AS STRING LOCAL st$ st$ = st$ + ";\red0\green128\blue0" 'TEAL Dark Green FUNCTION = st$ END FUNCTION FUNCTION RtfHeaderDeclareColorGreen() AS STRING LOCAL st$ st$ = st$ + ";\red128\green128\blue0" 'GREEN Cammo Green FUNCTION = st$ END FUNCTION FUNCTION RtfHeaderDeclareColorNavy() AS STRING LOCAL st$ st$ = st$ + ";\red0\green0\blue128" 'NAVY Dark Purple FUNCTION = st$ END FUNCTION FUNCTION RtfHeaderDeclareColorPurple() AS STRING LOCAL st$ st$ = st$ + ";\red128\green0\blue128" 'PURPLE Purple FUNCTION = st$ END FUNCTION FUNCTION RtfHeaderDeclareColorTealSwatch() AS STRING LOCAL st$ st$ = st$ + ";\red0\green128\blue128" 'TEAL Swatch Green FUNCTION = st$ END FUNCTION FUNCTION RtfHeaderDeclareColorGrey() AS STRING LOCAL st$ st$ = st$ + ";\red128\green128\blue128" 'GREY Dark Grey FUNCTION = st$ END FUNCTION FUNCTION RtfHeaderDeclareColorSilver() AS STRING LOCAL st$ st$ = st$ + ";\red192\green192\blue192" 'SILVER Light Grey FUNCTION = st$ END FUNCTION FUNCTION RtfHeaderDeclareColorRed() AS STRING LOCAL st$ st$ = st$ + ";\red255\green0\blue0" 'RED Bright Red FUNCTION = st$ END FUNCTION FUNCTION RtfHeaderDeclareColorLime() AS STRING LOCAL st$ st$ = st$ + ";\red0\green255\blue0" 'LIME Bright Green FUNCTION = st$ END FUNCTION FUNCTION RtfHeaderDeclareColorYellow() AS STRING LOCAL st$ st$ = st$ + ";\red255\green255\blue0" 'YELLOW Bright Yellow FUNCTION = st$ END FUNCTION FUNCTION RtfHeaderDeclareColorBlue() AS STRING LOCAL st$ st$ = st$ + ";\red0\green0\blue255" 'BLUE Bright Blue FUNCTION = st$ END FUNCTION FUNCTION RtfHeaderDeclareColorPink() AS STRING LOCAL st$ st$ = st$ + ";\red255\green0\blue255" 'PINK Bright Pink FUNCTION = st$ END FUNCTION FUNCTION RtfHeaderDeclareColorAuqua() AS STRING LOCAL st$ st$ = st$ + ";\red0\green255\blue255" 'AQUA Blue Green FUNCTION = st$ END FUNCTION FUNCTION RtfHeaderDeclareColorWhite() AS STRING LOCAL st$ st$ = st$ + ";\red255\green255\blue255" 'WHITE White FUNCTION = st$ END FUNCTION FUNCTION RtfHeaderDeclareColorBlack() AS STRING LOCAL st$ st$ = st$ + ";\red0\green0\blue0" 'BLACK Black FUNCTION = st$ END FUNCTION FUNCTION RtfDefaults() AS STRING LOCAL st$ st$ = st$ + "\cf16" 'Default Color 16 = Black st$ = st$ + "\f0" 'Default Font 0 st$ = st$ + "\fs11 " 'Default Font Size 11 FUNCTION = st$ END FUNCTION FUNCTION RtfCommandsEndOfLine() AS STRING FUNCTION = "\line " 'RTF does not wrap on $CR or $LF, but does on \line END FUNCTION FUNCTION RtfReplaceCr(CommandString AS STRING) AS STRING 'Replace $CR with a printable character that is non-ansii REPLACE $CR WITH CHR$(174) IN CommandString FUNCTION = CommandString END FUNCTION FUNCTION RtfFontCourier() AS STRING FUNCTION = "\f0" END FUNCTION FUNCTION RtfFontTimesNewRoman() AS STRING FUNCTION = "\f1" END FUNCTION FUNCTION RtfFontAndale() AS STRING FUNCTION = "\f2" END FUNCTION FUNCTION RtfFontLucidia() AS STRING FUNCTION = "\f3" END FUNCTION FUNCTION RtfFontGeorgia() AS STRING FUNCTION = "\f4" END FUNCTION FUNCTION RtfFontBold() AS STRING FUNCTION = "\b " END FUNCTION FUNCTION RtfFontUnBold() AS STRING FUNCTION = "\b0 " END FUNCTION FUNCTION RtfFontItalic() AS STRING FUNCTION = "\i " END FUNCTION FUNCTION RtfFontUnItalic() AS STRING FUNCTION = "\i0 " END FUNCTION FUNCTION RtfFontUnderline() AS STRING FUNCTION = "\ul " END FUNCTION FUNCTION RtfFontUnUnderline() AS STRING FUNCTION = "\ul0 " END FUNCTION FUNCTION RtfFontSize(SizeForFont AS LONG) AS STRING FUNCTION = "\fs" + TRIM$(STR$(SizeForFont*2)) + " " END FUNCTION FUNCTION RtfFontMaroon() AS STRING FUNCTION = "\cf1 " END FUNCTION FUNCTION RtfFontGreen() AS STRING FUNCTION = "\cf2 " END FUNCTION FUNCTION RtfFontOlive() AS STRING FUNCTION = "\cf3 " END FUNCTION FUNCTION RtfFontNavy() AS STRING FUNCTION = "\cf4 " END FUNCTION FUNCTION RtfFontPurple() AS STRING FUNCTION = "\cf5 " END FUNCTION FUNCTION RtfFontTeal() AS STRING FUNCTION = "\cf6 " END FUNCTION FUNCTION RtfFontGrey() AS STRING FUNCTION = "\cf7 " END FUNCTION FUNCTION RtfFontSilver() AS STRING FUNCTION = "\cf8 " END FUNCTION FUNCTION RtfFontRed() AS STRING FUNCTION = "\cf9 " END FUNCTION FUNCTION RtfFontLime() AS STRING FUNCTION = "\cf10 " END FUNCTION FUNCTION RtfFontYellow() AS STRING FUNCTION = "\cf11 " END FUNCTION FUNCTION RtfFontBlue() AS STRING FUNCTION = "\cf12 " END FUNCTION FUNCTION RtfFontFuchsia() AS STRING FUNCTION = "\cf13 " END FUNCTION FUNCTION RtfFontAqua() AS STRING FUNCTION = "\cf14 " END FUNCTION FUNCTION RtfFontWhite() AS STRING FUNCTION = "\cf15 " END FUNCTION FUNCTION RtfFontBlack() AS STRING FUNCTION = "\cf16 " END FUNCTION FUNCTION RtfTextOpenParenthesis() AS STRING FUNCTION = "\(" END FUNCTION FUNCTION RtfTextCloseParenthesis() AS STRING FUNCTION = "\)" END FUNCTION FUNCTION RtfTextOpenCurlyBrace() AS STRING FUNCTION = "\{" END FUNCTION FUNCTION RtfTextCloseCurlyBrace() AS STRING FUNCTION = "\}" END FUNCTION FUNCTION RtfTextOpenBracket() AS STRING FUNCTION = "\[" END FUNCTION FUNCTION RtfTextCloseBracket() AS STRING FUNCTION = "\]" END FUNCTION FUNCTION RtfTextBackSlash() AS STRING FUNCTION = "\\" END FUNCTION FUNCTION RichEditSetBackGroundColor(HwndDialog AS LONG, HwndRichEdit AS LONG, RedColor AS LONG, GreenColor AS LONG, BlueColor AS LONG) AS LONG CONTROL SEND HwndDialog, HwndRichEdit, %EM_SETBKGNDCOLOR, 0, RGB(RedColor, GreenColor, BlueColor) 'RGB(255,254,209) = Post-it Note Color FUNCTION = RGB(RedColor, GreenColor, BlueColor) END FUNCTION '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ ' Rich Edit stream in callback - for streaming in string contents '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ FUNCTION RichEditStreamInString (BYVAL dwCookie AS DWORD, BYVAL pbBuff AS BYTE PTR, BYVAL cb AS LONG, pcb AS LONG) AS DWORD pcb = MIN&(cb, LEN(gTxt) - (gPos - 1)) 'number of bytes to copy IF pcb > 0 THEN 'copy block from global string directly into Richedit's buffer. CopyMemory pbBuff, (gPtr + gPos - 1), pcb 'could use POKE$ too, but this is a bit faster gPos = gPos + pcb 'incr pos for next callback position. ELSE FUNCTION = %True 'Break the action END IF END FUNCTION FUNCTION RichEditSetText(HwndDialog AS LONG, HwndRichEdit AS LONG, TextToSet AS STRING) AS LONG CONTROL SET TEXT HwndDialog, HwndRichEdit, TextToSet END FUNCTION FUNCTION RichEditAddTextStreamIn(HwndDialog AS LONG, HwndRichEdit AS LONG, FontType AS STRING, FontColor AS STRING, FontSize AS LONG, FontBold AS LONG, FontItalic AS LONG, FontUnderline AS LONG, TextToAdd AS STRING) AS STRING STATIC CurrentText AS STRING LOCAL NewText AS STRING LOCAL NewFontType AS STRING LOCAL NewFontColor AS STRING LOCAL NewFontSize AS STRING LOCAL NewFontBold AS STRING LOCAL NewFontUnBold AS STRING LOCAL NewFontItalic AS STRING LOCAL NewFontUnItalic AS STRING LOCAL NewFontUnderline AS STRING LOCAL NewFontUnUnderline AS STRING LOCAL eStream AS EDITSTREAM LOCAL ret AS LONG REPLACE $CRLF WITH RtfCommandsEndOfLine IN TextToAdd REPLACE $CR WITH RtfCommandsEndOfLine IN TextToAdd REPLACE $LF WITH "" IN TextToAdd REPLACE RtfHeader WITH "" IN CurrentText REPLACE RtfHeaderDeclareColors WITH "" IN CurrentText REPLACE RtfDefaults WITH "" IN CurrentText CurrentText = MID$(CurrentText, 1, LEN(CurrentText) - 2) 'Strip the closing $CR and curly bracket SELECT CASE UCASE$(FontType) CASE "COURIER" NewFontType = RtfFontCourier() CASE "TIMESNEWROMAN" NewFontType = RtfFontTimesNewRoman() CASE "ANDALE" NewFontType = RtfFontAndale() CASE "LUCIDIA" NewFontType = RtfFontLucidia() CASE "GEORGIA" NewFontType = RtfFontGeorgia() CASE "" NewFontType = RtfFontCourier() END SELECT SELECT CASE UCASE$(FontColor) CASE "MAROON" NewFontColor = RtfFontMaroon CASE "GREEN" NewFontColor = RtfFontGreen CASE "OLIVE" NewFontColor = RtfFontOlive CASE "NAVY" NewFontColor = RtfFontNavy CASE "PURPLE" NewFontColor = RtfFontPurple CASE "TEAL" NewFontColor = RtfFontTeal CASE "GREY" NewFontColor = RtfFontGrey CASE "SILVER" NewFontColor = RtfFontSilver CASE "RED" NewFontColor = RtfFontRed CASE "LIME" NewFontColor = RtfFontLime CASE "YELLOW" NewFontColor = RtfFontYellow CASE "BLUE" NewFontColor = RtfFontBlue CASE "FUCHSIA" NewFontColor = RtfFontFuchsia CASE "AUQUA", "AQUA" 'In the case of typo's in code NewFontColor = RtfFontAqua CASE "WHITE" NewFontColor = RtfFontWhite CASE "BLACK" NewFontColor = RtfFontBlack CASE "" NewFontColor = RtfFontBlack CASE ELSE NewFontColor = RtfFontBlack END SELECT NewFontSize = RtfFontSize(FontSize) SELECT CASE FontBold CASE %FALSE NewFontBold = "" NewFontUnBold = "" CASE %TRUE NewFontBold = RtfFontBold NewFontUnBold = RtfFontUnBold END SELECT SELECT CASE FontItalic CASE %FALSE NewFontItalic = "" NewFontUnItalic = "" CASE %TRUE NewFontItalic = RtfFontItalic NewFontUnItalic = RtfFontUnItalic END SELECT SELECT CASE FontUnderline CASE %FALSE NewFontUnderline = "" NewFontUnUnderline = "" CASE %TRUE NewFontUnderline = RtfFontUnderline NewFontUnUnderline = RtfFontUnUnderline END SELECT NewText = NewText + RtfHeader NewText = NewText + RtfHeaderDeclareColors NewText = NewText + RtfDefaults SELECT CASE ASC(CurrentText) '<--- Somehow a -1(Null) is in the text so do not add it to CurrentText CASE -1 CASE ELSE NewText = NewText + CurrentText END SELECT NewText = NewText + NewFontType NewText = NewText + NewFontColor NewText = NewText + NewFontSize NewText = NewText + NewFontBold NewText = NewText + NewFontItalic NewText = NewText + NewFontUnderline NewText = NewText + TextToAdd NewText = NewText + NewFontUnBold NewText = NewText + NewFontUnItalic NewText = NewText + NewFontUnUnderline NewText = NewText + $CRLF NewText = NewText + "}" CurrentText = NewText eStream.pfnCallback = CODEPTR(RichEditStreamInString) 'pointer to RichEdit callback procedure gPos = 1 gTxt = NewText gPtr = STRPTR(gTxt) ret = SendMessage(GetDlgItem(HwndDialog, HwndRichEdit), %EM_STREAMIN, %SF_RTF, VARPTR(eStream)) 'stream in text FUNCTION = NewText END FUNCTION FUNCTION TextBoxAddRtfText(HwndDialog AS LONG, HwndTextBox AS LONG, TextToAdd AS STRING) AS STRING '*** Formatting for readability ONLY REPLACE "\line" WITH $CRLF IN TextToAdd ' REPLACE RtfHeaderDeclareVersionLanguage WITH $CRLF + $TAB + RtfHeaderDeclareVersionLanguage IN TextToAdd '<--- Real Code space not allowed between open curly brace and RTF Header REPLACE RtfHeaderDeclareFontBlock WITH $CRLF + $TAB + RtfHeaderDeclareFontBlock IN TextToAdd '<--- Not needed, but left for clarity REPLACE RtfHeaderDeclareFontCourierNew WITH $CRLF + $TAB + $TAB + RtfHeaderDeclareFontCourierNew IN TextToAdd REPLACE RtfHeaderDeclareFontTimesNewRoman WITH $CRLF + $TAB + $TAB + RtfHeaderDeclareFontTimesNewRoman IN TextToAdd REPLACE RtfHeaderDeclareFontAndale WITH $CRLF + $TAB + $TAB + RtfHeaderDeclareFontAndale IN TextToAdd REPLACE RtfHeaderDeclareFontLucida WITH $CRLF + $TAB + $TAB + RtfHeaderDeclareFontLucida IN TextToAdd REPLACE RtfHeaderDeclareFontGeorgia WITH $CRLF + $TAB + $TAB + RtfHeaderDeclareFontGeorgia + $CRLF + $TAB IN TextToAdd REPLACE RtfHeaderDeclareColorBlock WITH $CRLF + $TAB + RtfHeaderDeclareColorBlock IN TextToAdd REPLACE RtfHeaderDeclareColorMaroon WITH $CRLF + $TAB + $TAB + RtfHeaderDeclareColorMaroon IN TextToAdd REPLACE RtfHeaderDeclareColorTeal WITH $CRLF + $TAB + $TAB + RtfHeaderDeclareColorTeal IN TextToAdd REPLACE RtfHeaderDeclareColorGreen WITH $CRLF + $TAB + $TAB + RtfHeaderDeclareColorGreen IN TextToAdd REPLACE RtfHeaderDeclareColorNavy WITH $CRLF + $TAB + $TAB + RtfHeaderDeclareColorNavy IN TextToAdd REPLACE RtfHeaderDeclareColorPurple WITH $CRLF + $TAB + $TAB + RtfHeaderDeclareColorPurple IN TextToAdd REPLACE RtfHeaderDeclareColorTealSwatch WITH $CRLF + $TAB + $TAB + RtfHeaderDeclareColorTealSwatch IN TextToAdd REPLACE RtfHeaderDeclareColorGrey WITH $CRLF + $TAB + $TAB + RtfHeaderDeclareColorGrey IN TextToAdd REPLACE RtfHeaderDeclareColorSilver WITH $CRLF + $TAB + $TAB + RtfHeaderDeclareColorSilver IN TextToAdd REPLACE RtfHeaderDeclareColorRed WITH $CRLF + $TAB + $TAB + RtfHeaderDeclareColorRed IN TextToAdd REPLACE RtfHeaderDeclareColorLime WITH $CRLF + $TAB + $TAB + RtfHeaderDeclareColorLime IN TextToAdd REPLACE RtfHeaderDeclareColorYellow WITH $CRLF + $TAB + $TAB + RtfHeaderDeclareColorYellow IN TextToAdd REPLACE RtfHeaderDeclareColorBlue WITH $CRLF + $TAB + $TAB + RtfHeaderDeclareColorBlue IN TextToAdd REPLACE RtfHeaderDeclareColorPink WITH $CRLF + $TAB + $TAB + RtfHeaderDeclareColorPink IN TextToAdd REPLACE RtfHeaderDeclareColorAuqua WITH $CRLF + $TAB + $TAB + RtfHeaderDeclareColorAuqua IN TextToAdd REPLACE RtfHeaderDeclareColorWhite WITH $CRLF + $TAB + $TAB + RtfHeaderDeclareColorWhite IN TextToAdd REPLACE RtfHeaderDeclareColorBlack WITH $CRLF + $TAB + $TAB + RtfHeaderDeclareColorBlack + $CRLF + $TAB IN TextToAdd REPLACE RtfDefaults WITH $CRLF + $TAB + RtfDefaults + $CRLF IN TextToAdd CONTROL SET TEXT HwndDialog, HwndTextBox, TextToAdd FUNCTION = TextToAdd END FUNCTION #ENDIF
Code:
#PBFORMS CREATED V1.51 '------------------------------------------------------------------------------ ' The first line in this file is a PB/Forms metastatement. ' It should ALWAYS be the first line of the file. Other ' PB/Forms metastatements are placed at the beginning and ' end of "Named Blocks" of code that should be edited ' with PBForms only. Do not manually edit or delete these ' metastatements or PB/Forms will not be able to reread ' the file correctly. See the PB/Forms documentation for ' more information. ' Named blocks begin like this: #PBFORMS BEGIN ... ' Named blocks end like this: #PBFORMS END ... ' Other PB/Forms metastatements such as: ' #PBFORMS DECLARATIONS ' are used by PB/Forms to insert additional code. ' Feel free to make changes anywhere else in the file. '------------------------------------------------------------------------------ #COMPILE EXE #DIM ALL GLOBAL hDlg AS DWORD '------------------------------------------------------------------------------ ' ** Includes ** '------------------------------------------------------------------------------ #PBFORMS BEGIN INCLUDES #IF NOT %DEF(%WINAPI) #INCLUDE "WIN32API.INC" #ENDIF #IF NOT %DEF(%RICHEDIT_INC) #INCLUDE "RICHEDIT.INC" #ENDIF #INCLUDE "PBForms.INC" #PBFORMS END INCLUDES '------------------------------------------------------------------------------ '------------------------------------------------------------------------------ ' ** Constants ** '------------------------------------------------------------------------------ #PBFORMS BEGIN CONSTANTS %IDD_DIALOG1 = 101 %IDC_RICHEDIT1 = 1001 %IDC_TEXT = 1002 #PBFORMS END CONSTANTS '------------------------------------------------------------------------------ #IF NOT %DEF(%STRINGASRICHTEXTFORMAT) #INCLUDE "STRINGASRICHTEXTFORMAT.INC" #ENDIF '------------------------------------------------------------------------------ ' ** Declarations ** '------------------------------------------------------------------------------ DECLARE CALLBACK FUNCTION ShowDIALOG1Proc() DECLARE FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG #PBFORMS DECLARATIONS '------------------------------------------------------------------------------ '------------------------------------------------------------------------------ ' ** Main Application Entry Point ** '------------------------------------------------------------------------------ FUNCTION PBMAIN() PBFormsRichEdit () ' Load RichEdit ShowDIALOG1 %HWND_DESKTOP PBFormsRichEdit (%TRUE) ' Unload RichEdit END FUNCTION '------------------------------------------------------------------------------ '------------------------------------------------------------------------------ ' ** CallBacks ** '------------------------------------------------------------------------------ CALLBACK FUNCTION ShowDIALOG1Proc() SELECT CASE AS LONG CBMSG CASE %WM_INITDIALOG ' Initialization handler CASE %WM_NCACTIVATE STATIC hWndSaveFocus AS DWORD IF ISFALSE CBWPARAM THEN ' Save control focus hWndSaveFocus = GetFocus() ELSEIF hWndSaveFocus THEN ' Restore control focus SetFocus(hWndSaveFocus) hWndSaveFocus = 0 END IF CASE %WM_COMMAND ' Process control notifications SELECT CASE AS LONG CBCTL CASE %IDC_RICHEDIT1 END SELECT END SELECT END FUNCTION '------------------------------------------------------------------------------ '------------------------------------------------------------------------------ ' ** Dialogs ** '------------------------------------------------------------------------------ FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG LOCAL lRslt AS LONG #PBFORMS BEGIN DIALOG %IDD_DIALOG1->-> DIALOG NEW hParent, "Dialog1", 70, 70, 500, 121, %WS_POPUP OR %WS_BORDER _ OR %WS_DLGFRAME OR %WS_THICKFRAME OR %WS_CAPTION OR %WS_SYSMENU OR _ %WS_MINIMIZEBOX OR %WS_MAXIMIZEBOX OR %WS_CLIPSIBLINGS OR _ %WS_VISIBLE OR %DS_MODALFRAME OR %DS_3DLOOK OR %DS_NOFAILCREATE OR _ %DS_SETFONT, %WS_EX_CONTROLPARENT OR %WS_EX_LEFT OR _ %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR, TO hDlg CONTROL ADD PBFormsRichEdit(), hDlg, %IDC_RICHEDIT1, "RichEdit1", 5, 5, _ 190, 110, %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %WS_VSCROLL OR _ %WS_HSCROLL OR %ES_LEFT OR %ES_MULTILINE OR %ES_AUTOVSCROLL OR _ %ES_AUTOHSCROLL OR %ES_WANTRETURN, %WS_EX_CLIENTEDGE OR %WS_EX_LEFT _ OR %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR CONTROL ADD TEXTBOX, hDlg, %IDC_TEXT, "", 200, 5, _ 300, 110, %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %WS_VSCROLL OR _ %WS_HSCROLL OR %ES_LEFT OR %ES_MULTILINE OR %ES_AUTOVSCROLL OR _ %ES_AUTOHSCROLL OR %ES_WANTRETURN, %WS_EX_CLIENTEDGE OR %WS_EX_LEFT _ OR %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR #PBFORMS END DIALOG '*** Demo Colors RichEditAddTextStreamIn(hDlg, %IDC_RICHEDIT1, "Courier", "Blue", 10, %TRUE, %FALSE, %FALSE, "Hello" + $CRLF) RichEditAddTextStreamIn(hDlg, %IDC_RICHEDIT1, "TimesNewRoman", "Red", 12, %TRUE, %TRUE, %FALSE, "Hello" + $CRLF) RichEditAddTextStreamIn(hDlg, %IDC_RICHEDIT1, "GEORGIA", "Green", 14, %TRUE, %TRUE, %TRUE, "Hello" + $CRLF) RichEditAddTextStreamIn(hDlg, %IDC_RICHEDIT1, "", "", 14, %FALSE, %FALSE, %FALSE, $TAB + "Normal Text" + $CRLF) RichEditAddTextStreamIn(hDlg, %IDC_RICHEDIT1, "GEORGIA", "Blue", 14, %FALSE, %FALSE, %FALSE, $TAB + "Goodbye" + $CRLF) RichEditAddTextStreamIn(hDlg, %IDC_RICHEDIT1, "TimesNewRoman", "Red", 12, %FALSE, %TRUE, %FALSE, $TAB + "Goodbye" + $CRLF) RichEditAddTextStreamIn(hDlg, %IDC_RICHEDIT1, "Courier", "Green", 10, %FALSE, %TRUE, %TRUE, $TAB + "Goodbye" + $CRLF) '*** Show single characters as colors RichEditAddTextStreamIn(hDlg, %IDC_RICHEDIT1, "", "", 14, %FALSE, %FALSE, %FALSE, "" + $CRLF) RichEditAddTextStreamIn(hDlg, %IDC_RICHEDIT1, "", "", 14, %FALSE, %FALSE, %FALSE, "A") RichEditAddTextStreamIn(hDlg, %IDC_RICHEDIT1, "Courier", "Blue", 10, %TRUE, %FALSE, %FALSE, "B") RichEditAddTextStreamIn(hDlg, %IDC_RICHEDIT1, "TimesNewRoman", "Red", 10, %TRUE, %FALSE, %FALSE, "C") RichEditAddTextStreamIn(hDlg, %IDC_RICHEDIT1, "GEORGIA", "Green", 10, %TRUE, %FALSE, %FALSE, "D") RichEditAddTextStreamIn(hDlg, %IDC_RICHEDIT1, "", "", 12, %FALSE, %FALSE, %FALSE, $TAB + "1") RichEditAddTextStreamIn(hDlg, %IDC_RICHEDIT1, "Courier", "Green", 14, %TRUE, %FALSE, %FALSE, $TAB + "2") RichEditAddTextStreamIn(hDlg, %IDC_RICHEDIT1, "TimesNewRoman", "Red", 12, %TRUE, %FALSE, %FALSE, $TAB + "3") RichEditAddTextStreamIn(hDlg, %IDC_RICHEDIT1, "GEORGIA", "Blue", 10, %TRUE, %FALSE, %FALSE, $TAB + "4") '*** (){} and \ are RTF commands so if needing them as text use the following RichEditAddTextStreamIn(hDlg, %IDC_RICHEDIT1, "", "", 14, %FALSE, %FALSE, %FALSE, "" + $CRLF) LOCAL RtfCommandText AS STRING RtfCommandText = RtfCommandText + RtfTextOpenParenthesis RtfCommandText = RtfCommandText + RtfTextCloseParenthesis RtfCommandText = RtfCommandText + RtfTextOpenCurlyBrace RtfCommandText = RtfCommandText + RtfTextCloseCurlyBrace RtfCommandText = RtfCommandText + " and " RtfCommandText = RtfCommandText + RtfTextBackSlash RtfCommandText = RtfCommandText + " are RTF commands so if needing them as text use the following " + $CRLF RichEditAddTextStreamIn(hDlg, %IDC_RICHEDIT1, "", "", 14, %FALSE, %FALSE, %FALSE, "" + $CRLF) RtfCommandText = RtfCommandText + "RtfTextOpenParenthesis" + $CRLF RtfCommandText = RtfCommandText + "RtfTextCloseParenthesis" + $CRLF RtfCommandText = RtfCommandText + "RtfTextOpenCurlyBrace" + $CRLF RtfCommandText = RtfCommandText + "RtfTextCloseCurlyBrace" + $CRLF RtfCommandText = RichEditAddTextStreamIn(hDlg, %IDC_RICHEDIT1, "TimesNewRoman", "Red", 18, %TRUE, %FALSE, %FALSE, RtfCommandText) TextBoxAddRtfText(hDlg, %IDC_TEXT, RtfCommandText) '*** Change Background Color RichEditSetBackGroundColor hDlg, %IDC_RICHEDIT1, 255, 254, 209 'RGB(255,254,209) = Post-it Note Color ' RichEditSetBackGroundColor hDlg, %IDC_RICHEDIT1, 0, 0, 0 'RGB(255,254,209) = Post-it Note Color DIALOG SHOW MODAL hDlg, CALL ShowDIALOG1Proc TO lRslt #PBFORMS BEGIN CLEANUP %IDD_DIALOG1 #PBFORMS END CLEANUP FUNCTION = lRslt END FUNCTION '------------------------------------------------------------------------------