Часовой пояс: UTC + 3 часа




Куратор(ы):   Lord_of_Darkness   



Начать новую тему Новая тема / Ответить на тему Ответить  Сообщений: 985 • Страница 50 из 50<  1 ... 46  47  48  49  50
  Пред. тема | След. тема 
В случае проблем с отображением форума, отключите блокировщик рекламы
Автор Сообщение
 
Прилепленное (важное) сообщение

Убедительная просьба ко всем, кто выкладывает исходники:
1. Обязательно пользуйтесь тэгом code (иначе очень трудно читать)
2. Старайтесь делать отступы

Если вы хотите чтобы вам помогли в написании программы, внятно излагайте задание!

Прежде чем задать вопрос, воспользуйтесь учебником


Возможно, что нужная вам программа уже написана, поэтому советую просмотреть список здесь и здесь

Отредактировано куратором: Lord_of_Darkness. Дата: 07.07.2006 19:36



Партнер
 

Member
Статус: Не в сети
Регистрация: 20.03.2011
Откуда: Москва
IceBerg1994 вот вам программа
Код:
var
  i,j,count:integer;
  s,k:string;
  c:char;
begin
  randomize;
  Writeln('Random? y/n');
  Readln(c);
  if upCase(c)='Y' then
    for i := 1 to 60 do begin
      j:=random(27)+97;
      case j of
        123: c:='.';
        124: c:=','
        else c:= chr(j)
      end;
      s:=s+c;
    end
  else
    readln(s);
  for i := 1 to Length(s) do
    case s[i] of
    '.': k:=k+'ТЧК';
    ',': k:=k+'ЗПТ';
    else begin
      if ((s[i]=' ') and (s[i-1]=' ')) then
        continue;
      k:=k+s[i]
      end;
    end;
  for i := 1 to Length(k) do
    if k[i]<>' ' then inc(count);
  Writeln('Введенная строка'#10#13,s,#10#13);
  Writeln('Преобразованная строка'#10#13,k,#10#13);
  Writeln('Длина строки без пробелов'#10#13,count,#10#13);
  readln;
end.

К сожалению в вашем коде нету разбираться ни сил ни желания.

_________________
I would tell you a joke about UDP, but you probably wouldn't get it.


 

Member
Статус: Не в сети
Регистрация: 14.09.2008
Ребят помогите довести до ума задачу
Задан массив из пяти строк и шести столбцов.1)Сформировать массив из первых попавшихся положительных элементов
каждой строки и их индексов в исходной матрице,если положительных элементов в строке нет ,то результат равен нулю.
2)определить сумму отобранных элементов массива и их количество
3)определить минимальное и максимальное значение из отобранных элементов и их координаты и поменять местами стобцы исходной матрицы в которых они найдены, если номера столбцов разные.
делал задачу наподобие только там нужно просто было определить минимальное и максимальное значение массива и их координаты и поменять их местами в массиве. Остался код от неё
program lr5;
const m=5; n=6;
type tb=array[1..m,1..n] of real;
var a,an:string[80];
b:tb;
i,j:integer;
imax,jmax,imin,jmin:integer;
min,max:real;
fi:text;
Вывод значений массива вещественных данных
procedure p(b:tb;m,n:integer);
begin
for i:=1 to m do
begin
write (chr(186));
for j:=1 to n do
case j of
1,2,3,4,5:write (b[i,j]:11:4,chr(179));
3:write(b[i,j]:11,chr(179):2);
6:writeln(b[i,j]:12,chr(186));
end;
if i=m then writeln (an) else
writeln(a);
end
end;
Ввод исходных данных
procedure vvod (var b:tb);
begin
assign (fi,'d:\lr5.dat);
reset(fi);
for i:=1 to 4 do begin
readln(fi,a);
writeln(a);
end;
readln(fi,a);
readln(fi,an);
close(fi);
reset(fi);
for i:=1 to m do
for j:=1 to n do
read(fi,b[i,j]);
p(b,m,n);
close (fi);
end;
обработка-поиск минимального и максимального значений
procedure obr (var b:tb,m,n:integer; var mn,mx:real;va i1,i2,j1,j2:integer);
var i,j:integer;
r:real;
begin
mn:=b[1,1];
mx:=b[1,1];
i1:=1;
i2:=1;
j1:=1
j2:=1;
for i:=1 to m do
for j:=1 to n do
if b[i,j]<mn then begin
mn:=b[i,j];
i1:=i;
j1:=j;
end
else
if b[i,j]>mx then begin
mx:=b[i,j];
i2:=i;
j2:=j;
end;
writeln('i1=',i1,'j1=',j1,'i2=',i2,'j2=',j2);
b[i1,j1]:=mx;
b[i2,j2]:=mn;
end;
основная программа
begin
assign(output,'');
rewrite(output);
{lr5.res}
vvod(b);
obr(b,m,n,min,max,imin,imax,jmin,jmax);
writeln(#10#13,'результаты',#10#13);
p(b,m,n);
writeln
(#10#13,'min=',min:12,'imin=',imin,'jmin=',jmin,
#10#13,'max=',max:12,'imax=',imax,'jmax=',jmax);
close(output);
readkey;
end.

_________________
Gigabyte GA-MA770-UD3/955BE @3,93Ghz/Thermalright Silver Arrow/RAM 4GB @952Mhz(6-6-6-18-2T)/GTX 580 3GB @850mhz/SSD Plextor M3 128Gb/TT Toughpower750W


 

Народ кто знает как в конце программы задать вопрос пользователю хотели бы вы использовать еще программу.... если да то прога заного запускается а если нет то конец...... или допустим:
begin
clrscr;
writeln('Dobro pojalovat');
writeln('Vvedite koefficienty');
writeln('Koefficient a');
readln(a);
writeln('Koefficient b');
readln(b);
writeln('Koefficient c');
readln(c);


как задать вопрос пользователю.... правлино ли вы ввели коэффициенты если да то продолжается прога а если нет то заного вводить коэффициенты...????


 

Member
Статус: Не в сети
Регистрация: 18.05.2015
7 лет тишины :) трубу школоте уже не преподают?


 

Куратор темы
Статус: Не в сети
Регистрация: 03.01.2004
Откуда: Питер
IceBerg1994
Код:
repeat
 . . .
   writeln('подтвердите ввод (y/n)');
   readln(yn);
until yn = 'y';

_________________
Здесь так мало тех, с кем легко говорить,
Еще меньше тех, с кем не страшно молчать (c)


Показать сообщения за:  Поле сортировки  
Начать новую тему Новая тема / Ответить на тему Ответить  Сообщений: 985 • Страница 50 из 50<  1 ... 46  47  48  49  50
-

Часовой пояс: UTC + 3 часа


Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 2


Вы не можете начинать темы
Вы не можете отвечать на сообщения
Вы не можете редактировать свои сообщения
Вы не можете удалять свои сообщения
Вы не можете добавлять вложения

Перейти:  



Лаборатория














Создано на основе phpBB® Forum Software © phpBB Group
Русская поддержка phpBB | Kolobok smiles © Aiwan