Программа:
uses crt,TBL,graph; {подключение модулей}
function PrintNumbers(const yk: PInString):string;
var
temp: PInString; {буферная переменная для работы со стеком}
s,byf:string; {переменные для генерации строки}
n:word;
begin
temp:=yk; {копируем указатель на «голову» стека строк}
byf:=''; {обнуляем буферную переменную}
while temp<>nil do {выполняем до тех пор, пока стек не кончится}
begin
n:=temp^.number; {запоминаем номер строки}
temp:=temp^.next; {переход к след. Элементу стека}
s:=''; {обнуляем буферную переменную}
str (n,s); {переводим номер строки из word в string}
byf:=byf+s+' '; {«складываем» номера строк}
end;
PrintNumbers:=byf; {присваиваем значение процедуре}
end;
procedure PrintWords (const yk: PString);
var temp: PString;
strok,nom:word;
slov:string;
gm,gd:integer; {переменные для инициализации графики}
begin
temp:= yk; {копируем указатель на голову стека}
nom:=1; {счётчик строк, требуется при построение таблицы}
gm:=2; {инициализация графики }
gd:=VGA;
initGraph (gd,gm,'');
while temp<> nil do {выполняем до тех пор, пока стек не кончится}
begin
Table(temp^.st,nom,PrintNumbers(temp^.col)); {строим таблицу}
temp:=temp^.next; {переходим к след. Элементу стека}
end;
readkey; {ждём нажатия клавиши перед закрытием}
closeGraph; {закрываем графику}
end;
procedure AddNumber(var yk: PInString; n: word);
var temp: PInString;
begin
temp:=yk; {передаем указатель на голову стека }
while temp <> nil do {выполняем до тех пор, пока стек не кончится}
begin
if temp^.number = n then {если такой номер строки встречается в стеке , то выходим}
Exit;
temp:=temp^.next; {переходим к след. Элементу стека}
end;
new(temp); {если строка не обнаружена в стеке , заносим её}
temp^.next:=yk;
yk:=temp;
yk^.number:=n;
end;
procedure AddWord(var yk: PString; s: string; n: word);
var temp: PString;
begin
temp:=yk;
while temp<>nil do{выполняем до тех пор, пока стек не кончится}
begin
if s = temp^.st then {если слово уже есть, то добавляем номер строки в стек}
begin
AddNumber(temp^.col,n);
Exit;
end;
temp:=temp^.next; {переходим к след. Элементу стека}
end;
new(temp); {Если слово встречается впервые, добавляем его}
temp^.next:=yk;
yk:=temp;
yk^.st:=s;
yk^.col:=Nil;
AddNumber(yk^.col,n); {добавляем номер строки}
end;
var
f: text;
FileName: string;
ch,a: char;
MyWord: string;
line: word;
procedure Schet (fileName:string);
begin
ClrScr;
assign(f,fileName); {открытие файла}
reset(f);
myWord:=''; {обнуление переменной, в которой будут формироваться слова}
Line:=1;
while not Eof(f) do {выполнять пока не конец файла}
begin
if ch = #13 then inc(line); {если возврат каретки, то увеличиваем номер строки }
read(f,Ch); {читаем символ}
if ((not(ch in[',','.',' ',';'])) and (ch <> #13 ) and (ch <> #10))then myWord:=myWord+ch {проверяем символ.Если он – буква , то добавляем в буферно слово }
else {иначе считаем слово завершённым и если оно не пусто, вызываем процедуру добавления в стек}
begin
if (myWord <> '') then
AddWord(head,myWord,line); {добавление слова в стек}
while ((ch=' ') and (ch = #13) and (ch = #10) ) do read(f,ch); {пропуск символов, не являющихся буквами}
myWord:=''; {обнуление переменной, в которой будут формироваться слова}
end;
end;
PrintWords(head); {печать таблицы}
readKey;
close(f);
end;
procedure vivod(fileName:string);
var
st:string;{переменная, в которую будут заноситься строки из файла}
begin
clrscr;
assign(f,faleName);{присваиваем переменной f имя}
resert(f);{открытие файла}
while not(eof(f)) do{до тех пор, пока не конец файла}
begin
readln(f,st);{читать из файла}
writeln(st);{выводить на экран}
end;
readln;
close(f);{закрытие файла}
end;
begin
clrscr;
write('name of file:');
readln(fileName);{запись пути к файлу}
a:='';{символ для управления программой}
while a<>'q' do{выполнять пока символ не равен'q'}
begin
clrscr;
{******************вывод меню}
writeln('1-vivod');
writeln('2-prohod po strokam');
writeln('q-vihod');
a:=readkey;{чтение запроса, что делать дальше}
case a of{выбор, что делать}
'1':vivod(fileName);
'2':Schet(fileName);
end;
end;
end.{конец программы}
Модуль:
unit TBL;
interface {глобальные описание}
uses graphABC,crt;
type PString = ^Tstring;
PInString = ^TInString;
Tstring = record
st: string;
col: PInString;
next: PString;
end;
TInString = record
number: word;
next: PInString;
end;
const head: PString = nil;
procedure Table (sl:string;nom:word;s:string);
implementation {локальные описания}
procedure Table (sl:string;nom:word;s:string);
begin
if nom=1 then {Если выводится 1я строка таблицы, то создается «шапка» }
begin
line (320,1,320,15);
line (1,1,639,1);
line (1,15,639,15);
outtextxy (5,3,'slovo');
outtextxy (325,3,'stroki');
end;
inc(nom); {счётчик номеров строк в таблице. Используется при выводе и построение «шапки» }
line (320,nom*15,3
Вадим
Липецкий Государственный Технический Университет
Замечательный исполнитель, один из тех кто решает быстро, без ошибок и не гнёт цену за вып...
Александра
СПбГТИ(ТУ)
Замечательно выполненная работа! Исполнитель очень обязательный и надежный!
Оксана
НШФ ЮФУ
Огромное спасибо за сделаную работу в такой маленький срок.Этот исполнитель надёжный реком...
Алина
СПБГТИ
спасибо большое. работу приняли с 1-го раза без замечаний. работы была сдана досрочно