Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 08.03.2009, 18:52   #11
Buratino
Пользователь
 
Аватар для Buratino
 
Регистрация: 07.03.2009
Сообщений: 10
По умолчанию

Сам разобрался! Так работает:

Код:
program calculator;
var stroka,stroka0,stroka00: string;
    d,lens,i,N,len1,len2:integer;
    chisla:array[1..255]of real;
    chisla0:array[1..255]of real;
    chisla00:array[1..255]of real;

     procedure sortirovka;
     var i,s,pervcifra,N,len1,len2:integer;
      begin
       len1:=ord('0');      //12+2//     4  //#
       len2:=ord('9');
       s:=0; N:=length(stroka00); pervcifra:=1;
       for i:=1 to N do
        begin
          if ((len1-ord(stroka00[i]))*(len2-ord(stroka00[i]))<= 0) then
           begin
            if pervcifra=1 then
              begin
                pervcifra:=0;
                s:=s+1;
                stroka0[s]:='#';
              end;
              
            chisla0[s]:=chisla0[s]*10+(ord(stroka00[i])-len1); //if(s>4)then write('Fuck! It is error!');

           end;

          if ((len1-ord(stroka00[i]))*(len2-ord(stroka00[i]))> 0) then
           begin
            s:=s+1;
            stroka0[s]:=stroka00[i];
            pervcifra:=1;

           end;
        end;
       SetLength(stroka0,s)
      end;
     

function schet(len1,len2:integer;symb:char):integer;
 var i,N:integer;
 begin
  i:=len1+1;                                                     //len1 è len2 - êîîðäèíàòû ñêîáîê
  N:=0;
  while (i<len2) do                                             //Ïîäñ÷¸ò êîë-âà çíàêîâ
   begin
   if stroka[i]=symb then N:=N+1;
   i:=i+1;
   end;
   Result:=N;
 end;
 

 procedure func(len1,len2:integer;symbol:char);                             //ïîäñ÷¸ò âñåõ ôóíêöèé â çàäàííîì èíòåðâàëå
  var k,d,i,N:integer;
      symbol0:char;
  begin
  case symbol of
  '+': begin symbol0:='-'; N:=schet(len1,len2,symbol)+schet(len1,len2,symbol0); end;
  '*': begin symbol0:='/'; N:=schet(len1,len2,symbol)+schet(len1,len2,symbol0); end;
  '^': begin symbol0:='^'; N:=schet(len1,len2,symbol); end;
  end;


  for d:=1 to N do
   begin
      if stroka='#' then break;
       i:=len1+1;
       while ((stroka[i])<>symbol)and((stroka[i])<>symbol0) do i:=i+1;
       case stroka[i] of
       '+': chisla[i-1]:=chisla[i-1]+chisla[i+1];
       '-': chisla[i-1]:=chisla[i-1]-chisla[i+1];
       '*': chisla[i-1]:=chisla[i-1]*chisla[i+1];
       '/': chisla[i-1]:=chisla[i-1]/chisla[i+1];
       '^': chisla[i-1]:=power(chisla[i-1],chisla[i+1]);
       end;
       for k:=i to (length(stroka)-2) do
        begin
        stroka[k]:=stroka[k+2];
        chisla[k]:=chisla[k+2];
        end;

      delete(stroka,length(stroka)-1,2);
   end;

  end;

Begin

for i:=1 to 255 do
begin
chisla[i]:=0;
chisla0[i]:=0;
end;

  readln(stroka00);
  sortirovka();

 for i:=1 to 255 do
 begin
   chisla[i]:=chisla0[i];
 end;
   stroka:=stroka0;

 lens:=length(stroka);
  
  N:=schet(0,lens+1,'(');
   i:=0;
  while(i<N) do
  begin
   d:=1;
   while stroka[d]<>')' do d:=d+1;
   len2:=d;
   while stroka[d]<>'(' do d:=d-1;
   len1:=d;
   func(len1,len2,'^');
   func(len1,len2,'*');
   func(len1,len2,'+');
   stroka[len1]:='#';
   chisla[len1]:=chisla[len1+1];
   for d:=(len1+1) to (length(stroka)-2) do
      begin
      stroka[d]:=stroka[d+2];
      chisla[d]:=chisla[d+2];
      end;
    delete(stroka,length(stroka)-1,2);
   i:=i+1;
  end  ;
  
   len1:=0; len2:=length(stroka)+1;
   func(len1,len2,'^');
   func(len1,len2,'*');
   func(len1,len2,'+');

  writeln(chisla[1],' ');
 End.
