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

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

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

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

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

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

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

Выпуск № 863
от 25.04.2009, 23:35

Вопрос № 165368: Написать программу, рисующую кольцо, разбивающую его на 4 разноцветные дуги, а затем имитирующую вращение кольца, равномерно перемещая по нему разноцветные дуги....

Вопрос № 165.368

Написать программу, рисующую кольцо, разбивающую его на 4 разноцветные дуги, а затем имитирующую вращение кольца, равномерно перемещая по нему разноцветные дуги.

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

Отвечает: Тимошенко Дмитрий Здравствуйте, Crimerst! За неимением других ответов - высылаю два варианта. В первом дуги заполняются с помощью Arc - поэтому возникает муар, а во втором с помощью FloodFill - возникает "мерцание". Может быть какой-либо подойдет. С уважением, Дмитрий Приложение: {Вариант 1} program krug; uses graph,crt; const step=1; { Шаг движения дуг } width=20; { Толщина кольца } var grDriver, grMode: integer; Ugol,radius,x,y,i: word; begin { Инициализируем графику } grDriver:=Detect; grMode:=Detect; InitGraph(grDriver, grMode, ''); { В цикле рисуем в середине экрана 4 дуги разных цветов } { и сдвигаем угол на step на каждом шагу, до нажатия любой клавиши } Ugol:=0; x:=GetMaxX div 2; y:=GetMaxY div 2; { центр в середине экрана } radius:=GetMaxY div 2-50; { Радиус меньше половины разрешения по Y на 50 точек } repeat setColor(4); { Цвет первой дуги - красный } for i:=0 to width do arc(x,y,ugol,90+ugol,radius-i); setColor(14); { Цвет второй дуги - желтый } for i:=0 to width do arc(x,y,90+ugol,180+ugol,radius-i); setColor(2); { Цвет третьей дуги - зеленый } for i:=0 to width do arc(x,y,180+ugol,270+ugol,radius-i); setColor(1); { Цвет четвертой дуги - синий } for i:=0 to width do arc(x,y,270+ugol,360+ugol,radius-i); inc(ugol,step); if ugol>=360 then ugol:=ugol-360; delay(500); { Задержка примерно 0.5 сек } until keypressed; { Закрываем графику } CloseGraph; end. {Вариант 2} program krug2; uses graph,crt; const step=3; { Шаг движения дуг } cBorder=7; { Цвет границ } var grDriver, grMode: integer; Ugol,radius1,radius2,x,y: word; { Процедура рисования сегмента кольца с заданным углом и цветом } procedure DrawSegment(Ugol: word; color: byte); var ArcCoords1,ArcCoords2: ArcCoordsType; begin setColor(cBorder); { Наружные и внутренние границы не стираем } arc(x,y,ugol,90+ugol,radius1); GetArcCoords(ArcCoords1); arc(x,y,ugol,90+ugol,radius2); GetArcCoords(ArcCoords2); setColor(color); { Боковые рисуем нужным цветом } line(ArcCoords1.Xstart,ArcCoords1.Ystart,ArcCoords2.Xstart,ArcCoords2.Ystart); line(ArcCoords1.Xend,ArcCoords1.Yend,ArcCoords2.Xend,ArcCoords2.Yend); end; begin { Инициализируем графику } grDriver:=Detect; grMode:=Detect; InitGraph(grDriver, grMode, ''); { Задаем постоянные - центр и радиусы } x:=GetMaxX div 2; y:=GetMaxY div 2; { центр в середине экрана } radius1:=GetMaxY div 2-50; { Внешний радиус меньше половины разрешения по Y на 50 точек } radius2:=170; { Внутрений радиус 170 точек } { В цикле рисуем в середине экрана 4 дуги разных цветов } { и сдвигаем угол на step на каждом шагу, до нажатия любой клавиши } Ugol:=0; repeat DrawSegment(ugol,cBorder); { Рисуем границу первой дуги } setFillStyle(SolidFill,4); { Цвет первой дуги - красный } FloodFill(x+trunc(cos(ugol/180*pi+pi/4)*(radius2+10)), y-trunc(sin(ugol/180*pi+pi/4)*(radius2+10)),cBorder); DrawSegment(ugol+90,cBorder); { Рисуем границу второй дуги } setFillStyle(SolidFill,14); { Цвет второй дуги - желтый } FloodFill(x+trunc(cos((ugol+90)/180*pi+pi/4)*(radius2+10)), y-trunc(sin((ugol+90)/180*pi+pi/4)*(radius2+10)),cBorder); DrawSegment(ugol+180,cBorder); { Рисуем границу третьей дуги } setFillStyle(SolidFill,2); { Цвет третьей дуги - зеленый } FloodFill(x+trunc(cos((ugol+180)/180*pi+pi/4)*(radius2+10)), y-trunc(sin((ugol+180)/180*pi+pi/4)*(radius2+10)),cBorder); DrawSegment(ugol+270,cBorder); { Рисуем границу четвертой дуги } setFillStyle(SolidFill,1); { Цвет четвертой дуги - синий } FloodFill(x+trunc(cos((ugol+270)/180*pi+pi/4)*(radius2+10)), y-trunc(sin((ugol+270)/180*pi+pi/4)*(radius2+10)),cBorder); delay(500); { Задержка примерно 0.5 сек } { Стираем дуги } setFillStyle(SolidFill,0); FloodFill(x+trunc(cos(ugol/180*pi+pi/4)*(radius2+10)), y-trunc(sin(ugol/180*pi+pi/4)*(radius2+10)),cBorder); FloodFill(x+trunc(cos((ugol+90)/180*pi+pi/4)*(radius2+10)), y-trunc(sin((ugol+90)/180*pi+pi/4)*(radius2+10)),cBorder); FloodFill(x+trunc(cos((ugol+180)/180*pi+pi/4)*(radius2+10)), y-trunc(sin((ugol+180)/180*pi+pi/4)*(radius2+10)),cBorder); FloodFill(x+trunc(cos((ugol+270)/180*pi+pi/4)*(radius2+10)), y-trunc(sin((ugol+270)/180*pi+pi/4)*(radius2+10)),cBorder); { Стираем границы дуг } DrawSegment(ugol,0); DrawSegment(ugol+90,0); DrawSegment(ugol+180,0); DrawSegment(ugol+270,0); inc(ugol,step); if ugol>=360 then ugol:=ugol-360; { Чтобы не вызвать переполнения } until keypressed; { Закрываем графику } CloseGraph; end.

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

