home *** CD-ROM | disk | FTP | other *** search
/ PC Plus SuperCD (UK) 2000 March / pcp161b.iso / handson / archive / Issue158 / delphi / RichEditTest / redtest.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-08-16  |  4.3 KB  |  170 lines
  1. unit redtest;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls, ComCtrls, StrUtils, RichEditUtils, ExtCtrls;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     RichEdit1: TRichEdit;
  12.     Panel1: TPanel;
  13.     Button1: TButton;
  14.     Button2: TButton;
  15.     Button3: TButton;
  16.     Button4: TButton;
  17.     Button5: TButton;
  18.     Button6: TButton;
  19.     Button7: TButton;
  20.     Button8: TButton;
  21.     procedure Button1Click(Sender: TObject);
  22.     procedure Button2Click(Sender: TObject);
  23.     procedure Button3Click(Sender: TObject);
  24.     procedure Button4Click(Sender: TObject);
  25.     procedure Button5Click(Sender: TObject);
  26.     procedure Button6Click(Sender: TObject);
  27.     procedure Button7Click(Sender: TObject);
  28.     procedure Button8Click(Sender: TObject);
  29.   private
  30.     { Private declarations }
  31.   public
  32.     { Public declarations }
  33.     procedure SetDefAttributes;
  34.     procedure SetNormalAttributes;
  35.     procedure SetkeyWordAttributes;
  36.     function KeyWord( token : string ) : boolean;
  37.     procedure FormatLineAt( Red: TRichEdit; num : LongInt );     
  38.   end;
  39.  
  40. const
  41.   APPNAME = 'RichEdit Test Application';
  42.  
  43.   NUMKEYWORDS = 27;
  44.   Keywords : array[0..NUMKEYWORDS] of string =
  45.               ('unit','begin','end','procedure','function',
  46.               'if','while','do','then','else','repeat','until',
  47.               'const','var','type','uses','interface','implementation',
  48.               'string','of','array','program', 'private', 'public',
  49.               'published', 'and', 'with', 'or');
  50.  
  51. var
  52.   Form1: TForm1;
  53.  
  54. implementation
  55.  
  56. {$R *.DFM}
  57.  
  58. procedure TForm1.SetDefAttributes;
  59. begin
  60.   RichEdit1.DefAttributes.Style := [];
  61.   RichEdit1.DefAttributes.Color := clWindowText;
  62. end;
  63.  
  64. procedure TForm1.setNormalAttributes;
  65. begin
  66.  // default text attributes
  67.   RichEdit1.SelAttributes.Style := [];
  68.   RichEdit1.selAttributes.Color := clWindowText;
  69. end;
  70.  
  71. procedure TForm1.setKeyWordAttributes;
  72. begin
  73.  // text attributes for a keyword
  74.   RichEdit1.SelAttributes.Style := [fsBold];
  75.   RichEdit1.selAttributes.Color := clBlue;
  76. end;
  77.  
  78. function TForm1.KeyWord( token : string ) : boolean;
  79. var
  80.    isKW : boolean;
  81.    i    : integer;
  82. begin
  83.    isKW := false;
  84.    i := 0;
  85.    while ((i <= NUMKEYWORDS) and (isKW = false )) do
  86.    begin
  87.    //!! Test is case-insensitive (OK for Pascal. Change this for C or Java)
  88.       if lowercase(token) = KeyWords[i] then
  89.          isKW := true
  90.       else
  91.          Inc(i);
  92.    end;
  93.    result := isKW;
  94. end;
  95.  
  96. procedure TForm1.FormatLineAt( Red: TRichEdit; num : LongInt ); // num is RichEdit1.Lines[num]
  97. var
  98.    ti : tokenindexes;
  99.    i, numfound : integer;
  100.    StartIndex : LongInt;
  101.    s : string;
  102. begin
  103.   s := red.Lines[num];
  104.   TokensFoundAt( s, numfound, ti );
  105.   Red.SetFocus;
  106.   StartIndex := GetLineSelStartIndex( Red, num );
  107.   HideCaret(Red.Handle);
  108.   HideSelection(Red);
  109.   Red.Lines.BeginUpdate;
  110.   for i := 1 to numfound do
  111.   begin
  112.      Red.SelStart := StartIndex + ti[i].tstart;
  113.      Red.SelLength := ti[i].tend;
  114.      if KeyWord( Red.SelText ) then
  115.         SetKeyWordAttributes
  116.      else
  117.         SetNormalAttributes;
  118.    end;
  119.    Red.Lines.EndUpdate;
  120.    ShowSelection(Red);
  121.    ShowCaret(Red.Handle);
  122. end;
  123.  
  124. procedure TForm1.Button1Click(Sender: TObject);
  125. begin
  126.    FormatLineAt(RichEdit1, GetCurrLineNum(RichEdit1));
  127. end;
  128.  
  129. procedure TForm1.Button2Click(Sender: TObject);
  130. begin
  131.    ShowMessage( IntToStr( LinesShowing(RichEdit1) ) + ' lines showing.' );
  132. end;
  133.  
  134. procedure TForm1.Button3Click(Sender: TObject);
  135. begin
  136.   ShowMessage( 'Selection is in line: ' + IntToStr(GetCurrLineNum( RichEdit1 )));
  137. end;
  138.  
  139. procedure TForm1.Button4Click(Sender: TObject);
  140. var
  141.    l, c : longint;
  142. begin
  143.    l := 0; c := 0;
  144.    GetCurrLineAndColNum( RichEdit1, l, c );
  145.    ShowMessage( Format('Selection starts on line %d, at column %d', [l,c] ));
  146. end;
  147.  
  148. procedure TForm1.Button5Click(Sender: TObject);
  149. begin
  150.    ShowMessage('Current line starts at char number: ' +
  151.       IntToStr(GetLineSelStartIndex( RichEdit1, GetCurrLineNum(RichEdit1) )));
  152. end;
  153.  
  154. procedure TForm1.Button6Click(Sender: TObject);
  155. begin
  156.    HideSelection( RichEdit1 );
  157. end;
  158.  
  159. procedure TForm1.Button7Click(Sender: TObject);
  160. begin
  161.    ShowSelection( RichEdit1 );
  162. end;
  163.  
  164. procedure TForm1.Button8Click(Sender: TObject);
  165. begin
  166.   Close;
  167. end;
  168.  
  169. end.
  170.