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

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

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

> ООП, помогите доделать и исправить ошибочки!!!
-Катюшка-
сообщение 18.05.2006 20:18
Сообщение #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
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов
volvo
сообщение 19.05.2006 20:23
Сообщение #2


Гость






Цитата
пишут ошибку №100: disk read error...

Похоже, что у тебя файл битый, и при попытке прочесть очередную запись программа натыкается на конец файла. Как результат - ошибка №100...
 К началу страницы 
+ Ответить 

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


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

 



- Текстовая версия 19.07.2025 1:50
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"