Buratino вне форума Ответить с цитированием
Старый 16.03.2009, 12:49   #12
Buratino
Пользователь
 
Аватар для Buratino
 
Регистрация: 07.03.2009
Сообщений: 10
По умолчанию

Вот так точно работает!



Код:
program calculator;
var stroka,stroka0,stroka00: string;
    d,lens,i,N,len1,len2:integer;
    chisla:array[1..255]of real;
    chisla0:array[1..255]of real;
    chisla00:array[1..255]of real;
////////////////////////////////////////////////////////////////////////
      procedure proverka;
  var i:integer;
  begin
      for i:=1 to length(stroka) do
        if chisla[i]=0 then write(stroka[i])
        else write(chisla[i]);
        writeln();
  end;

////////////////////////////////////////////////////////////////////////
     procedure sortirovka;
     var i,s,pervcifra,N,len1,len2:integer;
      begin
       len1:=ord('0');
       len2:=ord('9');
       s:=0; N:=length(stroka00); pervcifra:=1;
       for i:=1 to N do
        begin
          if ((len1-ord(stroka00[i]))*(len2-ord(stroka00[i]))<= 0) then
           begin
            if pervcifra=1 then
              begin
                pervcifra:=0;
                s:=s+1;
                stroka0[s]:='#';
              end;
              
            chisla0[s]:=chisla0[s]*10+(ord(stroka00[i])-len1);

           end;

          if ((len1-ord(stroka00[i]))*(len2-ord(stroka00[i]))> 0) then
           begin
            s:=s+1;
            stroka0[s]:=stroka00[i];
            pervcifra:=1;

           end;
        end;
       SetLength(stroka0,s)
      end;
     
////////////////////////////////////////////////////////////////////////
function schet(len1,len2:integer;symb:char):integer;
 var i,N:integer;
 begin
  i:=len1+1;                                //len1 è len2 - êîîðäèíàòû ñêîáîê
  N:=0;
  while (i<len2) do                           //Ïîäñ÷¸ò êîë-âà çíàêîâ
   begin
   if stroka[i]=symb then N:=N+1;
   i:=i+1;
   end;
   Result:=N;
 end;
///////////////////////////////////////////////////////////////////////

 procedure func(len1,len2:integer;symbol:char);     //ïîäñ÷¸ò âñåõ ôóíêöèé â çàäàííîì èíòåðâàëå
  var k,d,i,N:integer;
      symbol0:char;
  begin
   case symbol of
   '+': begin symbol0:='-'; N:=schet(len1,len2,symbol)+schet(len1,len2,symbol0); end;
   '*': begin symbol0:='/'; N:=schet(len1,len2,symbol)+schet(len1,len2,symbol0); end;
   '^': begin symbol0:='^'; N:=schet(len1,len2,symbol); end;
   '.': begin symbol0:='.'; N:=schet(len1,len2,symbol); end;
   end;

   i:=len1+1;
   for d:=1 to N do
    begin

        //proverka;


        while ((stroka[i])<>symbol)and((stroka[i])<>symbol0) do i:=i+1;
        
         case stroka[i] of
          '+': chisla[i-1]:=chisla[i-1]+chisla[i+1];
          '-': chisla[i-1]:=chisla[i-1]-chisla[i+1];
          '*': chisla[i-1]:=chisla[i-1]*chisla[i+1];
          '/':chisla[i-1]:=chisla[i-1]/chisla[i+1];
          '^': chisla[i-1]:=power(chisla[i-1],chisla[i+1]);
          '.': begin while chisla[i+1]>1 do  chisla[i+1]:=chisla[i+1]/10; chisla[i-1]:=chisla[i-1]+chisla[i+1]; end;
         end;

        for k:=i to (length(stroka)-2) do
         begin
         
          stroka[k]:=stroka[k+2];
          chisla[k]:=chisla[k+2];
          
         end;
        delete(stroka,length(stroka)-1,2);

     end;
   end;
