Procedure OutLine (Line: Integer);

Begin Write (Student[Line].Name:20);

Write (Student[Line].Year:6);

Write (Student[Line].Lesson:10);

Write (Student[Line].Prise:7);

WriteLn;End;

Procedure OutStudent (OutNum: Integer); Var I: Integer;

Begin ClrScr;

WriteLn ('familiya':20,'god':6,'predmet':10,'ocenka':7);

For I:=1 To OutNum Do OutLine (I);End;

Procedure OutStudentPrise1 (OutNum, OutPrise: Integer);Var Col, I: Integer;

Begin WriteLn;

Col:=0;

WriteLn ('dannye o stud-h polu4ivshih ocenki: ',OutPrise);

For I:=1 To OutNum Do If (Student[I].Prise=OutPrise) Then Begin Col:=Col+1;

OutLine (I); End;

WriteLn ('4islo stud polu4ivshih ocenku ',OutPrise,': ',Col);End;

Procedure OutStudentPrise2 (OutNum, OutPrise1, OutPrise2: Integer);

Var I: Integer;

Begin WriteLn;

WriteLn ('dannye o stud polu4ivshih ocenku : ',OutPrise1,' Ё ',OutPrise2);

For I:=1To OutNum Do If ((Student[I].Prise=OutPrise1)Or (Student[I].Prise=OutPrise2))Then OutLine (I);

End;

Procedure OutStudentName (OutNum:Integer; OutLetter:Char);Var I: Integer;

Begin WriteLn;

WriteLn ('dannye o studentah 4i familii na4inayutsa na "',OutLetter,'"');

For I:=1 To OutNum Do If (Copy(Student[I].Name,1,1)=OutLetter)Then OutLine (I);End;

Begin InputStudent (Num);

OutStudent (Num); Prise1:=4;

OutStudentPrise1 (Num, Prise1); Prise2:=5;

OutStudentPrise2 (Num, Prise1, Prise2); Letter:='Ђ';

OutStudentName (Num, Letter);

ReadLn;

End.

6.Описание: Дана таблица материалов с следующей информацией по каждому материалу: название, удельный вес, вид проводимости (диэлектрик, полупроводник, проводник). Выписать из таблицы все полупроводники и их удельный вес.

program one;

Uses CRT;

Const Veshestvo = 1;

Type Material = Record

Name: String[20]; Weight: Real; Provod: Integer;

End;

Var Result,I,J,N: Integer; F : Array[1..20] Of Material; Begin

F[1].name := 'med'; F[1].Weight := 4.00; F[1].Provod := 2;

F[2].name := 'bumaga'; F[2].Weight := 66.0; F[2].Provod := 0;

F[3].name := 'ЉаҐ¬­Ё©'; F[3].Weight := 5.40; F[3].Provod := 1;

F[4].name := 'germany'; F[4].Weight := 21.5; F[4].Provod := 1;

F[5].name := 'arsenid gallia'; F[5].Weight := 3.00; F[5].Provod := 1;

F[6].name := 'alluminiy'; F[6].Weight := 50.0; F[6].Provod := 2;

F[7].name := 'keramika'; F[7].Weight := 9.90; F[7].Provod := 0;

F[8].name := 'rezina'; F[8].Weight := 80.0; F[8].Provod := 0;

F[9].name := 'ftoroplast'; F[9].Weight := 4.00; F[9].Provod := 0;

ClrScr;

N := 9;

Result := 0;

Writeln('naimenovanie materiala udelny ves provodimost');

Writeln('-----------------------------------------------------------');

For I := 1 to N Do If (F[I].Provod = Veshestvo) Then Begin

Write(F[I].Name:22,F[I].Weight:15:2);

Case F[I].Provod Of

0: WriteLn('izolyator':15);

1: WriteLn('poluprovodnik':15);

2: WriteLn('provodnik':15); End;

Result := Result + 1; End;

Writeln('-----------------------------------------------------------');

Writeln('naideno ',Result,' material.');

If Result = 0 Then WriteLn('takogo materiala net'); Readln;

End.

7.Описание: Вывести из введеной строки слова с максимальным количеством вхождений буквл 'l' и 'o' и подсчитать количество этих вхождений.

Type Info = record

wrd,num : Byte; ch : Char;

End;

Var S, Temp:String; P,I : Byte; M, N : Info;

Function CalkChar(A:String;C:Char):Byte; Var I, Result : Byte;

Begin Result := 0;

For I := 1 To Length(A) Do If UpCase(A[I]) = UpCase(C) Then Inc(Result);

CalkChar := Result;

End;

Begin WriteLn('vvedite frazu po-angl:');

ReadLn(S);

I := 1;

M.num := 0; M.wrd := 0; M.ch := 'l';

N.num := 0; N.wrd := 0; N.ch := 'o';

While Pos(' ',S) <> 0 Do Begin P := Pos(' ',S);

Temp := Copy(S,1,P);

If M.wrd < CalkChar(Temp,M.ch) Then Begin M.num := I;

M.wrd := CalkChar(Temp,M.ch); End;

