опять что-то ненравиться 
program pascal;
{-----------------------------------------------------------------}
var
tm:array[1..40] of string; // максимальное к-во пунктов
vars:array[1..40] of string;
lines:integer;
vas:integer;
{-----------------------------------------------------------------} procedure soob(t: string);{ вывод сообщения. также удобно искать ошибки}
var n,m,r,n1: integer;
begin
n:= getStringWidth(t);m:= getStringHeight(t);{ n - ширина m - высота строки текста }
setColor(145,135,255);fillrect((getWidth - n) / 2-5,(getHeight - m) / 2-5,n+10,m+10);{ очищаем прямоугольник под текст }
setColor(140,10,35); if n<=getWidth then drawText(t, (getWidth - n) / 2,(getHeight - m) / 2); { центруем и печатаем если целикомпомещается на экране }
else begin r:=n-getWidth; for n1:=0 to r do begin { вычисляем сколько пикселей не влезло }
setColor(145,135,255);fillrect((getWidth - n) / 2-3,(getHeight - m) / 2-3,n+6,m+6); { если не очистить просто смажется }
setColor(140,10,35);drawText(t,0-n1,(getHeight - m) / 2);repaint; delay(10);{ центруем и печатаем }
if n1=0 then delay(2000);end;end; { задержка что б прочесть начало строки }
repaint;delay(1000);setColor(145,135,255);fillrect((getWidth - n) / 2-5,(getHeight - m) / 2-5,n+10,m+10);
end;
procedure massivizstroki(stroka:string);{процедура создает массив из строки,писал ее не я,а 12121}
var
n:integer; // убрал лишние переменные
begin
lines:=1;// - будет количество получившихся строк
tm[1]:=''; // что бы с прошлого вызова ничего не осталось
for n:=1 to length(stroka) do begin //разбивка на пункты
if copy(stroka,n-1,n)=';' then begin lines:=lines+1;tm[lines]:='';n:=n+1; end;
if copy(stroka,n-1,n)<>' ' then tm[lines]:=tm[lines]+copy(stroka,n-1,n); // вырезаем пробелы каторые могут быть
// иначе могут быть неувязки при проверке ведь 'end'<>' end'
end;
procedure vabr(stroka:string);
var
i:integer; // убрал лишние переменные
begin
vas:=1;// - будет количество получившихся строк
vars[1]:=''; // что бы с прошлого вызова ничего не осталось
for i:=1 to length(stroka) do begin //разбивка на пункты
if copy(stroka,i-1,i)=',' then begin vas:=lines+1;vars[vas]:='';i:=i+1; end;
if copy(stroka,i-1,i)<>' ' then vars[vas]:=vars[vas]+copy(stroka,i-1,i); // вырезаем пробелы каторые могут быть
// иначе могут быть неувязки при проверке ведь 'end'<>' end'
end;
{---------------------Cоздание переменных-------------------------------------------}
end;
{-----------------------------------------------}
procedure write(what:string;del:integer);
begin
drawText(what, 0, 0);
repaint;
delay(del);
end;
{------------------------------------------------}
procedure main;
var h:integer;
hel,lel:string;
hellen:integer;
begin
for h:=1 to lines do
begin
hel:=tm[h];// soob(hel);
hellen:=Length(hel);
//if hel='begin' then break; // после обработки 'program' выход из цикла и ничего больше не проверяется !!
if hel='end' then break; // короткие команы нужно проверить раньше длинных: если hel='end' то copy(hel,0,5) приведет к зависанию !!
//if Copy(hel,0,7)='program' then break;
//soob('|'+copy(hel,0,5)+'|'); // это я так искал ошибку
if copy(hel,0,5)='write' then begin lel:=copy(hel,7,hellen-2); write(lel,5000); end;
end;
end;
{------------------------------------------------}
begin
massivizstroki('program;begin;write("helloworld");end');
main;
end.
