Добрый день!!! Помогите пожалуйста решить такую задачу:
Допустим дана такая строка (13121123123-123123123). Как извлечь из нее число до первого знака опереции (*,-,/,+) b и поместить его в другую строку.
Конечно если знать что посли числа идет знак - то можно ипользовать эту реализацию.

function QWERTY(s : string):string;
var
  i,p : byte;
  sum : string;
begin
  sum :='';
  p := pos('-',s);
  for i :=1 to p-1 do
    sum := sum + s[i];
  QWERTY := sum;
end;
begin
Writeln(Qwerty('100528749-300'));
end.

.
А если я не знаю, какой знак операции идет после числа. Как поступать в такой ситуации?????!!

Не используй pos, иди по строке посимвольно:

 i:=1; 
while s[i] in ['0'..'9'] do begin
sum:=sum+s[i]; inc(i);
end; 

Malice, спасибо!!!Разобрался....Осталасась последняя ошибка..Она помойму связана с неправильным переводом числа (из стринг в реал).

Вот код программы. Проблемное место показано комментарием....Помогите пожалуйста. Мне во вторник нужно сдавать эту задачу!!!!!! (это калькулятор на базе польской записи);

 
const
max=1000;
type
 STACK = record
		  top:integer;
		  elem:array [1..max] of char;
		 end;

 STACK2 = record
		  top:integer;
		  elem:array [1..max] of real;
		 end;



 var
 s,s2:stack;
 symv:char;
 {---------------------------------------}
   procedure MakeNull (var S:STACK);
	   begin
		 S.top:=max + 1;
	   end;
{---------------------------------------}
	procedure MakeNullR (var S:STACK2);
	   begin
		 S.top:=max + 1;
	   end;

{---------------------------------------}
   function Empty (S:Stack):boolean;
	   begin
		if S.top > max then
		   Empty:=true
		else
		   Empty:=false;
	   end;
{----------------------------------------}
   function Top(s : stack) : char;
  begin
	if Empty(s) then exit
  else
	  Top := s.elem[s.top];
  end;
{---------------------------------------}
   procedure OutStack (var s:stack; var symv:char);
	  begin
		if Empty (s) then exit
	   else
		begin
		 symv:= s.elem[s.top];
		 s.top:=S.top + 1;
		end;
	  end;
{--------------------------------------}
  procedure OutStackR (var s:stack2; var x:real);
	  begin
		if Empty (s2) then exit
	   else
		begin
		 x:= s.elem[s.top];
		 s.top:=S.top + 1;
		end;
	  end;
{---------------------------------------}
	 procedure Instack (var S:Stack;x:char);
	  begin
		if S.top = 1 then exit
	   else
			begin
			 s.top:=s.top-1;
			 s.elem[s.top]:=x;
			end;
	   end;

{---------------------------------------}
  procedure InstackR (var S:Stack2;x:real);
	  begin
		if S.top = 1 then exit
	   else
			begin
			 s.top:=s.top-1;
			 s.elem[s.top]:=x;
			end;
	   end;
{----------------------------------------}
   function Prior(f : char) : Byte;
begin
	case f of
	   '+','-' : prior := 2;
	   '*','/' : prior := 3;
	   '(' , ')' : prior := 1;
		else
	 prior := 0;
	end;
end;

{----------------------------------------}
 procedure Dell(var s : stack);
begin
	if Empty(s) then exit
	else
	  s.top := s.top + 1;
