IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

> ООП, помогите доделать и исправить ошибочки!!!
сообщение
Сообщение #1


Гость






Вот это модуль. Он должен содержать описание объекта, который представляет бинарное дерево. Объект должен обладать возможностью добавления новых элементов, удаления существующих, поиска элемента по ключу, обхода дерева а также определять число вхождений элемента Е в дерево.
unit u_lr11;

interface

type
rabotnik=record
number:integer;
FIO:string[15];
godroj:integer;
pol:char;
cem:string[12];
koldet:integer;
oklad:integer;
end;
Ptree=^Ttree;
Ttree=object
data:rabotnik;
left,right:Ptree;
function addtree(top:Ptree;newnode:rabotnik):Ptree;
procedure prosmotr(top:Ptree);
function search(top:Ptree;x:integer):boolean;
procedure Count_E(Root:Ptree;Var n:Integer;E:rabotnik);
procedure delete(var top:Ptree;node:integer);
end;
ftype=file of rabotnik;
procedure orgtree(var f:ftype;top:Ptree);

implementation

function Ttree.addtree(top:Ptree;newnode:rabotnik):Ptree;
begin
if top=nil then
begin
new(top);
top^.data:=newnode;
top^.left:=nil;
top^.right:=nil;
end
else
if top^.data.fio>newnode.fio then
top^.left:=addtree(top^.left,newnode)
else
top^.right:=addtree(top^.right,newnode);
addtree:=top
end;

procedure Ttree.prosmotr(top:Ptree);
{процедура просмотра значений узлов дерева слева направо}
begin
writeln('N ','ФИО':15,' год рожд',' пол',' семсост':12,' дети',' оклад');
if top<>nil then
begin
prosmotr(top^.left);
with top^.data do
writeln(number,' ',fio:15,' ',godroj:9,' ',pol:4,' ',cem:12,' ',koldet:5,' ',oklad:6);
prosmotr(top^.right);
end;
end;

procedure orgtree(var f:ftype;top:Ptree);
var
z:rabotnik;
begin
writeln('выполняется процедура организации дерева');
readln;
reset(f);
top:=nil;
while not eof(f) do
begin
read(f,z);
top:=top^.addtree(top,z);
end;
end;

procedure Ttree.Count_E(Root:Ptree;Var n:Integer;E:rabotnik);
Begin
If Root<>Nil then begin
With Root^.data do
If (FIO=E.FIO) then Inc(n);
Count_E(Root^.left,n,E);
Count_E(Root^.right,n,E);
end;
End;

function Ttree.search(top:Ptree;x:integer):boolean;
begin
search:=false;
while top<>nil do
if top^.data.oklad=x then
begin
search:=true;
exit;
end
else
if top^.data.oklad>x then top:=top^.left
else top:=top^.right;
end;

procedure Ttree.delete(var top:Ptree; node:integer);
var
q:Ptree;
procedure delR(var x:Ptree);
begin
if x^.right<>nil then delR(x^.right)
else begin
q^.data:=x^.data;
q:=x;
x:=x^.left;
end;
end;

begin
if top=nil then exit {элемента нет}
else if node<top^.data.oklad then delete(top^.left, node)
else if node>top^.data.oklad then delete(top^.right,node)
else begin
q:=top;
if q^.right=nil then top:=q^.left
else if q^.left=nil then top:=q^.right
else delR(q^.left);
dispose(q);
end;
end;

begin
end.

