Хостинг Портала RusFAQ.ru:
MosHoster.ru - Профессиональный хостинг на Windows 2008

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

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

Botsman Статус: Студент Рейтинг: 177 ∙ повысить рейтинг >>

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

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

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

Выпуск № 844
от 04.04.2009, 18:35

Вопрос № 163572: Здравствуйте.Помогите пожайлуста решить задачю.Отблагодарю финансово. Ввести с клавиатуры границы диапазона двузначных чисел. Из этих чисел необходимо напечатать только те, цифры которых являються соседними в натуральном ряду. Подсчитать коли...

Вопрос № 163.572

Здравствуйте.Помогите пожайлуста решить задачю.Отблагодарю финансово. Ввести с клавиатуры границы диапазона двузначных чисел. Из этих чисел необходимо напечатать только те, цифры которых являються соседними в натуральном ряду. Подсчитать количество этих чисел и определить, сколько среди них четных и нечетных. Предусмотреть проверку правильности ввода информации.

Отправлен: 29.03.2009, 19:39 Вопрос задал: Петешов Иван Анатольевич (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Киселева Светлана Александровна Здравствуйте, Петешов Иван Анатольевич! Надеюсь, что идея программы будет понятна. У меня f - переменная-"флажок", которая будет хранить назначенное ей нами значение 0 до тех пор, пока данных нетили данные введены некорректно (левая граница диапазона меньше правой, или границы диапазона - не двузначные числа). Если данные корректны, то f меняет свое значение на 1, и мы выходим из цикла ввода данных. Далее переменные, отвечающие за количества предварительно обнуляются, организуется цикл for по заданному диапазону. В цикле каждое текущее двузначное число i разбиваем на цифры p и v. Если разница между ними по модулю равна 1 (какая из цифр на 1 больше: первая или вторая - мы ведь угадать не можем!), то кол-во искомых чисел увеличиваем на 1, выводим число на печать, а также делаем проверку на чет-нечет: если остаток от деления i на 2 равен 0, то число четное, иначе - нечетное, соответсвующее кол-во должно увеличиться на 1. После цикла перейдем на следующую строку (wri teln;), и выведем два сообщения в отдельных строках о кол-ве четных и нечетных среди найденных чисел. Вроде все. program chisla; var a,b:byte; {границы диапазона} p,v:byte; {первая и вторая цифры числа} kol, Kol_chet, Kol_nechet:byte; {общее кол-во искомых чисел, кол-во четных и нечетных чисел} i,f: byte; BEGIN f:=0; while f = 0 do begin writeln('Vvedite diapazon dvuznachnyh chisel:'); write('Levaya granica a='); readln(a); write('Pravaya granica b='); readln(b); if (a<b) and (a<=99) and (b<=99) and (a>=10) and (b>=10) then f:=1 else writeln('Dannye nekorrektny'); end; Kol:=0; Kol_chet:=0; kol_nechet:=0; for i:=a to b do begin p:=i div 10; v:=i mod 10; if abs(p-v)=1 then begin Kol:=kol+1; write(i:3); if i mod 2=0 then kol_chet:=kol_chet+1 else Kol_nechet:=kol_nechet+1; end; end; writ eln; writeln('Kolichestvo chetnyh ravno ',kol_chet); writeln('Kolichestvo nechetnyh ravno ',kol_nechet); readln; End. Удачи!

Ответ отправила: Киселева Светлана Александровна (статус: 1-й класс) Ответ отправлен: 30.03.2009, 13:52 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 246373 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Вопрос № 163.573

Здравствуйте.Помогите пожайлуста решить программу. Составить программу, вырезающую из файла с текстом программы на языке Turbo-Pascal все комментарии.

Отправлен: 29.03.2009, 19:46 Вопрос задал: Петешов Иван Анатольевич (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Бизин Михаил Анатольевич Здравствуйте, Петешов Иван Анатольевич! Код в приложении. Компилируете, получаете Exe-шник, запускаете его с параметром, в качестве которого выступает файл с комментариями, например: CutComm.exe CutComm.pas На экран выйдет содержимое файла с вырезанными комментариями. Если хотите сохранить в файл, используйте DOS-овскую возможность перенаправления потока вывода, Например: CutComm.exe CutComm.pas > Outfile.pas Программа распознаёт директивы. Приложение: program CutComm; uses sysutils; var FileName,S,S1: string; f1: Text; i,j,q: integer; CommentOpen,QuotaOpen: boolean; begin if ParamCount=0 then begin Writeln('*** Usage: CutComm filename'); Writeln('*** For output to file: CutComm filename > fileout'); halt(1); end; FileName:=ParamStr(1); Assign (f1, FileName); {$I-} Reset (f1); {$I+} { Открыть файл на чтение, $I - выкл/вкл встроенный обработчик ошибок } if IOResult = 0 then begin { Существует ли файл? } CommentOpen:=false; While not Eof(f1) do begin //Пока не достигли конца файла Readln(f1,S); //Читаем строку S1:=''; //Очищаем переменную, в которой собираем строку без комментариев QuotaOpen:=false; while Length(S)>0 do begin if QuotaOpen then begin //Если в режиме кавычек, то ищем вторую кавычку q:=Pos('''',S); if q=0 then q:=Length(S); //Если второй кавычки нет, то считаем, что она в конце строки S1:=S1+Copy(S,1,q); Delete(S,1,q); QuotaOpen:=false; Continue; end; if CommentOpen then begin //Если в режиме комментария, то ищем конец комментария i:=Pos('}',S); if i=0 then break; Delete(S,1,i); CommentOpen:=false; Continue; end; q:=Pos('''',S); //Позиция кавычки i:=Pos('{',S); //Позиция комментария { j:=Pos('//',S); //Позиция комментария // if (i>0)or(j>0) then begin //Если в строке есть комментарии if (q>0) and ((q<i)or(i=0)) and ((q<j)or(j=0)) then begin {Если первой встретиласть кавычка} S1:=S1+Copy(S,1,q); Delete(S,1,q); QuotaOpen:=true; //Включить режим кавычек Continue; end; if (j>0) and ((j<i)or(i=0)) then begin //Комментарий начиная // до конца строки вырезать S1:=S1+Copy(S,1,j-1); break; end; if i<Length(S) then {Проверить, может это директива} if S[i+1]='$' then begin S1:=S1+Copy(S,1,i); Delete(S,1,i); Continue; end; //Встретили комментарий начинающийся с { S1:=S1+Copy(S,1,i-1); Delete(S,1,i-1); CommentOpen:=True; //Включить режим комментария end else begin {Комментариев в оставшейся строке нет} S1:=S1+S; break; end; end; Writeln(S1); end; Close(f1); end else begin Writeln('File ',FileName,' not found'); end; end.

Ответ отправил: Бизин Михаил Анатольевич (статус: 3-й класс) Ответ отправлен: 31.03.2009, 18:18 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 246505 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Вопрос № 163.586

Дан массив из пяти строк. В строке "наименование завода_количество выпускаемой продукции". Вычислить общее количество выпускаемой продукции, распечатать наименование завода, выпустившего максимальное количество

Отправлен: 29.03.2009, 20:52 Вопрос задал: смирнов артем владимирович (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Пупорев Юрий Борисович Здравствуйте, смирнов артем владимирович! Решение с пояснениями в приложении. Приложение: uses crt; const n=5; var pr:array[1..n] of string;{массив строк} s:string;{вспомогательная строка} i,f,j,kp,max,imax:word;{счетчики, общее количество, макс и его номер} t,c:integer;{переменные для перевода строки в число} begin clrscr; writeln('Введите ',n,' строк типа "Завод_А 500":'); for i:=1 to n do begin repeat {в цикле проверяем правильность ввода строки} write('Завод ',i,': '); readln(pr[i]);{читаем строку} if pos(' ',pr[i])=0 then writeln('Нет пробела!'){если нет пробела} else{если пробел есть} begin {смотрим дальше} f:=0; for j:=pos(' ',pr[i])+1 to length(pr[i]) do{от пробела до конца} if not (pr[i][j] in ['0'..'9']) then{если есть не цифра} begin f:=1;{фиксируем} writeln('Количество записано не числом!');{сообщаем} break;{заканчиваем проверку} end; end; until (f=0) and(pos(' ',pr[i])>0);{если есть пробел и после него только цифры, переходим к следующей строке} end; kp:=0;max:=0;imax:=1; for i:=1 to n do begin s:=copy(pr[i],pos(' ',pr[i])+1,length(pr[i])-pos(' ',pr[i]));{берем часть строки после пробела, количество} val(s,t,c);{превращаем в число} kp:=kp+t;{суммируем} if t>max then{если число больше предыдущих} begin max:=t;{оно макс} imax:=i;{запоминаем его номер} end; end; writeln('Общее количество выпускаемой продукции=',kp);{выводим сумму} write('Максимальное количество выпустил завод ', copy(pr[imax],1,pos(' ',pr[imax])-1),' ее количество=',max);{выводим название завода с макс номером и количество} readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Специалист) Ответ отправлен: 30.03.2009, 10:48 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 246351 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Вопрос № 163.587

4.Дан вещественный вектор А(10) такой, что а1 <= а2 <=...<= а10 и число х. Построить вектор С(11) из А и х, упорядоченные по невозрастанию.

Отправлен: 29.03.2009, 20:53 Вопрос задал: смирнов артем владимирович (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Botsman Здравствуйте, смирнов артем владимирович! Помогаю. По вашему условию, вектор A дан упорядоченным по неубыванию, поэтому в программе он создается УЖЕ упорядоченным (для простоты заполняется числами от 1 до 10) Сам код и комментарии - в приложении. Рад был помочь! Приложение: const n=10; var a:array[1..n] of real; c:array[1..n+1] of real; x:real; i:integer; BEGIN {sozdaem uporyadochennyi po vozrastaniyu massiv} for i:=1 to n do a[i]:=i; writeln('Ishodnyi massiv:'); for i:=1 to n do write(a[i]:6:2); writeln; write('x='); readln(x); {kopiruem vse elementy a[n-i+1]<x v c[i]} i:=1; while (a[n-i+1]>x) and(i<=n) do begin c[i]:=a[n-i+1]; inc(i,1); end; {vstavlyaem x} c[i]:=x; {kopiruem ostavshiesya elementy} while i<=n do begin c[i+1]:=a[n-i+1]; inc(i,1); end; writeln('REZULTAT:'); for i:=1 to n+1 do write(c[i]:6:2); writeln; readln; END. --------- Хочешь победить Excel? Спроси меня как! ;)

Ответ отправил: Botsman (статус: Студент) Ответ отправлен: 30.03.2009, 13:19 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 246368 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Вопрос № 163.597

Привет. Помогите написать программу: Определить, является ли строка правильным скобочным выражением. Для определенности можно ограничиться только круглыми скобками. Вот я написал, но она не работает и я уже не знаю че в ней можно изменить или дописать..... Program z1; var s:string; i, rask, zakr : integer; Begin Write('Vvedite striky'); Readln(s); rask:=0; zakr:=0; For i:=1 to length(s) do begin if s='(' then rask=rask+1; if s=')' then zakr=rask+1; end; if rask<>zakr then write('ne pravilno') else write('pravilno'); readln; End.

Отправлен: 29.03.2009, 21:44 Вопрос задал: Тихонов Алексей Александрович (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 2)

Отвечает: Киселева Светлана Александровна Здравствуйте, Тихонов Алексей Александрович! Попробуйте решить Вашу задачу таким способом: вам не нужны две переменные на подсчет открывающихся и закрывающихся скобок, достаточно одной, пусть это будет переменная rask. Если встретилась скобка открывающаяся, то увеличим значение этой переменной на 1, если закрывающаяся - уменьшим ее значение на 1. Еще я бы взяла не цикл for, а цикл while по следующим соображениям: если количество закрывающихся скобок на каком-то проверяемом символе больше, чем открывающихся (rask < 0), то очевидно, что выражение УЖЕ записано неправильно (например, '(ыов)вао)фыво(' - такая строка) и нет смысла идти с проверкой на следующий символ. Поэтому я завела "флажок"-переменную f, которой изначально присвоила значение 1 (если хотите, можете взять другое понравившееся число, допустим, 7). Пока f = 1 - скобки пока еще поставлены корректно (открывающихся >= закрывающихся). Если же встретилась выше описанная ситуация, то f меняет св оё значение на другое (у меня в программе - на нуль). Тем самым f "сигнализирует" нам - всё, уже неверно, дальше нет смысла проверять. Итак, в цикле while мы проверяем два условия - не достигли пока еще конца строки? и в строке пока еще нет ошибочной постановки закрывающейся скобки ПЕРЕД соответствующей ей открывающейся? Далее, Ваша ошибочка была в том, что Вам надо не всю строку s проверять - скобка она или нет, а СИМВОЛ s[i], т.е. i-ый символ строки. Также неплохо бы после then устраивать не сравнение через "=", а присваивание ":=", тогда компьютер не будет на вас "ругаться" разными сообщениями об ошибке. Program z1; var s:string; i, rask : integer; f:byte; Begin Writeln('Vvedite stroky'); Readln(s); rask:=0; f:=1; i:=1; while (i<=length(s)) and (f=1) do begin if s[i]='(' then rask:=rask+1; if s[i]=')' then rask:=rask-1; if rask<0 then f:=0; i:=i+1; end; if (rask=0) and (f=1) then write('pravilno') {если всё было корректно: f осталось равно 0} {а также кол-во откр. и закр. скобок дало в} {разности нуль: rask = 0, то все правильно!} else write('ne pravilno'); readln; End.

Ответ отправила: Киселева Светлана Александровна (статус: 1-й класс) Ответ отправлен: 30.03.2009, 13:23 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 246370 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Вопрос № 163.619

Здравствуйте, помогите, пожалуйста, написать программу в Turbo Pascal с использованием процедур, задание такое На плоскость задаются координаты N произвольных точек. Выделить среди них две точки, расстояние между которыми максимально и две точки, расстояние между которыми минимально. Предусмотреть графическую иллюстрацию.

Отправлен: 30.03.2009, 05:24 Вопрос задал: Dmitrii3842 (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Бизин Михаил Анатольевич Здравствуйте, Dmitrii3842! Программа в приложении. Графический режим, если сразу не запустится, Вам самому придётся отредактировать процедуру InitBgi. Т.к. способ ввода массива точек не указан, то для простоты и быстроты координаты задаются случайными. Если нужно заполнение другим образом, нужно переписать процедуру FillArray. Результат в текстовом режиме выглядит так: Min Distance: between 1 & 4 points, R=13.04 Max Distance: between 4 & 6 points, R=605.30 Приложение: program Distance; uses crt,graph; Type TPoint = record {запись координаты точки} X,Y: integer; end; const N = 10; { Количество точек на плоскости } var Points: array[1..N] of TPoint; {Массив точек} imin,jmin,imax,jmax: integer; R,Rmin,Rmax: real; procedure InitBgi; var grdriver, grmode, errcode : integer; begin grdriver := vga; grmode := vgahi; initgraph(grdriver, grmode, 'd:pppgi'); { Путь к папке bgi должен быть в соответствии с Вашей системой } errcode:= graphresult; if errcode <> grok then begin CloseGraph; writeln('Graphics error: ', grapherrormsg(errcode)); halt(1); end; end; procedure FillArray; var i: integer; begin randomize; {Запуск генератора случайных чисел} {Задать случайные координаты} For i:=1 to N do begin Points[i].X:=random(640); Points[i].Y:=random(480); end; end; procedure FindMinMax; var i,j: integer; begin Rmin:=1000000; Rmax:=0; {Пробежаться по всем парам точек} For i:=1 to N-1 do begin For j:=i+1 to N do begin {Вычислить расстояние между точкми} R:=sqrt(sqr(Points[i].X-Points[j].X)+sqr(Points[i].Y-Points[j].Y)); if R<Rmin then begin {Сравнить с минимальным найденным} Rmin:=R; imin:=i; jmin:=j; end; if R>Rmax then begin {Сравнить с максимальным найденным} Rmax:=R; imax:=i; jmax:=j; end; end; end; end; procedure PrintMinMax; begin Writeln('Min Distance: between ',imin,' & ',jmin,' points, R=',Rmin:5:2); Writeln('Max Distance: between ',imax,' & ',jmax,' points, R=',Rmax:5:2); end; procedure DrawPoints; var i: integer; s: string; begin For i:=1 to N do begin {Нарисовать точки и их номера} Circle(Points[i].X,Points[i].Y,3); Str(i,s); OutTextXY(Points[i].X-4,Points[i].Y-14,s); end; {Соединить самые близкие и далёкие точки линиями} Line(Points[imin].X,Points[imin].Y,Points[jmin].X,Points[jmin].Y); Line(Points[imax].X,Points[imax].Y,Points[jmax].X,Points[jmax].Y); end; begin clrscr; {Очистка текстового экрана} FillArray; {Заполнить массив точек случайными координатами} FindMinMax; {Найти самые близкие и самые далёкие точки} PrintMinMax; {Вывести найденные точки на экран} Writeln('Press any key for Drawing'); ReadKey; InitBgi; {Инициализация графики} DrawPoints; {Отобразить результат в графическом виде} Writeln('Press any key for Exit'); ReadKey; CloseGraph; {Выйти из графического режима} end.

Ответ отправил: Бизин Михаил Анатольевич (статус: 3-й класс) Ответ отправлен: 30.03.2009, 11:25 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 246353 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Вопрос № 163.635

Здравсвуйте эксперты, подскажите пожалуйста, почему следующий код заливает весь экран, а не только нарисованый квадрат, и как это исправить? Вырезал из другой программы, поэтому куча лишних переменных обьявлена. Заранее спасибо) Приложение: uses crt,graph; const xs=100; ys=50; var mode,driver: integer; x0,y0:integer; r1,r2,l,l2,i,s,h:integer; al:real; a,b: array [0..6,1..2] of integer; begin l:=100; s:=400; h:=200; {write('l=');readln(l); write('s=');readln(s); write('h=');readln(h);} detectgraph(driver,mode); {mode:=9; driver:=2;} initgraph(driver,mode,'d: pgi'); rectangle(10,10,100,100); floodfill(5,5,1); readln; closegraph; end.

Отправлен: 30.03.2009, 11:36 Вопрос задал: Tribak (статус: Студент) Всего ответов: 3 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Зенченко Константин Николаевич Здравствуйте, Tribak! Добавил, хелп по floodfill(15,15,15); - Вы установили цвет границы, не соответствующему текущему, тому которым нарисован прямоугольник. Изменил координаты области. Удачи! Приложение: uses crt,graph; const xs=100; ys=50; var mode,driver: integer; x0,y0:integer; r1,r2,l,l2,i,s,h:integer; al:real; a,b: array [0..6,1..2] of integer; begin l:=100; s:=400; h:=200; {write('l=');readln(l); write('s=');readln(s); write('h=');readln(h);} detectgraph(driver,mode); {mode:=9; driver:=2;} initgraph(driver,mode,''); rectangle(10,10,100,100); readkey; { FloodFill (процедура) (модуль Graph) Закрашивает замкнутую область, используя текущие стиль и цвет закраски. Объявление: Procedure FloodFill(X, Y : Integer; Border : Word); Режим: Real, Protected Замечания: Закрашивает замкнутую область на растровых устройствах. Точка с координатами (X, Y) начальная точка внутри замкнутой области, с которой начнется закраска. Текущий шаблонзакраски устанавливается процедурами SetFillStyle и SetFillPattern. Закрашивается область, ограниченная цветом с номером Border. Если точка (X, Y) находится внутри замкнутой области, то закраска будет происходить внутри области. Если же эта точка находится снаружи замкнутой области, то будет закрашено все пространство вне области.} floodfill(15,15,15); readln; closegraph; end.

Ответ отправил: Зенченко Константин Николаевич (статус: Профессор) Ответ отправлен: 30.03.2009, 12:12 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 246361 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Отвечает: Бизин Михаил Анатольевич Здравствуйте, Tribak! У Вас команда заливки FloodFill(X,Y,BorderColor) третьим параметром требует цвет границы, за которым закрашивать не надо. Установите BorderColor таким же, как цвет, которым рисуется квадрат. В данном случае закрасится область за пределами квадрата. Если хотите закрасить область внутри квадрата, поместите координаты X,Y внутрь квадрата. Попробуйте такую вставку: SetColor(YELLOW); rectangle(10,10,100,100); SetFillStyle(1,GREEN); floodfill(11,11,YELLOW);

Ответ отправил: Бизин Михаил Анатольевич (статус: 3-й класс) Ответ отправлен: 30.03.2009, 12:19 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 246362 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Отвечает: Киселева Светлана Александровна Здравствуйте, Tribak! Наверное,я смогу помочь. Вот этот фрагмент: rectangle(10,10,100,100); floodfill(5,5,1); я бы записала так: SetColor(3); {установка цвета контура квадрата - голубой} rectangle(10,10,100,100); {рисование контура квадрата} SetFillStyle(1,2); {установка стила закраски: 1 - сплошной; 2 - зеленая заливка} floodfill(20,20,3); {координаты точки ВНУТРИ квадрата (20;20), 3 - цвет КОНТУРА, } {которым БЫЛ НАРИСОВАН квадрат} Надеюсь, поможет... Удачи!

Ответ отправила: Киселева Светлана Александровна (статус: 1-й класс) Ответ отправлен: 30.03.2009, 12:54 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 246364 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Вопрос № 163.647

Здравствуйте! Помогите пожалуйста написать программу на даннное задание: На шахматной доске стоят черный король и три белые ладьи (ладья бьет по горизонтали и вертикали). Проверить, не находится ли король под боем, а если есть угроза, то от кого именно. Использовать массив размерностью 8*8. Позицию каждой фигуры в обычной нотации(d7) или парой чисел(4;7)

Отправлен: 30.03.2009, 14:35 Вопрос задала: Грязнева Ольга Михайловна (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Грязнева Ольга Михайловна! Решение с пояснениями в приложении. Над оформлением вывода можно еще работать как в текстовом, так и в графическом режиме, здесь по сути только алгоритм. Приложение: uses crt; type ladja=record {тип запись координат поля} x:'a'..'h';{вертикали} y:1..8;{горизонтали} end; var a:array['a'..'h',1..8]of char;{шахматная доска} L:array[1..3] of Ladja;{массив ладей} yk,n,i,y,k:byte;{координаты и счетчики циклов-цифры} xk,x:char;{то же, символы} begin clrscr; randomize; repeat writeln('Vvedite koordinaty korola: '); write('Vertikal (a-h) =');readln(xk); write('Horizontal(1-8) =');readln(yk); until (xk>='a')and(xk<='h')and(yk>=1)and(yk<=8);{если не вышли за пределы доски} for i:=1 to 3 do {задаем координаты ладей} begin writeln('Ladja ',i); repeat write(' Vertikal (a-h) =');readln(L[i].x); write(' Horizontal (1-8) =');readln(L[i].y); until ((L[i].x<>xk)or(L[i].y<>yk)){если не за полем} and(L[i].x>='a')and(L[i].x<='h')and(L[i].y>=1)and(L[i].y<=8);{и не попали на поле короля} end; clrscr;{очищаем экран} for y:=8 downto 1 do{заполняем поле} begin for x:='a' to 'h' do begin a[x,y]:='0';{пустые клетки-0, можно по другому} a[xk,yk]:='K';{поле короля} for i:=1 to 3 do if (y=L[i].y)and(x=L[i].x)then a[x,y]:='L';{поля ладей} write(a[x,y]:3); end; writeln; end; k:=0; for x:=xk downto 'a' do {от позиции короля идем влево} if a[x,yk]='L' then{если попали на ладью} begin writeln('Ugroza s polya ',x,yk);{угроза} k:=1;{фиксируем} break;{дальше не идем, остальные ладьи, если они на этой линии не угрожают, т.к. перекрыты первой ладьей} end; for x:=xk to 'h' do{тоже вправо} if a[x,yk]='L' then begin writeln('Ugroza s polya ',x,yk); k:=1; break; end; for y:=yk downto 1 do{вниз} if a[xk,y]='L' then begin writeln('Ugroza s polya ',xk,y); k:=1; break; end; for y:=yk to 8 do {вверх} if a[xk,y]='L' then begin writeln('Ugroza s polya ',xk,y); k:=1; break; end; if k=0 then write('Ugroz net!');{если ни в одну сторону ладью не встретили, угрозы нет} readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Специалист) Ответ отправлен: 31.03.2009, 14:11 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 246493 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Вопрос № 163.663

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

Отправлен: 30.03.2009, 16:09 Вопрос задал: dmi_5116 (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Костя Симанович Здравствуйте, dmi_5116! Решение задачи в приложении, если кол-во строк нечетное, то последняя строка не трогается. алгоритм простой берём оба числа первой строки записываем в buf, buf2, в первую строку записываем переменные второй строки, на место второй строки записываем переменные из buf, buf2. Удачи. Приложение: {задача меняет местами две соседних строки в двумерном массиве} program mass1; const n = 11; // кол-во строк var mass : array[1..n, 1..2] of integer; i, j : integer; buf, buf2: integer; begin randomize; for i := 1 to n do // заполняем массив begin for j := 1 to 2 do begin mass[i, j] := random(50); write(mass[i, j], ' ' ); // сразу выводим для контроля end; writeln; end; i := 1; repeat // меняем местами if i + 1 <= n then begin buf := mass[i, 1]; buf2:= mass[i, 2]; mass[i, 1] := mass[i + 1, 1]; mass[i, 2] := mass[i + 1, 2]; mass[i + 1, 1] := buf; mass[i + 1, 2] := buf2; end; i := i + 2; until i >= n; // выводим результат writeln; writeln; for i := 1 to n do begin for j := 1 to 2 do write(mass[i, j], ' '); writeln; end; readln; end.

Ответ отправил: Костя Симанович (статус: Студент) Ответ отправлен: 30.03.2009, 16:28 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 246392 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это!

© 2001-2009, Портал RusFAQ.ru, Россия, Москва. Авторское право: ООО "Мастер-Эксперт Про" Техподдержка портала, тел.: +7 (926) 535-23-31 Хостинг: "Московский хостер" Поддержка: "Московский дизайнер" Авторские права | Реклама на портале ∙ Версия системы: 5.13 от 01.12.2008
RusFAQ.ru | MosHoster.ru | MosDesigner.ru RusIRC.ru | Kalashnikoff.ru | RadioLeader.ru