///////////////////////////////////////////////////////////////////////////
var d:integer;
begin
 d:=1;
 while stroka[d]<>')' do d:=d+1;
 len2:=d;
 while stroka[d]<>'(' do d:=d-1;
 len1:=d;
end;
////////////////////////////////////////////////////////////////////////////
Begin

  while true do
  begin
  
for i:=1 to 255 do
begin
chisla[i]:=0;
chisla0[i]:=0;
end;

  read(stroka00);

  if stroka00='q' then break;

  sortirovka();

 for i:=1 to 255 do
 begin
   chisla[i]:=chisla0[i];
 end;
 stroka:=stroka0;
 lens:=length(stroka);
  
 N:=schet(0,lens+1,'(');
 
 for i:=1 to N do
  begin
   gran();
   func(len1,len2,'.'); gran;
   func(len1,len2,'^'); gran;
   func(len1,len2,'*'); gran;
   func(len1,len2,'+');
   stroka[len1]:='#';
   chisla[len1]:=chisla[len1+1];
   for d:=(len1+1) to (length(stroka)-2) do
      begin
      stroka[d]:=stroka[d+2];
      chisla[d]:=chisla[d+2];
      end;
    delete(stroka,length(stroka)-1,2);
  end;
  
   func(1,length(stroka),'.');
   func(1,length(stroka),'^');
   func(1,length(stroka),'*');
   func(1,length(stroka),'+');

  writeln('=',chisla[1]);
  writeln();
  end;
 End.
Buratino вне форума Ответить с цитированием
Старый 10.10.2010, 12:48   #13
Соколов Дмитрий
Пользователь
 
Аватар для Соколов Дмитрий
 
Регистрация: 26.03.2009
Сообщений: 55
По умолчанию

Ты слишком загромоздил код программы, мы её на курсах начальных делали, вспомню, скину код
Sokol
Соколов Дмитрий вне форума Ответить с цитированием
Старый 10.10.2010, 13:13   #14
Соколов Дмитрий
Пользователь
 
Аватар для Соколов Дмитрий
 
Регистрация: 26.03.2009
Сообщений: 55
По умолчанию

Program kalkulator;
Var a,r,c: real;
b: char;
Begin
Write('Первое число:');
readln (a);
Write ('Введите знак');
readln (b);
Write ('Второе число');
readln (c);
case b of
'+': r:=a+c;
'-': r:=a-c;
'*': r:=a*c;
'/': r:=a/c;
end;
Write ('Результат:',r);
End.
Sokol

Последний раз редактировалось Соколов Дмитрий; 10.10.2010 в 13:28.
Соколов Дмитрий вне форума Ответить с цитированием
Старый 10.10.2010, 13:18   #15
Соколов Дмитрий
Пользователь
 
Аватар для Соколов Дмитрий
 
Регистрация: 26.03.2009
Сообщений: 55
По умолчанию

Вариантов много, но краткость сестра таланта)))
Sokol

Последний раз редактировалось Соколов Дмитрий; 10.10.2010 в 14:03.
Соколов Дмитрий вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
калькулятор FARGO Общие вопросы Delphi 1 14.12.2008 23:01
Калькулятор ViNcHeStEr Помощь студентам 5 23.11.2008 15:39
Калькулятор Димарик Общие вопросы Delphi 1 04.10.2008 15:52
Калькулятор Nixtone Помощь студентам 7 03.07.2008 23:17
Калькулятор! HAMMAN Помощь студентам 15 04.03.2007 13:25