Программа:
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-го раза без замечаний. работы была сдана досрочно
Елена
СГУГиТ
Здравствуйте, заказ выполнен досрочно, спасибо большое за проделанную работу. Желаю успехо...
Александра
ИРНИТУ
Все работы раньше срока, на отлично. Отзывчивый исполнитель, всем рекомендую.
Кристина
НГСХА
Спасибо огромное за сотрудничество)работа выполнена без единого нарекания)очень довольна)р...