Forum MOJA PASJA - PROGRAMOWANIE Strona Główna
http://www.programuj.com
  WikiWiki  FAQFAQ    SzukajSzukaj    UżytkownicyUżytkownicy    GrupyGrupy   RejestracjaRejestracja 
 ProfilProfil   Zaloguj się, by sprawdzić wiadomościZaloguj się, by sprawdzić wiadomości   ZalogujZaloguj 




Dodawanie liczb rzymskich


 
Napisz nowy temat   Odpowiedz do tematu    Forum MOJA PASJA - PROGRAMOWANIE Strona Główna -> Pascal
Zobacz poprzedni temat :: Zobacz następny temat  
Autor Wiadomość
bemol



Dołączył: 04 Lut 2010
Posty: 1

Post Zacytuj zaznaczone Odpowiedz z cytatem OCEŃ POST
Witam. Mam problem. Napisałem program, który pobiera dane z pliku tekstowego i dodaje rzędami liczby rzymskie. Jednak w pewnym momencie zaczęło się coś chrzanić.
Program muszę napisać na dziś Very Happy na godzinę 10, jeśli komuś się chce to prosiłbym o pomoc.

Funkcje:
Digits - zamienia pojedynczy znak rzymski na liczbę arabską
HowLong - zwraca długość linijek pliku
Roman2Arabic - zamienia rzymską na arabską
Arabic2Roman - na odwrót
CheckNumber - sprawdza poprawność liczby (np. czy nie jest VV,XXXX,IIIV)
ConvertNumber - zamienia niepoprawną liczbę na poprawną
Procedura:
UseFile - pobiera z pliku liczby i dodaje do tablicy dwuwymiarowej (wiersz,liczba)

kod poniżej:
Pascal:

program Rzymskie;

{$APPTYPE CONSOLE}

uses
  SysUtils;

var content:array[1..100,1..10] of string;
myLength,k,l,suma:integer;
myF:string;
decision:char;

function Digits(RomanNumber:char):integer;
var x:integer;
begin
x:=0;
if RomanNumber='M' then x:=1000;
if RomanNumber='D' then x:=500;
if RomanNumber='C' then x:=100;
if RomanNumber='L' then x:=50;
if RomanNumber='X' then x:=10;
if RomanNumber='V' then x:=5;
if RomanNumber='I' then x:=1;
if x=0 then Digits:=0
else Digits:=x;
end;

function HowLong(nameOfFile:string):integer;
var i:integer;
contentFile:text;
  begin
    i:=0;
    assign(contentFile,nameOfFile + '.txt');
    reset(contentFile);
    while not EOF(contentFile) do
    begin
    readln(contentFile);
    inc(i);
    end;
    Result:=i;
  end;

function Roman2Arabic(aNumber:string):integer;
var LengthNumber:integer;
i:integer;
NewNumber:integer;
begin
i:=1;
NewNumber:=0;
LengthNumber:=Length(aNumber);
while i<LengthNumber do
  begin
    if i=LengthNumber then NewNumber:=NewNumber+Digits(aNumber[i])
    else
    begin
    if Digits(aNumber[i])>=Digits(aNumber[i+1]) then
    NewNumber:=NewNumber+Digits(aNumber[i])
    else NewNumber:=NewNumber-Digits(aNumber[i])
    end;
  inc(i);
  end;
Roman2Arabic:=NewNumber;
end;

function Arabic2Roman(Number:integer):string;
var Roman:array[1..13] of string;
Arabic:array[1..13] of integer;
exRoman:string;
temp,i:integer;
begin
Arabic[1]:=1;Arabic[2]:=4;Arabic[3]:=5;Arabic[4]:=9;Arabic[5]:=10;Arabic[6]:=40;Arabic[7]:=50;Arabic[8]:=90;Arabic[9]:=100;Arabic[10]:=400;Arabic[11]:=500;Arabic[12]:=900;Arabic[13]:=1000;
Roman[1]:='I';Roman[2]:='IV';Roman[3]:='V';Roman[4]:='IX';Roman[5]:='X';Roman[6]:='XL';Roman[7]:='L';Roman[8]:='XC';Roman[9]:='C';Roman[10]:='CD';Roman[11]:='D';Roman[12]:='CM';Roman[13]:='M';
exRoman:='';
temp:=Number;
for i:=13 downto 1 do
  while temp>=Arabic[i] do
  begin
  temp:=temp-Arabic[i];
  exRoman:=exRoman+Roman[i];
  end;
