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

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

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

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

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

Зенченко Константин Николаевич Статус: Профессор Рейтинг: 74 ∙ повысить рейтинг >>

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

Выпуск № 797
от 01.02.2009, 02:35

Вопрос № 158756: уважаемые эксперты помогите решить, программа pascalABC: Графика в Паскале. Нарисовать правильный шестиугольник. Очень прошу оставьте коментарии к каждой функции...

Вопрос № 158.756

уважаемые эксперты помогите решить, программа pascalABC: Графика в Паскале. Нарисовать правильный шестиугольник. Очень прошу оставьте коментарии к каждой функции

Отправлен: 26.01.2009, 00:44 Вопрос задал: Давыдов Артём Аркадьевич (статус: 1-й класс) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Зенченко Константин Николаевич Здравствуйте, Давыдов Артём Аркадьевич! Программа в приложении, на PascalABC. Удачи! Приложение: uses crt,graphABC; const r=50; var x,y,z:integer; begin y:=WindowHeight div 2;{считаем центр экрана} x:=WindowWidth div 2;{считаем центр экрана} z:=0;{начальный угол} MoveTo(x+Round(r*cos(2*z*Pi/360)),y+Round(r*sin(2*z*Pi/360)));{начальная точка} repeat inc(z,60);{следующий угол} LineTo(x+Round(r*cos(2*z*Pi/360)),y+Round(r*sin(2*z*Pi/360)));{рисуем линию} until 360<=z; ReadKey; end. --------- Итерация от человека, рекурсия — от Бога (Питер Дойч)

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

Отвечает: Boriss Здравствуйте, Давыдов Артём Аркадьевич! Известно, что описание - это нечто вроде поноса для программиста. Так что написал комментарии самые минимальные - лучше спрашивайте, что не понятно в минифоруме Сделал двумя способами: первый "простой" - через LineTo, которая вычерчивает линию "из данной (прежней) точки" (где закончилось предыдущее рисование или куда перемещен графический курсор с помощью MoveTo) в новую, координаты которой указаны как параметры Второй еще проще - с помощью процедуры рисования многоугольников DrawPoly. Ей передается число вершин и массив специального состава Приложение: uses Graph; CONST R1 = 200; R2 = 100; TYPE corner = record {Новый тип = описание одной вершины} x, y: Integer; end; var grDriver: Integer; grMode: Integer; ErrCode: Integer; x_center, y_center, i: Integer; fi: Real; corners: array[1 .. 13] of corner; begin grDriver := Detect; InitGraph(grDriver, grMode,'D:BPBGI'); {} ErrCode := GraphResult; if ErrCode = grOk then begin { Do graphics } x_center := GetMaxX div 2; y_center := GetMaxY div 2; {Коордианты вершин} for i:= 0 to 5 do begin fi := pi*i*60/180; corners[i*2+1].X := x_center + Round(R1*sin(fi)); corners[i*2+1].Y := y_center + Round(R1*cos(fi)); fi := fi + 30*pi/180; corners[i*2 + 2].X := x_center + Round(R2*sin(fi)); corners[i*2 + 2].Y := y_center + Round(R2*cos(fi)) end; corners[13] := corners[1]; {"замыкание" - для этого и нужно 13, а не 12 вершин} MoveTo(corners[1].X, corners[1].Y); for i:=2 to 12 do LineTo(corners[i].X, corners[i].Y); LineTo(corners[1].X, corners[1].Y); Readln; {Второй способ с помощью стандартной процкдуры DrawPoly} ClearViewPort; SetColor(LightRed); DrawPoly(13, corners); ReadLn; CloseGraph; end else Writeln('Graphics error:', GraphErrorMsg(ErrCode)); end. --------- Вывод - то место в тексте, где вы устали думать

Ответ отправил: Boriss (статус: Профессор) Россия, Саранск Организация: Мордовский госуниверситет, Саранск, Факультет Электронной Техники WWW: Программирование на Паскале ICQ: 320096696 ---- Ответ отправлен: 26.01.2009, 13:08 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 242188 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Вопрос № 158.815

