unit Unit1;
interface
uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics,
 Controls, Forms, Dialogs, StdCtrls, ComCtrls;
type
 TForm1 = class(TForm)
  RichEdit1: TRichEdit;
  Button1: TButton;
  OpenDialog1: TOpenDialog;
  Button2: TButton;
  procedure RichEdit1KeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
  procedure HighLight;
  function CheckList(InString: string): boolean;
  procedure Button1Click(Sender: TObject);
  procedure Button2Click(Sender: TObject);
 private
  { Private declarations }
 public
  { Public declarations }
 end;
var
 Form1: TForm1;
implementation
{$R *.dfm}
function TForm1.CheckList(InString: string): boolean;
const TheList: array[1..13] of string = ('begin', 'or', 'end','end.',
'end;', 'then', 'var', 'for', 'do', 'if', 'to', 'string', 'while');
var X: integer;
begin
 Result := false;
 X := 1;
 InString := StringReplace(InString, ' ', '',[rfReplaceAll]);
 InString := StringReplace(InString, #$A, '',[rfReplaceAll]);
 InString := StringReplace(InString, #$D, '',[rfReplaceAll]);
 while X < High(TheList) + 1 do
 if TheList[X] = lowercase(InString) then
 begin
  Result := true;
  X := High(TheList) + 1;
 end
 else inc(X);
end;
procedure TForm1.RichEdit1KeyUp(Sender: TObject; var Key: Word;
 Shift: TShiftState);
var WEnd, WStart, BCount: integer;
 Mark: string;
begin
 if (ssCtrl in Shift) and (Key = ord('V')) then Button2Click(Self);
 if (Key = VK_Return) or (Key = VK_Back) or (Key = VK_Space) then
 begin
  if RichEdit1.SelStart > 1 then
  begin
  WStart := 0;
  WEnd := RichEdit1.SelStart;
  BCount := WEnd - 1;
  while BCount <> 0 do
  begin
  Mark := copy(RichEdit1.Text, BCount, 1);
  if (Mark = ' ') or (Mark = #$A) then
  begin
  WStart := BCount;
  BCount := 1;
  end;
  dec(BCount);
  end;
  RichEdit1.SelStart := WEnd - (WEnd - WStart);
  RichEdit1.SelLength := WEnd - WStart;
  if CheckList(RichEdit1.SelText) then
  RichEdit1.SelAttributes.Style := [fsBold]
  else RichEdit1.SelAttributes.Style := [];
  RichEdit1.SelStart := WEnd;
  RichEdit1.SelAttributes.Style := [];
  end;
 end;
end;
function SearchFor(WorkSpace, Search: string; Start: integer): integer;
var Temp: string;
begin
 Temp := copy(WorkSpace, Start, length(WorkSpace));
 Result := pos(Search, Temp);
end;
procedure TForm1.HighLight;
var WStart, WEnd, WEnd2: integer;
 WorkSpace, SWord: string;
begin
 WStart := 1;
 WEnd := 1;
 with RichEdit1 do
 begin
  WorkSpace := Text + ' ' + #$D#$A;
  while WEnd > 0 do
  begin
  WEnd := SearchFor(WorkSpace, ' ', WStart);
  WEnd2 := SearchFor(WorkSpace, #$A, WStart);
  if WEnd2 < WEnd then WEnd := WEnd2;
  SWord := copy(WorkSpace, WStart, WEnd - 1);
  if (SWord <> ' ') and (SWord <>'') then
  if CheckList(SWord) then
  begin
  SelStart := WStart - 1;
  SelLength := length(SWord);
  SelAttributes.Style := [fsBOLD];
  SelStart := WStart + length(SWord) + 1;
  SelAttributes.Style := [];
  end;
  WStart := WStart + WEnd;
  end;
  SelStart := length(Text);
  SetFocus;
 end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
 if OpenDialog1.Execute then
 begin
  RichEdit1.Lines.LoadFromFile(OpenDialog1.FileName);
  HighLight;
 end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
 RichEdit1.PasteFromClipboard;
 HighLight;
end;
end.