Консультация № 159369
01.02.2009, 23:42
0.00 руб.
0 0 0
Доброго времени уважаемые знатоки.у меня вот такй вопрос:
я в программирование полный ноль,мне нужна программа паскале которая обрабатывает код паскаля по синтаксису(делает его читабельным или можно сказать оформляет код).С большим трудом я написал небольшую программу,но хочю что ы она выводила текст как в турбопаскале.Вот код моей программы,пожалуйста помогите модернизировать.

Приложение:
program _111005;
uses crt;
var f,f2: text;
a,b: string;
i: byte;
reserved,comment,apostr: boolean;
fn: string [15];

procedure wordtype; {finding out if the word is reserved}
var f1: text; a1: string;
begin
assign (f1,'reserv.txt');
reset (f1);
repeat
readln (f1,a1);
if a1=b then reserved:=true;
until (eof (f1)) or (reserved);
close (f1);
end;

procedure divtype (b2: string);
begin
if b2='''' then apostr:=true;
if b2='{' then comment:=true;
end;

procedure comment_ext;
begin
if a[1]='{' then delete (a,1,1);
if pos ('}',a)>0 then
begin
b:=copy (a,1,pos ('}',a)-1);
write (f2,'{\cf16\i ',b,'}');
delete (a,1,pos ('}',a));
comment:=false;
end else
begin
write (f2,'{\cf16\i ',a,'}');
a:='';
end;
end;

procedure apostr_ext;
begin
write (f2,'{\cf4 ''');
delete (a,1,1);
b:=copy (a,1,pos ('''',a));
write (f2,b,'}');
delete (a,1,pos ('''',a));
apostr:=false;
end;

begin clrscr;
writeln ('Enter file name');
readln (fn);
assign (f,fn);
fn:=copy (fn,1,pos (('.'),fn)-1);
fn:=fn+'.rtf';
reset (f);
assign (f2,fn);
rewrite (f2);
writeln (f2,'{\rtf1\ansi');
write (f2,'{\colortbl;\red0\green0\blue0;\red0\green0\blue255;\red0\green255\blue255;');
write (f2,'\red0\green255\blue0;\red255\green0\blue255;\red255\green0\blue0;\red255\green255\blue0;\red255\green255\');
write (f2,'blue255;\red0\green0\blue128;\red0\green128\blue128;\red0\green128\blue0;\red128\green0\blue128;\red128\green0\');
writeln (f2,'blue0;\red128\green128\blue0;\red128\green128\blue128;\red192\green192\blue192;}');

repeat
writeln (f2,'');
write (f2,'\par ');
readln (f,a);
writeln (a);
repeat
b:='';
i:=1;
if comment then comment_ext;

if (not comment) and (a<>'') then
begin
if (ord (a[i]) >= 97) and (ord (a[i]) <= 122) then
begin
repeat
b:=b+a[i];
i:=i+1;
until (ord (a[i]) < 97) or (ord (a[i]) > 122) or (i>length (a));
delete (a,1,i-1);
end;

wordtype;

if reserved then
begin
write (f2,'{\b\caps ',b,'}');
reserved:=false;
end
else write (f2,b);

while ((ord (a[1]) < 97) or (ord (a[1]) > 122)) and (a<>'') do
begin
divtype (a[1]);
if (not comment) and (not apostr) then
begin
if a[1]=' ' then write (f2,' ') else write (f2,'{\cf6 ',a[1],'}');
delete (a,1,1);
end;
if comment then comment_ext;
if apostr then apostr_ext;
end;
end;

until a='';

until eof (f);

readln;
close (f);
write (f2,'}');
close (f2);
end.

Обсуждение

Форма ответа