Вопрос № 165.369

Здравствуйте, уважаемые эксперты! Помогите решить следующую задачу. Написать программу, обрабатывающую данные рекурсивным способом. Определить, является ли заданная строка "правильной записью целого числа" (возможно со знаком). Число вводить посимвольно.

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Crimerst! Решение задачи с комментариями в приложении. Приложение: uses crt; procedure Prav(st:string;k:byte);{рекурсивная процедура} var f:boolean; begin f:=true; if (k<>length(st)) then {если не конец строки} begin if not(st[k] in ['0'..'9']) or not(st[1] in ['-','1'..'9']){если не цифра или первый символ не минус и не 1-9(0 нельзя)} or((st[1]='-')and not(st[2] in ['1'..'9'])) {или первая минус, а вторая не 1-9(ноль нельзя)} or((st[1] in ['1'..'9'])and not(st[2] in ['0'..'9'])) then{или рервый=1-9 и второй не цифра} begin f:=false;{меняем значение флага} writeln('Не является!');{выводим сообщение} readln;{читаем} halt;{завершаем программу} end else Prav(st,k+1);{если нормально, смотрим следующий символ} end; if (k=length(st))and f then writeln('Является!');{дошли до конца и все нормально} end; var c:char; s:string; n:byte; p:boolean; begin clrscr; writeln('Vvedite chislo, окончание ввода точка:'); s:='';{пустая строка} repeat read(c);{читаем символ} s:=s+c;{добавляем в строку} until c='.';{точка, конец} readln;{читаем} delete(s,length(s),1);{} n:=3;{начинаем с 3-го символа} Prav(s,n); readln end.

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

Вопрос № 165.379

