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

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

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

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

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

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

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

Выпуск № 747
от 06.12.2008, 12:05

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

Вопрос № 152.347

Здравствуйте, уважаемые эксперты я решил научится программированию взяв одну из книг где также есть задачи для само выполнения. Я не могу решить одну из задач, не вижу свой ошибки в коде, в приложении текст задачи и мой код. Подскажите в каком месте эта коварная ошибка. Заранее спасибо. Приложение: Текст задания : Составить программу, анализирующую код символа на принадлежность символа к определенной группе. Добавить защиту от "Дурака". Листинг программы: uses crt; label nachalo; var a,b1:char; b2,b3:string; b,c,e,z,b4,b5:integer; begin{1} clrscr; nachalo: readln(a); b2:=a; c:=length(b2); if c<4 then begin{2} goto nachalo; end;{1} for z:=1 to 3 do begin b3:=copy(b2,z,1); val(b3,b4,e); b5:=ord(b4); case b5 of 48..57: writeln('проверка'); else begin{4} writeln(''); goto nachalo; end;{3} end; val(b2,b4,e); b:=ord(b4); case b of 48..57: begin{5} write('Цифры'); end;{4} 65..122: begin{6} write('Буквы ');end;{5} 128..175: begin{7} write(' Буквы');end;{6} 224..241: begin{8} write('Буквы');end;{7} else begin{9} write('Неверный код'); end;{8} readkey; end.{9}

Отправлен: 30.11.2008, 11:45 Вопрос задал: WiniHakStyle (статус: 4-й класс) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 3)

Отвечает: Layer Здравствуйте, WiniHakStyle! В приведенном примере кусок, приведенный в приложении, всегда(!) будет возвращать выполнение к началу. потому как идет присвоение символа строке, а не накапливание символов в строке. Попробуй b2 := a заменить на b2 := b2+a;(см. приложение). И не забывай обнулять b2 перед началом выполнения. если выполнение будет неоднократным. Приложение: как было: b2:=a; c:=length(b2); if c<4 then begin{2} goto nachalo; end;{1} как надо: b2:=b2 + a; c:=length(b2); if c<4 then begin{2} goto nachalo; end;{1}

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

Вопрос № 152.379

Уважаемые эксперты! Помогите мне с решением задачи. На плоскости заданы своими координатами n точек. Составить функцию, определяющую между какими из пар точек самое большое расстояние. Указание: координаты точек занести в массив.

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

Отвечает: Шевченко Дмитрий Здравствуйте, Gudwin! В приложении код программы. Если Вам необходимо вводить точки вручную - замените часть {заполнение массива} на: {заполнение массива} For i:= 1 to N do begin Write('Enter x',i,': '); ReadLn(m[i].x); Write('Enter y',i,': '); ReadLn(m[i].y); end; {основная часть} ..... С уважением, Дмитрий. Приложение: program z152379; const N = 10;{количество точек} type t4k = record{собственный тип, описывающий одну точку (x и y - её координаты)} x,y:Real; end; mas = array[1..N] of t4k;{массив с точками} Function rasst(x1,y1,x2,y2:real):Real;{функция, вычисляющая расстояние между двумя точками} begin rasst:=sqrt(sqr(x2-x1) + sqr(y2-y1)); end; var i,k,max1,max2:Integer; max:Real; m:mas; begin {заполнение массива} Randomize; For i:= 1 to N do begin m[i].x:=Random(100)/10; m[i].y:=Random(100)/10; Write('(',m[i].x:0:1,';',m[i].y:0:1,') '); end; WriteLn(); {основная часть} max1:=1;{точки, между которыми максимальное расстояние} max2:=2; max:=rasst(m[1].x, m[1].y, m[2].x, m[2].y);{считаем максимальным расстояние между первой и второй} For i:= 1 to N-1 do For k:= i+1 to N do{считаем расстояния от i-той точки, до всех последующих (чтобы не считать по 2 раза расстояния)} IF rasst(m[i].x, m[i].y, m[k].x, m[k].y) > max then{если нашли большее расстояние - } begin max:=rasst(m[i].x, m[i].y, m[k].x, m[k].y);{запоминаем его} max1:=i;{и запоминаем пару точек, между которыми это расстояние} max2:=k; end; WriteLn('max. distance = ',max:0:6);{выводим ответ} WriteLn('This is distance between points: ',max1,' and ',max2); end.

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

