PC Plus SuperCD (UK) 2000 March/pcp161b.iso/handson/archive/Issue158/delphi/LinesShowing/linesunit.pas

Pascal/Delphi Source File | 1999-08-13 | 5.8 KB | 205 lines

unit linesunit;

{  Demo application to illustrate the use of the LinesShowing() function.

   Calculate the indexes of 1st and last lines visible in RichEdit
   then format only those lines.

   Maybe an interesting example, but far from ideal as a real-world
   syntax-colouring editor!

}
interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, ExtCtrls, richeditutils, strutils;

type
  TForm1 = class(TForm)
    RichEdit1: TRichEdit;
    Panel1: TPanel;
    LinesShowingBtn: TButton;
    RecolBtn: TButton;
    LineIndexesBtn: TButton;
    procedure LinesShowingBtnClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure RecolBtnClick(Sender: TObject);
    procedure LineIndexesBtnClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    function GetCharFromPos( x, y : integer ) : LongInt;
    function GetLineNumAt(x , y : integer) : LongInt;
    procedure FormatLineAt( Red: TRichEdit; num : LongInt );
    procedure SetDefAttributes;
    procedure SetNormalAttributes;
    procedure SetKeyWordAttributes;
    function KeyWord( token : string ) : boolean;
    procedure RecolourScreen;
  end;


var
  Form1: TForm1;
const
  APPNAME = 'Working with Visible Lines Test Application';

  NUMKEYWORDS = 27;
  Keywords : array[0..NUMKEYWORDS] of string =
              ('unit','begin','end','procedure','function',
              'if','while','do','then','else','repeat','until',
              'const','var','type','uses','interface','implementation',
              'string','of','array','program', 'private', 'public',
              'published', 'and', 'with', 'or');

implementation

{$R *.DFM}


procedure TForm1.SetDefAttributes;
begin
  RichEdit1.DefAttributes.Style := [];
  RichEdit1.DefAttributes.Color := clWindowText;
end;

procedure TForm1.setNormalAttributes;
begin
 // default text attributes
  RichEdit1.SelAttributes.Style := [];
  RichEdit1.selAttributes.Color := clWindowText;
end;

procedure TForm1.setKeyWordAttributes;
begin
 // text attributes for a keyword
  RichEdit1.SelAttributes.Style := [fsBold];
  RichEdit1.selAttributes.Color := clBlue;
end;

function TForm1.KeyWord( token : string ) : boolean;
var
   isKW : boolean;
   i    : integer;
begin
   isKW := false;
   i := 0;
   while ((i <= NUMKEYWORDS) and (isKW = false )) do
   begin
   //!! Test is case-insensitive (OK for Pascal. Change this for C or Java)
      if lowercase(token) = KeyWords[i] then
         isKW := true
      else
         Inc(i);
   end;
   result := isKW;
end;


procedure TForm1.LinesShowingBtnClick(Sender: TObject);
// calculate the number of lines showing in the Richedit control
begin
  Caption := 'Lines Showing (0-based index) = ' + IntToStr(LinesShowing( RichEdit1 ));
end;

procedure TForm1.FormCreate(Sender: TObject);
var
   i : integer;
begin
   for i := 1 to 100 do
       RichEdit1.Lines.Add(Format('[%d] This is Line %d. keywords=array, unit, begin end.', [i, i]));
   RichEdit1.SelStart := 0;
   Caption := APPNAME;
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  RichEdit1.Refresh; { a 'feature' in RichEdit can fail to refresh the
                        display after the form has been resized. This
                        forces an update }
end;

// --- Note: Maybe We could add the next two functions to richeditutils.pas?
function TForm1.GetCharFromPos( x, y : integer ) : LongInt;
{ return char index from x, y coordinates }
var
   P : TPoint;
begin
   P := Point(x,y);
   result := SendMessage(RichEdit1.Handle, EM_CHARFROMPOS, 0, longint(@P){MAKELPARAM(1, 1)} );
end;

function TForm1.GetLineNumAt(x , y : integer) : LongInt;
{ return line number containing point at specified coordinates }
begin
   result := GetLineNum(RichEdit1, GetCharFromPos(x,y));
end;

procedure TForm1.FormatLineAt( Red: TRichEdit; num : LongInt ); // num is RichEdit1.Lines[num]
var
   ti : tokenindexes;
   i, numfound : integer;
   StartIndex : LongInt;
   s : string;
begin
  s := red.Lines[num];
  TokensFoundAt( s, numfound, ti );
  StartIndex := GetLineSelStartIndex( Red, num );
  for i := 1 to numfound do
  begin
     Red.SelStart := StartIndex + ti[i].tstart;
     Red.SelLength := ti[i].tend;
    if KeyWord( Red.SelText ) then
        SetKeyWordAttributes
     else
        SetNormalAttributes;
   end;
end;

procedure TForm1.RecolourScreen;
var
   i, startSelPos, FirstVisLine, LastVisLine : LongInt;
begin
  Richedit1.Lines.BeginUpdate;    // hide caret, selection etc.
  HideSelection(RichEdit1);
  HideCaret(RichEdit1.Handle);
  startSelPos := RichEdit1.selStart;
  RichEdit1.WordWrap := false;
  FirstVisLine := GetLineNumAt(0,0);
  LastVisLine := FirstVisLine + LinesShowing(RichEdit1);
  Richedit1.Lines.EndUpdate;

  RichEdit1.Lines.BeginUpdate;
  for i := FirstVisLine to LastVisLine do     // then colour visible lines
      FormatLineAt(RichEdit1, i);

  RichEdit1.selStart := startSelPos;
  ShowCaret(RichEdit1.Handle);
  ShowSelection(RichEdit1);
  RichEdit1.selStart := startSelPos;
  RichEdit1.Lines.EndUpdate;
  RichEdit1.setFocus;
end;

procedure TForm1.RecolBtnClick(Sender: TObject);
begin
   RecolourScreen;
end;

procedure TForm1.LineIndexesBtnClick(Sender: TObject);
// display indexes of visible lines. First line is at position 1.
// last line is the index of the last line that's even partially visible
var
   FirstVisLine, LastVisLine : longint;
begin
  FirstVisLine := GetLineNumAt(0,0) +1;  // +1 to match Lines 1-based indexing
  LastVisLine := FirstVisLine + LinesShowing(RichEdit1);
  ShowMessage( Format( 'First visible line is %d, last visible line is %d.',
                       [FirstVisLine, LastVisLine] ));
end;

end.