witam
mam maly problem z programem i juz sama nie wiem co mam zrobic
mam program ktory zamienia liczby w systemie rzymskim na arabskie i na odwrot. z zamiana na rzymskie nie ma problemow, chodzi o rzymskie na arabskie.
w samej zamianie nie ma raczej bledow, ale zamiana ta nie uwzglednia tego, jak ktos napisze zla liczbe (np. XXX czy XIXI) i wtedy tez wypisuje wynik. zeby przed tym sie uchronic, podana liczbe w systemie rzymskim zamieniam na arabska i potem spowrotem na rzymska ta druga moja funkcja i sprawdzam czy zamieniona liczba i ta podana przez uzytkownika sa takie same. jesli sa, to program powinien wypisac liczbe arabska, jesli nie, poinformowac o bledzie. jednak za kazdym razem informuje o bledzie, mimo ze zamieniona i podana sa takie same (kaze programowi wypisywac ta zamieniona, i rzeczywiscie sa one takie same). juz nie wiem co moge zrobic, prosze o pomoc:)
program ArabskieRzymskie;
uses
Crt;
var
Arabska : integer;
Rzymska : string;
procedure start(tytul:string);
begin
ClrScr;
writeln(tytul);
writeln
end;
procedure czekaj;
begin
writeln;
writeln('Nacisnij klawisz ENTER');
readln
end;
function Wstaw(num : integer; one, five, ten : string) : string;
var
i: integer;
T: string;
begin
T:='';
if num < 4 then for i:=1 to num do T:=T+one;
if num = 4 then T:=one + five;
if num = 5 then T := five;
if (num > 5) and (num < 9) then
begin
T:=five;
for i:=1 to num - 5 do T:=T+one;
end;
if num = 9 then T:=one+ten;
Result := T;
end;
function ar(a: integer): string;
var
i: integer;
Rzym: string;
begin
if (a div 1000) > 0 then
begin
for i := 1 to a div 1000 do
Rzym := Rzym +'M';
a := a mod 1000;
end;
if (a div 100) > 0 then
begin
Rzym := Rzym + Wstaw(a div 100,'C','D','M');
a := a mod 100;
end;
if (a div 10) > 0 then
begin
Rzym := Rzym + Wstaw(a div 10,'X','L','C');
a := a mod 10;
end;
if a > 0 then
Rzym := Rzym + wstaw(a,'I','V','X');
Result := Rzym;
end;
function ra(r : string) : integer;
var
i, add, min, sum: integer;
pom: boolean;
begin
sum := 0;
pom := false;
for i:= 1 to Length(r) do
begin
add := 0;
min := 0;
if pom = false then
begin
case R[i] of
'M': add := 1000;
'D': add := 500;
'C': add := 100;
'L': add := 50;
'X': add := 10;
'V': add := 5;
'I': add := 1;
end;
case R[i + 1] of
'M': min := 1000;
'D': min := 500;
'C': min := 100;
'L': min := 50;
'X': min := 10;
'V': min := 5;
'I': min := 1;
end;
if add < min then begin add := min - add; pom := true; end;
sum := sum + add;
end
else
pom := false;
end;
result := sum;
end;
procedure NaRzymska;
begin
start('Funkcja zamieniajaca liczby arabskie na rzymskie.');
writeln('Podaj liczbe w systemie arabskim: ');
readln(Arabska);
if (Arabska > 0) and (Arabska < 10000) then
begin
writeln('Ta liczba w systemie rzymskim to: ',ar(Arabska));
end
else writeln('Bledna liczba.');
readln;
czekaj;
end;
procedure NaArabska;
var
zamieniona : string;
begin
start('Funkcja zamieniajaca liczby rzymskie na arabskie.');
writeln('Podaj liczbe w systemie rzymskim: ');
readln(Rzymska);
zamieniona := ar(ra(Rzymska));
writeln(Rzymska);
writeln(ra(Rzymska));
writeln(ar(ra(Rzymska)));
if zamieniona=Rzymska
then writeln('Ta liczba w systemie arabskim to: ',ra(Rzymska))
else writeln('Podana przez Ciebie liczba w systemie rzymskim nie jest poprawna.');
readln;
czekaj;
end;
procedure Koniec;
begin
start('Wywolano zakonczenie programu');
czekaj;
halt
end;
procedure Menu;
const format=6;
begin
start('MENU');
writeln('1':format,' - zamiana liczby arabskiej na rzymska');
writeln('2':format,' - zamiana liczby rzymskiej na arabska');
writeln('Esc':format,' - zakoczenie programu');
writeln
end;
procedure KtoraFunkcja(var klawisz:char);
begin
write('Podaj, ktora funkcje wybierasz: 1,2 czy Esc: ');
klawisz:=ReadKey;
writeln(klawisz);
end;
procedure WybierzFunkcje(klawisz:char);
const Esc=#27;
begin
case klawisz of
'1':NaRzymska;
'2':NaArabska;
Esc:Koniec
end
end;
var klawisz:char;
begin
start('Program zamiany liczb');
czekaj;
repeat
Menu;
KtoraFunkcja(klawisz);
WybierzFunkcje(klawisz)
until False
end.