Arabic2Roman:=exRoman;
end;

function CheckNumber(Number:string):integer;
var NumberLenght,i:integer;
x:integer;
begin
x:=0;
NumberLenght:=Length(Number);
for i:=1 to NumberLenght do
begin
if Number[i]=Number[i+1] then
if (Number[i]='L') or (Number[i]='V') or (Number[i]='D') then x:=1;
end;
if NumberLenght > 3 then
begin
for i:=1 to NumberLenght do
begin
if (Number[i]=Number[i+1]) and (Number[i]=Number[i+2]) and (Number[i]=Number[i+3]) then x:=2;
end;
end;
if x>0 then CheckNumber:=x
else CheckNumber:=0;
end;

function ConvertNumber(Number:string):string;
var temp,Len,i:integer;
begin
if Number<>'' then
begin
Len:=Length(Number);
temp:=0;
for i:=1 to Len do
begin
  if Digits(Number[i])>=Digits(Number[i+1]) then
  temp:=temp+Digits(Number[i])
  else temp:=temp-Digits(Number[i]);
end;
ConvertNumber:=Arabic2Roman(temp);
end;
end;

procedure UseFile(nameOfFile:string);
var i,u:integer;
myWord:string;
myCharacter:char;
contentFile:text;
  begin
    assign(contentFile,nameOfFile + '.txt');
    reset(contentFile);
    i := 1;
    u := 1;
    myWord := '';
    while not EOF(contentFile) do
      begin
        while not EOLn(contentFile) do
        begin
          read(contentFile,myCharacter);
          if not (myCharacter = ' ') then myWord := myWord + myCharacter
          else
          begin
            content[i][u] := myWord;
            inc(u);
            myWord := '';
          end;
        end;
        read(contentFile,myCharacter);
        content[i,u] := myWord;
        myWord := '';
        inc(i);
        u := 1;
      end;
  end;

begin
  myF:='';
  suma:=0;

    repeat
      writeln('Wprowadz nazwe pliku (bez rozszerzenia), ktory ma sluzyc jako dane:');
      readln(myF);
    until myF <> '';

  myLength := HowLong(myF);

  if myLength < 100 then
    begin
      UseFile(myF);
        for k:=1 to myLength do
          begin
            for l:=1 to 10 do
              begin
                if content[k,l]<>'' then
                begin
                  if CheckNumber(content[k,l])=0 then
                    suma:=suma+Roman2Arabic(content[k,l])
                  else
                  repeat
                    begin
                      writeln('W pliku istnieje liczba zapisana niepoprawnie w formacie liczb rzymskich, czy konwertowac do poprawnej liczby? (t/n)');
                      readln(decision);
                    end;
                  until (upcase(decision)='T') or (upcase(decision)='N');

                  decision:=upcase(decision);

                  if (decision='T') then
                    writeln(ConvertNumber(content[k,l]))
                  else writeln('Niepoprawna liczba');
                  decision:=#0;
            end;
          end;
        writeln(suma);
        suma:=0;
        end;
    end
  else writeln('Plik ' + myF + '.txt jest zbyt dlugi. Maksymalna ilosc wierszy w pliku to 100.');
  readln;
end.
Powrót do góry
Ogląda profil użytkownika Wyślij prywatną wiadomość
Wyświetl posty z ostatnich:   
Napisz nowy temat   Odpowiedz do tematu    Forum MOJA PASJA - PROGRAMOWANIE Strona Główna -> Pascal Wszystkie czasy w strefie CET (Europa)
Strona 1 z 1

 
Skocz do:  
Nie możesz pisać nowych tematów
Nie możesz odpowiadać w tematach
Nie możesz zmieniać swoich postów
Nie możesz usuwać swoich postów
Nie możesz głosować w ankietach


hosting sponsorowany przez hosted.pl
Powered by phpBB © 2001, 2002 phpBB Group