Всё компилируется, но при запуске выдаётся сообщение Cannot run a unit
Что делать?!!! Я не разбираюсь в модулях... blink.gif
А это сама программа,где я использую модуль
program lab11;
uses crt,u_lr11;
var
top,fnd,Root,addtree:PTree;
f:ftype;
nbr,n:integer;
key1,fdl,E:string;
begin
assign(f,'cotrydnik.dat');
top:=nil;
repeat
clrscr;
writeln('1-Организация дерева');
writeln('2-Просмотр дерева');
writeln('3-Добавление листа в дерево');
writeln('4-Удаление элемента из дерева');
writeln('5-Поиск в дереве по ключу');
writeln('6-Число вхождений элемента Е в дерево');
writeln('7-Выход');
writeln('--------------------------------------------------------------------------------');
writeln;
writeln('Введите номер пункта меню');
readln(nbr);
case nbr of
1:orgtree(f,top);
2:begin
writeln;
writeln('Выполняется процедура просмотра дерева');
writeln;
top^.prosmotr(top);
writeln;
readln;
end;
3:addtree:=(top,newnode);
4:begin
writeln;
writeln('Введите фамилию удаляемого элемента');
readln(fdl);
top^.delete(top,fdl);
end;
5:begin
writeln;
writeln('Введите ключевую фамилию');
readln(key1);
fnd:=top^.poisk(top,key1);
writeln;
if fnd<>nil then
writeln('Найдено')
else writeln('Не найдено');
readln;
end;
6:begin
writeln;
writeln('Введите фамилию сотрудника');
readln(E);
writeln;
n:=0;
top^.Count_E(Root,n,E);
writeln('Число сотрудников с фамилией ',E,' равно ',n);
readln;
end;
end;
until nbr=7;
end.

Это вообще не компилируется... mega_chok.gif
ПАМАГИТЕ!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! wacko.gif
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов
сообщение
Сообщение #2


Гость






Погоди, ты что, вручную данные набирала? Файл-то типизированный... Должна программно делать это.

Прикрепила бы файл, мы бы посмотрели, может с файлом все нормально, тогда в другом месте ошибку будем искать.
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Гость






Не хочет загружать этот файлик. не то разрешение, говорят( правов нетуsad.gif
 К началу страницы 
+ Ответить 

Сообщений в этой теме
-Катюшка-   ООП   19.05.2006 0:18
APAL   Судя по ошибке - ты пытаешься запустить модуль... …   19.05.2006 2:00
-Катюшка-   В меню Compile в строке Distination должно стоят…   19.05.2006 3:13
volvo   -Катюшка-, значится так... Я тут кое-что нашаманил…   19.05.2006 5:19
-Катюшка-   Так, уже лучше, спасибки) Вот только у меня ошибк…   19.05.2006 23:53
volvo   Похоже, что у тебя файл битый, и при попытке проч…   20.05.2006 0:23
-Катюшка-   Похоже, что у тебя файл битый А что это значит? З…   20.05.2006 0:49
Bokul   procedure orgtree(var f:ftype;var top…   20.05.2006 0:49
volvo   Погоди, ты что, вручную данные набирала? Файл-то т…   20.05.2006 0:54
-Катюшка-   Не хочет загружать этот файлик. не то разрешение, …   20.05.2006 1:10
Bokul   Не хочет загружать этот файлик. не то разрешение,…   20.05.2006 1:16
ПухачОк   Тогда добро пожаловать на наш форум :) Зарегистр…   20.05.2006 1:55
volvo   Тогда в архив его, и присоединяй (rar или zip)...   20.05.2006 1:58
ПухачОк   Вот файл(наконец-то!) ПухачОк, а ты пробивал…   20.05.2006 2:26
Bokul   ПухачОк, а ты пробивала добавить seek (f,0) в свою…   20.05.2006 2:14
volvo   Файл битый однозначно. Прошел по программе в пошаг…   20.05.2006 2:41
ПухачОк   Придется файл создавать заново. Создала новый фай…   20.05.2006 3:06
volvo   Показывай код, которым создаешь файл, может там чт…   20.05.2006 3:37
ПухачОк   Там вроде правильно...Если это вообще то, что надо…   20.05.2006 3:42
volvo   Ну, ПухачОк, надо же быть внимательнее!!…   20.05.2006 4:06
ПухачОк   Эхъ, я дусяк!)))) пасибо огромное!!…   20.05.2006 4:17
ПухачОк   Блина!!!! Не пашут мои процедурки …   21.05.2006 0:25
volvo   Блина!!!! Не пашут мои процедурки …   21.05.2006 1:29
ПухачОк   Тэкс, ща попытаюсь переделать, можить даже получит…   21.05.2006 2:12
ПухачОк   УУУУУУУУУРРРРРРРРРРАААААААААА!!!!…   21.05.2006 2:27


 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 28.03.2024 18:33
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name