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.
|
Подсветка синтаксиса
