PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

syntax coloration in rtf

https://www.purebasic.fr/english/viewtopic.php?t=38198

Page 1 of 1

syntax coloration in rtf

Posted: Fri Jul 17, 2009 1:07 pm
by dobro
this code use RTF for coloration

for this sample he color only word "if,else" and balise " <?php" and "?>"

the procedure for color is

sortie$= key_coloration(total_text$," <?php ",couleur_rouge$)

total_text= the listing to color
" <?php " = the word to color

couleur_rouge$ = the color whit form :

Code: Select all

couleur_noir$=" \cf0 "
      couleur_bleu$=" \cf1 "
      couleur_vert$=" \cf2" 
      couleur_rouge$=" \cf4 "
      couleur_magenta$=" \cf5 "
      couleur_marron$=" \cf6 "


the code :

Code: Select all


;by Dobro
; recherche d'une balise PHP et recolorie en rouge les balises PHP

Declare.S RTF(type.L, text.S)
Declare.S  gnozal_Remplace(Texte.S, MotCherche.S, MotRemplace.S)
Declare.S key_coloration(total_text$,mot$,coul$)
;- Window Constants
;
Enumeration
  #Window_0
EndEnumeration

;- Gadget Constants
;
Enumeration
  #Editor_0
  #String_chercher
  #Text_0
  #Button_chercher
EndEnumeration

;- Fonts
Global FontID1
FontID1 = LoadFont(1, "Arial", 14)

