Ive been reading the forum for almost a month and heres my contribution. My 1st PB program is a cool IRC Program.
It supports font color/highlight color/italic/bold
Based from:
Converted to PB 4.0
to use:
DoColors(#EDITOR_GADGET_ID, "IRC MSG HERE")
Code: Select all
RTFCodes.s = ""
TblColor.s = "{\rtf1{\colortbl\red255\green255\blue255;\red0\green0\blue0;\red0\green0\blue123;\red0\green146\blue0;\red255\green0\blue0;\red123\green0\blue0;\red156\green0\blue156;\red255\green125\blue0;\red255\green255\blue0;\red0\green255\blue0;\red0\green146\blue148;\red0\green255\blue255;\red0\green0\blue255;\red255\green0\blue255;\red123\green125\blue123;\red214\green211\blue214;}"
CrLf.s = "{\par}}"
Procedure.l isNumber1(msg.s)
check.b = Asc(msg)
If check >= 48 And check <= 57
ProcedureReturn 1
Else
ProcedureReturn 0
EndIf
EndProcedure
Procedure.l isNumber2(msg.s)
check1.b = Asc(Left(msg,1))
check2.b = Asc(Right(msg,1))
If check1 >= 48 And check1 <= 57 And check2 >= 48 And check2 <= 57
ProcedureReturn 1
Else
ProcedureReturn 0
EndIf
EndProcedure
Procedure ManageRTF(sAddDel.s)
Shared RTFCodes.s
RTFCodes = Trim(RTFCodes)
If FindString(sAddDel,"\cf",1) > 0
; We have it set. Lets delete it now
; We cant include "1" because it will conflict
; With 10, 11, 12, 13, 14, 15 As "\cf1...0...1..etc
For X = 2 To 15
If FindString(RTFCodes, "\cf" + Str(X), 1)
RTFCodes = ReplaceString(RTFCodes, "\cf" + Str(X), "")
Break
EndIf
Next X
; If 2-15 doesn't get rid of it, 0 Or 1 will!
If FindString(RTFCodes, "\cf0", 1) > 0
RTFCodes = ReplaceString(RTFCodes, "\cf0", "")
EndIf
If FindString(RTFCodes, "\cf1", 1) > 0
RTFCodes = ReplaceString(RTFCodes, "\cf1", "")
EndIf
ElseIf FindString(sAddDel, "\highlight", 1) > 0
; We have it set. Lets delete it now
; We cant include "1" because it will conflict
; With 10, 11, 12, 13, 14, 15 As "\cf1...0...1..etc
For X = 2 To 15
If FindString(RTFCodes, "\highlight" + Str(X), 1)
RTFCodes = ReplaceString(RTFCodes, "\highlight" + Str(X), "")
Break
EndIf
Next X
;' If 2-15 doesn't get rid of it, 0 Or 1 will!
If FindString(RTFCodes, "\highlight0", 1) > 0
RTFCodes = ReplaceString(RTFCodes, "\highlight0", "")
EndIf
If FindString(RTFCodes, "\highlight1", 1) > 0
RTFCodes = ReplaceString(RTFCodes, "\highlight1", "")
EndIf
EndIf
; It Exists. Remove code
If FindString(RTFCodes, sAddDel, 1) > 0
RTFCodes = ReplaceString(RTFCodes, sAddDel, "")
; Need To add the space back due To the fact I trimmed it above. Otherwise text
; will Not display
RTFCodes = RTFCodes + " "
; Doesn't exist. Add code
Else
RTFCodes = RTFCodes + sAddDel + " "
EndIf
EndProcedure
Procedure DoColors(editorGadget.l, sText.s)
Shared TblColor.s
Shared RTFCodes.s
Shared CrLf.s
ForeColor.s
OutPutLine.s
BackColor.s
; Check If incomming text has codes (Bold, Underline Or Color)
; If Not, then output text via normal methods
If (FindString(sText, Chr(2), 0) = 1) And (FindString(sText, Chr(3), 1) = 0) And (FindString(sText, Chr(31), 1) = 0)
;AddGadgetItem(editorGadget, -1, sText)
SendMessage_(GadgetID(editorGadget), #EM_REPLACESEL, 0, sText + Chr(10))
ProcedureReturn
EndIf
; Reset RTFCodes And OutPutLine since this is a new line.
RTFCodes = ""
OutPutLine = TblColor + "{"
For X = 1 To Len(sText)
; Bold Character Code
If Mid(sText, X, 1) = Chr(2)
ManageRTF("\b")
OutPutLine = OutPutLine + "}{" + RTFCodes
; Underline Character Code
ElseIf Mid(sText, X, 1) = Chr(31)
ManageRTF("\ul")
OutPutLine = OutPutLine + "}{" + RTFCodes
; Color Character Code
ElseIf Mid(sText, X, 1) = Chr(3)
; Double Forecolor selection
If isNumber2(Mid(sText, X + 1, 2))
; Eg forecolor selection 04, or 05 etc...
If Mid(sText, X + 1, 1) = "0"
; We want get rid of the "0"
ForeColor = Mid(sText, X + 2, 1)
Else
ForeColor = Mid(sText, X + 1, 2)
EndIf
ManageRTF("\cf" + ForeColor)
X = X + 2
; We now have the forecolor selection from the ##. Lets now see
; If any background wants To be set
; We could have background if numbers
; follow this point
If Mid(sText, X + 1, 1) = ","
; We have double digit background selection
If isNumber2(Mid(sText, X + 2, 2))
; Set background (TODO GET RID OF Left(X,1) = "0"
BackColor = Mid(sText, X + 2, 2)
ManageRTF("\highlight" + BackColor)
OutPutLine = OutPutLine + "}{" + RTFCodes
X = X + 3
; We have single digit background selection
ElseIf isNumber1(Mid(sText, X + 2, 1))
BackColor = Mid(sText, X + 2, 1)
ManageRTF("\highlight" + BackColor)
OutPutLine = OutPutLine + "}{" + RTFCodes
X = X + 2
Else
; No number following "," Continue With just the forecolor
OutPutLine = OutPutLine + "}{" + RTFCodes
EndIf
Else
; No Backgrounds, so Continue With just the forecolor
OutPutLine = OutPutLine + "}{" + RTFCodes
EndIf
; Single Forecolor Selection
ElseIf isNumber1(Mid(sText, X + 1, 1))
ForeColor = Mid(sText, X + 1, 1)
ManageRTF("\cf" + ForeColor)
X = X + 1
; We may have background. Lets check
If Mid(sText, X + 1, 1) = ","
; We have double digit background selection
If isNumber2(Mid(sText, X + 2, 2))
BackColor = Mid(sText, X + 2, 2)
ManageRTF("\highlight" + BackColor)
OutPutLine = OutPutLine + "}{" + RTFCodes
X = X + 3
; We have single digit background selection
ElseIf isNumber1(Mid(sText, X + 2, 1))
BackColor = Mid(sText, X + 2, 1)
ManageRTF("\highlight" + BackColor)
OutPutLine = OutPutLine + "}{" + RTFCodes
X = X + 2
Else
; We didn't find any numbers after the "," so just use the forecolor
OutPutLine = OutPutLine + "}{" + RTFCodes
EndIf
Else
; No Background, so Continue With forecolor
OutPutLine = OutPutLine + "}{" + RTFCodes
EndIf
EndIf
Else
; No Color/Bold/Underline codes To process, get the single character.
OutPutLine = OutPutLine + Mid(sText, X, 1)
EndIf
Next X
; Finnish off the OutPutLine so it's ready For display
OutPutLine = OutPutLine + "}" + CrLf
; Display it
;AddGadgetItem(editorGadget, -1, OutPutLine)
SendMessage_(GadgetID(editorGadget), #EM_REPLACESEL, 0, OutPutLine)
EndProcedure
