freepascal.ru

Код: Выделить всё

program xy;

uses crt;

var
   x, y: real;

begin
   ClrScr;
   Write  ('Введите число X:');
   ReadLn(x);
   WriteLn;
   Write  ('Введите число Y:');
   ReadLn(y);
   WriteLn;

   If x = y then
   begin
   Writeln('Числа Х и Y равны. Запустите программу еще раз с разными значениями Х и Y');
   ReadLn;
   exit;
   end;

   If x > y then
   begin
   writeln('Большим является X и синус числа равен:',sin(x):3:3);
   writeln('Меньшее - Y и его косинус:',cos(y):3:3);
   end
   else
   begin
   writeln('Большим является Y и синус числа равен:',sin(y):3:3);
   writeln('Меньшее - X и его косинус:',cos(x):3:3);
   end;

   Readln;
end.

Код: Выделить всё

program func;

uses crt;

const
     a = 0.5;
     b = 3.2;

var
   f, x: real;

begin

   ClrScr;
   Write('Введите число X, оно должно быть > 0: ');
   ReadLn(x);
   Writeln;

   If x <= 0 then
   begin
   writeln('Число X <= 0. Запустите программу заново с Х > 0.');
   readln;
   exit;
   end;

   f := exp(2*x)*sin(a+x)/cos(a+x)-exp(ln(b)*3*x)*sin(b-x)/cos(b-x);

   writeln('Значение функции f = e^2x*tg(a+x) - b^3x*tg(b-x), при a = 0.5, b = 3.2,  равно: ',f:5:3);
   readln;
end.


Код: Выделить всё

program koor;

uses crt;

var
   x1,x2,y1,y2 : integer;
   res1, res2  : real;

begin
   ClrScr;
   Write  ('Введите через пробел координаты точки А:');
   Read(x1);
   Read(y1);
   WriteLn;
   Write  ('Введите через пробел координаты точки B:');
   Read(x2);
   Read(y2);
   WriteLn;

   res1 := sqrt(sqr(x1)+sqr(y1));
   res2 := sqrt(sqr(x2)+sqr(y2));

   if res1 = res2 then
   begin
   writeln('Точки A и B симметричны отностительно начала координат');
   ReadLn;
   exit;
   end;

   if res1 < res2 then
   writeln('Точка А находится ближе к началу координат.')
   else
   writeln('Точка B находится ближе к началу координат.');

   Readln;
end.


Код: Выделить всё

program sequence;

uses crt;

var
   seq: array[1..100] of integer;
   n, i, cnt: integer;
   r: real;


begin
     clrscr;
     write('Введите длину последовательности чисел: ');
     readln(n);
     for i:=1 to n do
       begin
           Write('Введите значение ',i,' элемента массива: ');
           readln(seq[i]);
       end;

     for i:=1 to n do
         if (seq[i] < 0) and (abs(frac(seq[i]/5)) = 0) then
         cnt := cnt + 1;

     write('В последоватеьности из ',n,' чисел: ');
     for i:=1 to n do
           Write(seq[i],' ');

     writeln;
     write('В этой последовательности отрицатеьных чисел кратных 5 - ',cnt);
     readln;

end.


Код: Выделить всё

program arrays;

uses crt;

var
   seq: array [1..100,1..100] of integer;
   i, j, m, n: integer;

begin
     clrscr;
     write('Через пробел введите размерность двумерного массива: ');
     read(m);
     readln(n);
     writeln('Массив заполнился следующим образом:');

   for i:=1 to m do
       begin
       for j:=1 to n do
       begin
       if i < j then
       seq[i,j] := i + j;
       if i = j then
       seq[i,j] := 3;
       if i > j then
       seq[i,j] := -1;
       write(seq[i,j],' ');
       end;
       writeln;
       end;

   readln;

end.


Код: Выделить всё

program strings;

uses crt;

const
     st = 'АЕИОУЫЭЮЯ';

var
   str: string;
   i, cnt: integer;

begin
     clrscr;
     write('Введите строку для обработки: ');
     readln(str);

     for i := 1 to length(str) do
         if pos(str[i],st) <> 0 then
         cnt := cnt + 1;

     writeln;
     writeln('В строке: ',str);
     writeln;
     write('Заглавных гласных букв - ',cnt);
     readln;
end.


Код: Выделить всё

program records;

uses crt;

type
    Tinfo = record
         Family: string[20];
         Group: string[5];
         Srok: integer;
         end;

