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

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

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

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

Шичко Игорь Статус: Практикант Рейтинг: 134 ∙ повысить рейтинг >>

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

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

Выпуск № 762
от 22.12.2008, 08:35

Вопрос № 154549: Даны натуральные числа n, x₁, y₁, x₂, y₂, ... , x_n, y_n. Построить на экране точки с координатами x_i, y_i расположенные в верхней половине экрана....

Вопрос № 154.549

Даны натуральные числа n, x1, y1, x2, y2, ... , xn, yn. Построить на экране точки с координатами xi, yi расположенные в верхней половине экрана.

Отправлен: 16.12.2008, 10:51 Вопрос задал: Иванов Виктор Олегович (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 3)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Иванов Виктор Олегович! Держи 2 варианта, как обещал. Коды в приложении. Приложение: 1. Оконный режим. uses crt; const n=1000; {общее количество точек} type TPoint=record {точку запишем в виде записи, так удобнее} x,y:integer; end; var a:array[1..n] of TPoint; {массив точек} i:integer; begin clrscr; randomize; for i:=1 to n do begin a[i].x:=random(80); {распределяем точки случано по всему экрану} a[i].y:=random(25); end; for i:=1 to n do if a[i].y<25 div 2 then {если выше середины} begin gotoXY(a[i].x,a[i].y); {устанавливаем курсор в точку} TextColor(random(14)+1);{выбираем случайный цвет} write('.');{рисуем точку} end; readln; end. 2. Графический режим. Практически все также. uses crt,graph; {добавляем модуль Graph} const n=1000; type TPoint=record x,y:integer; end; var a:array[1..n] of TPoint; gd,gm,i:integer; begin clrscr; randomize; writeln('Ishodnyj massiv tochek:'); for i:=1 to n do begin a[i].x:=random(640); {размеры экрана в графическом режиме 640х480} a[i].y:=random(480); end; Initgraph(gd,gm,''); {инициализация графического режима} for i:=1 to n do if a[i].y<GetmaxY div 2 then {если выше середины экрана} PutPixel(a[i].x,a[i].y,random(14)+1); {рисуем точку случайным цветом по координатам} readln; closegraph;{выход из графического режима} end.

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

Вопрос № 154.550

Уважаемые эксперты, добрый день. Очень прошу помогите мне с задачами. зарание благодарен. Очень срочно надо просто. 1.Дан символьный файл, содержащий, по крайней мере один символ пробела. Удалить все его элементы, расположенные после последнего символа пробела, включая и этот пробел. 2. Дана матрица размера M ´ N. Преобразовать матрицу, поменяв местами минимальный и максимальный элемент в каждой строке. 3. Дан текстовый файл. Заменить в нем все прописные русские буквы на строчные, а все строчные — на прописные.

Отправлен: 16.12.2008, 11:28 Вопрос задал: Садошенко Александр Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Садошенко Александр ! Решение задачи №2 в приложении. Не пишите по нескольку задач в один вопрос, меньше шансев на ответы. Приложение: uses crt; const m=6; {размеры матрицы} n=8; var a:array[1..m,1..n] of integer; i,j,min,max,jmin,jmax,f:integer; begin clrscr; randomize; writeln('Ishodnaja matrica:');{создание исходной матрицы} for i:=1 to m do begin for j:=1 to n do begin a[i,j]:=random(20); write(a[i,j]:4); end; writeln; end; for i:=1 to m do begin min:=a[i,1];max:=a[i,1];jmin:=1;jmax:=1;{начальные значения} for j:=1 to n do begin if a[i,j]<min then {ищем минимальный в строке} begin min:=a[i,j];{запоминаем} jmin:=j; {запоминаем номер} end; if a[i,j]>max then {тоже с максимальным} begin max:=a[i,j]; jmax:=j; end; end; f:=a[i,jmin]; {меняем с помощью дополнительной переменной найденные элементы местами} a[i,jmin]:=a[i,jmax]; a[i,jmax]:=f; end; writeln('Rezultat:'); for i:=1 to m do begin for j:=1 to n do write(a[i,j]:4); writeln; end; readln end.

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

Вопрос № 154.621

Здравствуйте уважаемые эксперты!Не могли бы вы мне помочь в составлении трёх блок схем по Pascal? 1.Найти количество чисел от 100 до 200,кратных 13. 2.Найти все значения функции x(в кубе)-0,33│2x-1│на отрезке [-10;10] с шагом 2. 3.Поменять местами максимальный элемент матрицы А(8,8) с элементом А(3,3). Буду очень признателен...

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

Отвечает: Ksyasha Здравствуйте, Reper91! Тут блок-схемы по первым двум заданиям http://slil.ru/26449255 Третье чуть позже

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

Вопрос № 154.631

Извините пожалуйста что так часто просто очень нужна эта сортировка, пожалуста помогите. осортировать нужно оба массива одномерный(d[i]) и двумерный (a[i,j]), что то вроде этого: for i:=1 to n do begin for j:=1 to m do if d[i]>d[i+1] then begin c:=a[i,j]; a[i,j]:=a[i+1,j]; a[i+1,j]:=c; k:=d[i]; d[i]:=d[i+1]; d[i+1]:=k; end; end;