Помогите решить задачку !!!! Дан одномерный массив размерности 20. Заполнить его случайными числами на отрезке [-25,25]. Заменить все ее члены, большие Z, этим числом. Подсчитать количество замен. Вывести исходный и полученный массивы на печать.

Отправлен: 20.04.2009, 08:19 Вопрос задал: 036498 Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Andrey Popkov Здравствуйте, ! вот один из вариантов решения: Приложение: var m: array [1..20] of integer; i, j, z: Integer; procedure ShowArray; begin For i:= 1 to 20 do {вывод на экран по 5 элементов в строке} begin write(m[i]:5,' |'); if i mod 5 = 0 then Writeln; end; end; begin Randomize; {заполнение cлучайными числами} For i:= 1 to 20 do begin m[i]:= Random(25); if Random(10) mod 2 = 0 then m[i]:= m[i] * (-1); end; Writeln('Inputed array:'); ShowArray; Writeln; Write('Input Z:'); Readln(z); Writeln; j:= 0; {счетчик замен} for i := 1 to 20 do if m[i] > z then begin m[i]:= z; Inc(j); end; Writeln( j, ' values replaced on ', z); Writeln; ShowArray; Readln; end.

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

Вопрос № 165.382

Здравствуйте, опять прошу помочь мне. Задача: В одномерном массиве, состоящем из 35 вещественных элементов вычислить: а) номер максимального элемента массива. б) приобразовать массив таким образом, чтоб в первой его половине располагались элементы, стоявшие в нечетных , во второй половине в четных позициях. Большое спасибо.

Отправлен: 20.04.2009, 09:54 Вопрос задал: Ложкин Иван Дмитриевич (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Quikk Здравствуйте, Ложкин Иван Дмитриевич! По пункту А. Поиск максимального элемента в массиве: program massive; uses crt; var m: array [1..100] of integer; i: byte; n,max: integer; begin clrscr; randomize; repeat write('Введите N: '); readln(n); until (n>0) and (n<=100); write('Массив:'); for i:=1 to n do begin m[i]:=random(4); write(m[i]:4); end; writeln; max:=m[1]; for i:=2 to n do if max<m[i] then max:=m[i]; writeln('Максимальный элемент: ',max); write('Индекс:'); for i:=1 to n do if max=m[i] then write(i:4); readln; end.

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

Отвечает: Andrey Popkov Здравствуйте, Ложкин Иван Дмитриевич! решение а) и б) в одном флаконе : Приложение: var m: array [1..35] of Real; i: Integer; r: Real; rmaxidx: Integer; procedure ShowArray; begin For i:= 1 to 35 do {вывод на экран по 5 элементов в строке} begin write(i:4,':',m[i]:8:3,' |'); if i mod 5 = 0 then Writeln; end; end; begin Randomize; {заполнение вещественными случайными числами (+1 чтобы избежать 0 в знаменателе)} For i:= 1 to 35 do m[i]:= Random(100) + 1/(Random(100)+1); Writeln('Inputed array:'); ShowArray; {поиск индекса максимального значения} rmaxidx:= 1; for i:= 1 to 35 do if m[rmaxidx] < m[i] then rmaxidx:= i; Writeln; Writeln('Max index = ', rmaxidx, ' (', m[rmaxidx]:8:3 ,')' ); {считаем что 2я часть массива начинается с 19 элемента } For i:= 1 to 9 do begin {меняем местами четные элементы 1й части с нечеными 2й} r:= m[i*2]; m[i*2]:= m[i*2+17]; m[i*2+17]:= r; end; Writeln; Writeln('Converted array:'); ShowArray; Readln; end.

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

Вопрос № 165.411

