Skocz do zawartości

skasna

Użytkownicy
  • Zawartość

    1
  • Rejestracja

  • Ostatnia wizyta

Reputacja

0 Neutralny

O skasna

  • Tytuł
    Chicken
  1. problem z programem

    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.
×