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