Программирование на языке Pascal - ФОРУМ

Объявление

Продолжается конкурс на "Самый прикоьный юзербар" Голосовать и просматривать голоса других вы можете в форуме События, раздел "Голосование"

Информация о пользователе

Привет, Гость! Войдите или зарегистрируйтесь.

Вы здесь » Программирование на языке Pascal - ФОРУМ » Задачи по программированию » Разные коды, кому может понадобится

Разные коды, кому может понадобится

Страница:   1 2

Сообщений 31 страница 36 из 36

31

  • Автор: baitur
  • Модератор
  • Откуда: Алматы, Казахстан
  • Зарегистрирован: 28-01-2008
  • Приглашений: 0
  • Сообщений: 82
  • Уважение: +2
  • Позитив: +4
  • Пол: Мужской
  • Возраст: 33 [1991-01-15]
  • Провел на форуме:
    9 часов 19 минут
  • Последний визит:
    28-02-2012 15:32:22
Код:
program pack_unpack;
uses Crt;
var
  H,M,S:integer;
  T:double;
function pack_time(H,M,S:integer):double;
{ Упаковка времени - перевод часов (H) 
  минут (M) и секунд (S) в часть суток }
begin
  pack_time:= (H*3600.0 + M*60 + S)/86400.0;
end;

procedure unpack_time(t:double;var H,M,S:integer);
{ Распаковка времени - перевод части суток 
  в часы (H), минуты (M) и секунды (S)     }
var
  t1:double;
begin
  t1:=t*86400;
  H:=trunc(t1/3600.0);
  t1:=t1-3600.0*H;
  M:=trunc(t1/60.0);
  S:=trunc(t1-60.0*M);
end;

begin {main}
  clrscr;
  H:=18; M:=0; S:=0;
  T:=pack_time(H,M,S);
  writeln(H:2,':',M:2,':',S:2,' =',T:6:2);
  T:=0.5;
  unpack_time(T,H,M,S);
  writeln(H:2,':',M:2,':',S:2,' =',T:6:2);
  readln;
end.

0

32

  • Автор: Mixazzz
  • Новичок
  • Зарегистрирован: 28-03-2008
  • Приглашений: 0
  • Сообщений: 4
  • Уважение: +0
  • Позитив: +0
  • Провел на форуме:
    26 минут
  • Последний визит:
    10-12-2008 23:03:24

Автор , а можно вас попросить написать код, который бы  искал в матрице размером ni nj  (const=10) номер столбца ( j )  в котором наибольшее кол-во одинаковых элементов
вывести номер столбца.
(ni , nj вводиться с клавиатуры)
впринципе нужен сам код вычисления этого столбца,а дальше я его применяю для процедуры в следующем коде.

Код:
program laba_1;
uses crt;
const
  nmax=10;
type
  mas=array[1..nmax,1..nmax] of integer;
var
  m:mas;
 i,j,ni,nj,strnull,copies:integer;
function nullelement (m:Mas):integer;
begin
 strnull:=0;                                  
 for i:=1 to ni do                            
  for j:=1 to nj do
   if m[i,j]=0 then
    begin
      inc(strnull);
      j:=nj;
    end;
   nullelement:=strnull;