Уважаемые эксперты помогите пожалуйста сделать 1 задания. Очень нужна ваша помощь. Вот задание: Дана последовательность, содержащая от 1 до 30 слов, в каждом из которых от 1 до 5 прописных латинских букв; между соседними словами - запятая, за последним словом - точка. Напечатать:те слова, перед которыми в последовательности находятся только меньшие (по алфавиту) слова, а за ними - только большие

Отправлен: 26.01.2009, 15:16 Вопрос задал: Кузьменко Денис Евгеньевич (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 3)

Отвечает: Boriss Здравствуйте, Кузьменко Денис Евгеньевич! В приложении код программы, решающей Вашу задачу. Для простоты понимания выделяю (формирую) вспомогательные слова. Можно было не делать такого, а обойтись одними положениями разрывов слов. По-моему, логика простая, но ... при реализации возможны ошибки (увы). Проверьте. Если хотите вводить свою строку, то перед (или вместо) WriteLn(src); напишите ReadLn(src); Типизированная константа (src в нашем случае) допускает возможность изменения. Но код будет работать правильно, если есть в введенной строке точка (см. условие). Если нет, то .... сейчас чуть изменю так, чтобы в этом случае не работала программа Приложение: CONST breaks: Set of char = ['.',',']; {Символы разрывов строк} src: String = 'aaaa,babab,ccc,ddd,daf,gggg,hhh.kkkk'; VAR WordBreak: Array[1..30] of Integer; {границы слов} s1, s, s2: String; maxChar, minChar: Char; j, i, k, count: Integer; BEGIN WriteLn; WriteLn(src); if POS('.', src) = 0 then begin WriteLn('В введенной строке нет завершающей точки'); Halt(1); {Немедленное завершение программы. Именно ЭТО ДОБАВИЛ} end; {Отмечаем позиции начал слов} j:=1; WordBreak[j]:=0; {Одно-то слово есть} for i:=1 to length(src) do begin if src[i] in breaks then begin inc(j); WordBreak[j] := i; if src[i] = '.' then Break; {Если встретилась точка - немедленный выход из цикла} end; end; WriteLn('Всего слов: ',j-1); {на одно меньше, чем разрывов} {анализируем слова со 2-го по предпоследнее} count := 0; {сколько слов найдено будет. Для вывода сообщения, если таких нет} for i :=2 to j-2 do begin {формирую слова для понятности. Можно легко без этого обойтись} s1 := copy(src, WordBreak[i-1]+1, WordBreak[i] - WordBreak[i-1]-1); s := copy(src, WordBreak[i]+1, WordBreak[i+1] - WordBreak[i] -1); s2 := copy(src, WordBreak[i+1]+1, WordBreak[i+2] - WordBreak[i+1]-1); {Находим максимальый символ в предыдущем} maxChar := s1[1]; for k:=2 to length(s1) do if s1[k] > maxChar then MaxChar := s1[k]; {Находим минимальный в данном} minChar := s[1]; for k:=2 to length(s) do if s[k] < minChar then minChar := s[k]; if minChar < maxChar then Continue; {Если минимальный символ в "этом" меньше максимально в предыдущем, то условие не выполнено. Вся остальная часть цикла игнорируется и переходим к следуеющему i} {Анализ слующей пары} maxChar := minChar; minChar := s2[1]; for k := 2 to length(s2) do if s2[k] < minChar then minChar := s2[k]; if minChar < maxChar then Continue; {аналогично} WriteLn(s); {Вывод слова, удовлетворяющего условию} inc(count); end; if count = 0 then WriteLn('Не найдено слов, удовлетворяющих условию'); END. --------- Вывод - то место в тексте, где вы устали думать

