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

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

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

> Задача на записи
Needhelp
сообщение 22.04.2007 18:24
Сообщение #1


Живет здесь...
**

Группа: Пользователи
Сообщений: 69
Пол: Мужской

Репутация: -  0  +



Program SedihA;
Uses
Crt;
Type
TypePubl = (Book,Journal,Newspaper);
Litter = record
Title : string[50];
Author : string[50];
case V : TypePubl of
Book : (YearB : integer);
Journal : (Num : 1..12;
YearJ : 1900..2007);
Newspaper : (Day : Integer;
Month : Integer;
YearN : integer);
end;
Const
Count = 3;
Var
Katalog : array [1..count] of Litter;
NumArray : 1..count;
YesLitter : Boolean;
Vybor : byte;
Edition : TypePubl;
CountFind : integer;
b,j,n : Integer;
Procedure InputData;
Begin
writeln;
writeln('Vvedite dannie o literature ', NumArray,' :');
write('Chislo ykazavayshei vid izdaniya: ');
Write('1-kniga, 2-zhyrnal, 3-gazeta : ');
readln(Vybor);
case Vybor of
1 : Katalog[NumArray].v:=Book;
2 : Katalog[NumArray].v:=Journal;
3 : Katalog[NumArray].v:=Newspaper;
end;
with katalog[NumArray] do
begin
write('Familia avtora? ');
readln(Author);
write('Nazvanie? ');
readln(Title);
case v of
Book : begin
write('God izdania? ');
readln(YearB);
b:=b+1;
end;
Journal : begin
write('Nomer ? ');
readln(Num);
write('God izdania? ');
readln(YearJ);
j:=j+1;
end;
Newspaper : begin
write('Data izdaniaÿ: Den? ');
readln(Day);
write('Mesac? ');
readln(Month);
write('God? ');
readln(YearN);
n:=n+1;
end;
end;
end;
End;
Procedure WriteData;
Begin
writeln;
with Katalog[NumArray] do
begin
writeln('Nazvanie : ',Title);
writeln('Familia avtora: ',Author);
case v of
Book : writeln('God izdania: ',YearB);
Journal: begin
writeln('Nomer : ', Num);
writeln('God izdania: ',YearJ);
end;
Newspaper : writeln('Data: Den: ',Day,' Mesac: ',Month,'God: ',YearN);
end;
end;
end;
Procedure FindLitter;
Begin
writeln('Poisk literaturi po tipy: ');
writeln;
write('1-kniga, 2-zhyrnal, 3-gazeta: ');
readln(Vybor);
case Vybor of
1 : Edition:=Book;
2 : Edition:=Journal;
3 : Edition:=Newspaper;
end;
YesLitter:=False;
CountFind:=0;
for numarray:=1 to count do
if katalog[numarray].v = edition
then
begin
YesLitter:=True;
CountFind:=CountFind+1;
WriteData;
end;
if not YesLitter
then
writeln('Net v biblioteki')
else
writeln('Vsego v biblioteki ',CountFind,' takix izdaniy');
ReadLn;
End;
Begin
for NumArray:=1 to Count do
InputData;
writeln;
WriteLn('Knig -> ',b);
WriteLn('Jornalov -> ',j);
WriteLn('Gazet -> ',n);
FindLitter;
ReadLn;
End.


Задание..
Осуществить ввод общей информации (автор, название ) о содержимом библиотеки: имеющиеся книги, журналы, газеты. Если книга, то осуществить дополнительно ввод года издания; если журнал - год издания и номер журнала; если газета - год, месяц и день выхода газеты.Осуществить вывод информации, поиск литературы по типу издания. (это программа делает)
Дополнит...
1)Подсчитывает кол-во книг,журналов, газет...(делает)
2)Вывести список (газет) в порядке даты выхода (Вот это вызвало затруднение!!!....)
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов(1 - 5)
volvo
сообщение 22.04.2007 18:32
Сообщение #2


Гость






Сортировка по любому из полей записи не получается, что-ли? В поиске посмотри, Romtek выкладывал пример...

Добавлено через 3 мин.
Вот: Как упорядочить данные по возрастанию?
(все, что тебе потребуется - поменять функцию сравнения)
 К началу страницы 
+ Ответить 
Needhelp
сообщение 22.04.2007 18:41
Сообщение #3


Живет здесь...
**

Группа: Пользователи
Сообщений: 69
Пол: Мужской

Репутация: -  0  +


Цитата(volvo @ 22.04.2007 19:32) *

Сортировка по любому из полей записи не получается, что-ли? В поиске посмотри, Romtek выкладывал пример...

Добавлено через 3 мин.
Вот: Как упорядочить данные по возрастанию?
(все, что тебе потребуется - поменять функцию сравнения)


Спасибо)))
Про поиск забыл))

Сообщение отредактировано: Needhelp - 22.04.2007 18:41
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
Needhelp
сообщение 22.04.2007 19:43
Сообщение #4


Живет здесь...
**

Группа: Пользователи
Сообщений: 69
Пол: Мужской

Репутация: -  0  +



function Compare (T1,T2: Litter ): integer;
begin
if T1.YearN > T2.YearN then Compare := 1
else if T1.YearN = T2.YearN then Compare := 0
else Compare := -1
end;



Функцию переписал..и сразу вопрос??? Он будет сортировать по году? У меня 3 параметра день, месяц, год...
Дальше.."ступор" procedure QuickSort (var A: ; Lo, Hi: Integer); в "var A" что прописать?
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
volvo
сообщение 22.04.2007 19:55
Сообщение #5


Гость






Цитата
"var A" что прописать?
Там должен быть массив... То есть,

Const
Count = 3;
Type
ArrCatalogue = Array [1 .. Count] Of Litter;

Var
Katalog : ArrCatalogue;

...
procedure QuickSort (var A: ArrCatalogue; Lo, Hi: Integer);
...


А насчет
Цитата
Он будет сортировать по году?
- будет сортировать так, как ты скажешь... Например:

function Compare (T1,T2: Litter ): integer;
begin
If T1.YearN = T2.YearN Then Begin

If T1.Month = T2.Month Then Begin

If T1.Day = T2.Day Then Compare := 0
Else Compare := (T1.Day - T2.Day)

End
Else Compare := (T1.Month - T2.Month)

End
Else Compare := (T1.YearN - T2.YearN)
end;

Будет сортировать по всем трем параметрам... (Только проверь, я мог ошибиться, набирал прямо здесь, но думаю, идея понятна)
 К началу страницы 
+ Ответить 
Needhelp
сообщение 22.04.2007 20:21
Сообщение #6


Живет здесь...
**

Группа: Пользователи
Сообщений: 69
Пол: Мужской

Репутация: -  0  +


ага good.gif
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

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

 



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