end;
{----------------------------------------}
  procedure opz (var out:string);
	var
	 i: integer; inp:string;
	 t: boolean; out2:string;
	  begin
	   Makenull(s);
		 write ('INP = ');
		  readln (inp);
		for i:=1 to length (inp) do
		  case inp[i] of
		   '0'..'9': begin
					  if (inp[i]>='0') and (inp[i]<='9') then
						out:=out+inp[i];
						 end;

	'+','-','*','/': begin
					   out:=out+' ';
						while Prior(Top(s))>= Prior(inp[i]) do
						   begin
							outstack(s,symv);
							out:=out+symv+' ';
						   end;
							instack (s,inp[i]);
						  end;


	   '(' : InStack(s,inp[i]);

			')' : begin
					  while Prior(Top(s)) <> 1 do
						 begin
							 OutStack(s,symv);
							 out:=out+' '+symv;
						 end;
					  Dell(s);
				  end;
		end;
	 for i:=max downto s.top do
			out:=out+' '+s.elem[i];

				writeln ('OPZ = ',out);

			  end;
{-----------------------------------------------------}
 procedure Result (out:string;var res:real);
  var
   error:integer;
   num,x,y:real;
   s3:stack2;
   estr:string;
   i:integer;

	begin
	 MakeNullR(s3);
	  for i := 1 to Length(out) do
	   case out[i] of
		 '0'..'9' : begin
				  if (out[i]>='0') and (out[i]<='9') then
					 begin
					  out:=out+out[i];
					  val(out,num,error);
					  InstackR(s3,num);	{<--- TUTA GEMOROY}
					end;
				   end;

			  ' ': begin estr:=estr+out[i]; end;
			  '+': begin
					 OutStackR(s3,y);
					 OutStackR(s3,x);
					 res:=x+y;
				   end;
			  end;
   writeln('mass:');

	 for i:=max downto s3.top do
	  writeln(s3.elem[i]);

   writeln('----------');
  writeln('RES = ',res);
	writeln('----------');
  end;



  var
   outp,inp:string; res:real;
	begin
	 OPZ (outp);
	  Result(outp,res);


	  readln;
	 end.

Maximka, ты опять неверно пытаешься делать... Смотри внимательно:

  for i := 1 to Length(out) do
    case out[i] of
      '0'..'9' : begin
        if (out[i]>='0') and (out[i]<='9') then begin
          out:=out+out[i];
          val(out,num,error);
          InstackR(s3,num); { <--- Здесь ! }
        end;
      end;
  ...

Если строка будет '123+234', сколько чисел у тебя будут занесены в стек? У тебя заносятся ЦИФРЫ! А это не нужно, надо занести именно числа... Я тебе уже говорил об этом. Кстати, зачем новую тему создал? Это же продолжение твоей предыдущей темы про "Польскую запись"...

ЗА новую тему извиняюсь...Старую можно сносить....

volvo, что у меня не получается..Не могли бы вы исправить ошибку...
Когда вводишь 1032+123123 в стек попадает только первое число, причем 8 раз

Я считываю строку до первого пробела и заношу результат в другую строку(out).В этой строке находятся только цифры, соответственно всю строку можно перевести в целое число (real),что я и делаю.В переменной num хранится число, я его переношу в стек S3. И так далее... Я никак не пойму почему в стек попадает несколько раз, только первое число?..Мне очень нужна ваша помощь...Помогите пожалуйста. Это последняя задача, которую мне осталось сдать...

Вот подобная программа, только попроще - там только сложение и вычитание.
Зато все работает.

За вариант спасибо!!, но очень хочется доделать свою..

Вроде исправил...Но один баг остался...Выражения вида (235674234-2565677) считаются на ура. А стоит ввести (235674234-2565677)-234. Результат почемуто неправильный. Помогите ПОЖАЛУЙСТА!!!!!!!!!

const
max=1000;
type
 STACK = record
          top:integer;
          elem:array [1..max] of char;
         end;

 STACK2 = record
          top:integer;
          elem:array [1..max] of real;
         end;



 var
 s,s2:stack;
 symv:char;
 {---------------------------------------}
   procedure MakeNull (var S:STACK);
       begin
         S.top:=max + 1;
       end;
{---------------------------------------}
    procedure MakeNullR (var S:STACK2);
       begin
         S.top:=max + 1;
       end;

{---------------------------------------}
   function Empty (S:Stack):boolean;
       begin
        if S.top > max then
           Empty:=true
        else
           Empty:=false;
       end;
{----------------------------------------}
   function Top(s : stack) : char;
  begin
    if Empty(s) then exit
  else
      Top := s.elem[s.top];
  end;
{---------------------------------------}
   procedure OutStack (var s:stack; var symv:char);
      begin
        if Empty (s) then exit
       else
        begin
         symv:= s.elem[s.top];
         s.top:=S.top + 1;
        end;
      end;
{--------------------------------------}
  procedure OutStackR (var s:stack2; var x:real);
      begin
        if Empty (s2) then exit
       else
        begin
         x:= s.elem[s.top];
         s.top:=S.top + 1;
        end;
      end;
{---------------------------------------}
     procedure Instack (var S:Stack;x:char);
      begin
        if S.top = 1 then exit
       else
            begin
             s.top:=s.top-1;
             s.elem[s.top]:=x;
            end ;
       end;