Ответ отправил: Boriss (статус: Профессор) Россия, Саранск Организация: Мордовский госуниверситет, Саранск, Факультет Электронной Техники WWW: Программирование на Паскале ICQ: 320096696 ---- Ответ отправлен: 27.01.2009, 20:22 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 242325 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Вопрос № 158.830

Я в информатике ни бум-бум... а очень нужна программа, точнее две программы: 1) Программа, которая кодирует и декодирует буквы латинского алфавита. Надо использовать код, предложенный Френсисом Бэконом. 2) Программа,которая составляет таблицу из m-позиционного кода для источника с n возможными сообщениями. Мне сказали, что это вроде легко, по школьной программе, но для меня это то же самое, что начать говорить по-китайски. Я ничего не понимаю... Пожалуйста, помогите мне!!!

Отправлен: 26.01.2009, 17:09 Вопрос задала: К. Екатерина Александровна (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 3)

Отвечает: Зенченко Константин Николаевич Здравствуйте, К. Екатерина Александровна! Первая программа в приложении - декодирует если введенная строка состоит только из одних "А" и "В", иначе кодирует эту строку. Если верить источнику, то таблица которой пользовался Ф.Бекон представляет собой двоичный код. Удачи! Приложение: var a,b,c:string; x,y:integer; z:boolean; begin {вводим строку} repeat write('Enter string:'); Readln(a); until length(a)>0; {для контроля} b:=a; z:=true; {контролируем кодирование-декодирование} while (z)and(length(b)>0)do begin z:=(b[1]='A')or(b[1]='B')or(b[1]='a')or(b[1]='b');{} delete(b,1,1);{} end; {проверяем что получилось} if z then begin{Decode} write('Decode:'); b:='';{результат работы} while length(a)>0 do begin {получаем закодированную букву} if length(a)>5 then begin{если длина строки больше} c:=copy(a,1,5); delete(a,1,5); end else begin{если длина строки меньше равнна} c:=a; a:=''; end; x:=0; while length(c)>0do begin{декодируем смещение в алфавите} x:=x*2+ord(c[1]='B'); delete(c,1,1); end; b:=b+chr(ord('a')+x);{записываем очередную букву} end; end else begin{Code} write('Code:'); b:='';{результат работы} while length(a)>0 do begin if a[1]in ['a'..'z']then a[1]:=chr(ord(a[1])-32);{приводим все буквы к одному регистру} x:=ord(a[1])-ord('A');{смещение в алфавите} c:=''; for y:=1 to 5 do begin c:=chr(ord('A')+(x mod 2))+c;{кодируем одну букву} x:=x div 2; end; b:=b+' '+c;{формируем строку, дополнительный пробел - для наглядности} delete(a,1,1);{удаляем закодированный символ} end; end; write(b); readln; end. --------- Итерация от человека, рекурсия — от Бога (Питер Дойч)

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

Вопрос № 158.836

Помогите, пожалуйста, с задачей! Задачу нужно сделать с помощью указателей (создавать списки)и через процедуры. Условие задачи Вводить коэффициенты и степени многочлена, до тех пока не введём 0 0 Вывести на экран результат. (пример) 2 3 4 5 0 0 2x^3+4x^5 Причем выведенный многочлен должен быть с упорядоченными степенями и коэффициентами Затем ввести второй многочлен, выписать его и написать произведение первого и второго многочленов. Отдельно выписать сумму первого и второго многочленов. Т.е. программа должна выписывать: первый многочлен, второй многочлен, их сумму (первого и второго многочленов), их произведение (первого и второго многочленов) Задачу нужно сделать с помощью указателей (создавать списки)и через процедуры.

Отправлен: 26.01.2009, 17:50 Вопрос задал: Abelman (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 2)

