freepascal.ru

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

var num,kod:integer;
begin
  randomize;
  kod:=1001+random(8999);
  repeat
    write('введите число ');
    readln(num);
      if num=kod then begin
        writeln('вы угадали,загаданное число ',kod);
        break;
      end;
      if num<kod then
        writeln('загаданное число больше')
      else
        writeln('загаданное число меньше');
  until false;
  readln;
end.

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

Загадайте число от 0 до 9999, запишите на бумаге и нажмите Enter
Ваше число больше 5000? (y/n)
Ваше число больше .... ? (y/n)
Ваше число больше .... ? (y/n)
...
Вы задумали число NNNN

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

var l,m,r:integer;
    ch:char;
begin
  writeln('Загадайте число от 1 до 9999 и нажмите Enter');
  readln;
  l:=1;r:=9999;
  m:=5000;
  while l<=r do begin
    writeln('ваше число больше ',m,' ?  (Y/N)');
    readln(ch);
      case ch of
        'Y','y' :  l:=m+1;
        'N','n' :  r:=m-1;
      end;
    m:=(l+r) div 2;
  end;
  writeln('Вы загадали число ',l);
  readln;
end.

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

var     X, P : integer;
        C, S, R, T, Y, U : string;

begin
Writeln('Напишите Ваш город:'); Readln(C);
Writeln('теперь улицу:'); Readln(S);
Writeln('а теперь номер дома пожалуйста:'); Readln(X);
Writeln('и конечно же номер квартиры:'); Readln(P);
R := 'Город: ' + C + ' ';
T := 'Улица: ' + S + ' ';
Y := 'Дом: ' + X;
U := 'Квартира: ';
Writeln(R + T + Y + U);
Writeln('Спасибо, теперь нажмите Enter'); Readln
end.

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

var
        C, S, R, X, P : string;

begin
Writeln('Напишите Ваш город:'); Readln(C);
Writeln('теперь улицу:'); Readln(S);
Writeln('а теперь номер дома пожалуйста:'); Readln(X);
Writeln('и конечно же номер квартиры:'); Readln(P);
R := 'Город: ' + C + ' ' + 'Улица: ' + S + ' ' + 'Дом: ' + X + ' ' + 'Квартира: ' + P;
Writeln(R);
Writeln('Спасибо, теперь нажмите Enter'); Readln
end.

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

var
  c,s:string;
begin
  writeln('напишите ваш город:');
  readln(s);
  writeln('теперь улицу:');
  readln(c);
  s:='город:'+s+',улица:'+c;
  writeln('а теперь номер дома:');
  readln(c);
  s:=s+',дом:'+c;
  writeln('и конечно номер квартиры:');
  readln(c);
  s:=s+',квартира:'+c;
  writeln(s+'.');
  writeln('спасибо,теперь нажмите Enter');
  readln
end.

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

type tarray=array [1..20] of string;

procedure push(var stack:string;ch:char);
begin
  stack:=stack+ch;
end;

function pop(var stack:string;var ch:char):boolean;
begin
  if length(stack)=0 then
    pop:=false
  else begin
    ch:=stack[length(stack)];
    delete(stack,length(stack),1);
    pop:=true;
  end;
end;

procedure stacksort(var amas:tarray;var asize:byte);
var s,sa,sb,sc:string;
    c:char;i:byte;
begin
  sa:='';sb:='';sc:='';
  for i:=1 to asize-1 do begin
    s:=amas[i];
    writeln('Начальный состав: ',s);
    writeln;
    while pop(s,c) do
      case c of
        'A'..'Z' : push(sa,c);
        'a'..'z' : push(sb,c);
        '0'..'9' : push(sc,c);
      end;
    while pop(sa,c) do push(s,c);
    writeln('состав А: ',s);
    writeln;
    s:='';
    while pop(sb,c) do push(s,c);
    writeln('состав В: ',s);
    writeln;
    s:='';
    while pop(sc,c) do push(s,c);
    writeln('состав С: ',s);
    writeln;
  end;
end;

var mas:tarray;
    i:byte;
begin
  i:=0;
  repeat
    inc(i);
    readln(mas[i]);
  until mas[i]='';
  stacksort(mas,i);
  readln
end.

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

procedure push(var stack:string;ch:char);
begin
// тра-ля-ля
end;

function pop(var stack:string;var ch:char):boolean;
begin
// тра-ля-ля
end;

var sa,sb,sc:string;  // тупики

procedure Sort(var arg: string);
var c: char;
begin
  while pop(arg,c) do
    case c of
      'A'..'Z' : push(sa,c);
      'a'..'z' : push(sb,c);
      '0'..'9' : push(sc,c);
    end;
end;