Procedure Open_Window_0()
  If OpenWindow(#Window_0, 241, 72, 528, 415, "New window ( 0 )",  #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_TitleBar )
    If CreateGadgetList(WindowID(#Window_0))
      EditorGadget(#Editor_0, 20, 20, 490, 340)
     ; StringGadget(#String_chercher, 210, 370, 180, 30, "")
     ; TextGadget(#Text_0, 50, 370, 170, 30, "Mot a rechercher")
      SetGadgetFont(#Text_0, FontID1)
      ButtonGadget(#Button_chercher, 410, 370, 90, 30, "colorer")
      
    EndIf
  EndIf
EndProcedure

Open_Window_0()
Restore debut:
total_text$="{\rtf1\ansi "
While texte$<>"::"
  Read.S texte$
  AddGadgetItem(#Editor_0, -1, texte$) 
  total_text$=total_text$+texte$+" \par " 
Wend
total_text$=total_text$+" }"+Chr(10)



Repeat ; Start of the event loop
  
  Event = WaitWindowEvent() ; This line waits until an event is received from Windows
  
  WindowID = EventWindow() ; The Window where the event is generated, can be used in the gadget procedures
  
  GadgetID = EventGadget() ; Is it a gadget event?
  
  EventType = EventType() ; The event type
  
  ;You can place code here, and use the result as parameters for the procedures
  
  If Event = #PB_Event_Gadget 
    If GadgetID = #Editor_0 
    ElseIf GadgetID = #String_chercher  
    ElseIf GadgetID = #Button_chercher
      
   ; definition du RTF
      bold$="\b " :fin_bold$=" \b0 "
      couleur_noir$=" \cf0 "
      couleur_bleu$=" \cf1 "
      couleur_vert$=" \cf2" 
      couleur_rouge$=" \cf4 "
      couleur_magenta$=" \cf5 "
      couleur_marron$=" \cf6 "
   
      
     sortie$= key_coloration(total_text$," <?php ",couleur_rouge$)
      sortie$=key_coloration(sortie$," ?>",couleur_rouge$)
      
      sortie$=key_coloration(sortie$," If ",couleur_bleu$)
        sortie$=key_coloration(sortie$," Else ",couleur_bleu$)
      sortie$=key_coloration(sortie$," While ",couleur_vert$)
     
      SetGadgetText(#Editor_0, sortie$) 
    EndIf 
  EndIf
  
Until Event = #PB_Event_CloseWindow ; End of the event loop

End
;

Procedure.S RTF(type.L, text.S)
  ;_____________________________________________________________________________________________
  ;¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
  ;   Procédure qui décore la chaîne.d'entrée Text
  ;     Type = 1: "{Sortie}" = RTF("Entrée") >> Décore avec une paire d'accolades
  ;     Type = 2: Décore la chaîne d'entrée des ressources nécessaires pour le format RTF
  ;               Spécialement conçu pour un SetGadgetText()
  ;
  ;               Prépare une table succinte de fonte:
  ;                   0 : Tahoma
  ;                   1 : Arial
  ;                   2 : Courier New
  ;
  ;               Prépare une table type de couleurs
  ;                   0  : Noir
  ;                   1  : Bleu
  ;                   2  : Vert
  ;                   3  : Cyan
  ;                   4  : Rouge
  ;                   5  : Magenta
  ;                   6  : Marron
  ;                   7  : Gris
  ;                   8  : Gris
  ;                   9  : Bleu clair
  ;                   10 : Vert clair
  ;                   11 : Cyan clair
  ;                   12 : Rouge clair
  ;                   13 : Magenta clair
  ;                   14 : Jaune
  ;                   15 : Blanc
  ;_____________________________________________________________________________________________
  ;¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
  
  Static Used.L
  Static FontTable.S
  Static ColorTable.S
  
  Protected l.L
  Protected r.L
  Protected v.L
  Protected b.L
  Protected S.S = text   
  
  If Used = 0
    FontTable = "{\fonttbl{\f0\fswiss\fprq2\fcharset0 Tahoma;}{\f1\fswiss\fcharset0 Arial;}{\f2\fswiss\fcharset0 Courier New}}"
    ColorTable = "{\colortbl ;"
    For i = 1 To 15
      l = ((i & 8) >> 3) * 128
      r = l + ((i & 4) >> 2) * 127
      v = l + ((i & 2) >> 1) * 127
      b = l + (i & 1) * 127
      ColorTable + "\red" + Str(r) + "\green" + Str(v) + "\blue" + Str(b) + ";"
    Next
    ColorTable + "}"
    Used = 1
  EndIf
  
  If type = 2: S = "\rtf1\ansi{\deflang1036}" + FontTable + ColorTable + S: type = 1: EndIf
  If type = 1: S = "{" + S + "}": EndIf
  
  ProcedureReturn S
EndProcedure

Procedure.S gnozal_Remplace(Texte.S, MotCherche.S, MotRemplace.S)
  Structure MemoryArray
    Byte.c[0]
  EndStructure
  Global Dim AllowedChar.c(255)
  For i = '0' To '9'
    AllowedChar(i) = 1
  Next
  For i = 'A' To 'Z'
    AllowedChar(i) = 1
  Next
  For i = 'a' To 'z'
    AllowedChar(i) = 1
  Next 
  
  Protected Recherche, LongueurCherche, LongueurRemplace
  Protected *Texte.MemoryArray
  Longueur = Len(MotCherche)
  LongueurRemplace = Len(MotRemplace)
  *Texte = @Texte
  Repeat
    Recherche = FindString(Texte, MotCherche, Recherche)
    If Recherche
      If AllowedChar(*Texte\Byte[Recherche + Longueur - 1]) = 0
        If Recherche = 1 Or (AllowedChar(*Texte\Byte[Recherche - 2]) = 0)
          Texte = Left(Texte, Recherche - 1) + MotRemplace + Right(Texte, Len(Texte) - Recherche - Longueur + 1)
          Recherche + LongueurRemplace - Longueur
        EndIf
      EndIf
      Recherche + 2
    EndIf
  Until Recherche = 0
  ProcedureReturn Texte
EndProcedure



Procedure.S key_coloration(total_text$,mot$,coul$)
  chaine_remplace$=RTF(2, bold$+coul$+mot$+" \cf0 "+fin_bold$) 
  sortie$=gnozal_Remplace( total_text$,mot$,chaine_remplace$) 
  ProcedureReturn sortie$
EndProcedure


DataSection
  debut:
  Data.S "* <?php"
  Data.S "* // Ouverture des sessions"
  Data.S "* session_start();"
  Data.S "*"
  Data.S "* // Création d'une image"
  Data.S "* header ("+Chr(34)+"Content-type: image/png"+Chr(34)+");"
  Data.S "* $image = imagecreate(70,20);"
  Data.S "*"
  Data.S "* // définition des couleur et coloriage du fond en noir"
  Data.S "* $noir = imagecolorallocate($image, 0, 0, 0);"
  Data.S "* $blanc = imagecolorallocate($image, 255, 255, 255);"
  Data.S "* $gris = imagecolorallocate($image, 150, 150, 150);"
  Data.S "*"
  Data.S "* // Le nombre de ligne est pour Le moment de zéro"
  Data.S "* $nb = 0;"
  Data.S "*"
  Data.S "* // On va dessinné ligne par ligne jusqu'a 7"
  Data.S "* While ( $nb < 7 ) {"
  Data.S "  *"
  Data.S "  * // On défini Le point de départ et d'arrivé en X"
  Data.S "  * $xd = rand(0,70);"
  Data.S "  * $xa = rand(0,70);"
  Data.S "  *"
  Data.S "  * // Si Le point de départ de x=0 alors en Y On part d'ou on veut"
  Data.S "  * // Sinon Le point de départ est forcément à 20"
  Data.S "  * If ( $xd == 0 ) {"
  Data.S "    * $yd = rand(0,19);"
  Data.S "    * }"
  Data.S "  * Else {"
  Data.S "    * $yd = 0;"
  Data.S "    * }"
  Data.S "    *"
  Data.S "    * // Si Le point d'arrivé de X=70 alors en Y on arrive ou on veut"
  Data.S "    * // Sinon Le point d'arrivé est forcément à 19"
  Data.S "    * If ( $xa == 70 ) {"
  Data.S "      * $ya = rand(0,19);"
  Data.S "      * }"
  Data.S  "    * Else {"
  Data.S "      * $ya = 19;"
  Data.S "      * }"
  Data.S "      *"
  Data.S "      * // On dessine la ligne"
  Data.S "      * ImageLine ($image, $xd, $yd, $xa, $ya, $gris);"
  Data.S "      *"
  Data.S "      * // et On prépar pour la lign suivante"
  Data.S "      * $nb++;"
  Data.S "      * }"
  Data.S "      *"
  Data.S "      * // On écrit Le captcha"
  Data.S "      * imagestring($image, 5, 8, 2, $_SESSION['captcha'], $blanc);"
  Data.S "      *"
  Data.S "      * // On Génère l'image"
  Data.S "      * imagepng($image);"
  Data.S "      * ?>"
  Data.S "      *"
  Data.S  "ceci n'est plus coloré "
  Data.S  "voila voila"
  Data.S "::"
EndDataSection
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited