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

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

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

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

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

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

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

Выпуск № 809
от 15.02.2009, 01:35

Вопрос № 159993: Помогите нарисовать треугольник через процедуру,с помощью одного оператора, вот например я написал uses graph,graphhelp; begin; opengraph; treug(120,240,240,350,350,120); readln; closegraph; end.? Где:treug-новый оператор, а g...

Вопрос № 159.993

Помогите нарисовать треугольник через процедуру,с помощью одного оператора, вот например я написал uses graph,graphhelp; begin; opengraph; treug(120,240,240,350,350,120); readln; closegraph; end.? Где:treug-новый оператор, а graphhelp-новый модуль)))) Но теперь мне надо написать ее через процедурую Помогите плиз)))

Отправлен: 09.02.2009, 12:11 Вопрос задал: Цуба Андрей Федорович (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 2)

Отвечает: Шевченко Дмитрий Здравствуйте, Цуба Андрей Федорович! Не очень понял, что же Вам надо - то ли просто написать процедуру для рисования треугольника, то ли написать модуль graphhelp, чтобы Ваш код работал, поэтому сделал и то и другое - смотрите код в приложении. Если что не понятно - обращайтесь в аську(пишите, что вы с RusFAQ), или в личку. С уважением, Дмитрий. Приложение: {Если надо сделать просто через процедуру: } uses graph; procedure treug(x1,y1,x2,y2,x3,y3:Word); begin MoveTo(x1,y1);{перемещаем курсор в первую точку} LineTo(x2,y2);{рисуем треугольник} LineTo(x3,y3); LineTo(x1,y1); end; var GrDrv,GrMode:Integer; begin; GrDrv:=Detect;{определяем драйвер, необходимый для графического режима} InitGraph(GrDrv,GrMode,'');{открываем графическое окно} treug(120,240,240,350,350,120);{рисуем треугольник} readln; closegraph; end. {Если надо сделать через свой модуль:} {создаёте файл graphhelp.tpu, туда пишете то что написано ниже и компилируете - создаётся файл с модулем. Запускать с помощью Вашего кода} unit graphhelp; Interface procedure opengraph; procedure treug(x1,y1,x2,y2,x3,y3:Word); Implementation uses graph; procedure opengraph; var GrDrv,GrMode:Integer; begin; GrDrv:=Detect; InitGraph(GrDrv,GrMode,''); end; procedure treug(x1,y1,x2,y2,x3,y3:Word); begin MoveTo(x1,y1); LineTo(x2,y2); LineTo(x3,y3); LineTo(x1,y1); end; end.

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

Вопрос № 160.022

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

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

Отвечает: Motoden Здравствуйте, Gorelkovmisha! Программа выполняющая пункт (а) в приложении. В условии пункта (б) по-моему ошибка. Матрица А в условии не фигурирует. Приложение: program m; uses CRT; type matr=array[1..10,1..10] of real; var i,j,k,z,n:integer; t:real; x:char; a,b,c:matr; procedure vvod_matrix(var n:integer; var matrix1:matr); var ii,jj:integer; begin writeln('Vvedite poryadok matrixi:'); write('n='); readln(n); writeln('Vvedite elementi matrixi:'); for ii:=1 to n do begin for jj:=1 to n do begin write('[',ii,',',jj,']='); readln(matrix1[ii,jj]); end; end; end;{vvod matrixi} procedure vivod_matrix(n:integer; matrix1:matr); var jj,ii:integer; begin ii:=0; while ii<n do begin ii:=ii+1; jj:=0; while jj<n-1 do begin jj:=jj+1; write(matrix1[ii,jj]:3:0); end; jj:=jj+1; writeln(matrix1[ii,jj]:3:0); end; end;{vivod matrixi} begin ClrScr; repeat writeln('Viberite nomer operacii:'); writeln(' 0-transponirovanie'); writeln(' 1-slojenie matrix'); writeln(' 2-umnojenie matrix'); readln(z); case z of 0: begin vvod_matrix(n,A); vivod_matrix(n,A); for i:=1 to n do begin for j:=1 to n do begin b[i,j]:=a[j,i]; end; end; writeln; writeln('Rezultat:'); vivod_matrix(n,B); end; 1: begin vvod_matrix(n,A); vivod_matrix(n,A); vvod_matrix(n,B); vivod_matrix(n,B); for i:=1 to n do begin for j:=1 to n do begin c[i,j]:=a[i,j]+b[i,j]; end; end; writeln; writeln('Rezultat:'); vivod_matrix(n,c); end; 2: begin vvod_matrix(n,A); vivod_matrix(n,A); vvod_matrix(n,B); vivod_matrix(n,B); for i:=1 to n do begin for j:=1 to n do begin t:=0; for k:=1 to n do begin t:=t+a[i,k]*b[k,j]; end; c[i,j]:=t; end; end; writeln; writeln('Rezultat:'); vivod_matrix(n,c); end; end; writeln('Povtor? (y/n)'); x:=readkey; until x=char(ord('n')); end.

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