var
    info: array [1..100] of Tinfo;
    term: array [1..100] of Integer;
    n, i, tmp, err: integer;


begin
     clrscr;
     write('Введите количество студентов: ');
     readln(n);
     Writeln('Через пробел введите фамилию студента, его группу и срок обучения в месяцах: ');
     for i := 1 to n do
         begin
         with info[i] do
              begin
              write('Введите фамилию ',i, ' студента: ');
              readln(family);
              write('Введите группу ',i, ' студента: ');
              readln(group);
              write('Введите срок обучения ',i, ' студента: ');
              read(srok);
              end;
         end;

     for i := 1 to n do
         begin
         with info[i] do
              begin
              val(copy(group,1,1),tmp,err);
              if err = 0 then
              term[i] := srok - tmp  * 12;
              end;
         end;

     for i := 1 to n do
         begin
         writeln('Для студента ',info[i].family,' осталось учиться ',term[i],' месяцев');
         end;
     readln;
end.


omsk_mail писал(а):Для введенного целого числа определить, делится ли оно нацело на два, три или на пять.

Код: Выделить всё

var x: integer;
...
if (x mod 2)=0 then
...
if (x mod 3)=0 then
...
if (x mod 5)=0 then
...


Вопрос:Строковые величины -- Найти, сколько раз в предложении встречаются заглавные гласные буквы

Код: Выделить всё

Const
  MyString = 'ААББЮЮВВГГУЁЖ';
Var
  aVoices, aString, aVoice: String;
  aCount: Integer;
Begin
  aVoices := 'А_Е_Ё_И_О_У_Ы_Э_Ю_Я_';
  aCount := 0;
  While Not(Pos('_', aVoices) = 0) Do
    Begin
      aVoice := Copy(aVoices, 1, Pos('_', aVoices) - 1);
      aString := MyString;
      While Not(Pos(aVoice, aString) = 0) Do
        Begin
          Inc(aCount);
          Delete(aString, 1, Pos(aVoice, aString));
        End;
      Delete(aVoices, 1, Pos('_', aVoices));
    End;


v-t-l писал(а):

omsk_mail писал(а):Для введенного целого числа определить, делится ли оно нацело на два, три или на пять.

Код: Выделить всё

var x: integer;
...
if (x mod 2)=0 then
...
if (x mod 3)=0 then
...
if (x mod 5)=0 then
...


Код: Выделить всё

var n:integer;
begin
writeln('vvedite chislo');
readln(n);
if (n mod 5=0) or (n mod 3=0)or (n mod 2=0) then writeln('da')
else writeln('net');
readln;
end.

Brainenjii писал(а):

Вопрос:Строковые величины -- Найти, сколько раз в предложении встречаются заглавные гласные буквы

Предложенный вариант не учитывает одиннаковые заглавные гласные (например строка 'АААААА'), не работает с UTF8 и не реагирует на букву Ё(!). Мой вариант:

Код: Выделить всё

Const
  MyString = 'ААББЮЮВВГГУЁЖ';
Var
  aVoices, aString, aVoice: String;
  aCount: Integer;
Begin
  aVoices := 'А_Е_Ё_И_О_У_Ы_Э_Ю_Я_';
  aCount := 0;
  While Not(Pos('_', aVoices) = 0) Do
    Begin
      aVoice := Copy(aVoices, 1, Pos('_', aVoices) - 1);
      aString := MyString;
      While Not(Pos(aVoice, aString) = 0) Do
        Begin
          Inc(aCount);
          Delete(aString, 1, Pos(aVoice, aString));
        End;
      Delete(aVoices, 1, Pos('_', aVoices));
    End;


omsk_mail писал(а):Выдает ошибку непредвиденный конец файла

Light13 писал(а):

omsk_mail писал(а):Выдает ошибку непредвиденный конец файла

Мдя.

Не пробовали учить, иногда помогает

Добавить в конец End.

omsk_mail писал(а):

v-t-l писал(а):

omsk_mail писал(а):Для введенного целого числа определить, делится ли оно нацело на два, три или на пять.

Код: Выделить всё

var x: integer;
...
if (x mod 2)=0 then
...
if (x mod 3)=0 then
...
if (x mod 5)=0 then
...


А этот вариант правильный или нет

Код: Выделить всё

var n:integer;
begin
writeln('vvedite chislo');
readln(n);
if (n mod 5=0) or (n mod 3=0)or (n mod 2=0) then writeln('da')
else writeln('net');
readln;
end.

Добавлено спустя 11 минут:

Brainenjii писал(а):

Вопрос:Строковые величины -- Найти, сколько раз в предложении встречаются заглавные гласные буквы

Предложенный вариант не учитывает одиннаковые заглавные гласные (например строка 'АААААА'), не работает с UTF8 и не реагирует на букву Ё(!). Мой вариант:

Код: Выделить всё

Const
  MyString = 'ААББЮЮВВГГУЁЖ';
Var
  aVoices, aString, aVoice: String;
  aCount: Integer;
Begin
  aVoices := 'А_Е_Ё_И_О_У_Ы_Э_Ю_Я_';
  aCount := 0;
  While Not(Pos('_', aVoices) = 0) Do
    Begin
      aVoice := Copy(aVoices, 1, Pos('_', aVoices) - 1);
      aString := MyString;
      While Not(Pos(aVoice, aString) = 0) Do
        Begin
          Inc(aCount);
          Delete(aString, 1, Pos(aVoice, aString));
        End;
      Delete(aVoices, 1, Pos('_', aVoices));
    End;


Выдает ошибку непредвиденный конец файла

Код: Выделить всё

program koor;

uses crt;

var
   x1,x2,y1,y2 : integer;
   res1, res2  : real;

begin
   ClrScr;
   Write  ('Введите через пробел координаты точки А:');
   Read(x1);
   Read(y1);
   WriteLn;
   Write  ('Введите через пробел координаты точки B:');
   Read(x2);
   Read(y2);
   WriteLn;

   res1 := sqrt(sqr(x1)+sqr(y1));
   res2 := sqrt(sqr(x2)+sqr(y2));

   if res1 = res2 then
   begin
   writeln('Точки A и B симметричны отностительно начала координат');
   ReadLn;
   exit;
   end;

   if res1 < res2 then
   writeln('Точка А находится ближе к началу координат.')
   else
   writeln('Точка B находится ближе к началу координат.');

   Readln;
end.

Код: Выделить всё

program records;

uses crt;

type
    Tinfo = record
         Family: string[20];
         Group: string[5];
         Srok: integer;
         end;

var
    info: array [1..100] of Tinfo;
    term: array [1..100] of Integer;
    n, i, tmp, err: integer;


begin
     clrscr;
     write('Введите количество студентов: ');
     readln(n);
     Writeln('Через пробел введите фамилию студента, его группу и срок обучения в месяцах: ');
     for i := 1 to n do
         begin
         with info[i] do
              begin
              write('Введите фамилию ',i, ' студента: ');
              readln(family);
              write('Введите группу ',i, ' студента: ');
              readln(group);
              write('Введите срок обучения ',i, ' студента: ');
              read(srok);
              end;
         end;

     for i := 1 to n do
         begin
         with info[i] do
              begin
              val(copy(group,1,1),tmp,err);
              if err = 0 then
              term[i] := srok - tmp  * 12;
              end;
         end;

     for i := 1 to n do
         begin
         writeln('Для студента ',info[i].family,' осталось учиться ',term[i],' месяцев');
         end;
     readln;
end.

omsk_mail писал(а):Нет не пробовал учить так, как считаю его нет необходимости учить

omsk_mail писал(а):Посмотрите где зарыта собака почему не работает

Код: Выделить всё

uses crt,
  FileUtil;//чтобы этот модуль компилятор нашел - нужно добавить в зависимости проекта пакет LCL

var
   x1,x2,y1,y2 : integer;
   res1, res2  : real;

begin
  ClrScr;
  Write  (UTF8ToConsole('Введите через пробел координаты точки А:'));
  Read(x1);
  Readln(y1);//лучше буфер ввода очищать

  Write (UTF8ToConsole('Введите через пробел координаты точки B:'));
  Read(x2);
  Readln(y2);//лучше буфер ввода очищать

  res1 := sqrt(sqr(x1)+sqr(y1));
  res2 := sqrt(sqr(x2)+sqr(y2));

  if res1 = res2 then
    writeln(UTF8ToConsole('Точки A и B симметричны отностительно начала координат'))
  else
    if res1 < res2 then
      writeln(UTF8ToConsole('Точка А находится ближе к началу координат.'))
    else
      writeln(UTF8ToConsole('Точка B находится ближе к началу координат.'));

  Readln;
end.

omsk_mail писал(а):Записи -- Построить массив записей о студентах. Каждая запись должна содержать фамилию, группу, срок обучения. Рассчитать для каждого студента, сколько месяцев осталось до окончания обучения