{---------------------------------------}
  procedure InstackR (var S:Stack2;x:real);
      begin
        if S.top = 1 then exit
       else
            begin
             s.top:=s.top-1;
             s.elem[s.top]:=x;
            end ;
       end;
{----------------------------------------}
   function Prior(f : char) : Byte;
begin
    case f of
       '+','-' : prior := 2;
       '*','/' : prior := 3;
       '(' , ')' : prior := 1;
        else
     prior := 0;
    end;
end;

{----------------------------------------}
 procedure Dell(var s : stack);
begin
    if Empty(s) then exit
    else
      s.top := s.top + 1;
end;
{----------------------------------------}
  procedure opz (var out:string);
    var
     i: integer; inp:string;
     t: boolean; out2:string;
      begin
       Makenull(s);
         write ('INP = ');
          readln (inp);
        for i:=1 to length (inp) do
          case inp[i] of
           '0'..'9': begin
                      if (inp[i]>='0') and (inp[i]<='9') then
                        out:=out+inp[i];
                         end;

    '+','-','*','/': begin
                       out:=out+' ';
                        while Prior(Top(s))>= Prior(inp[i]) do
                           begin
                            outstack(s,symv);
                            out:=out+symv+' ';
                           end;
                            instack (s,inp[i]);
                          end;


       '(' : InStack(s,inp[i]);

            ')' : begin
                      while Prior(Top(s)) <> 1 do
                         begin
                             OutStack(s,symv);
                             out:=out+' '+symv;
                         end;
                      Dell(s);
                  end;
        end;
     for i:=max downto s.top do
            out:=out+' '+s.elem[i];

                writeln ('OPZ = ',out);

              end;
{-----------------------------------------------------}
 procedure Result (out:string ;var res:real);
  var
   error:integer;
   num,x,y:real;
   s3:stack2;
   estr,out2:string;
   i:integer;

    begin
     MakeNullR(s3);
      for i := 1 to Length(out) do
       case out[i] of
         '0'..'9' : begin
                  if (out[i]>='0') and (out[i]<='9') then
                     begin
                      out2:=out2+out[i];
                       end;
                     end;

              ' ': begin
                         val(out2,num,error);
                         InstackR(s3,num);
                         out2:='';
                   end;
              '+': begin
                     OutStackR(s3,y);
                     OutStackR(s3,x);
                     res:=x+y;
                     InStackR(s3,res);
                   end;
              '-': begin
                     OutStackR(s3,y);
                     OutStackR(s3,x);
                     res:=x-y;
                     InStackR(s3,res);
                   end;
              '*': begin
                     OutStackR(s3,y);
                     OutStackR(s3,x);
                     res:=x*y;
                     InStackR(s3,res);
                   end;
              '/': begin
                     OutStackR(s3,y);
                     OutStackR(s3,x);
                     res:=x/y;
                     InStackR(s3,res);
                   end;




              end;
   writeln('mass:');

     for i:=max downto s3.top do
      writeln(s3.elem[i]);

   writeln('----------');
  writeln('RES = ',res);
    writeln('----------');
  end;



  var
   outp,inp:string; res:real;
    begin
     OPZ (outp);
      Result(outp,res);


      readln;
     end.

HELLLLLLLP!!!!!!!!!!!!!!!!!!!!! Мне задачу завтра сдавать!!!!! Очень хочется продолжать учиться!!!!!

Чего кричишь? Сам виноват. Ошибки то простые:
В процедуре Result ты при встрече в строке пробела пытаешься засунуть в стек число. Это было бы логично, если бы пробелы стояли только после чисел, а ты их лепишь и после знаков и после скобок. Всязи с этим проще всего заменить блок в case out[i]

         '0'..'9' : begin
                  if (out[i]>='0') and (out[i]<='9') then 
                    begin 
                       out2:=out2+out[i];
                    end;
          end;

на

'0'..'9' : begin out2:='';
 while (out[i] in ['0'..'9']) and (i<length(out)) do begin
  out2:=out2+out[i]; inc(i);
   end; val(out2,num,error);   dec(i);
     InstackR(s3,num);
 end;

Немного не корректно, но пойдет.
ps: case с пробелом убрать вообще.

Malice, спасибо что откликнулся - добрая душа!!!! Но я уже сам все исправил..Если кому надо то кину исходники...