If N.wrd < CalkChar(Temp,N.ch) Then Begin N.num := I;

N.wrd := CalkChar(Temp,N.ch); End;

Delete(S,1,P); Inc(I); End;

If M.wrd < CalkChar(S,M.ch) Then Begin M.num := I;

M.wrd := CalkChar(S,M.ch); End;

If N.wrd < CalkChar(S,N.ch) Then Begin N.num := I;

N.wrd := CalkChar(S,N.ch); End;

WriteLn('-------------');

If M.wrd <> 0 Then WriteLn('bukva ',M.ch,'4asche vstre4aetsa v ',M.num,'-¬ slove, celyh ',M.wrd,' raz( )');

If N.wrd <> 0 Then WriteLn('bukva ',N.ch,' 4asche vstre4aetsa v ',N.num,'-m slove, celyh ',N.wrd,' raz( )');readln;

End.

8.Описание: Из исходной таблицы игрушек с полями: название игрушки, стоимость, возрастные ограничения, выписать сведения для игрушек стоимостью менее 4 рублей, подходящие детям 5 лет.

Uses CRT;

Const Vozrast = 5;

Cena = 400;

Type Toy = Record

Name: String[20]; Sale: Integer; Min: Integer; Max: Integer;

End;

Var Sum,Result,I,J,N: Integer; F : Array[1..20] Of Toy;

Begin

F[1].name := 'mya4'; F[1].Sale := 400; F[1].min := 1; F[1].max := 9;

F[2].name := 'kukla'; F[2].Sale := 660; F[2].min := 3; F[2].max := 7;

F[3].name := 'samolet'; F[3].Sale := 540; F[3].min := 3; F[3].max := 5;

F[4].name := 'pupsik'; F[4].Sale := 210; F[4].min := 1; F[4].max := 3;

F[5].name := 'knijka'; F[5].Sale := 300; F[5].min := 1; F[5].max := 5;

F[6].name := 'mashinka'; F[6].Sale := 500; F[6].min := 3; F[6].max := 8;

F[7].name := 'parovoz'; F[7].Sale := 990; F[7].min := 4; F[7].max := 7;

F[8].name := 'ula'; F[8].Sale := 800; F[8].min := 2; F[8].max := 5;

F[9].name := 'konstruktor'; F[9].Sale := 400; F[9].min := 6; F[9].max := 9;

ClrScr;

N := 9;

Result := 0;

Sum := 0;

Writeln('igryshka cena, kop. Min vozrast Max vozrast');

Writeln('-----------------------------------------------------------');

For I := 1 to N Do If (F[I].min <= Vozrast) And (Vozrast <= F[I].max) And (F[I].Sale <= Cena) Then Begin

WriteLn(F[I].Name:20,F[I].Sale:12,F[I].Min:14,F[I].Max:13);

Result := Result + 1; Sum := Sum +F[I].Sale; End;

Writeln('-----------------------------------------------------------');

Writeln('stoimost pokupki: ',Sum/100:3:2,' rub.');

If Result = 0 Then WriteLn('pokupku sovershit nevozmojno!');

Readln;

End.

9.Описание: Из первой таблицы, где заданы коэффициенты для уравнений задания линий выписать в новую таблицу только те коэффициенты, которые формируют линию, параллельную первой в исходной таблице.

Uses CRT;

Type Line = Record

A,B,C: Integer;

End;

Var Result,I,J,N: Integer; F,G : Array[1..20] Of Line;

Begin

F[1].A := 1; F[1].B := 9; F[1].C := 2;

F[2].A := 2; F[2].B := 6; F[2].C := 3;

F[3].A := 3; F[3].B := 5; F[3].C := 1;

F[4].A := 4; F[4].B := 2; F[4].C := 4;

F[5].A := 3; F[5].B := 3; F[5].C := 1;

F[6].A := 2; F[6].B := 5; F[6].C := 2;

F[7].A := 1; F[7].B := 9; F[7].C := 5;

F[8].A := 2; F[8].B := 6; F[8].C := 1;

F[9].A := 3; F[9].B := 5; F[9].C := 2;

ClrScr;

N := 9; Result := 0; I := 1;

For J := 2 to N Do If (F[I].A = F[J].A) And (F[I].B = F[J].B) Then Begin Write('liniya ',I,' paralelna linii ',J,' ');

WriteLn(F[I].A,'X + ',F[I].B,'Y + ',F[I].C);

Result := Result + 1; End;

Writeln('naideno ',Result,' liniy');

If Result = 0 Then WriteLn('takih liniy net');

Readln;

End.

10.Описание: Имеется запись о багаже пассажира (кол-во вещей и общий вес вещей). Выяснить, имеется ли пассажир, багаж которого превышает багаж каждого из остальных пассажиров и по числу вещей и по весу. Дать сведения о багаже, число вещей в котором не меньше, чем в любом другом багаже, а вес вещей не больше, чем в любом другом багаже.

