Здравствуйте, уважаемые эксперты! Помогите исправить ошибки в программе. Есть запись "Студент", в задании требуется отсортировать студентов по возрастанию номеров групп. Вот мой код, работает неправильно:

const max=11;
type Student = Record
 FirstName:String[32];

SecondName:String[32];
 Group:Integer;
 Institution:String[32];
end;
  StudentList=record
  Student_Array:Array[1..max] of Student;
  temp:Student;
  n:integer;
end;

procedure InputData(var TStudent:StudentList);
var i,n:integer;
begin

  repeat
    writeln('Введите количество студентов: ');
    readln(n);
    if (n<=0) or (n>max) then
    writeln('Ошибка, повторите снова ');
  until(n>0)
 and(n<=max);
    TStudent.n:=n;
    for i:=1 to n do
    begin
   writeln('Введите имя',i,' ');
     readln(TStudent.Student_Array[i].FirstName);
     writeln('Введите фамилию',i,' ');
     readln(TStudent.Student_Array[i].SecondName);
     writeln('Введите группу ',i,' ');
     readln(TStudent.Student_Array[i].Group);
     writeln('Введите учебное заведение',i,' ');
     readln(TStudent.Student_Array[i].Institution);

   end;
   end;

procedure output(VAR a: array of Student; temp: Student; n:integer);
var i,j:integer;
begin
for i:=1 to n do
begin
  for j:=1 to n-i do
     if a[j].Group>a[j+1].Group then
     begin
          temp:=a[j];
          a[j]:=a[j+1];
          a[j+1]:=temp;
     end;
  end;
for i:=1 to n do
writeln('Студент',a[i].SecondName,'Группа ',a[j].Group);
readln;
end;

var S
 tudents:StudentList;
  Student_Array:Array[1..max] of Student;
  temp:Student;
  n:integer;
begin
  InputData(Students);
  output(Student_Array, temp, n);
end.

Отправлен: 07.06.2009, 10:16
Вопрос задал: Alex12, Посетитель
Всего ответов: 1
Страница вопроса >>