Отвечает: Зенченко Константин Николаевич Здравствуйте, Abelman! Программа в приложении. Думаю Вам это нужно, если нет обращайтесь в мини-форум. Удачи! Приложение: {пользовательский тип} type isType=^isList; isList=record x,y:integer; z:isType; end; {преременные основной программы} var a,b:isType; {вывод одного элемента} procedure showOne(x,y:integer); begin write(x);{} if y<>0 then write('*X^',y);{} end; {сотируем по убыванию степеней} procedure sortPolinom(var c:isType); var d,e:isType; begin d:=c; while d^.z<>nil do begin while (d^.y>d^.z^.y)and(d^.z<>nil)do d:=d^.z; if d^.z<>nil then begin e:=d^.z; d^.z:=d^.z^.z; e^.z:=c; c:=e; d:=c; end; end; end; {вводим полином} procedure inputPolinom(var c:isType); var d:isType; e,f:integer; begin c:=nil; repeat write('parametr:');{показатель и степень} readln(e); write('degree:'); readln(f); if(e=0)and(f=0)then break; {ещем в списке введенную степень} d:=c; while (d^.y<>f)and(d<>nil) do d:=d^.z; if d=nil then begin{нет, содаем элемент и включаем его в список} new(d); d^.x:=e; d^.y:=f; d^.z:=c; c:=d; end else inc(d^.x,e); until false; sortPolinom(c); end; {освобождаем занимаемую память} procedure freePolinom(var c:isType); var d:isType; begin while c<>nil do begin d:=c; c:=c^.z; dispose(d);{освобождаем} end; end; {выводим полином на экран} procedure showPolinom(c:isType); begin while c<>nil do{пока не выведем весь список} begin showOne(c^.x,c^.y); c:=c^.z;{следующий элемент} if c<>nil then write(' + ');{если не достигли предела выводим знак} end; writeln; end; {процедура умножения полиномов} procedure multPolinom(c,d:isType); var e,f,g:isType; begin write('Mult Polinoms:'); {будем формировать новый список} g:=nil; while d<>nil do begin {востанавливаем умножаемый список} e:=c; while e<>nil do begin f:=g; {проверяем если такая степень} while (f^.y<>(d^.y+e^.y))and(f<>nil)do f:=f^.z; if f<>nil then inc(f^.x,d^.x*e^.x){есть увеличиваем показатель} else begin{нет дбавляем новый} new(f); f^.x:=d^.x*e^.x; f^.y:=d^.y+e^.y; f^.z:=g; g:=f; end; e:=e^.z; end; d:=d^.z; end; sortPolinom(g); showPolinom(g); freePolinom(g); end; {процедура суммирования} procedure summPolinom(c,d:isType); begin write('Summa Polinoms:'); while (c<>nil)and(d<>nil)do begin if c^.y=d^.y then begin{если степени равны складываем показатели} showOne(c^.x+d^.x,c^.y); c:=c^.z; d:=d^.z; end else if c^.y>d^.y then begin{выводим первый полином} showOne(c^.x,c^.y); c:=c^.z; end else begin{выводим второй полином} showOne(d^.x,d^.y); d:=d^.z; end; if (c<>nil)or(d<>nil)then write(' + '); end; {выводим оставшиеся полиномы} if c<>nil then showPolinom(c); if d<>nil then showPolinom(d); end; begin {вводим первый полином} writeln('Enter First Polinom:'); inputPolinom(a); {вводим второй полином} writeln('Enter Second Polinom:'); inputPolinom(b); {выводим первый полином} write('First Polinom:'); showPolinom(a); {выводим второй полином} write('Second Polinom:'); showPolinom(b); {выполняем задание} multPolinom(a,b); summPolinom(a,b); {освобождаем память} freePolinom(a); freePolinom(b); readln; end. --------- Итерация от человека, рекурсия — от Бога (Питер Дойч)

Ответ отправил: Зенченко Константин Николаевич (статус: Профессор) Украина, Киев Тел.: +380979536619 Адрес: Украина г.Киев ---- Ответ отправлен: 27.01.2009, 18:24 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 242314 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это! Оценка за ответ: 5 Комментарий оценки: Всё понятно и всё работает! Большое спасибо за помощь, тем более, такую быструю!

© 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