Help!строки! Опции

[SERGSWAT]

Текст адания:
Дан текст из заглавных латинских букв, за которыми следует пробел. Определите, является ли этот текст правильной записью римскими цифрами числа от 1 до 999, и если является, то записать его арабскими(в десятичной системе)...вот и все. Уменя есть программа для преобразования римских цифр в арабские, но она работает не корректно, т.е число 4 записывает в виде IIII а не IV. Вот она:

Код

program TranslateRomanToArab;
USES CRT;
const
Trans: array[1..13] of record
Arab: word;
Roman: string;
end = ((Arab: 1000; Roman:'M'), (Arab: 900; Roman: 'CM'),
(Arab: 500; Roman: 'D'), (Arab: 400; Roman: 'CD'),
(Arab: 100; Roman: 'C'), (Arab: 90; Roman: 'XC'),
(Arab: 50; Roman: 'L'), (Arab: 40; Roman: 'XL'),
(Arab: 10; Roman: 'X'), (Arab: 9; Roman: 'IX'),
(Arab: 5; Roman: 'V'), (Arab: 4; Roman: 'IV'),
(Arab: 1; Roman: 'I'));

var
Rchislo: string;
Achislo: longint;
CurNumber: byte;
CurSymbol: string;
CurVal: word;
begin
clrscr;
Write('Input Roman Number: ');
ReadLn(Rchislo);

{ If value in RomanNumber is incorrect, then value of ArabianNumber is }
{ incorrect too }

{--- Translate ---------}
Achislo := 0;
CurNumber := 1;
repeat
CurSymbol := Trans[CurNumber].Roman;
CurVal := Trans[CurNumber].Arab;

while Copy(Rchislo, 1, Length(CurSymbol)) = CurSymbol do
begin
Inc(Achislo, CurVal);
Delete(Rchislo, 1, Length(CurSymbol));
end;

Inc(CurNumber); {smeshenie poryadka na 1}
until Rchislo = '';
{--- End of translate ---------}

WriteLn('Arabian Number: ', Achislo);
READLN;
end.

Как мне сюда вставить условие на проверку является ли введеная строка римским числом или нет!!!

Сообщение отредактировано: volvo - 4.01.2006 3:05

[volvo]

FAQ: Работа с римскими числами смотрел?

Кроме этого, пользуйся тегами [ code ] и в следующий раз давай более корректное название темы...

[SERGSWAT]

Народ, вот у меня возникла проблема: вроде бы работающая прога:

program stroka;
USES CRT;
Const
     konst=13 ;
     R: Array[1 .. konst] of String =
        ('I','IV','V','IX','X','XL','L','XC','C','CD','D','CM','M');
     A: Array[1 .. konst] of Integer =
        (1,4,5,9,10,40,50,90,100,400,500,900,1000);
Var
	N, Err,i : Integer;
	vv_stroka: string;
        BigText: string;
{---------- perevod stroki v verhniy registr ---------------}
function Big(vv_stroka: string): string;
begin
		for i:=1 to length(vv_stroka) do
              	begin
                   case vv_stroka[i] of
                        'a'..'z': dec(vv_stroka[i],32);
                        '1'..'0': dec(vv_stroka[i],1);
              	   end;
     	        end;
	 	BigText:=vv_stroka;
end;
{---------opredelenie pravil'nosti zapisi rimskogo chisla----------------}
Function Rchislo(N: Integer): String;
Var
	Result: String;
	i: Integer;
begin
	Result:= '';
	i :=13;        {kolichestvo elementov v massive}
	While N > 0 do
        	begin
			While A[i] > N do Dec(i);
			Result := Result + R[i];
			Dec(N, A[i]);                           		end;
	Rchislo := Result;
end;

{------------ rimskoe chislo to arabskoe chislo ---------------}
Function Achislo(BigText: String): integer;
Var
	Result,i, p: Integer;
        error:string;
begin
        Achislo := -1 ;	
        error:='Dannaya stroka ne yavlaetsya chislom';
	Result := 0;
	i :=13;
	p := 1;
        begin
	     While p <=Length(BigText) do
		begin
			While Copy(BigText, p, Length(R[i])) <> R[i] do
				begin
					Dec(i);
					If i = 0 then Exit;
				end;
			Result := Result + A[i];
			p := p + Length(R[i]);
		end;
	     If Rchislo(Result) = BigText then Achislo := Result
        end;

end;
{================= osnovnaya programma ======================}
begin
     clrscr;
	write('Vvedite stroku:');   {vvod stroki}
       	readln(vv_stroka);
        Big(vv_stroka);           {preobrazovanie v verxniy registr}
        writeln('Preibrazovannaya stroka:',BigText:5);
        Achislo(BigText);
        writeln('chislo:',Achislo(BigText):7);
        readln;
end.

Как мне вставить вот эту часть проги на разбиение строки на слова в основную часть проги (выше):

 {------------ razbienie stroki na slova ----------------}

Procedure Razbienie(vv_stroka:string);
Var
 i:Integer;
 w:String;

Begin

     If vv_stroka[Length(vv_stroka)]<>' 'Then
     vv_stroka:=vv_stroka+' ';
     W:=' ';
     writeln('VVEDENIE SLOVA:');
     For i:=1 To length(vv_stroka) Do
         begin
          If vv_stroka[i]<>' ' Then w:=w+vv_stroka[i]
             Else
              Begin
                   WriteLn(w);
                   w:=' ' ;
              End;

         End;
READLN;
end;

вот здесь возникает вопрос: Как вывести на экран, что введеная строка не является римским числом!!!

Сообщение отредактировано: volvo - 7.11.2006 3:27