Вопрос № 152.381

Пожалуйста помогите решить пару задач: №1 Дана целочисленная таблица a[1..m]. Среди элементов таблицы есть хотя бы один отрицательный. Найти сумму S элементов расположенных после отрицательного элемента, затем найти сумму простых множителей числа S. №2 Составить из двух таблиц 3-ю упорядоченную по возростанию Плз помогите если не трудно.....

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Frustyle! Решение задачи №1 в приложении. Приложение: uses crt; const n=10; var a:array[1..n]of integer; {ваша таблица} i,k,j:byte; S,sm:longint; b:boolean; begin clrscr; repeat {цикл ввода и проверки введенных данных} writeln('Введите ',n,' элементов массива:'); for i:=1 to n do read(a[i]); {} readln; k:=0; for i:=1 to n do if a[i]<0 then inc(k); if k=0 then writeln('В масиве нет отрицательного элемента. Повторите ввод'); if k>1 then writeln('В масиве более 1 отрицательного элемента. Повторите ввод'); if a[n]<0 then writeln('Отрицательный элемент последний. Повторите ввод.'); until (k=1); {если выполнены условия, выходим из цикла} for i:=1 to n do if a[i]<0 then {если нашли отрицательное} begin k:=i; {запоминаем его номер} break; {прекращаем поиск} end; S:=0; for i:=k+1 to n do S:=S+a[i]; {от следующего элемента до конца считаем сумму} writeln('Сумма=',S); k:=2;sm:=0; writeln('Простые множители:'); while S>0 do {пока число больше 0} begin b:=true; {делится на очердное число 2,3,5,7…} while k<=S div 2 do {пока делитель меньше половины числа} begin if S mod k=0 then {если делится без остатка} begin write(k,' '); {выводим его} sm:=sm+k; {прибавляем к сумме} S:=S div k; {запоминаем} b:=false; {если больше не делится на это число} break; {заканчиваем} end; inc(k); {переходим к следующему простому числу (сложные делители, типа 4, мы уже исключили)} end; if b then {если болше ни на что не делится} begin write(S); {выводим остаток числа, т.е. последний делитель, если число простое, типа 17, то само число} sm:=sm+S; {прибавляем его} break; end; end; writeln; write('Сумма простых множителей=',sm); readln end.

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

Вопрос № 152.382

обрый день, помогите решить? Составить Паскаль-программу формирования вектора X[i], каждый элемент которого равен количеству положительных элементов i-той строки матрицы А.