Просьба помочь еще с одной задачей:Задача "Отрезки". На прямой линии определенным образом расположено N отрезков (N < 500). Из них нужно выбрать максимальное количество непересекающихся, т.е. не имеющих НИ ОДНОЙ общей точки. Считать, что координаты концов всех отрезков являются целыми числами. Требуется написать программу, которая определяет максимальное число отрезков и выводит координаты их концов (в случае, если решение не единственно, достаточно выдать любое). Технические требования: Формат входных данных: В первой строке входного файла задано целое число N. В каждой из последующих N строк — пара целых чисел, задающих левый и правый концы отрезка. Формат выходных данных: Выходной файл в первой строке содержит найденное количество отрезков, а затем список выбранных отрезков. Описание каждого отрезка должно располагаться на отдельной строке в виде пары чисел, задающих левый и правый концы отрезка. Пример файла входных данных: 3 -1 34 6 3 5 Пример файла выходных данных: 2 -1 3 4 6 39

Отправлен: 20.04.2009, 13:55 Вопрос задала: Улитина Наталья Владимировна (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 3)

Отвечает: Micren Здравствуйте, Улитина Наталья Владимировна! Программа. Суть алгоритма сводится к тому, что отрезки сначала сортируются по одной из своих координат(в данной программе по правому концу отрезка), а затем выбираются отрезки по прядку и проверяется условие не пересечения с последним добавленным в список-результат отрезком. Код: program Pascal_165411; type PCut=^TCut; { Отрезок } TCut=object public constructor Init(ax1,ax2:Integer); function GetX1: Integer; function GetX2: Integer; private x1,x2:Integer; end; PNode=^TNode; { Узел списка } TNode=object private cut:TCut; prev,next:PNode; end; { Список } TList=object(TNode) constructor Init; destruc tor Done;virtual; procedure Add(acut:TCut); { Добавляет отрезок к списку } function GetNext:PCut; { Позволяет идти по списку вперед } function GetSize:Integer; { Возвращает размер списка } private size:Integer; current:PNode; procedure DeleteNode(node:PNode); end; constructor TCut.Init(ax1: Integer; ax2: Integer); begin { Минимальная координата всегда в x1, максимальная в x2 } if ax1<=ax2 then begin self.x1:=ax1; self.x2:=ax2; end else begin self.x1:=ax2; self.x2:=ax1; end; end; function TCut.GetX1: Integer; begin GetX1:=x1; end; function TCut.GetX2: Integer; begin GetX2:=x2; end; constructor TList.Init; begin { Устанавливаем начальные значения для списка } prev:=@self; next:=@self; current:=@self; size:=0; end; { Деструктор. Уничтожает список } destructor TList.Done; begin while size>0 do D eleteNode(next); end; { Удаляет узел списка } procedure TList.DeleteNode(node:PNode); begin if (node<>@self) and (node<>nil) and (size>0) then begin node^.prev^.next:=node^.next; node^.next^.prev:=node^.prev; Dispose(node); Dec(size); end; end; procedure TList.Add(acut:TCut); var node,insertPoint:PNode; begin insertPoint:=next; { Вставляем элемент в список сортируя по x2 по возрастанию для этого ищем позицию вставки } while insertPoint<>@self do begin if insertPoint^.cut.GetX2>acut.GetX2 then break; insertPoint:=insertPoint^.next; end; { Собственно вставка } new(node); node^.cut.Init(acut.GetX1,acut.GetX2); node^.next:=insertPoint; node^.prev:=insertPoint^.prev; insertPoint^.prev^.next:=node; insertPoint^.prev:=node; Inc(size); end; function TList.GetNext:PCut; begin current:=current^.next; { Если уже дошл и до корня вернуть нуль-указатель, иначе указатель на отрезок } if current=@self then GetNext:=nil else GetNext:=@current^.cut; end; function TList.GetSize:Integer; begin GetSize:=size; end; var list,res:TList; inF,outF:Text; N,i,x1,x2,right:Integer; cut:TCut; cutPtr:PCut; begin { Инициализация списка исходных данных } list.Init; { Открываем файлы. Имена файлов задайте какие вам нужно!!! } Assign(inF,'e:file.txt'); Assign(outF,'e:out.txt'); Reset(inF); ReWrite(outF); { Читаем 1ю строку в которой количество отрезков } ReadLn(inF,N); { Читаем отрезки и заносим в список } for i := 1 to N do begin ReadLn(inF,x1,x2); cut.Init(x1,x2); list.Add(cut); end; Close(inF); { Инициализация списка результата } res.Init; { Проходим по списку отрезков } cutPtr:=list.GetNext; while cutPtr<>nil do begin { Исключаем отрез ки левая координата которых меньше границы right - условие не пересечения } if (cutPtr^.GetX1>right) or (res.GetSize=0) then begin res.Add(cutPtr^); { Добавим отрезок к списку. } right:=cutptr^.GetX2; { Изменим границу } end; cutPtr:=list.GetNext; { Следующий элемент } end; { Выводим размер списка результата } WriteLn(outF,res.GetSize); { Идем по списку и ваводим его в файл } cutPtr:=res.GetNext; while cutPtr<>nil do begin WriteLn(outF,cutPtr^.GetX1,' ',cutPtr^.GetX2); cutPtr:=res.GetNext; end; Close(outF); list.Done; res.Done; end. Не забудьте задать имена файлов какие Вам нужно.

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

