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

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

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

Восстановить пароль
Повторная активизация e-mail

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

Ответ
 
Опции темы Поиск в этой теме
Старый 18.04.2010, 21:10   #1
ttjke
Пользователь
 
Регистрация: 30.11.2009
Сообщений: 13
По умолчанию Калькулятор римских цифр

Я сделал калькулятор римских цифр,только вот проблема тысяча (М) не вводится.Подскажите пожалуйста почему
Код:
function TForm2.Digit(C: Char): Word;
begin
    Result:=0;
  case C of
  'I': Result:=1;
    'V': Result:=5;
    'X': Result:=10;
    'L': Result:=50;
    'C': Result:=100;
    'D': Result:=500;
    'M': Result:=1000;
  end;


end;
procedure TForm2.exClick(Sender: TObject);
begin
case N of
  1: Aredit.Text:=IntTostr(X+StrToInt(Aredit.Text));

  2: Aredit.Text:=IntTostr(X-StrToInt(Aredit.Text));

  3: Aredit.Text:=IntTostr(X*StrToInt(Aredit.Text));

  4: Aredit.Text:=IntTostr(X Div StrToInt(Aredit.Text));
end;

REdit.Text:=ArabycToR(StrToInt(Aredit.Text));

end;



function TForm2.RToArabyc(S: String): Integer;
Var
  I,A,I9,I1:Integer;
  x9x:Boolean;   
  Ar9x:Array[1..7] Of Boolean;    
  Ar19x:Array[1..7] Of Boolean;
  Ar1x:Array[1..7] Of Word;       
  x91, x19:word;
begin
x19:=7;
  for I := 1  to 7 do
  begin
    Ar9x[I]:=False;         

    if I mod 2 = 0  then     
    Ar1x[i]:=1               

    else
    Ar1x[i]:=3;               

  end;
  x9x:=False;               
  Result:=0;                 

  for I := 1  to length(s) do 
  begin


      for A := 1 to 7 do     
      begin



        if S[i] = RChars[A] then
        Begin
          if x91=a then      
          Begin
            Result:=-1;
            Exit;
          End;
          if not x9x then     
          Begin

              if Digit(S[i])>=Digit(S[i+1]) then 
              Begin                            


                  if Ar1x[A]>0 then              
                  Begin
                     For I1:=1 to A do
                     Begin
                    
                       if (Ar9x[I1]) or (x19-1<A) then
                       Begin
                         Result:=-1;
                         Exit;
                       End;

                     End;
                     Result:=Result+Digit(RChars[A]); 
                     Ar1x[A]:= Ar1x[A]-1;
                     Break;
                  End

                  Else
                  Begin
                     Result:=-1; 
                     Exit;
                  End;
              End
Else  
              Begin
             If  ((A mod 2 = 1) and (Ar1x[A]<3))then
               Begin
                     Result:=-1;
                     Exit;
               End;
 x9x:=True;  
                 if x19>A then
                 x19:=A;
                  Break;
              End;
End
 Else         
         Begin
 for i9:=2 to A do 
           Begin             
              if (Ar9x[I9]) or ((I9-1 mod 2 = 0) and (Ar1x[I9-1]<1)and (S[I-1]<>RChars[I9-1])) or ((I9-1 mod 2 = 1) and (Ar1x[I9-1]<3)and (S[I-1]<>RChars[I9-1]))then
              Begin
              Result:=-1;
              Exit;
              End;

           End;
 x9x:=False;     
           Ar9x[A]:=True;   
           x91:=A; 
           Result:=Result+Digit(S[I])-Digit(S[I-1]);  
           Break;
         End;
 End;
end
end;
end;
function TForm2.ArabycToR(INT: Integer): String;
Var
  a,o,I,Index:Integer;
begin
  Result:='';
  O:=Int;
  if Int>3000 then
  begin
    ShowMessage('Слишком большое значение');
    Exit;
  end;
  for I := 1 to 13 do
  begin
    a:= O Div rDigitsV[i];
    o:= O Mod rDigitsV[i];
    for Index := 1 to A do
    Result:=Result+rDigits[I];
end;
end;
procedure TForm2.Verify;
Var
  Ar1x:Array[1..7] Of Word;
  Ar9x:Array[1..7] Of Boolean;
  T:string;
begin
while RToArabyc(Redit.Text)<0 do
  begin
    T:=Redit.Text;
    Delete(T,length(T),1);
    Redit.Text:=T;
  end;
  ArEdit.Text:=IntToStr(RToArabyc(REdit.Text));
end;
Procedure TForm2.MSpeedButtonClick(Sender: TObject);
begin
  REdit.Text:=REdit.Text+'M';
  Verify;
end;
ttjke вне форума Ответить с цитированием
Старый 19.04.2010, 23:03   #2
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,229
По умолчанию

Перевод из арабских цифр в римские и обратно...
http://www.programmersforum.ru/showp...40&postcount=3
Serge_Bliznykov вне форума Ответить с цитированием
Старый 20.04.2010, 12:29   #3
ttjke
Пользователь
 
Регистрация: 30.11.2009
Сообщений: 13
По умолчанию

перевести я перевел, мне надо чтоб в edit отображалось тысяча (М)
остальные все отображаются
ttjke вне форума Ответить с цитированием
Старый 20.04.2010, 14:26   #4
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,229
По умолчанию

с телепатами на форуме традиционно плохо...

Цитата:
мне надо чтоб в edit отображалось тысяча (М)
А что отображается?

выложите целиком проект (исходники запакуйте и выложите на любой хостинг).
Сформулируйте чётко, что Вы делаете, что при этом происходит, а что должно по Вашему мнению происходить...
тогда Ваши шансы получить толковый ответ резко увеличиваются!
Serge_Bliznykov вне форума Ответить с цитированием
Ответ


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



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Перевод из римских в арабские числа winnix Помощь студентам 23 31.05.2010 15:40
Калькулятор римских цифр ttjke Помощь студентам 2 21.03.2010 16:57
Сортировка римских чисел nopster Общие вопросы C/C++ 0 18.06.2009 12:00
Натуральное число, в записи которого п цифр, называется числом Армстронга, если сумма его цифр, возведенн OTLi4HO Общие вопросы C/C++ 6 14.01.2009 19:48
Калькулятор ViNcHeStEr Помощь студентам 5 23.11.2008 15:39