РАССЫЛКИ ПОРТАЛА RFPRO.RU

Чемпионы рейтинга экспертов в этой рассылке

Пупорев Юрий Борисович Статус: Специалист Рейтинг: 470 ∙ повысить рейтинг >>

_Ayl_ Статус: 5-й класс Рейтинг: 342 ∙ повысить рейтинг >>

Micren Статус: Практикант Рейтинг: 298 ∙ повысить рейтинг >>

∙ / КОМПЬЮТЕРЫ И ПО / Языки программирования / Pascal

Нам очень важно Ваше мнение об этом выпуске рассылки. Вы можете оценить этот выпуск по пятибалльной шкале, пройдя по ссылке:
оценить выпуск >>

Вопрос № 169128: В приложении моя игра. Помогите разобраться, в ней есть несколько процедур. Процедура Меню объявлена самой последней. При выходе(или окончании) из игры нужно сделать выход в меню, а не в ОС. Также и при выходе из процедуры Instruct. Вопрос № 169134: Доброго времени суток, уважаемые программисты! Помогите пожалуйста с задачей (точнее только с процедурой обработки, всё остальное уже написано): на главную диагональ матрицы А(К,К) поместить наибольшие элементы этой матрицы (сначала наибольший, затем...

В приложении моя игра. Помогите разобраться, в ней есть несколько процедур. Процедура Меню объявлена самой последней. При выходе(или окончании) из игры нужно сделать выход в меню, а не в ОС. Также и при выходе из процедуры Instruct.

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

Приложение:
uses Graph,Crt; const ArrowUp=#72; ArrowDown=#80; var grD,grM,j:integer; c:char; procedure ShowPoint(dY,dColor:integer;z:string); begin setfillstyle(1,3*dColor+1); bar(220,120+dY+35,370,120+dY+70); outtextxy(240,120+dY+38,z); end; procedure ShowMenu(z:integer); var y:integer; x:array[0..2]of string; begin x[2]:=\'Play Ping-Pong\'; x[1]:=\'Info\'; x[0]:=\'Exit\'; ClearDevice; setcolor(2); settextstyle(1,0,3); setfillstyle(8,11); bar(120,120,490,340); for y:=0 to 2 do ShowPoint(60*y,ord((2-y)=z),x[2-y]); end; procedure igra; begin ClearDevice; outtextxy(100,110,\'Game\'); readKey end; procedure exit; begin ClearDevice; setcolor(1); settextstyle(2,0,8); outtextxy(100,110,\'Igru sozdal student MATI\'); outtextxy(100,140,\'Sergey Tyan. 3Cay-169\'); outtextxy(100,170,\'Versia 1.1\'); outtextxy(100,200,\'GOOD LUCK! ;-)\'); ReadKey; end; procedure instruct; begin ClearDevice; settextstyle(2,0,8); textcolor(4); outtextxy(100,110,\'!!! PING PONG !!!\'); outtextxy(100,140, \'Pravila igri: \'); outtextxy(100,170,\'Dvigaya raketku, otbivat myach. \'); outtextxy(100,200,\'Igra do 5 ochkov. Upravlenie: \'); outtextxy(100,230,\'3-vverh, 2-stop, 1-vniz\'); outtextxy(100,260,\'P-pausa\'); outtextxy(100,290,\'YDASCHI DRUSIJA\'); outtextxy(120,350,\'Press any key!\'); ReadKey; end; {--------------------------------------------------------------------------------} begin grd:=detect; initgraph(grd,grm,\'bgi\'); j:=2; repeat {визуальная часть} ShowMenu(j); repeat c:=ReadKey; until ord(c)<>0; {исполнительная часть} if c=ArrowUp then j:=(j+4)mod 3; if c=ArrowDown then j:=(j+2)mod 3; if c=#13 then case j of 2:igra; 1:instruct; 0:exit; end; until (c=#13)and(j=0); closegraph; end. Украина, Киев
Тел.: +38-097-953-66-19
Адрес: Украина, Киев

-----
Итерация от человека. Рекурсия — от Бога. — Л. Питер Дойч

Ответ отправил: Зенченко Константин Николаевич, Модератор
Ответ отправлен: 12.06.2009, 20:54

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

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

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

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

Доброго времени суток, уважаемые программисты! Помогите пожалуйста с задачей (точнее только с процедурой обработки, всё остальное уже написано): на главную диагональ матрицы А(К,К) поместить наибольшие элементы этой матрицы (сначала наибольший, затем следующий по величине и т.д.), а диагональные элементы - на место наибольших. Заранее благодарен))) Просто сейчас идёт подготовка к экзамену и осталась вот эта последняя задача, которую я не знаю как решить.
З.Ы.: попробовал сделать обработку, но не получилось((( Код в приложении.

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

Приложение:
PSortList = ^TSortList; TSortList = Record next : PSortList; {следующий элемент списка} value : Integer; {значение} line : Integer; {строка элемента в матрице} col : Integer; {столбец элемента в матрице} end; .. Var m : PSortList; .. Procedure AddList (var m : PSortList; e : Integer; l, c : Integer); var p, q : PSortList; begin new (q); q^.value := e; q^.line := l; q^.col := c; if m = nil then begin q^.next := m; m := q; end if m^.value < e then begin q^.next := m; m := q; end else begin p := m; while p^.next <> nil do begin if p^.next^.value < e then begin q^.next := p^.next; p^.next := q; break; end; p := p^.next; end; end; end; .. Procedure Obrabotka(var A:Matrica; Line,Column:integer); var i : Integer; p : PSortList; t : Integer; begin .. p := m; for i := 1 to Line do begin t := A^[i]^[i]; A^[i]^[i] := p^.e; A^[p^.line]^[p^.col] := t; p := p^.next; end; .. end;

Ответ отправил: _Ayl_, 5-й класс
Ответ отправлен: 09.06.2009, 15:00

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

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

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

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

Отправлен: 09.06.2009, 00:20
Вопрос задал: толянко
Всего ответов: 1
Страница вопроса >>

Приложение:
uses crt; const n=8;{размер четвертей матрицы} type matr=array[1..2*n,1..2*n] of integer;{тип матрицы} function Sred(m:matr;x1,y1,x2,y2:byte):real; {нахождение среднего в четверти, в параметрах индексы углов четверти} var i,j:byte; sr:real; begin sr:=0; for i:=x1 to y1 do for j:=x2 to y2 do sr:=sr+m[i,j]/((y1-x1+1)*(y2-x2+1));{считаем среднее} Sred:=sr; end; var a:matr; v:array[1..4] of real; i,j:byte; x:integer; begin clrscr; writeln(\'Ishodnaya matrica:\'); for i:=1 to 2*n do begin for j:=1 to 2*n do begin a[i,j]:=random(10); if(i<=n)and(j<=n)then{первый блок} begin textcolor(10);{своим цветом} write(a[i,j]:3); end else if(i<=n)and(j>n)then{второй блок} begin textcolor(11); write(a[i,j]:3); end else if(i>n)and(j<=n)then{третий блок} begin textcolor(12); write(a[i,j]:3); end else if(i>n)and(j>n)then{четвертый блок} begin textcolor(13); write(a[i,j]:3); end end; writeln; end; readln; for i:=1 to n do{перестановка блоков по часовой стрелке} for j:=1 to n do begin x:=a[i,j]; a[i,j]:=a[n+i,j]; a[n+i,j]:=a[n+i,n+j]; a[n+i,n+j]:=a[i,n+j]; a[i,n+j]:=x; end; writeln(\'Rezultat:\'); for i:=1 to 2*n do begin for j:=1 to 2*n do begin if(i<=n)and(j<=n)then begin textcolor(12); write(a[i,j]:4); end; if(i<=n)and(j>n)then begin textcolor(10); write(a[i,j]:4); end; if(i>n)and(j<=n)then begin textcolor(11); write(a[i,j]:4); end; if(i>n)and(j>n)then begin textcolor(13); write(a[i,j]:4); end; end; writeln; end; v[1]:=Sred(a,1,n,1,n);{создаем вектор по среднему в блоках} v[2]:=Sred(a,1,n,n+1,2*n); v[3]:=Sred(a,n+1,2*n,n+1,2*n); v[4]:=Sred(a,n+1,2*n,1,n); writeln(\'Вектор:\'); for i:=1 to 4 do write(v[i]:5:2); readln end.

Ответ отправил: Пупорев Юрий Борисович, Специалист
Ответ отправлен: 09.06.2009, 12:29

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

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

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

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

Отправлен: 09.06.2009, 00:29
Вопрос задал: несократ, Х Заблокирован
Всего ответов: 1
Страница вопроса >>

Приложение:
uses crt; const nmax=20;{максимальный размер матрицы} type matr=array[1..nmax,1..nmax] of real;{матрицы} mas=array[1..nmax] of real;{векторы} procedure Vvod(var mt:matr;var x:byte;c:char);{создание матриц} var i,j:byte; begin writeln(\'Матрица \',c); repeat write(\'размер матрицы=\'); readln(x); until x in [1..nmax]; for i:=1 to x do for j:=1 to x do mt[i,j]:=10*random-4; end; procedure Vyvod(var mt:matr;x:byte;c:char);{вывод исходных матриц на экран} var i,j:byte; begin writeln(\'Исходная матрица \',c); for i:=1 to x do begin for j:=1 to x do if (i=j)and(j mod 2=0) then{элементы, которые будем менять, выделим красным цветом} begin textcolor(12); write(mt[i,j]:5:1); end else begin textcolor(15);{остальные по умолчания, обычно белым} write(mt[i,j]:5:1); end; writeln; end; textcolor(15); end; procedure Vector(var mt:matr;x:byte;var v:mas;var y:byte;c:char);{создание вектора и замена элементов матрицы} var i,j:byte; sr:real; begin y:=0; for j:=1 to x do if j mod 2=0 then{четный столбец} begin y:=y+1;{считаем их} sr:=0; for i:=1 to x do sr:=sr+mt[i,j]/x;{вычисляем среднее в столбце} v[y]:=sr;{записываем в вектор} mt[j,j]:=sr;{на главную диагональ} end; writeln(\'Вектор:\'); for i:=1 to y do write(v[i]:5:1);{выводим вектор} writeln; writeln(\'Измененная матрица \',c); for i:=1 to x do begin for j:=1 to x do if (i=j)and(j mod 2=0) then{выводим матрицу, выделяем цветом замененные элементы} begin textcolor(12); write(mt[i,j]:5:1); end else begin textcolor(15); write(mt[i,j]:5:1); end; writeln; end; textcolor(15); end; var x,y,z:matr; nx,ny,nz:byte; vx,vy,vz:mas; nvx,nvy,nvz:byte; begin clrscr; randomize; Vvod(x,nx,\'X\');{создаем матрицы} Vvod(y,ny,\'Y\'); Vvod(z,nz,\'Z\'); clrscr;{очищаем экран} Vyvod(x,nx,\'X\');{выводим по порядку матрицы и делаем преобразования} Vector(x,nx,vx,nvx,\'X\'); readln; clrscr; Vyvod(y,ny,\'Y\'); Vector(y,ny,vy,nvy,\'Y\'); readln; clrscr; Vyvod(z,nz,\'Z\'); Vector(z,nz,vz,nvz,\'Z\'); readln end.

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

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

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

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

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

Здравствуйте! Опять я, опять с задачкой по Златопольскому, и новыми трудностями. Разобраться с массивами вроде разобралась, сумму, умножение, матриц научилась делать, а вот более посложнее задача. (я не прошу ее решить, это слишком, учитывая то, что мне и так много людей помогли здесь, но хоть чуть-чуть объяснить, что и к чему в этой задаче..). Заранее благодарна, если кто возьмется помочь..

*Дан квадратный массив целых чисел. Определить, является ли он симметричным относительно своей побочной диагонали.*

Отправлен: 09.06.2009, 09:22
Вопрос задал: Reresana, 1-й класс
Всего ответов: 1
Страница вопроса >>

Приложение:
const n = 5; var a: array [1..n,1..n] of integer; i,j: integer; pr: boolean; {признак симметричности} begin for i:=1 to n do for j:=1 to N do begin write (\'a[\', i ,\',\', j, \']=\'); readln (a[i,j]); writeln end; pr:= true; for i:= 1 to n-1 do for j:= 1 to n-i do begin if a[i,j] <> a[n-j+1, n-i+1] then pr:= false; {если не совпадают перебрасываем в false} end; if pr then writeln(\'yes\') else writeln(\'no\'); readln; end.

Ответ отправил: Шичко Игорь, Практикант
Ответ отправлен: 09.06.2009, 08:35

Оценка ответа: 5
Комментарий к оценке:
Только на 5 :))))

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

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

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

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

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