Отправлен: 30.11.2008, 16:07 Вопрос задала: Osipova (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: SHERRY Здравствуйте, Osipova! Для удобства возьмём квадратную матрицу. Элементы матрицы сгенерируем автоматически. Элементы вектора будут выводиться в столбик, после вертикальной черты справа от матрицы. Нуль за положительное число не считаем. Код: const n = 5; {порядок матрицы} var ms: array [1..n, 1..n] of integer; {матрицы} v: array [1..n] of integer; {вектор} i,j,count: integer; {вспомогательные элементы} begin randomize; {запускаем генератор случайных чисел} for i:=1 to n do begin count := 0; {предположим, что положительных элементов в строке нет} for j:=1 to n do begin ms[i,j] := random(10)-4; {сгенерируем случайное число в промежутке [-4; 6)} write(ms[i,j]:4) ; {выведем элемент на экран} if ms[i,j] > 0 then inc(count); {если он положительный, то увеличим счётчик на единичку} end; v[i] := count; {элемент вектора = значению счётчика} write(' |', v[i]:5); {выведем значение текущего элемента вектора на экран} writeln; {переход на следующую строку на экране} end; readln; end. Будут вопросы - отписывайтесь в мини-форуме или ЛС. Best regard's! --------- Самурай без меча подобен самураю с мечом, только без меча..

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

Отвечает: Delph Здравствуйте, Osipova! Предлагаю Вашему вниманию немного более универсальный пример, чем в ответе SHERRY. Я предполагаю, что у нас прямоугольная матрица, не обязательно квадратная. При помощи константы MaxValue можно настроить границы значений для элементов матрицы (константа определяет максимальное значение абсолютной величины элементов). Приложение: Program Pr152382; Uses CRT; Const M= 10; N = 12; MaxValue = 100; Var A: Array[1..M, 1..N] of Integer; X: Array[1..M] of Integer; i, j: Integer; Begin ClrScr; TextColor(15); Randomize; Write('Матрица A[', M, '*', N, '] (жёлтым) '); WriteLn('и вектор X[', M, '] (красным):'); WriteLn; for i := 1 to M do begin TextColor(14); X[i] := 0; for j := 1 to N do begin { Заносим в матрицу случайные значения в диапазоне от -MaxValue до +MaxValue } A[i, j] := Random(2 * MaxValue + 1) - MaxValue; Write(A[i, j]: 5); if A[i, j] > 0 then inc(X[i]); end; TextColor(12); WriteLn(' ==> ', X[i]:2); WriteLn; end; TextColor(15); Write('Нажмите <Enter> для выхода из программы...'); ReadLn; End. --------- Сомневайся во всём! Реальность часто бывает не такой, как мы о ней думаем.

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

Вопрос № 152.390

Здравствуйте,уважаемые эксперты помогите мне пожалуйста с решением двух задач: 1.Составить функцию,которая определяет наибольший делитель двух натуральных чисел и привести пример ее использования. 2.Составить функцию,которая определяет сумму всех чисел от 1 до N и привести пример ее использования.

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

Отвечает: SHERRY Здравствуйте, Evela! пример задания любой функции: © Цитата: function имя_функции(var входящие_параметры: тип_параметра): тип_результата_возвращаемого функцией; {локальные переменные могут использоваться только в заданной функции} var переменная1: тип; переменная2: тип; begin {код функции} end; Все выделенные слова - зарезервированные понятия. Основное отличие функции от процедуры: функция возвращает значение, которое можно присвоить переменной соответствующего типа. Код: var a,b: integer; function NOD(var m,n: integer): integer; var rez: integer; begin if n > m then {определим б0льшее число для корректности работы} begin rez := n; n := m; m := rez; end; rez := 0; While (m - n > 0) do begin rez := m - n; m := rez; end; NOD := rez; end; function Sum(var n: integer): integer; var i,rez: integer; begin rez := 0; for i:=1 to n do rez := rez + i; Sum := rez; end; begin a := 6; writeln(sum(a)); b := 13; writeln(NOD(a,b)); readln; end. Будут вопросы - отписывайтесь в мини-форум или ЛС. Best regard's! --------- Самурай без меча подобен самураю с мечом, только без меча..

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

Вопрос № 152.391

Здравствуйте!Помогите решить задачу: Задана последовательность X = (x1, x2, …, x10). Сформировать из неё одномерный массив Y, состоящий из элементов, удовлетворяющих условию: Xi>=P, где p - произведение элементов массива X, имеющих чётные индексы. Если таковых не окажется, вывести фразу «Искомых элементов нет». Полученный массив напечатать в столбик. X = {2.95, 7.34, -4.2, 0.5, -4.9, 0.22, 0.35, 1, 10.1, 12}.

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

Отвечает: Layer Здравствуйте, Angelika! См. код ниже. Проверял в Delphi - работает. Pascal в чистом виде под рукой не нашел, но уверен в положительном результате. Добавлено приложение. -------- ∙ Отредактировал: Зенченко Константин Николаевич, Профессор ∙ Дата редактирования: 30.11.2008, 20:46 (время московское) Приложение: uses crt; const ARRAYLENGTH = 10; var p: real; x: array[1..ARRAYLENGTH] of real = (2.95, 7.34, -4.2, 0.5, -4.9, 0.22, 0.35, 1, 10.1, 12); y: array[1..ARRAYLENGTH] of real; elcount: integer; i: integer; begin p := 1; for i:=2 to ARRAYLENGTH do if (i mod 2)=0 then p := p * x[i]; elcount := 1; for i:=1 to ARRAYLENGTH do if x[i]>=p then begin y[elcount] := x[i]; inc(elcount); end; if elcount < 2 then writeln('Искомых элементов нет') else for i:=1 to elcount-1 do writeln(y[i]:5:2); readln; end.

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

Вопрос № 152.401

Здравствуйте уважаемые эксперты! Помогите решить задачу: ------------------------------------------------------------------------------------- Определить объект TFish — аквариумная рыбка. Рыбка имеет координаты, скорость, размер, цвет, направление движения. Методами объекта являются: ∙ Init — устанавливает значения полей объекта и рисует рыбу на экране методом Draw. ∙ Draw — рисует рыбу в виде уголка с острием в точке Coord и направленного острием по ходу движения рыбы. ∙ Look — проверяет несколько точек на линии движения рыбы. Если хоть одна из них отличается по цвету от воды, возвращаются ее цвет и расстояние до рыбы. ∙ Run — перемещает рыбу в текущем направлении на расстояние, зависящее от текущей скорости рыбы. Иногда случайным образом меняет направление движения рыбы. Если рыба видит препятствие, направление движения меняется, пока препятствие не исчезнет из поля зрения рыбы.

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

Отвечает: Verena Здравствуйте, Саубанов Ильгам Инсафович! Для примера рассмотрю случай для четырёх направлений (т.е. рыба может плыть только вверх, вниз, направо или налево). Для большего числа направлений задача решается аналогично. Метод Init реализован процедурой, не конструктором. Рыба состоит из двух перпендикулярных линий с началом в заданной точке и длиной примерно равной размеру рыбы (рассчитываются как диагонали равнобедренного прямоугольного треугольника). Цветом воды считается чёрный. Функция Run имеет в теле бесконечный цикл, бесконечно перемещая рыбу с заданной скоростью по экрану (если необходимо сделать её одноразовой, т.е. единожды переместить рыбу на какое-то расстояние, достаточно просто избавиться от цикла и незначительно изменить код). PS: Думаю, как создавать и использовать объекты Вы поймёте из примера, потому не буду на этом останавливаться. Код в приложении, всё должно быть ясно из комментариев. Удачи! Приложение: Uses crt, Graph; Const Xlimit = 639; {Предел экрана по х} Ylimit = 479; {Предел по у} Type TFish = object {Объект рыба} x, y: word; {Координаты} v: word; {Скорость} size: word; {Размер} color: word; {Цвет} dir: 1..4; {1 - налево, 2 - направо, 3 - вверх, 4 - вниз} procedure Init (x0, y0: word; v0: word; sz: word; col: word; dir0: byte); {инициализация} procedure Draw; {процедура отрисовки } procedure Eraze; {Процедура стирания} procedure Look (var col: word; var l: integer); {процедура поиска препятствия} procedure Run; {Процедура движения} end; procedure TFish.Init (x0, y0: word; v0: word; sz: word; col: word; dir0: byte); begin x:= x0; {Инициализация всех элементов} y:= y0; v:= v0; size:= sz; color:= col; dir:= dir0; Draw; end; procedure TFish.Draw; var dim: integer; {Сдвиг по координате} begin SetColor (color); {Устанавливаем цвет} MoveTo (x, y); {Идём на нос рыбы} dim:= Round (size/sqrt(2)); {Находим смещение (считаем размер диагональю прямоугольного треугольника)} case dir of {Выбираем направление движения и рисуем рыбу в ту сторону носом} 1: begin LineTo (x+dim, y+dim); MoveTo (x, y); LineTo (x+dim, y-dim); end; 2: begin LineTo (x-dim, y+dim); MoveTo (x, y); LineTo (x-dim, y-dim); end; 3: begin LineTo (x+dim, y+dim); MoveTo (x, y); LineTo (x-dim, y+dim); end; 4: begin LineTo (x-dim, y-dim); MoveTo (x, y); LineTo (x+dim, y-dim); end; end; end; procedure TFish.Eraze; {Стереть рыбу на текущей позиции} var dim: integer; begin SetColor (0); {Устанавливаем на цвет воды (чёрный)} MoveTo (x, y); {Дальше всё аналогично} dim:= Round (size/sqrt(2)); case dir of 1: begin LineTo (x+dim, y+dim); MoveTo (x, y); LineTo (x+dim, y-dim); end; 2: begin LineTo (x-dim, y+dim); MoveTo (x, y); LineTo (x-dim, y-dim); end; 3: begin LineTo (x+dim, y+dim); MoveTo (x, y); LineTo (x-dim, y+dim); end; 4: begin LineTo (x-dim, y-dim); MoveTo (x, y); LineTo (x+dim, y-dim); end; end; end; procedure TFish.Look (var col: word; var l: integer); var i, dx, dy: integer; begin case dir of {Ищем коэффициент смещения по координатным осям} 1: begin dx:= -1; dy:= 0; end; 2: begin dx:= 1; dy:= 0; end; 3: begin dx:= 0; dy:= -1; end; 4: begin dx:= 0; dy:= 1; end; end; for i:=1 to 2*size+v do {Проверяем точки на два размера вперёд плюс скорость} if (GetPixel (x+dx*i, y+dy*i)<>0) then {Если попался цвет не воды} begin col:= GetPixel (x+dx*i, y+dy*i); {Запоминаем и выходим} l:= i; break; end; end; procedure TFish.Run; {Движение} var dx, dy: integer; col: word; l: integer; begin randomize; while true do {В бесконечном цикле} begin case dir of {Вычисляем коэффициент смещения} 1: begin dx:= -1; dy:= 0; end; 2: begin dx:= 1; dy:= 0; end; 3: begin dx:= 0; dy:= -1; end; 4: begin dx:= 0; dy:= 1; end; end; l:= -1; {Значение расстояния до препятствия} Look (col, l); {Ищем препятствие} if (x+dx*v+size>Xlimit) or (y+dy*v+size>Ylimit) or (l>0) or (x+dx*v-size<0) or (y+dy*v-size<0) then {Если координаты выходят за пределы экрана или нашлось препятствие} begin Eraze; {Стираем рыбу} dir:= random (4)+1; {Выбираем новое направление} continue; {Переходим на следующую итерацию} end; Eraze; {Стираем рыбу} x:=x+dx*v; y:= y+dy*v; {Даём ей новые координаты} Draw; {Рисуем на новом месте} delay (9000); {Ждём для эффекта анимации} end; end; Var fish: TFish; grDriver, grMode, ErrCode: integer; grPath: string; begin {пример использования} grDriver:= VGA; {Режим} grMode:= VGAHi; {Разрешение 640х480} grPath:= 'c: p7'; {Каталог с файлом драйвера egavga.bgi} InitGraph (grDriver, grMode, grPath); ErrCode:= GraphResult; {Проверяем, успешна ли инициализация} if ErrCode<>grOk then {Если нет - выходим из программы} Begin Writeln ('Ошибка инициализации графического режима'); Halt (1); End; SetColor (2); {Нарисуем препятствие - две зелёные линии} MoveTo (0, 200); LineTo (200, 0); MoveTo (0, 200); LineTo (200, 200); fish.Init (300, 200, 5, 50, 4, 1); {Инициализируем рыбу} fish.Run; {Запускаем движение} end. --------- Эта история - не для истории, понимаешь?

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

Вопрос № 152.415

Уважаемые эксперты: создать файл произвольных символов. Создать файл символов, встречающихся в заданом файле один раз. Вывести на экран содержимое файлов.

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

Отвечает: Костя Симанович Здравствуйте, Парейко Сергрей Николаевич! Так как вы не указали какими символами заполнять файл, я решил заполнить одиночными заглавными латинскими буквами. Случайное число генерируется функцией random, а символ возвращается функцией chr. Они записываются в файл dann.txt, паралельно формируется массив из этих же символов. Дальше обрабатываем массив и неповторяющиеся символы записываем во второй файл (dann1.txt), который также выводим на экран. Оба файла записываются на диск С. Надеюсь помог. Удачи. Приложение: program fil; const n = 20; // кол-во эл-ов файла можно поменять var f, f1 : text; mass : array[1..n] of char; ch : char; a : integer; // номер символа i, j : integer; b : boolean; begin writeln('Генерируем файл.'); assign(f, 'c:dann.txt'); // основной файл assign(f1,'c:dann1.txt');// дополнительный rewrite(f); // открываем на запись randomize; for i := 1 to n do begin a := random(26)+65; //номер счучайного символа от A до Z writeln(f, chr(a)); // записываем в файл случайный символ write(chr(a), ' '); // выводим на экран mass[i] := chr(a); // записываем в массив end; close(f); // выше сформировали файл, его можно просмотреть любым редактором // ниже начнём обработку rewrite(f1); //открываем второй на запись writeln; writeln('Ниже символы которые не повторяются. Это содержимое второго файла.'); writeln; for i := 1 to n do begin b := false; ch := mass[i]; for j := i+1 to n do if ch = mass[j] then b := true; // проверяем совпадения if not b then begin writeln(f1, ch); b := false; write(ch, ' '); end; end; close(f1); writeln; writeln('Нажмите ентер.'); readln; end.

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

Вопрос № 152.438

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

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

Отвечает: Шичко Игорь Здравствуйте, Angelanna! Попробуйте такой код в приложении. При запуске у Вас уже должен быть на диске файл c:1.txt Приложение: uses SysUtils; var f: TextFile; i, kol: integer; a: array[1..100] of WideString; temp: WideString; in_word: string; ch: Char; begin writeln('Vvedite stroky poiska:'); readln(in_word); {ввод строки поиска} AssignFile(f, 'c:1.txt'); {соединение с файлом} Reset(f); {открытие для чтения} temp:= ''; kol:= 0; while not eof (f) do begin read(f, ch); {считываем по символам} if ch = '.' then {есди точка, то конец предложения} begin temp:= temp + ch; kol:= kol + 1; a[kol]:= temp; temp:= ''; end else temp:= temp + ch; end; CloseFile(f); for i:= 1 to kol do if Pos(in_word, a[i]) > 0 then {если в предолжении есть наше слово} writeln(a[i]); readln; end.

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

Вопрос № 152.484

Нужно написать программу по следуещему заданию. Буду очень признательна за помощь. Дана последовательность целых чисел 0,1,...,10 . Заполнить ими матрицу 10х10 следующим образом. Полученную матрицу распечатать: 1 2 3 ... 10 0 1 2 ... 9 0 0 1 ... 8 ................ 0 0 0 .... 1

Отправлен: 01.12.2008, 10:55 Вопрос задала: Literain (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Layer Здравствуйте, Literain! См. код в приложении. Писал прямо в форме ответа, поэтому могут быть какие-то опечатки, нету под рукой паскаля чтоб проверить. Приложение: uses crt; var a: array[1..10, 1..10] of byte; i, j: integer; begin for i:=1 to 10 do begin for j:=1 to i-1 do begin a[i,j] := 0; Write(' 0'); end; for j:=i to 11-i do begin a[i,j] := j-i+1; write(' '); write(a[i,j]); end; WriteLn; end; readkey; end.

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

Отвечает: Шичко Игорь Здравствуйте, Literain! Предлагаю Вам следующий код (в приложении). Приложение: var i, j: integer; a: array[1..10, 1..10] of integer; begin for i:= 1 to 10 do begin for j:= 1 to 10 do begin if j<i then a[i, j]:= 0 else a[i, j]:= j-i+1; write(a[i,j]:5); end; writeln; end; readln; end.

Ответ отправил: Шичко Игорь (статус: Практикант) Ответ отправлен: 01.12.2008, 11:24 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 237232 на номер 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