uses crt; type bagaj = record ves:double;kol_veshei: integer; end; var bagage:array[1..20] of bagaj; i,j,n,temp:byte;rez,k:double;a:boolean; begin clrscr; writeln('Vvedite kol-vo passajirov (n <= 20):'); readln(n); for i:=1 to n do begin writeln('Vvedite svedeniya o ',i,'-om bagaje passajira:'); writeln('Vvedite ves bagaja: '); readln(bagage[i].ves); writeln('Vvedite kol-vo veshei bagaja: '); readln(bagage[i].kol_veshei);end; clrscr; writeln('Bagage, sredniy ves odnoi veshi otlichaetsya ne bolee'); writeln('chem na 0.3 kg ot obshego srednego vesa:'); writeln; a:=true; for i:=1 to n do begin rez:=bagage[i].ves/bagage[i].kol_veshei; if (abs(bagage[i].ves - rez) <= 0.3) then begin a:=false; writeln('Bagage nomer ',i); writeln('ves bagaja: ',(bagage[i].ves):5:2,' kg'); writeln('kol-vo veshei: ',bagage[i].kol_veshei);writeln; end;end; if (a) then writeln('Takogo bagaja net!'); writeln; writeln('Kol-vo passajirov imeyushih bolee 2 veshei:'); writeln; temp:=0; for i:=1 to n do if (bagage[i].kol_veshei > 2) then temp:=temp+1; writeln('Takih passajirov ',temp,' chelovek'); if temp = 0 then writeln('Takih passajirov net!'); writeln; writeln('Kol-vo veshei bolshe srednego chisla veshei: '); writeln; rez:=0; temp:=0; for i:=1 to n do rez:=rez+bagage[i].kol_veshei; for i:=1 to n doif (bagage[i].kol_veshei > (rez/n)) then temp:=temp+1; writeln('Takih veshei ',temp); if temp = 0 then writeln('Takih veshei 0');.writeln; writeln('Bagage iz 1 veshi s vesom ne menee 30 kg'); writeln; temp:=0; for i:=1 to n doif bagage[i].kol_veshei = 1 thenif bagage[i].ves >= 30 thentemp:=temp+1; writeln('Imeetsya ',temp,' passajirov s takim bagajom'); readln; end.

11.Описание: 1.Список книг состоит из 10 записей. Запись содержит поля: Фамилия автора, название книги, год издания.Найти название книг данного автора, изданных с 1960 года. Program df; Uses crt; Type knigi= record Fam:string[15];Naz:string[30];Gad:integer; End; Var s:array[1..10] of knidi; I,k:integer;Av:string;Begin clrscr; For i:=1 tio 10 do begin with s[i] do begin Writeln(vvedi fam,i); Readln(fam); Writeln(vvedi nazv,i); Readln(nazv); Writeln(god); Readln(god);End;end; Writeln(vvedi av); Readln(avt); K:=length(av); For i:=1 to 10 do begin With s[i] do begin If (copy(fam,1,k)=av) and (god>1960) then writeln(nazv,nazv); End;End; End.

12.Описание: Из ведомости 3-х студентов с их оценками ( порядковый номер, Ф.И.О. и три оценки) определить количество отличников и средний бал каждого студента. Program Spic; Type wed = record n:integer ; fio:string[40] ; bal:array [1..3] of integer end;Var spisok:wed; i,j,kol,s:integer; sr:real; Begin kol:=0; with spisok do For i:=1 to 3 do begin n:=i; Write (' Vvedite FIO # ', i ,' '); Readln (fio); s:=0; For j:= 1 to 3 do begin write ( 'Vvedite ocenky: ' ); readln ( bal [j] ); s := s+ bal [j]; end; if s=15 then kol:=kol+1; sr := s/3; writeln ( fio, ', Sredniy bal = ', sr:4:1); end; writeln ( ' Kolichestvo otlichnikov = ', kol ); readln; end.

13.Описание: программа показывает пример объединения координат точек в запись. Здесь используется массив из записей типа RecPoint. Каждая такая запись содержит в себе поля с координатами x, y, z и поле комментария. Таким образом, одна запись описывает одну точку, а массив из записей представляет собой набор точек. Program Records; Uses crt; type RecPoint = record x, y, z: real; comment: string end; var Point: array [1..10] of RecPoint; i: integrer; delta: real; begin Clrscr; for i := 1 to 10 do begin Point[i].x := 2*i - 3; Point[i].y := 3*Point[i].x + 2; Point[i].z := 6*Point[i].y - 2*Point[i].x + 1; delta := Point[i].z - Point[i].x; if delta > 100 then Point[i].comment := 'z - x > 100.' else Point[i].comment := 'Нет комментариев.'; end; Writeln ('Результа расчёта (поля записи):'); Write (' ':7,'x'); Write (' ':8,'y'); Write (' ':8,'z'); Writeln (' комментарии'); for i := 1 to 10 do begin Write (Point[i].x:8:3,' '); Write (Point[i].y:8:3,' '); Write (Point[i].z:8:3,' ':2); Writeln (Point[i].comment); end; Readkey; end.

Страницы: 1, 2, 3, 4, 5, 6, 7, 8, 9, 10