Отправлен: 16.12.2008, 20:56 Вопрос задал: S K A L T (статус: 1-й класс) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Зенченко Константин Николаевич Здравствуйте, S K A L T ! Смотрите приложение. Удачи! Приложение: const n=5; var a:array[1..n,1..n]of integer; b:array[1..n]of integer; i,j,c:integer; d:boolean; begin {создаенм массивы и выводим} for i:=1 to n do begin b[i]:=random(20); write(b[i]:3,' ':3); for j:=1 to n do begin a[i,j]:=random(20); write(a[i,j]:3); end; writeln; end; {начинаем сортировку} repeat writeln; d:=true;{флаг окончания сортировки} for i:=1 to n-1 do if b[i]>b[i+1]then for j:=1 to n do begin c:=a[i,j]; a[i,j]:=a[i+1,j]; a[i+1,j]:=c; c:=b[i]; b[i]:=b[i+1]; b[i+1]:=c; d:=false;{сбрасываем флаг сортировки, т.е. была замена} end; {выводи измененого массива} for i:=1 to n do begin write(b[i]:3,' ':3); for j:=1 to n do write(a[i,j]:3); writeln; end; readln; until d; end. --------- Итерация от человека, рекурсия — от Бога (Питер Дойч)

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

Вопрос № 154.638

Здраствуйте, помогите решить задачу на pascal'e Сведения об автомобиле состоят из его марки, номера и фамилии владельца. Создать файл, содержащий сведения о нескольких автомобилях, после чего определить количество автомобилей каждой марки.

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Ахметов Андрей Васильевич! Решение задачи с пояснениями в приложении. Приложение: uses crt; type Tauto=record {тип запись с полями по условию} mar:string[15];{марка} nom:string[15];{номер} fam:string[15];{фамилия} end; var a:Tauto; {переменная типа Tauto для хранения одной записи} f:file of Tauto;{типизированный файл того же типа для хранения всех записей} i,n,k,m:integer; c:char; {символьная переменная для окончания цикла ввода данных} s:array[1..50] of string;{строковый массив для хранения названий марок} begin clrscr; assign(f,'auto.dat'); {связываем переменную с файлом на диске} rewrite(f); {открываем для записи} n:=1;s[n]:=''; {формируем массив названий марок, первый элемент-пустая строка} repeat {заполняем данные} write('Marka: ');readln(a.mar);{вводим марку} m:=0; for i:=1 to n do if s[i]=a.mar then m:=m+1;{смотрим была ли такая марка раньше} if m=0 then {если нет} begin inc(n); s[n]:=a.mar;{заносим ее в массив} end else if m>0 then {если да} begin inc(n); s[n]:=''; {заносим пустую строку} end; write('Nomer: ');readln(a.nom); {вводим номер и фамилию} write('Familia: ');readln(a.fam); write(f,a); {заносим звпись в файл} c:=readkey; {ожидаем команды прекратить ввод данных} until c=#27; {по нажатию Esc прекращаем} clrscr; {очищаем экран} writeln('Informacia o kolichestve auto raznyh marok:'); writeln; for i:=1 to n do {идем по массиву названий марок} if s[i]<>''then {если не пустая строка} begin k:=0; reset(f); {открываем файл для чтения} while not eof(f) do begin read(f,a); {читаем записи} if s[i]=a.mar then k:=k+1; {считаем количество очередной марки} end; writeln('Kolichestvo auto marki ',s[i],'=',k);{выводим} close(f); {закрываем файл, т.к. он прочитан до конца, и все повторяем со следующей маркой} end; readln end.

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

Вопрос № 154.670

Вариант 17 1. Описать структуру с именем ZNAK, содержащую следующие поля: - фамилия, имя; - знак Зодиака; - день рождения (массив из трех чисел). 2. Написать программу, выполняющую следующие действия: - ввод с клавиатуры данных в файл; - вывод на экран информации о людях, родившихся в месяц, значение которого введено с клавиатуры; если таких нет, выдать на дисплей соответствующее сообщение. Приложение: плс помогите с етим заданием

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Speluk! Решение задачи с пояснениями в приложении. Приложение: uses crt; type ZNAK=record {тип запись с полями по условию} fam:string[15]; nam:string[15]; zod:string[15]; roz:array[1..3] of word; end; var a:ZNAK; {переменная типа ZNAK} f:file of ZNAK;{типизиорованный файл для хранения записей} i,k:integer;{счетчики} c:char; {символьная переменная для выхода из цикла добавления данных} ms:word;{переменная для запроса месяца} begin clrscr; assign(f,'zod.dat');{связываем переменную с файлом на диске} rewrite(f);{открываем его для записи} repeat {начинаем вводить данные} write('familia: ');readln(a.fam); write('Imja: ');readln(a.nam); write('Znak zodiaka: ');readln(a.zod); writeln('Data rozdenia: '); repeat {даты вводим с проверкой диаппазона} write('den: ');readln(a.roz[1]); until (a.roz[1]>0)and(a.roz[1] <=31); repeat write('mesjac: ');readln(a.roz[2]); until (a.roz[2]>0)and(a.roz[2]<=12); repeat write('god: ');readln(a.roz[3]); until (a.roz[3]>=1900)and(a.roz[3]<=2008); write(f,a); {заносим запись в файл} c:=readkey; {ожидаем нажатия клавиши} until c=#27; {по нажатию Esc ввод данных прекращается} reset(f); {открываем файл для чтения} clrscr; {очищаем экран} repeat {запрашиваем месяц с проверкой интервала} write('Vvedite mesjac: ');readln(ms); until (ms>0)and(ms<=12); writeln('Informacia o ludjah, rodivshihsja v ',ms,' mesjace:'); writeln; k:=0; {предполагаем что нужной записи нет} while not eof(f) do {пока не кончится файл} begin read(f,a); {читаем записи} if a.roz[2]=ms then {если месяц совпал} begin k:=1; {фиксируем совпадение и выводим информацию на экран} writeln(a.fam,' ',a.nam,' ',a.zod,' ',a.roz[1],'.',a.roz[2],'.' ,a.roz[3]); end; end; if k=0 then write('Rodivshihsja v dannom mesjace net!');{если нет совпадений} close(f); readln end.

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

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