end;
procedure copyelement(m:mas;var copies:integer);
var
smax,jmax,sum:integer;
begin
< ??? CODE ???>
end;
begin
 clrscr;
 writeln('Введите размеры матрицы:');
 repeat                                               {Задаем размеры матрицы в пределах ограниченных константой}
  write('введите кол-во строк ');
  readln(ni);
  if (ni>nmax) and (ni<=0) then
    writeln('недопустимое значение, повторите ввод');
 until (ni<=nmax) and (ni>0);
 repeat
  write('введите кол-во столбцов: ');
   readln(nj);
  if (nj>nmax) and (nj<=0) then
    writeln('недопустимое значение, повторите ввод'');
 until (nj<=nmax) and (nj>0);
 writeln('введие матрицу построчно : ');      {ввод матрицы}
 writeln;
 for i:=1 to ni do
  begin
   for j:=1 to nj do
    read(m[i,j]);
   readln;
  end;
nullelement(m);
if nullelement(m) = 0 then
 writeln('строк содержащих нулевые элементы не найдено')
else
 writeln ('кол-во строк содержащих нулевые элементы = ',nullelement(m));
copyelement(m,copies);
writeln('Столбец с наибольшим кол-вом одинаковых элементов = ',copies);
end.

0

33

  • Автор: Noxt
  • Администратор
  • Noxt
  • Откуда: Беларусь, Гомель
  • Зарегистрирован: 23-01-2008
  • Приглашений: 0
  • Сообщений: 31
  • Уважение: +3
  • Позитив: +2
  • Пол: Мужской
  • Возраст: 32 [1991-11-15]
  • Провел на форуме:
    1 день 2 часа
  • Последний визит:
    21-04-2008 20:19:31

Держи:

Код:
 readln(n,m);
 for i:=1 to n do
    for j:=1 to m do
      read(a[i,j]);

 max_nom:=1;
 max_sum:=1; 

 for j:=1 to m do
 begin
    for i:=1 to n do
    begin
      sum:=1;

      for l:=i+1 to n do inc(sum,ord(a[i,j]=a[l,j]));

      if sum>max_sum then
      begin
         max_sum:=sum;
         max_nom:=j;
      end;
    end;
 end;

 write(max_nom);

0

34

  • Автор: Mixazzz
  • Новичок
  • Зарегистрирован: 28-03-2008
  • Приглашений: 0
  • Сообщений: 4
  • Уважение: +0
  • Позитив: +0
  • Провел на форуме:
    26 минут
  • Последний визит:
    10-12-2008 23:03:24

Чето код все время выдает 1 столбик. :no:

0

35

  • Автор: Noxt
  • Администратор
  • Noxt
  • Откуда: Беларусь, Гомель
  • Зарегистрирован: 23-01-2008
  • Приглашений: 0
  • Сообщений: 31
  • Уважение: +3
  • Позитив: +2
  • Пол: Мужской
  • Возраст: 32 [1991-11-15]
  • Провел на форуме:
    1 день 2 часа
  • Последний визит:
    21-04-2008 20:19:31

Измени
"sum:=0;" на "sum:=1;"

0

36

  • Автор: Mixazzz
  • Новичок
  • Зарегистрирован: 28-03-2008
  • Приглашений: 0
  • Сообщений: 4
  • Уважение: +0
  • Позитив: +0
  • Провел на форуме:
    26 минут
  • Последний визит:
    10-12-2008 23:03:24

Небольшой код по работе с записями и типизированными файлами...код максимально понятно написан.

Код:
{Работа с записями и типизированными файлами в TP7}
{+----------------Mixazzz 7.03.08----------------+}
program fileloader;
uses crt;
const
 nmax=10;
type
 stud = record
  name:string;
  age:byte;
 end;
var
group:array[1..nmax] of stud;
i,n:integer;
f:file of stud;
begin
clrscr;
writeln('+-----Работа с базой данных-----+');
repeat
 writeln('Введите кол-во студентов');
 readln(n);
 if (n<1) or (n>nmax) then
 clrscr;
 writeln('Ошибка!Неверное значение');
until (n>=1) and (n<=nmax);
clrscr;
i:=0;
while i<n do
 with group[i] do
  begin
   clrscr;
   write('Введите имя ',i+1,'-ого студента  : ');
   readln(group[i].name);
   write('Введите возраст текущего студента : ');
   readln(group[i].age);
   inc(i);
  end;
if i=n then
 clrscr;
 writeln('Сохранение записи (студенты) в файл t.txt');
 assign(f,'t.txt');
 {$I-}
 reset(f);
 {$I+}
 if IOResult <> 0 then
  begin
   write('Ошибка!Файл t.txt ­не найден');
   halt;
  end;
 rewrite(f);
 for i:=1 to n do
  write(f, group[i]);
 close(f);
 write('Файл сохранен, нажмите любую клавишу для выхода');
 readkey;
end.

Отредактировано Mixazzz (12-04-2008 01:53:52)

0

Страница:   1 2

Вы здесь » Программирование на языке Pascal - ФОРУМ » Задачи по программированию » Разные коды, кому может понадобится

Рейтинг форумов | Создать форум бесплатно