procedure PrintResult(const aText: string; var aTupik: string);
var s: string; c: char;
begin
  s:='';
  while pop(aTupik,c) do push(s,c);
  writeln(aText,s);    writeln;
end;

var s:string;

begin
  // Очищаем тупики
  sa:=''; sb:=''; sc:='';
  // Обработка вводимых строк
  repeat
    Write('Состав: '); Readln(s);
    if Length(s)=0 then Break;
    Sort(s);
  until false;
  // Освобождение тупиков и формирование отправляемых составов
  PrintResult('состав А: ',sa);
  PrintResult('состав B: ',sb);
  PrintResult('состав C: ',sc);
  Readln;
end.

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

{программа Р_46_А}

program P_46_3;

procedure fillbignumber(var arg:string);
var i,n:byte;
begin
  readln(n);
  for i:=1 to n do
    arg:=arg+char(random(100) mod 10+ord('0'));
end;

procedure writebignumber(var arg:string);
var i:byte;
begin
  for i:=length(arg) downto 1 do
    write(arg[i]);
  writeln;
  writeln;
end;

procedure countbignumber(var arg1,arg2:string);
var n1,n2,sum,ovr,i,j:integer;
begin
  if length(arg1)>length(arg2) then
    begin
      j:=length(arg1)-length(arg2);
      for i:=1 to j do
        arg2:=arg2+'0';
    end
  else
    if length(arg2)>length(arg1) then
    begin
      j:=length(arg2)-length(arg1);
      for i:=1 to j do
        arg1:=arg1+'0';
    end;
  ovr:=0;
  for i:=1 to length(arg1) do begin
    n1:=ord(arg1[i])-ord('0');
    n2:=ord(arg2[i])-ord('0');
    sum:=(n1+n2+ovr) mod 10;
    ovr:=(n1+n2+ovr) div 10;
    arg1[i]:=char(sum+ord('0'));
  end;
  if ovr<>0 then arg1:=arg1+'1';
end;

var s1,s2:string;

begin
  randomize;
  s1:='';s2:='';
  writeln('введите кол-во цифр 1-го числа(макс.254)');
  fillbignumber(s1);
  writeln('введите кол-во цифр 2-го числа(макс.254)');
  fillbignumber(s2);
  writeln;
  writeln('первое число:');
  writebignumber(s1);
  writeln('второе число:');
  writebignumber(s2);
  countbignumber(s1,s2);
  writeln('результат сложения:');
  writebignumber(s1);
  readln
end.

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

{программа Р_46_А}

program P_46_3;

procedure fillbignumber(const n:integer;var arg:string);
var i:byte;
begin
  for i:=1 to n do
    arg:=arg+char(random(100) mod 10+ord('0'));
end;

procedure countbignumber(var arg1,arg2:string);
var n1,n2,sum,ovr,i,j:integer;
begin
  if length(arg1)>length(arg2) then
    begin
      j:=length(arg1)-length(arg2);
      for i:=1 to j do
        arg2:=arg2+'0';
    end
  else
    if length(arg2)>length(arg1) then
    begin
      j:=length(arg2)-length(arg1);
      for i:=1 to j do
        arg1:=arg1+'0';
    end;
  ovr:=0;
  for i:=1 to length(arg1) do begin
    n1:=ord(arg1[i])-ord('0');
    n2:=ord(arg2[i])-ord('0');
    sum:=(n1+n2+ovr) mod 10;
    ovr:=(n1+n2+ovr) div 10;
    arg1[i]:=char(sum+ord('0'));
  end;
  if ovr<>0 then arg1:=arg1+'1';
end;

var s1,s2:string;
n:integer;
begin
  randomize;
  s1:='';s2:='';
  writeln('введите кол-во цифр 1-го числа(макс.254)');
readln(n);
  fillbignumber(s1);
  writeln('введите кол-во цифр 2-го числа(макс.254)');
readln(n);
  fillbignumber(s2);
  writeln;
  writeln('первое число:');
  writeln(s1);
  writeln('второе число:');
  writeln(s2);
  countbignumber(s1,s2);
  writeln('результат сложения:');
  writeln(s1);
  readln
end.

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

function countbignumber(arg1,arg2:string):string;
var i:integer;
s:string;
begin
  if length(arg1)<length(arg2) then
  begin
    s:=arg2;
    arg2:=arg1;
  end
 else
    s:=arg1;

s:='0'+s;
      for i:=1 to abs(length(arg2)-length(s)) do
        arg2:='0'+arg2;

  sum:=0;
  for i:=length(s) downto 1 do
  begin
    sum:=sum+ord(s[i])+ord(arg2[i])-2*(ord('0'));
    s[i]:=chr(ord('0')+(sum mod 10));
    sum:=sum div 10;
  end;
  if s[1]='0' then delete(s,1,1);
  countbignumber:=s;
end;