Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- program Laba_3_1;
- {$APPTYPE CONSOLE}
- uses
- SysUtils;
- type
- TList = array of Integer;
- TInputMode = (WithFile, Console);
- resourcestring
- InstructionMessage
- = 'This program translates arabian numerals to roman numerals';
- ModeOfInputMessage = 'Where do you want to input data from? [F]ile or [C]onsole';
- IncorrectInputFilePathMessage
- = 'Incorrect input file path, check if file exists and try again';
- IncorrectInputModeMessage = 'Incorrect way of input, choose [F]ile or [C]onsole';
- OutputFileExistsErrorMessage
- = 'Incorrect output file, such file already exists, try again';
- ShouldCreateMessage = 'Do you want to save output data into file? [Y]es or [N]o';
- ShouldCreateErrorMessage = 'Incorrect answer, choose [Y]es or [N]o';
- SuccessfullySavedMessage = 'Output data was successfully saved into ';
- InputFilePathMessage = 'Enter input file path';
- OutputFilePathMessage = 'Enter output file path';
- EnterAmountMessage = 'Enter amount of elements of your sequence';
- EnterElemsMessage = 'Enter elements';
- IncorrectFileDataError
- = 'Error! Your input file contains invalid data, correct this and try again';
- IncorrectConsoleInputMessage
- = 'Error! It should be natural number from 1 to 2147483676';
- function GetInputFilePath: string;
- var
- Path: string;
- begin
- Writeln(InputFilePathMessage);
- Readln(Path);
- while not FileExists(Path) do
- begin
- Writeln(IncorrectInputFilePathMessage);
- Readln(Path);
- end;
- GetInputFilePath := Path;
- end;
- function ShouldCreateOutputFile: Boolean;
- var
- Answer: string;
- begin
- Writeln(ShouldCreateMessage);
- Readln(Answer);
- Answer := LowerCase(Answer);
- while (Answer <> 'y') and (Answer <> 'n') do
- begin
- Writeln(ShouldCreateErrorMessage);
- Readln(Answer);
- end;
- ShouldCreateOutputFile := Answer = 'y';
- end;
- function GetOutputFilePath: string;
- var
- Path: string;
- begin
- Writeln(OutputFilePathMessage);
- Readln(Path);
- while FileExists(Path) do
- begin
- Writeln(OutputFileExistsErrorMessage);
- Readln(Path);
- end;
- GetOutputFilePath := Path;
- end;
- function ChooseInputMode: TInputMode;
- var
- Mode: string;
- begin
- Writeln(ModeOfInputMessage);
- Readln(Mode);
- Mode := LowerCase(Mode);
- while (Mode <> 'c') and (Mode <> 'f') do
- begin
- Writeln(IncorrectInputModeMessage);
- Readln(Mode);
- end;
- if Mode = 'f' then
- ChooseInputMode := WithFile
- else
- ChooseInputMode := Console;
- end;
- function ReadFile(var InputFile: TextFile; Len: Integer): TList;
- var
- Sequence: TList;
- i: Integer;
- begin
- SetLength(Sequence, Len);
- Reset(InputFile);
- i := 0;
- while not EoF(InputFile) do
- begin
- Read(InputFile, Sequence[i]);
- Inc(i);
- end;
- CloseFile(InputFile);
- ReadFile := Sequence;
- end;
- function IsFileCorrect(var InputFile: TextFile): Integer;
- var
- AssumedLength, Item: Integer;
- begin
- AssumedLength := 0;
- IsFileCorrect := -1;
- try
- while not EoF(InputFile) do
- begin
- Read(InputFile, Item);
- Inc(AssumedLength);
- end;
- IsFileCorrect := AssumedLength;
- except
- Writeln(IncorrectFileDataError);
- end;
- end;
- function ReadConsole: TList;
- var
- N, i: Integer;
- IsCorrect: Boolean;
- List: TList;
- begin
- IsCorrect := False;
- Writeln(EnterAmountMessage);
- repeat
- try
- Readln(N);
- IsCorrect := True;
- except
- Writeln(IncorrectConsoleInputMessage);
- end;
- until IsCorrect;
- SetLength(List, N);
- Writeln(EnterElemsMessage);
- for i := 0 to N - 1 do
- begin
- IsCorrect := False;
- repeat
- try
- Readln(List[i]);
- IsCorrect := True;
- except
- Writeln(IncorrectConsoleInputMessage);
- end;
- until IsCorrect;
- end;
- ReadConsole := List;
- end;
- procedure WriteList(var OutputFile: TextFile; List: TList);
- var
- i, LastIndex: Integer;
- begin
- LastIndex := High(List);
- for i := 0 to LastIndex do
- Write(OutputFile, List[i], ' ');
- Writeln(OutputFile, '');
- end;
- procedure SortList(var OutputFile: TextFile; List: TList);
- var
- i, j, LastIndex, Current: Integer;
- begin
- LastIndex := High(List) + 1;
- Writeln(OutputFile, 'Sorted seqeunce');
- for i := 1 to LastIndex do
- begin
- WriteList(OutputFile, List);
- Current := List[i];
- j := i - 1;
- while (List[j] > Current) and (j >= 0) do
- begin
- List[j+1] := List[j];
- Dec(j);
- end;
- List[j+1] := Current;
- end;
- end;
- function Translate(Num: Integer): string;
- var
- Pattern, Triple, Roman, Temp: string;
- i, j, Divider, Digit, Whole, Remainder: Integer;
- begin
- Pattern := 'IVXLCDMMM';
- Roman := '';
- Divider := 1000;
- for i := 1 to 4 do
- begin
- Temp := '';
- Digit := Num div Divider mod 10;
- Divider := Divider div 10;
- Writeln(Digit);
- Whole := Digit div 5;
- Remainder := Digit mod 5;
- Triple := Copy(Pattern, 8 - (2*i - 1), 3);
- Writeln('Triple: ', Triple);
- if Whole = 1 then
- Temp := Temp + Triple[2];
- if (Remainder > 0) and (Remainder < 4) then
- for j := 1 to Remainder do
- Temp := Temp + Triple[1];
- if Remainder = 4 then
- if Whole = 0 then
- Temp := Triple[1] + Triple[2]
- else
- Temp := Triple[1] + Triple[3];
- //Temp := Temp + ' ';
- Writeln(Temp);
- Roman := Roman + Temp;
- Writeln('--------------');
- end;
- Writeln('Roman: ', Roman);
- end;
- procedure Main;
- var
- Len: Integer;
- List, ListToFile: TList;
- InputFile, OutputFile: TextFile;
- OutputFilePath: string;
- Number: Integer;
- begin
- Writeln(InstructionMessage);
- Readln(Number);
- Translate(Number);
- Writeln('Fin!');
- Readln;
- end;
- begin
- Main();
- end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement