home *** CD-ROM | disk | FTP | other *** search
/ Chip 1997 October / Chip_1997-10_cd.bin / tema / sw602 / wintext / disk1 / data.1 / SETCOLOR.TXT < prev    next >
Text File  |  1996-12-17  |  9KB  |  379 lines
  1.                                                                                                                                                                                                  //*************************************************************
  2. **********
  3. //*
  4. //*       Nßzev makra:   Nastavenφ barev
  5. //*             Autor:   Software602 a.s.
  6. //*   Datum vytvo°enφ:   17.12.1996
  7. //*
  8. //*     Nßzev souboru:   
  9. //*    Nßzev programu:   
  10. //*              Tisk:    
  11. //*
  12. //*             Popis:   Nastavenφ barev ve zdrojovΘm textu 
  13. makra
  14. //*                      (klφΦovΘ slova, komentß°e...)
  15. //*
  16. //*************************************************************
  17. *****mt***
  18. program Nastav_barvy;
  19.  
  20. const
  21.   COUNT          = 32;
  22.   MAXLEN         = 15;
  23.  
  24.   FIND_COMMENT   = 101;
  25.   FIND_STRING    = 102;
  26.   FIND_NUMBER    = 103;
  27.   FIND_MRIZKA    = 104;
  28.  
  29.  
  30. var
  31.   keyWord :array[1..COUNT] of string[MAXLEN];
  32.   startPos :integer;                          // p∙vodnφ 
  33. umφst∞nφ kurzoru
  34.   start_pos, end_pos, actual_pos :integer;
  35.   endDoc :integer;                            // konec 
  36. dokumentu
  37.   changeWords :integer;                       // poΦet 
  38. nalezen²ch slov
  39.   s :string[50];
  40.  
  41.   CAPTION :string[20];                        // nßzev makra
  42.   RESULT_COUNT :string[100];
  43.  
  44.  
  45.  
  46. procedure init;
  47. begin
  48.   keyWord[1]  := 'AND';
  49.   keyWord[2]  := 'ARRAY';
  50.   keyWord[3]  := 'BEGIN';
  51.   keyWord[4]  := 'CASE';
  52.   keyWord[5]  := 'CONST';
  53.   keyWord[6]  := 'CSISTRING';
  54.   keyWord[7]  := 'CSSTRING';
  55.   keyWord[8]  := 'DIV';
  56.   keyWord[9]  := 'DO';
  57.   keyWord[10] := 'DOWNTO';
  58.   keyWord[11] := 'ELSE';
  59.   keyWord[12] := 'END';
  60.   keyWord[13] := 'FILE';
  61.   keyWord[14] := 'FOR';
  62.   keyWord[15] := 'FUNCTION';
  63.   keyWord[16] := 'HALT';
  64.   keyWord[17] := 'IF';
  65.   keyWord[18] := 'MOD';
  66.   keyWord[19] := 'NOT';
  67.   keyWord[20] := 'OF';
  68.   keyWord[21] := 'OR';
  69.   keyWord[22] := 'PROCEDURE';
  70.   keyWord[23] := 'PROGRAM';
  71.   keyWord[24] := 'RECORD';
  72.   keyWord[25] := 'REPEAT';
  73.   keyWord[26] := 'STRING';
  74.   keyWord[27] := 'THEN';
  75.   keyWord[28] := 'TO';
  76.   keyWord[29] := 'TYPE';
  77.   keyWord[30] := 'UNTIL';
  78.   keyWord[31] := 'VAR';
  79.   keyWord[32] := 'WHILE';
  80.  
  81.   { stringy : }
  82.   CAPTION := 'SetColor';
  83.   RESULT_COUNT := 'PoΦet nalezen²ch klφΦov²ch slov: ';
  84.  
  85.   { caret : }
  86.   startPos := GetCaretPos;
  87.   CaretEnd(false);
  88.   endDoc := GetCaretPos;
  89.   CaretHome(false);
  90.  
  91.   { ostatnφ prom∞nnΘ : }
  92.   changeWords := 0;
  93. end;
  94.  
  95.  
  96. procedure setColor_COMMENT;
  97. begin
  98.   SetRGBColor(128, 128, 128);
  99.   SetFormatFont(kCHPitalic, kOn);
  100. end;
  101.  
  102.  
  103. procedure setColor_STRING;
  104. begin SetRGBColor(0, 0, 255); end;
  105.  
  106.  
  107. procedure setColor_MRIZKA;
  108. begin SetRGBColor(128, 0, 0); end;
  109.  
  110.  
  111. procedure setColor_NUMBER;
  112. begin SetRGBColor(0, 0, 255); end;
  113.  
  114.  
  115. procedure setColor_KEYWORD;
  116. begin
  117.   SetFormatFont(kCHPbold, kOn);     // bold
  118. {  SetRGBColor(255, 255, 255);}       // bφlß
  119. {  SetRGBColor(255, 255, 0);}         // ₧lutß
  120. {  SetRGBColor(0, 0, 128);}           // tmav∞ modrß
  121. end;
  122.  
  123.  
  124. function FindEndOf(readStr:string[2]; p, typ:integer):integer;
  125. { readStr: naΦten² °et∞zec
  126.   p:       poΦßteΦnφ pozice
  127.   typ:     typ vyhledßvanΘho °et∞zce }
  128. var
  129.   actual_pos, sz :integer;
  130.   konec :boolean;
  131.   s :string[2];
  132.   znak :char;
  133.   result, countChars :integer;
  134. begin
  135.   sz := StrLength(readStr);
  136.   countChars := 0;
  137.   result := -1;
  138.   actual_pos := p + sz;
  139.   konec := false;
  140.   UnSelectBlock;
  141.  
  142.   { nastavenφ caretu na zaΦßtek °et∞zce : }
  143.   CharRight(p-GetCaretPos, false);
  144.  
  145.   { selektovßnφ prvnφch znak∙ : }
  146.   if (readStr = '//') and (typ = FIND_COMMENT) then begin
  147.     { aby si caret uv∞domil, kde je jeho mφsto : }
  148.     CharRight; CharLeft; end;
  149.   CharRight(sz, true);
  150.  
  151.   { jestli₧e je typ komentß°e '//', selektuj do konce °ßdky : 
  152. }
  153.   if (readStr = '//') and (typ = FIND_COMMENT) then begin
  154.     RightOfLine(true);
  155.     result := GetCaretPos-1;
  156.     konec := true;
  157.   end;
  158.  
  159.   while not(konec) and (actual_pos < endDoc) do begin
  160.     s := GetText(actual_pos, actual_pos+1);
  161.  
  162.     case (typ) of
  163.       FIND_COMMENT: begin
  164.         znak := s;
  165.         if (znak = '*') then begin
  166.           s := s + GetText(actual_pos+1, actual_pos+2);
  167.           inc(actual_pos);
  168.         end;
  169.         konec := (ord(znak) = 125) or (s = '*)') or (s = 
  170. '*/');
  171.         result := actual_pos;
  172.         inc(countChars, StrLength(s));
  173.       end;
  174.  
  175.       FIND_STRING: begin
  176.         znak := s;
  177.         konec := ((ord(znak) = 39) or (ord(znak) = 34));
  178.         result := actual_pos;
  179.         inc(countChars, 1);
  180.       end;
  181.  
  182.       FIND_NUMBER: begin
  183.         znak := s;
  184.         konec :=
  185.           not(((ord(znak) >= 48) and (ord(znak) <= 57)) or 
  186. (znak = '.'));
  187.         result := actual_pos-1;
  188.         inc(countChars, 1);
  189.       end;
  190.  
  191.       FIND_MRIZKA: begin
  192.         znak := s;
  193.         konec := (znak <> '#');
  194.         result := actual_pos-1;
  195.         inc(countChars, 1);
  196.       end;
  197.     end; { case }
  198.  
  199.     inc(actual_pos);
  200.   end; { while }
  201.  
  202.   { selektuj vybran² text, ale pouze v p°φpad∞, ₧e hledan² 
  203. text nenφ
  204.     komentß° typu '//', ten u₧ je selektovan² : }
  205.   if not((readStr = '//') and (typ = FIND_COMMENT)) then
  206.     CharRight(countChars, true);
  207.  
  208.   case (typ) of
  209.     FIND_COMMENT: setColor_COMMENT;
  210.     FIND_STRING:  setColor_STRING;
  211.     FIND_MRIZKA:  setColor_MRIZKA;
  212.     FIND_NUMBER:  begin CharLeft(1, true); setColor_NUMBER; 
  213. end;
  214.   end;
  215.  
  216.   UnselectBlock;
  217.   FindEndOf := result;
  218. end;
  219.  
  220.  
  221. function CharIsOK(znak:char):boolean;
  222. begin
  223.   CharIsOK :=
  224.     (((ord(znak) >= 97) and (ord(znak) <= 122)) or
  225.     ((ord(znak) >= 65) and (ord(znak) <= 90)) or
  226.     (znak = '_'));
  227. end;
  228.  
  229.  
  230. function GetBeginOfWord(p:integer):integer;
  231. var
  232.   result :integer;
  233.   konec :boolean;
  234.   znak :char;
  235.   znak2 :char;
  236.   readStr :string[2];
  237. begin
  238.   result := -1;
  239.   konec := false;
  240.   actual_pos := p;
  241.  
  242.   while not(konec) and (actual_pos < endDoc) do begin
  243.     znak := GetText(actual_pos, actual_pos+1);
  244.     if (znak = '(') or (znak = '/')
  245.       then znak2 := GetText(actual_pos+1, actual_pos+2)
  246.       else begin if (actual_pos >= 1)
  247.         then znak2 := GetText(actual_pos-1, actual_pos)
  248.         else znak2 := (chr(255))
  249.       end;
  250.     readStr := Char2Str(znak) + Char2Str(znak2);
  251.  
  252.     { komentß° : }
  253.     if (znak = '{')
  254.       then actual_pos := FindEndOf(znak, actual_pos, 
  255. FIND_COMMENT)
  256.  
  257.     { komentß° : }
  258.     else if ((znak = '(') and (znak2 = '*')) or
  259.     ((znak = '/') and (znak2 = '*')) or
  260.     ((znak = '/') and (znak2 = '/'))
  261.       then actual_pos := FindEndOf(readStr, actual_pos, 
  262. FIND_COMMENT)
  263.  
  264.     { °et∞zec : }
  265.     else if (ord(znak) = 39) or (ord(znak) = 34)
  266.       then actual_pos := FindEndOf(znak, actual_pos, 
  267. FIND_STRING)
  268.  
  269.     { Φφslo : }
  270.     else if (ord(znak) >= 48) and (ord(znak) <= 57)
  271.     and not(CharIsOK(znak2))
  272.       then actual_pos := FindEndOf(znak, actual_pos, 
  273. FIND_NUMBER)
  274.  
  275.     { m°φ₧ka : }
  276.     else if (znak = '#')
  277.       then actual_pos := FindEndOf(znak, actual_pos, 
  278. FIND_MRIZKA)
  279.  
  280.     { nalezeno : }
  281.     else if (CharIsOK(znak)) then begin
  282.       konec := true;
  283.       result := actual_pos;
  284.     end;
  285.  
  286.     inc(actual_pos);
  287.   end; { while }
  288.  
  289.   GetBeginOfWord := result;
  290. end;
  291.  
  292.  
  293. function GetEndOfWord(p:integer):integer;
  294. var
  295.   result :integer;
  296.   konec :boolean;
  297.   znak :char;
  298. begin
  299.   result := p;
  300.   konec := false;
  301.   actual_pos := p;
  302.   while not(konec) do begin
  303.     znak := GetText(actual_pos, actual_pos+1);
  304.     if((ord(znak) < ord('A')) or (ord(znak) > ord('Z'))) and
  305.       ((ord(znak) < ord('a')) or (ord(znak) > ord('z'))) and
  306.       ((ord(znak) < ord('0')) or (ord(znak) > ord('9'))) and
  307.       (znak <> '_') then begin
  308.       konec := true;
  309.       result := actual_pos;
  310.     end;
  311.     inc(actual_pos);
  312.   end; { while }
  313.   GetEndOfWord := result;
  314. end;
  315.  
  316.  
  317. function IsOK(s:string[MAXLEN]):boolean;
  318. var
  319.   i :integer;
  320.   nalezeno :boolean;
  321. begin
  322.   i := 1;
  323.   nalezeno := false;
  324.   s := UpCase(s);
  325.   while (i <= COUNT) and not(nalezeno) do begin
  326.     nalezeno := (s = UpCase(keyWord[i]));
  327.     inc(i);
  328.   end;
  329.   IsOK := nalezeno;
  330. end;
  331.  
  332.  
  333. procedure Run;
  334. var
  335.   beginPos, endPos :integer;
  336.   s :string[MAXLEN];
  337.   i :integer;
  338.   konec :boolean;
  339. begin
  340.   endPos := GetCaretPos;
  341.   beginPos := endPos + 1;
  342.   konec := false;
  343.   while not(konec) do begin
  344.     beginPos := GetBeginOfWord(endPos);
  345.     if (beginPos >= 0) then begin
  346.       endPos := GetEndOfWord(beginPos);
  347.       if ((endPos - (beginPos+1)) <= MAXLEN) then begin
  348.         s := GetText(beginPos, endPos);
  349.         if (IsOK(s)) then begin
  350.           inc(changeWords);
  351.           CharRight(beginPos-GetCaretPos, false);
  352.           { p°eskoΦenφ prßzdn²ch odstavc∙ : }
  353.           if (GetCaretPos <> endPos) then begin
  354.             CharRight(1,false);
  355.             CharLeft(1,false);
  356.           end
  357.           else begin
  358.             CharLeft(1,false);
  359.             CharRight(1,false);
  360.           end;
  361.           CharRight(endPos-beginPos, true);
  362.           setColor_KEYWORD;
  363.         end;
  364.       end;
  365.     end
  366.     else konec := true;
  367.   end;
  368. end;
  369.  
  370.  
  371.  
  372. begin
  373.   init;
  374.   Run;
  375.   CaretHome;
  376.   CharRight(startPos);
  377.   s := RESULT_COUNT + Int2str(ChangeWords);
  378.   info_box(CAPTION, s);
  379. end.