Помощь - Поиск - Пользователи - Календарь
Полная версия: Записи
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
Needhelp
 Program SedihA;
Uses
Crt;
Const
Count = 3;
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;
ArrCatalogue = Array [1 .. Count] Of Litter;
Var
Katalog : ArrCatalogue;
NumArray : 1..count;
YesLitter : Boolean;
Vybor : byte;
Edition : TypePubl;
CountFind : integer;
b,j,n,i,a,g: 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;
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;
procedure QuickSort (var A: ArrCatalogue; Lo, Hi: Integer);
var
i,j: integer;
x, y: Litter;
procedure Sort (l, r: Integer);
begin
repeat
x := A[(l+r) shr 1];
i := l; j := r;
repeat
while Compare( A[i], x ) < 0 do inc(i);
while Compare( A[j], x ) > 0 do dec(j);
if i <= j then
begin
y := A[i]; A[i] := A[j]; A[j] := y;
inc(i); dec(j);
end;
until i > j;
if l < j then Sort (l, j);
l := i;
until l >= r;
end;

begin
Sort (Lo,Hi);
end;
var
Data: ArrCatalogue;
Begin
for NumArray:=1 to Count do
InputData;
writeln;
WriteLn('Knig -> ',b);
WriteLn('Jornalov -> ',j);
WriteLn('Gazet -> ',n);
QuickSort (Data, 1, count);
FindLitter;
ReadLn;
End.


В общем, по идее, должен выдавать газеты, отсортированные по датам... А выдает так, как ввел я...
Хотя, скорее всего, что-то я не допонял... yes2.gif
volvo
А ничего, что ты заполняешь один массив (katalog), а сортируешь - другой (Data)?

Добавлено через 2 мин.
P.S. Причем, в Data данных нет вообще, он пустой...
  QuickSort (katalog, 1, count);
должно отработать ...
Needhelp
Volvo респект)))Как всегда, в точку попал!!!)))
А ошибка глупая...мог и сам додуматься rolleyes.gif
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.