Поиск неописанных идентификаторов и вывод их на экран месте со строкой

[Ilai]

Добрый день!

Помогите пожалуйста с программой. Моя программа ищет неописанные идентификаторы и выводит их на экран месте со строкой(при этом выделив другим цветом переменную). Но у меня выделяет другим цветом только один символ(а переменные могут иметь больше символов.) На скриншоте показано. В идентификаторе "ret" выделяет только последний символ. Помогите пожалуйста

Program Kurs;
uses SysUtils, Process, graph, strutils;
var
 str, str0:string;
 f: file;
 i: integer;
 
Procedure Compile(var str:string);
var
  proc : TProcess;
  outfile : string;
begin
  outfile := ChangeFileExt(str, '.txt');
 
  proc := TProcess.Create(nil);
  proc.CommandLine := 'C:\FPC\2.6.4\bin\i386-win32\fpc.exe -b ' + str +
                      ' -Fe' + outfile;
  proc.Options := proc.Options + [poWaitOnExit];
  proc.Execute;
 
  proc.Free;
  end;
 
Procedure DrawStr(var str2:string; x,y:integer);
var
S:integer;
 
begin
S:=2;
SetTextStyle(SansSerifFont,HorizDir,S);
SetColor(black);
OutTextXY(x,y,str2);
end;
 
 
Procedure Search(var str0:string; var str1:string);
var
f:text;
i,j,x,y:integer;
prov,str,str2,str3:string;
flag0,flag00,flag1,flag2,flag3:boolean;
 
begin
x:=detect;
initgraph(x,y,'');
y:=50;
SetFillStyle(SolidFill,green);
bar(0, 0, pred(getmaxx), pred(getmaxy));
assign(f,str0);
reset(f);
flag0:=true;
str1:='';
while not Eof(f) do
begin
if flag0=true then
begin
readln(f,str);
prov:='';
for j:=1 to length(str) do
begin
prov:=prov+str[j];
if prov='Compiling' then break;
end;
end;
if prov='Compiling' then
begin
readln(f,str);
flag0:=false;
flag1:=false;
flag2:=false;
if pos('Fatal:',str) = 0 then
flag3:=true
else flag3:=false;
str2:='';
if flag3=true then
begin
for i:=1 to length(str) do
begin
if str[i]='(' then
flag1:=true;
if str[i+1]=')' then
flag2:=true;
if flag2=true then
begin
str1:=str1 + ' ';
flag1:=false;
flag2:=false;
end;
if flag1=true then
str1:=str1 + str[i+1];
str2:=str2+str[i];
if i=length(str) then
begin
if flag3=true then
begin
y:=y+50;
DrawStr(str2,x,y);
end;
end;
end;
end;
end;
end;
end;
 
 
Procedure Draw(var f:text; numstr,numsto,k:integer);
var str,str1:string;
    i,j:integer;
begin
reset(f);
i:=0;
while not Eof(f) do
 begin
  readln(f,str);
  i:=i+1;
  if i=numstr then
   begin
    j:=1;
    str1:=str;
   end;
 end;
close(f);
for i:=1 to length(str1) do
 begin
  if i=numsto-1 then setcolor(12) else setcolor(0);
  outtextXY(i*20,k,str1[i]);
 end;
end;
 
 
Procedure Search_Err(var str0,str,str1:string);
const
D=[',',' '];
var
k,n,count,numstr,numsto:integer;
numstr1,numsto1:string;
f:text;
 
begin
assign(f,str);
k:=getmaxY div 2 +100;
n:=1;
count := WordCount(str1, D);
while n < Count do
begin
numstr1:=ExtractWord(n, str1, D);
numsto1:=ExtractWord(n + 1, str1, D);
inc(n,2);
val(numstr1,numstr);
val(numsto1,numsto);
Draw(f,numstr,numsto,k);
k:=k+20;
end;
end;
 
 
Procedure Output(var str0,str:string);
var
 f:text;
 str1:string;
 
begin
Search(str0,str1);
Search_Err(str0,str,str1);
end;
 
begin
write('Ââåäèòå ГЇГіГІГј ГЄ ГґГ*éëó .pas: ');
read(str);
if str='test' then
str:='D:\Ret\University\Kursovaya\Test.pas';
str0:=str;
for i:=length(str0) downto 1 do
if str0[i]='.' then
begin
delete(str0, i+1, length(str0)); break;
end;
str0:=str0+'txt';
assign(f,str0);
rewrite(f);
close(f);
Compile(str);
Output(str0,str);
readln;
end.