Вопрос № 160.028

Дорогие эксперты помогите пожалуйста решить задачку: дано натуральное число n, проверить будут ли все цифры числа различными!! P.S. Я знаю что такая задача уже обсуждалась, но надо только через DIV и MOD в Паскале Pleease!! а то из-за одной задачки до сессии не допускают...((

Отправлен: 09.02.2009, 18:29 Вопрос задала: Popkova Yuliya Nikolaeva (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Micren Здравствуйте, Popkova Yuliya Nikolaeva! Программа кроме проверки печатает встречающиеся повторно цифры: Код: program Pascal_160028; { Основание системы счисления } const CBase=10; { Диапазон цифр в числе } type TDigits=0..CBase-1; var t,i:TDigits; DigitsSet,Match:set of TDigits; { Множества присутствующих цифр и повторно встретившихся } N:LongInt; begin { Вводим число } Write('Enter number:'); ReadLn(N); { Пока есть цифры } while N<>0 do begin { Берем цифру } t:=N mod CBase; { Отсекаем последнюю } N:=N div CBase; { Если уже встречалась } if t in DigitsSet then Match:=Match+[t] { Добавим в повторно встретившиеся } else DigitsSet: =DigitsSet+[t]; { Добавим в первый раз встретившиеся } end; { Если нет повторно встретившихся } if Match=[] then WriteLn('All digits are different') else begin { Если есть повторы печатаем их } Write('Not all digits are different: ['); for i := 0 to CBase-1 do if i in Match then Write(i,','); WriteLn(#8,']'); end; ReadLn; end. В принципе печатать совпадающие цифры не требуется. Поэтому вот программа без этого. Код: program Pascal_160028; { Основание системы счисления } const CBase=10; { Диапазон цифр в числе } type TDigits=0..CBase-1; var t:TDigits; DigitsSet:set of TDigits; N:LongInt; Different:Boolean; be gin { Вводим число } Write('Enter number:'); ReadLn(N); { Пока есть цифры } Different:=true; while (N<>0) and Different do begin { Берем цифру } t:=N mod CBase; { Отсекаем последнюю } N:=N div CBase; { Если уже встречалась } if t in DigitsSet then Different:=false else DigitsSet:=DigitsSet+[t]; { Добавим в первый раз встретившиеся } end; { Если нет повторно встретившихся } if Different then WriteLn('All digits are different') else Write('Not all digits are different'); ReadLn; end. Выбирайте какая Вам больше нравится.

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

Вопрос № 160.040

Доброго времени суток! Помогите решить задачу, тема файлы. Дана непустая последовательность слов, содержащих от 1 до 8 букв; между соседними словами -- запятая, за последним словом -- точка. Напечатать все слова, отличные от последнего слова.

Отправлен: 09.02.2009, 20:42 Вопрос задал: Korniychug Petro Dmytrovich (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Mixala Здравствуйте, Korniychug Petro Dmytrovich! Все вроде просто - в первом цикле вводиться весь текст, разбивается на слова, их количество n. Потом в цикле перебираются все слова и сравниваются с последним, если не совпали, то выводятся в столбик. Приложение: var s:string; a:array[1..100] of string; i,n:integer; begin Read(s); //читаем сразу всю посл-ть n:=1; For i:=1 to length(s) do begin if s[i]='.' then break; if s[i]=',' then begin n:=n+1; continue; end; a[n]:=a[n]+s[i]; end; For i:=1 to n do if a[i]<>a[n] then WriteLn(a[i]); end;

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

Отвечает: Зенченко Константин Николаевич Здравствуйте, Korniychug Petro Dmytrovich! Программа в приложении. Строка Seek(e,FileSize(e)-10); отвечает за перемещение указателя в файле на позицию десять символов(запятая, слово максимум 8 символов и точка) до конца файла(такой вариант работает при условии, что исходный файл записан правильно и после точки нет других символов). Без этой строки можно обойтись, но это получается двойной просмотр файла, который увеличивает время работы программы(такой вариант будет работать только до первой точки в файле). Удачи! Приложение: var a,b:string; c:char; d:longint; e:file of char;{TEXT} f:text; begin assign(e,'inp.txt'); reset(e); assign(f,'out.txt'); rewrite(f); Seek(e,FileSize(e)-10); a:=''; {поиск последнего слова} repeat read(e,c); if c=',' then a:=''{сбрасываем текущее слово, т.к. оно не последнее} else if c<>'.'then a:=a+c; until eof(e)or(c ='.'); {начинаем просмотр и запись} reset(e); b:=''; repeat read(e,c); if c=',' then begin{проверяем совпадение и сбрасывает текущее слово} if b<>a then write(f,b,c); b:=''; end else if c<>'.'then b:=b+c; until eof(e)or(c ='.'); write(f,a,'.'); close(e): close(f); end. --------- Итерация от человека, рекурсия — от Бога (Питер Дойч)

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

Вопрос № 160.041

Доброго времени суток! Помогите решить задачу, тема Указатели и динамическая память: Описать функцию или процедуру, которая: меняет местами первый и последний элементы непустого списка L;

Отправлен: 09.02.2009, 20:45 Вопрос задал: Korniychug Petro Dmytrovich (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 4)

Отвечает: Зенченко Константин Николаевич Здравствуйте, Korniychug Petro Dmytrovich! Программа в приложении. Коментировал только процедуру modifyList. Программа написана под ТР 7.0. Удачи! Приложение: type isType=^isList; isList=record data:integer; next:isType; end; var a:isType; procedure createList(var d:isType;c:integer); var b:isType; begin while c>0 do begin new(b); b^.data:=random(20); b^.next:=d; d:=b; dec(c); end; end; procedure outputList(b:isType); begin while b<>nil do begin write(b^.data:4); b:=b^.next; end; end; procedure modifyList(var b:IsType); var c:isType; begin c:=b; {ищем конец списка} while c^.next^.next<>nil do c:=c^.next; {закольцовываем его исключая первый элемент} c^.next^.next:=b^.next; {устанавливаем первый элемент перед последним} b^.next:=c^.next; {переключаем связи} c^.next:=b; {сохраняем голову списка и разрываем кольцо} b:=b^.next; c^.next^.next:=nil; end; procedure deleteList(var b:isType); var c:isType; begin repeat c:=b; b:=b^.next; dispose(c); until b=nil; end; begin {создаем список} a:=nil; createList(a,10); {выводим исходный список} outputList(a); writeln; {изменяем список} modifyList(a); {выводим результат и освобождаем память} outputList(a); deleteList(a); readln; end. --------- Итерация от человека, рекурсия — от Бога (Питер Дойч)

Ответ отправил: Зенченко Константин Николаевич (статус: Профессор) Украина, Киев Тел.: +380979536619 Адрес: Украина г.Киев ---- Ответ отправлен: 10.02.2009, 14:14 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 243333 на номер 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