Вопрос № 165.412

Здравствуйте, прошу помочь мне. Задача: В одномерном массиве, состоящем из 35 вещественных элементов вычислить: а) номер максимального элемента массива. б) приобразовать массив таким образом, чтоб в первой его половине располагались элементы, стоявшие в нечетных , во второй половине в четных позициях. Большое спасибо.

Отправлен: 20.04.2009, 14:00 Вопрос задал: Ложкин Иван Дмитриевич (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Ложкин Иван Дмитриевич! Решение задачи с комментариями в приложении. Приложение: uses crt; const n=35;{размер массива} var a:array[1..n] of real;{тип массива} i,k,j,imx:byte;{счетчики циклов и номер максимального} mx,x:real;{максимальный и буфер для обмена элементов} begin clrscr; randomize; writeln('Массив:'); a[1]:=10*random; {присваиваем значение первому элементу массива, случайное вещественное число в интервале (0;10)} write(a[1]:5:2);{выводим его} mx:=a[1];imx:=1;{пока оно максимальное и номер его=1} for i:=2 to n do{остальной массив} begin a[i]:=10*random;{присваиваем значения} if a[i]>mx then{если больше предыдущего максимального} begin mx:=a[i];{это максимум} imx:=i;{его номер} end; write(a[i]:5:2);{выводим остальной массив} end; writeln; writeln('Номер максимального=',imx); k:=0;{перестановок пока нет} for i:=2 to n do{идем по массиву, первое переставлять не надо} if odd(i)then {если индекс нечетный} begin x:=a[i];{запомним число} k:=k+1;{считаем перестановку} for j:=i downto k+1 do{от этого номера до предыдущего переставленного+1} a[j]:=a[j-1];{сдвигаем все на 1 вправо} a[k+1]:=x;{на освободившееся место ставим запомненное число} end; writeln('Перестановка:'); for i:=1 to n do write(a[i]:5:2); readln end.

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

Вопрос № 165.431

Определить делителем каких чисел a,b,c является число k.

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

Отвечает: Proce Здравствуйте, Dimasic59! Код программы в приложении. Приложение: program z_165431; var a, b, c, k: Integer; begin Write('Vvedite chislo a>'); ReadLn(a); Write('Vvedite chislo b>'); ReadLn(b); Write('Vvedite chislo c>'); ReadLn(c); Write('Vvedite chislo k>'); ReadLn(k); if ((a mod k) = 0) or ((a mod k) = 0) or ((a mod k) = 0) or ((a mod k) = 0) then begin Write('Chisla, deliashiesia na ', k, ': '); if (a mod k) = 0 then Write(a, ';'); if (b mod k) = 0 then Write(b, ';'); if (c mod k) = 0 then Write(c, ';'); writeln end else writeln('Takih chisel net'); readln end.

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

Отвечает: Spirit87 Здравствуйте, Dimasic59! очень просто, через функцию mod Приложение: if a mod k = 0 then //делитель а else if b mod k = 0 then // делитель b else if с mod k = 0 then //делитель c

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

Отвечает: Киселева Светлана Александровна Здравствуйте, Dimasic59! Может мой вариант решения Вам больше понравится. Если остаток от деления чисел a или b или c на k равен 0 (делятся нацело), то k - делитель. Остаток от деления находится при помощи mod и сравнивается с нулем. Еще я завела переменную fl, которая меняет произвольное начальное значение (я взяла 0) на другое (я понменяла на 1), если ХОТЯ БЫ ОДНО из чисел окажется кратным для k. Если этого не произойдет, то fl останется равным 0, тогда нужно выдать сообщение, что k не является делителем ни одного из этих чисел. program delitel; var a,b,c,k:integer; fl:byte; Begin write('a='); readln(a); write('b='); readln(b); write('c='); readln(c); write('k='); readln(k); fl:=0; if a mod k=0 then begin writeln('k - delitel chisla a'); fl:=1 end; if b mod k=0 then begin writeln('k - delitel chisla b'); fl:=1 end; if c mod k=0 then begin writeln('k - delitel chisla c'); fl:=1 end; if fl=0 then writeln('k ne yavlyaetsya delitelem a,b,c'); readln END. --------- Если помочь другим в твоих силах - помоги!

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

Вопрос № 165.453

Доброго времени суток.Заданное число, от 1 до 1999, напечатать римскими цифрами XLVI и т.д. Вводвывод в файл. Код в приложении. Задание: оптимизировать код так, чтобы из файла считывалось не число, а несколько. Например сейчас если в файле будет 1 2 3 4, то переведется тока 1, а надо чтобы все перевелись. Желательно использование процедур, функций. Заранее спасибо. Приложение: program lab5; uses crt; var scratch,fo,fz: string; i: integer; decimal: longint; fo1,fz1:text; const Romans: array[1..13] of string = ('I', 'IV', 'V', 'IX', 'X', 'XL', 'L', 'XC', 'C', 'CD', 'D', 'CM', 'M'); Arabics: array[1..13] of Integer = (1, 4, 5, 9, 10, 40, 50, 90, 100, 400, 500, 900, 1000); begin clrscr; writeln('Vvedite imya faila s celochilennim znacheniem'); readln(fo); assign(fo1,fo); writeln('Vvedite imya faila s konechnim znacheniem'); readln(fz); assign(fz1,fz); reset(fo1); rewrite(fz1); read(fo1,decimal); for i := 13 downto 1 do while (Decimal >= Arabics[i]) do begin Decimal := Decimal - Arabics[i]; scratch := scratch + Romans[i]; end; write(fz1,scratch); close(fo1); close(fz1); readln; readkey; end.

Отправлен: 20.04.2009, 21:14 Вопрос задал: Bel9illi (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 4)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Bel9illi! Решение с функцией для перевода многих чисел из файла в приложении. Приложение: program lab5; uses crt; const Romans: array[1..13] of string = ('I', 'IV', 'V', 'IX', 'X', 'XL', 'L', 'XC', 'C', 'CD', 'D', 'CM', 'M'); Arabics: array[1..13] of Integer = (1, 4, 5, 9, 10, 40, 50, 90, 100, 400, 500, 900, 1000); function Roman(Decimal:integer):string;{функция перевода} var i: integer; scratch:string; begin scratch:='';{сначала строка пустая} for i := 13 downto 1 do while (Decimal >= Arabics[i]) do begin Decimal := Decimal - Arabics[i]; scratch := scratch + Romans[i]; end; Roman:=scratch;{результат} end; var fo,fz,rim: string; arb:integer; fo1,fz1:text; begin clrscr; writeln('Vvedite imya faila s celochilennim znacheniem'); readln(fo); assign(fo1,fo); writeln('Vvedite imya faila s konechnim znacheniem'); readln(fz); assign(fz1,fz); reset(fo1); rewrite(fz1); while not eof(fo1) do{пока не конец файла} begin read(fo1,arb);{читаем очередное число} write(fz1,Roman(arb),' ');{преобразуем и записываем в новый файл} end; close(fo1); close(fz1); write('Fail zapisan!'); readkey end.

Ответ отправил: Пупорев Юрий Борисович (статус: Специалист) Ответ отправлен: 21.04.2009, 06:43 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 247945 на номер 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