Приложение:
type Student = Record FirstName:String[32]; SecondName:String[32]; Group:Integer; Institution:String[32]; uses crt; const max=11; type Student = Record FirstName:String[32]; SecondName:String[32]; Group:Integer; Institution:String[32]; end; StudentList=Array[1..max] of Student; procedure InputData(var TStudent:StudentList;var n:integer); var i:integer; begin repeat writeln(\'Ведите количество студентов: \'); readln(n); if (n<=0) or (n>max) then writeln(\'Ошибка, повторите снова.\'); until n in [1..max]; for i:=1 to n do begin writeln(\'Студент \',i); write(\'Имя: \');readln(TStudent[i].FirstName); write(\'Фамилия: \');readln(TStudent[i].SecondName); write(\'Группа: \');readln(TStudent[i].Group); write(\'Учебное заведение: \');readln(TStudent[i].Institution); end; clrscr; end; procedure output(var TStudent:StudentList;n:integer); var i,j:integer; temp:Student; begin for i:=1 to n-1 do for j:=i+1 to n do if TStudent[i].Group> TStudent[j].Group then begin temp:= TStudent[i]; TStudent[i]:= TStudent[j]; TStudent[j]:=temp; end; writeln(\'Список студентов, отсортированный по возрастанию номера группы:\'); writeln(\'---------------------------------------------\'); writeln(\'| Имя | Фамилия | Группа | ВУЗ |\'); writeln(\'---------------------------------------------\'); for i:=1 to n do begin gotoXY(1,whereY);write(\'| \',TStudent[i].firstname); gotoXY(11,whereY);write(\'| \',TStudent[i].secondname); gotoXY(25,whereY);write(\'| \',TStudent[i].group); gotoXY(34,whereY);write(\'| \',TStudent[i].institution); gotoXY(45,whereY);write(\'|\'); writeln; end; writeln(\'---------------------------------------------\'); readln end; var Students:StudentList; n:integer; begin clrscr; InputData(Students,n); Output(Students,n); end.

Ответ отправил: Пупорев Юрий Борисович, Специалист
Ответ отправлен: 07.06.2009, 15:07

Оценка ответа: 3

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 250571 на номер 1151 (Россия) | Еще номера >>

Отправить WebMoney: Неплохо (25 руб.) Хорошо (35 руб.) Отлично (50 руб.) БЛЕСТЯЩЕ! (75 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

помогите пожалуйста написать программу для перевода дробной части десятичных чисел в N-ную систему счисления
спасибо!

Отправлен: 07.06.2009, 17:02
Вопрос задал: love_pascal, Посетитель
Всего ответов: 1
Страница вопроса >>

Приложение:
Type TDigit = 0..35; TDigitChars = array [TDigit] of Char; TDecDigit = 0..9; Const dc : TDigitChars = \'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ\'; cMaxDigit = 100; cMaxDecDigit = 30; Type TNumber = array [1..cMaxDigit] of TDigit; TDecNumber = array [1..cMaxDecDigit] of TDecDigit; Var n : TNumber; d : TDecNumber; s : string; f : Boolean; p : Byte; k : Byte; Procedure ZeroNumber (var n : TNumber); var i : Byte; begin for i := 1 to cMaxDigit do n [i] := 0; end; Procedure ZeroDecNumber (var d : TDecNumber); var i : Byte; begin for i := 1 to cMaxDecDigit do d [i] := 0; end; Function Str2Dec (s : string; var d : TDecNumber) : Boolean; var i : Byte; begin Str2Dec := true; ZeroDecNumber (d); for i := 1 to length (s) do if not (s [i] in [\'0\'..\'9\']) then begin Str2Dec := false; break; end else d [i] := ord (s [i]) - ord (\'0\'); end; Procedure OutputNum (n : TNumber; k : Byte); var i : Byte; begin if k = 0 then write (\'0\'); for i := 1 to k do write (dc [n [i]]); end; Procedure Multiply (t1 : TDecNumber; var t2 : TDecNumber; var z : TDigit; p : Byte; l : Byte); var i : Byte; r : Word; begin ZeroDecNumber (t2); r := 0; for i := l downto 1 do begin r := t1 [i] * p + r; t2 [i] := r mod 10; r := r div 10; end; z := r; end; Function isZeroDecNumber (d : TDecNumber; l : Byte) : Boolean; var i : Byte; begin isZeroDecNumber := true; for i := 1 to l do if d [i] <> 0 then begin isZeroDecNumber := false; break; end; end; Function Convert (d : TDecNumber; var n : TNumber; p : Byte; k : Byte) : Byte; var t1, t2 : TDecNumber; i, j, l : Byte; z : TDigit; begin ZeroDecNumber (t1); ZeroDecNumber (t2); ZeroNumber (n); i := cMaxDecDigit; while (i > 0) and (d [i] = 0) do Dec (i); l := i; for i := i downto 1 do t1 [i] := d [i]; j := 1; Repeat Multiply (t1, t2, z, p, l); n [j] := z; if z > 0 then if isZeroDecNumber (t2, l) then break; if j = k then break; Inc (j); Multiply (t2, t1, z, p, l); n [j] := z; if z > 0 then if isZeroDecNumber (t1, l) then break; Inc (j); Until j > k; Convert := j; end; Procedure ClrScr; assembler; asm mov ax, 3 int 10h end; Begin f := false; Repeat ClrScr; write (\'Введите дробное число (не более \', cMaxDecDigit, \' знаков после запятой): 0,\'); readln (s); if length (s) <= cMaxDecDigit then f := Str2Dec (s, d); Until f; f := true; Repeat write (\'Введите требуемую систему счисления (целое число от 2 до 36): \'); readln (p); f := (p < 2) or (p > 36); Until not f; Repeat write (\'Введите требуемое количество знаков после запятой в записи числа\'); write (\' в системе счисления с основанием \', p, \' (не более \', cMaxDigit, \' знаков): \'); readln (k); Until (k > 0) and (k <= cMaxDigit); k := Convert (d, n, p, k); write (\'Дробная часть в системе счисления с основанием \', p, \' равна: \'); OutputNum (n, k); End.

Ответ отправил: _Ayl_, 5-й класс
Ответ отправлен: 08.06.2009, 16:33

Оценка ответа: 5

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 250630 на номер 1151 (Россия) | Еще номера >>

Отправить WebMoney: Неплохо (25 руб.) Хорошо (35 руб.) Отлично (50 руб.) БЛЕСТЯЩЕ! (75 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

помогите написать программу, реализующею нахождение, модуля и аргумента комплексного числа, заданного в виде записи а(а.re, a.im). А также нахождение суммы, произведение и частного двух комплексных чисел записанных в виде a(a.re,a.im) и b(b.re,b.im)

Отправлен: 07.06.2009, 18:45
Вопрос задал: lesem88, Посетитель
Всего ответов: 1
Страница вопроса >>

Приложение:
uses crt; type complex=record re,im:real; end; procedure Vyvod(var f:complex); begin if f.im<0 then writeln(f.re:9:5,\' -\',-f.im:0:5,\'i\') else writeln(f.re:9:5,\' +\',f.im:0:5,\'i\'); end; function Modul(f:complex):real; begin Modul:=sqrt(sqr(f.re)+sqr(f.im)); end; function Argument(f:complex):real; begin Argument:=arctan(f.im/f.re); end; procedure Summa(f,g:complex;var z:complex); begin z.re:=f.re+g.re; z.im:=f.im+g.im; end; procedure Proizvedenie(f,g:complex;var z:complex); begin z.re:=f.re*g.re-f.im*g.im; z.im:=g.re*f.im+f.re*g.im; end; procedure Chastnoe(f,g:complex;var z:complex); begin z.re:=(f.re*g.re+f.im*g.im)/(sqr(g.re)+sqr(g.im)); z.im:=(f.im*g.re-f.re*g.im)/(sqr(g.re)+sqr(g.im)); end; var a,b,c:complex; begin clrscr; writeln(\'Vvedite deist. i mnim. chasti a:\'); read(a.re,a.im); readln; writeln(\'Modul A=\',Modul(a):0:6); writeln(\'Argument A=\',Argument(a):0:6); writeln(\'Vvedite deist. i mnim. chasti b:\'); read(b.re,b.im); readln; writeln(\'Modul B=\',Modul(b):0:6); writeln(\'Argument B=\',Argument(a):0:6); Summa(a,b,c); write(\'A+B=\'); Vyvod(c); Proizvedenie(a,b,c); write(\'A*B=\'); Vyvod(c); Chastnoe(a,b,c); write(\'A/B=\'); Vyvod(c); readln end.

Ответ отправил: Пупорев Юрий Борисович, Специалист
Ответ отправлен: 08.06.2009, 07:09

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 250608 на номер 1151 (Россия) | Еще номера >>

Отправить WebMoney: Неплохо (25 руб.) Хорошо (35 руб.) Отлично (50 руб.) БЛЕСТЯЩЕ! (75 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

для произвольной матрицы А(M,N) сформировать одномерный массив В, каждый элемент которого равен 1,если в столбце есть хотя бы один отрицательный элемент, и 0,если отрицательных эл-ов нет,используя процедуру. Вывести на экран номера столбцов, не содержащих отрицательных эл-ов.

Отправлен: 07.06.2009, 20:39
Вопрос задал: Поливанов Владимир Дмитриевич, Посетитель
Всего ответов: 1
Страница вопроса >>

Приложение:
uses crt; const mx=20;{максимальный размер матрицы и вектора} type mas=array[1..mx] of integer;{вектор} matr=array[1..mx] of mas;{матрица} procedure Vector(mt:matr;x,y:byte;var v:mas);{процедура создания вектора} var i,j,k:byte; begin writeln(\'Не содержат отрицательных элементов столбцы:\'); for j:=1 to y do{смотрим все столбцы} begin k:=0; for i:=1 to x do{вниз по столбцу} if mt[i,j]<0 then k:=k+1;{если отрицательный, считаем} if k>0 then v[j]:=1{если есть, в вектор 1} else if k=0 then{если нет} begin v[j]:=0;{в вектор ноль} writeln(\'№ \',j);{выводим номер} end; end; end; var a:matr; b:mas; m,n,i,j:byte; begin clrscr; randomize; repeat write(\'Количество строк m=\'); readln(m); until m in [1..mx]; repeat write(\'Количество столбцов n=\'); readln(n); until n in [1..mx]; writeln(\'Матрица:\'); for i:=1 to m do begin for j:=1 to n do begin a[i,j]:=random(10)-2; write(a[i,j]:4); end; writeln; end; Vector(a,m,n,b); writeln; writeln(\'Вектор:\'); for i:=1 to n do write(b[i],\' \'); readln end.

Ответ отправил: Пупорев Юрий Борисович, Специалист
Ответ отправлен: 07.06.2009, 21:45

Оценка ответа: 5
Комментарий к оценке:
благодарю, вы мне очень помогли!

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 250591 на номер 1151 (Россия) | Еще номера >>

Отправить WebMoney: Неплохо (25 руб.) Хорошо (35 руб.) Отлично (50 руб.) БЛЕСТЯЩЕ! (75 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

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

Отправлен: 07.06.2009, 20:41
Вопрос задал: Поливанов Владимир Дмитриевич, Посетитель
Всего ответов: 1
Страница вопроса >>

Приложение:
uses crt; var s,s1,s2:string; i,k:byte; begin clrscr; writeln(\'Stroka:\'); readln(s); s1:=\'\'; i:=1; while not(s[i] in [\' \',\',\']) do{пока не пробел или запятая} begin s1:=s1+s[i];{составляем первое слово} i:=i+1;{следующий символ} end; for i:=length(s) downto 1 do{идем с конца строки, ищем первый разделитель} if s[i] in [\' \',\',\']then{если пробел или запятая} begin k:=i;{запоминаем индекс} break;{дальше не ищем} end; s2:=copy(s,k+1,length(s)-k);{копируем последнее слово} insert(s1,s,k+1);{вставляем первое слово перед последним} delete(s,k+1+length(s1),length(s2));{удаляем последнее} insert(s2,s,1);{вставляем последнее перед первым} delete(s,1+length(s2),length(s1));{удаляем бывшее последнее} write(s); readln end.

Ответ отправил: Пупорев Юрий Борисович, Специалист
Ответ отправлен: 07.06.2009, 21:18

Оценка ответа: 5

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 250590 на номер 1151 (Россия) | Еще номера >>

Отправить WebMoney: Неплохо (25 руб.) Хорошо (35 руб.) Отлично (50 руб.) БЛЕСТЯЩЕ! (75 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Здравствуйте!!!Помогите пожалуйста раобраться почему моя программа не работает.Задание такое: В массив В записать K<L наибольших элементов массива X(L), L <300. Нужно сделать программу с использованием динамических переменных и с записью в файл.Заранее спасибо!!

Отправлен: 07.06.2009, 21:06
Вопрос задал: sanek711, Посетитель
Всего ответов: 1
Страница вопроса >>

Приложение:
{$R-} type TMas=array[1..1] of integer; PMas=^TMas; TMas1=array[1..1] of integer; PMas1=^TMas1; procedure OpenFileIn(NameFile:string; var FileIn:text); begin writeln(\'Введите имя входного файла \'); readln(NameFile); assign(FileIn,NameFile); {$I-} reset(FileIn); {$I+} if IOResult<>0 then begin writeln(\'Ошибка!!! Файл \',NameFile,\' не найден\'); readln; halt; end; end; procedure ReadDimensionOfMas(var FileIn:text; var Line:integer); begin read(FileIn,Line); end; procedure AllocationOfMemoryToMas(Line:integer; var Mas:PMas); begin GetMem(MaS,Line*SizeOf(integer)); end; procedure ReadMatrix(Line:integer; Mas:PMas; var FileIn:text); var i:integer; begin for i:=1 to Line do read(FileIn,Mas^[i]); end; procedure ReadMasFromFileToPMas(var Mas:PMas; var Line:integer); var FileIn:text; NameFile:string; begin OpenFileIn(NameFile,FileIn); ReadDimensionOfMas(FileIn,Line); AllocationOfMemoryToMas(Line,Mas); ReadMatrix(Line,Mas,FileIn); Close(FileIn); end; procedure PrintMas(Line:integer; Mas:PMas); var i:integer; begin for i:=1 to Line do write(Mas^[i],\' \'); writeln; end; procedure inp(Line:integer; var k:integer); begin writeln(\'Введите размерность искомого массива непревышающего размерность исходного\'); readln(k); if (k>Line) or (Line<=0) then begin while (Line<=0) or (k>Line) do begin writeln(\'Ошибка при вводе!(Неправильные данные,введите снова)\'); readln(k); end; writeln(\'Данные введены верно\'); end; end; procedure Din(k:integer; var Mas1:PMas1); begin GetMem(Mas1,k*SizeOf(integer)); end; procedure Find(Mas:PMas;var Mas1:PMas1; Line,k:integer); var i,j,t:integer; begin for j:= 1 to Line do for i:= 1 to Line-1 do if Mas^[i] < Mas^[i+1] then begin t:= Mas^[i]; Mas^[i]:= Mas^[i+1]; Mas^[i+1]:= t; end; for i:= 1 to k do Mas1^[i]:= Mas^[i]; writeln(\'Искомые элементы массива\'); for i:= 1 to k do writeln(Mas1^[i]:6); readln; end; procedure OpenFileOut(NameFile:string; var FileOut:text); begin writeln(\'Введите имя выходного файла \'); readln(NameFile); assign(FileOut,NameFile); rewrite(FileOut); end; procedure OutputMas1ToFile(k:integer; var FileOut:text; var Mas1:PMas1); var i,j:integer; begin for i:=1 to k do write(FileOut,Mas1^[i],\' \'); writeln(FileOut); end; procedure DeleteDinamicMasAndMas1(Line,k:integer; Mas:PMas;Mas1:PMas1); begin FreeMem(Mas,Line*SizeOf(integer)); FreeMem(Mas1,k*SizeOf(integer)); end; procedure WriteMas1ToFile(k:integer; Mas1:PMas1); var FileOut:text; NameFile:string; begin OpenFileOut(NameFile,FileOut); OutputMas1ToFile(k,FileOut,Mas1); Close(FileOut); end; var Mas:PMas; Mas1:PMas1; Line,k:integer; begin ReadMasFromFileToPMas(Mas,Line); writeln(\'Исходный массив имеет следующий вид:\'); PrintMas(Line,Mas); inp(Line,k); Din(k,Mas1); Find(Mas,Mas1,Line,k); writeln(\'Искомый массив имеет следующий вид:\'); WriteMas1ToFile(k,Mas1); DeleteDinamicMasAndMas1(Line,k,Mas,Mas1); end.

Ответ отправил: _Ayl_, 5-й класс
Ответ отправлен: 08.06.2009, 14:21

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 250622 на номер 1151 (Россия) | Еще номера >>

Отправить WebMoney: Неплохо (25 руб.) Хорошо (35 руб.) Отлично (50 руб.) БЛЕСТЯЩЕ! (75 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

подать вопрос экспертам этой рассылки >>