redmanexe

Lab3Challenge3Delphi

Nov 3rd, 2024
9
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 8.29 KB | None | 0 0
  1. Program Lab3Challenge3;
  2.  
  3. {$APPTYPE CONSOLE}
  4.  
  5. uses
  6. SysUtils;
  7.  
  8. Type
  9. TArray = Array of Integer;
  10.  
  11. Const
  12. DEFAULT_INPUT_FILE = './input.txt';
  13. DEFAULT_OUTPUT_FILE = './output.txt';
  14.  
  15. PRINT_TYPE_MIN = 0;
  16. PRINT_TYPE_MAX = 2;
  17.  
  18. SCAN_TYPE_MIN = 0;
  19. SCAN_TYPE_MAX = 1;
  20.  
  21. ARRAY_LENGTH_MIN = 1;
  22. ARRAY_LENGTH_MAX = 1000;
  23. ARRAY_VALUES_MIN = -10000;
  24. ARRAY_VALUES_MAX = 10000;
  25.  
  26. ERR_READ_INT_VALUE = $10000000;
  27.  
  28. Function IsTextFile(Const FilePath: String): Boolean;
  29. Var
  30. IsTxt: Boolean;
  31. Len: Integer;
  32. Begin
  33. Len := Length(FilePath);
  34. IsTxt := ((Len > 2) And (FilePath[Len - 3] = '.') And (FilePath[Len - 2] = 't') And (FilePath[Len - 1] = 'x') And
  35. (FilePath[Len] = 't'));
  36.  
  37. IsTextFile := IsTxt;
  38. End;
  39.  
  40. Function CheckFileAvailability(Const FilePath: String; Const Read: Boolean): Boolean;
  41. Var
  42. IsAvailable: Boolean;
  43. Checkable: TextFile;
  44. Begin
  45. IsAvailable := True;
  46. AssignFile(Checkable, FilePath);
  47. Try
  48. If (Read) Then
  49. Reset(Checkable)
  50. Else
  51. Begin
  52. If (FileExists(FilePath)) Then
  53. Append(Checkable)
  54. Else
  55. Rewrite(Checkable);
  56. End;
  57. Close(Checkable);
  58. Except
  59. IsAvailable := False;
  60. End;
  61.  
  62. If (IsAvailable And Not IsTextFile(FilePath)) Then
  63. IsAvailable := False;
  64.  
  65. CheckFileAvailability := IsAvailable;
  66. End;
  67.  
  68. Function TakeIntValueFromConsole(Const Description: String): Integer;
  69. Var
  70. Value: Integer;
  71. IsCorrect: Boolean;
  72. Begin
  73. IsCorrect := False;
  74. Value := 0;
  75. Repeat
  76. Write(Description);
  77. Try
  78. Readln(Value);
  79. IsCorrect := True;
  80. Except
  81. Writeln('Enter number, not string or anything else!');
  82. End;
  83. Until IsCorrect;
  84.  
  85. TakeIntValueFromConsole := Value;
  86. End;
  87.  
  88. Function TakeIntValueInRangeFromConsole(Const Description: String; Const Min: Integer; Const Max: Integer): Integer;
  89. Var
  90. Value: Integer;
  91. IsCorrect: Boolean;
  92. Begin
  93. Repeat
  94. Value := TakeIntValueFromConsole(Description);
  95. IsCorrect := True;
  96. If ((Value < Min) Or (Value > Max)) Then
  97. Begin
  98. Writeln('Value must be in range from ', Min, ' to ', Max, '!');
  99. IsCorrect := False;
  100. End;
  101. Until IsCorrect;
  102.  
  103. TakeIntValueInRangeFromConsole := Value;
  104. End;
  105.  
  106. Function TakeIntValueFromFile(Var FileToRead: TextFile): Integer;
  107. Var
  108. Value: Integer;
  109. Begin
  110. Try
  111. Read(FileToRead, Value);
  112. Except
  113. Value := ERR_READ_INT_VALUE;
  114. End;
  115.  
  116. TakeIntValueFromFile := Value;
  117. End;
  118.  
  119. Procedure TakeCorrectFile(Var FileToAssign: TextFile; Const Input: Boolean);
  120. Var
  121. FilePath, DefaultFilePath: String;
  122. IsCorrect: Boolean;
  123. Begin
  124. Repeat
  125. DefaultFilePath := DEFAULT_OUTPUT_FILE;
  126. If (Input) Then
  127. Begin
  128. Write('Enter path to input file (when empty - ', DEFAULT_INPUT_FILE, '): ');
  129. DefaultFilePath := DEFAULT_INPUT_FILE;
  130. End
  131. Else
  132. Write('Enter path to output file (when empty - ', DEFAULT_OUTPUT_FILE, '): ');
  133.  
  134. ReadLn(FilePath);
  135. If (FilePath = '') Then
  136. FilePath := DefaultFilePath;
  137. IsCorrect := True;
  138.  
  139. If (Not CheckFileAvailability(FilePath, Input)) Then
  140. Begin
  141. IsCorrect := False;
  142. WriteLn('This path contains wrong file or file, which cannot be accessed! Enter another path!');
  143. End;
  144. Until IsCorrect;
  145.  
  146. AssignFile(FileToAssign, FilePath);
  147. If (Input) Then
  148. Reset(FileToAssign)
  149. Else
  150. Rewrite(FileToAssign);
  151. End;
  152.  
  153. Procedure SortArray(Var Arr: TArray);
  154. Var
  155. Key, I, J, K: Integer;
  156. Begin
  157. Write('[');
  158. For K := 0 To Length(Arr) - 2 Do
  159. Write(Arr[K], ', ');
  160. WriteLn(Arr[Length(Arr) - 1], ']; i = 0');
  161.  
  162. For I := 1 To Length(Arr) - 1 Do
  163. Begin
  164. Key := Arr[I];
  165.  
  166. J := I - 1;
  167. While (J >= 0) And (Arr[J] > Key) Do
  168. Begin
  169. Arr[J + 1] := Arr[J];
  170. J := J - 1;
  171. End;
  172. Arr[J + 1] := Key;
  173.  
  174. Write('[');
  175. For K := 0 To Length(Arr) - 2 Do
  176. Write(Arr[K], ', ');
  177. WriteLn(Arr[Length(Arr) - 1], ']; i = ', I);
  178. End;
  179. End;
  180.  
  181. Function ReadArrayFromFile(): TArray;
  182. Var
  183. Arr: TArray;
  184. FileToRead: TextFile;
  185. IsCorrect: Boolean;
  186. I: Integer;
  187. Begin
  188. Repeat
  189. TakeCorrectFile(FileToRead, True);
  190. Var
  191. N := TakeIntValueFromFile(FileToRead);
  192. IsCorrect := True;
  193. If (N > (ARRAY_LENGTH_MIN - 1)) And (N < (ARRAY_LENGTH_MAX + 1)) Then
  194. Begin
  195. SetLength(Arr, N);
  196. For I := 0 To High(Arr) Do
  197. Begin
  198. Arr[I] := TakeIntValueFromFile(FileToRead);
  199. If (Arr[I] < ARRAY_VALUES_MIN) Or (Arr[I] > ARRAY_VALUES_MAX) Then
  200. IsCorrect := False;
  201. End;
  202. End
  203. Else
  204. Begin
  205. IsCorrect := False;
  206. If (N < ARRAY_LENGTH_MIN) Then
  207. WriteLn('Array cannot be smaller, than ', ARRAY_LENGTH_MIN, '!');
  208.  
  209. If (N > ARRAY_LENGTH_MAX) Then
  210. WriteLn('Array cannot be bigger, than ', ARRAY_LENGTH_MAX, '!');
  211. End;
  212.  
  213. If (N > (ARRAY_LENGTH_MIN - 1)) And (N < (ARRAY_LENGTH_MAX + 1)) And Not IsCorrect Then
  214. WriteLn('File contains wrong values!');
  215. Until IsCorrect;
  216.  
  217. ReadArrayFromFile := Arr;
  218. End;
  219.  
  220. Function ReadArrayFromConsole(): TArray;
  221. Var
  222. N, I: Integer;
  223. Arr: TArray;
  224. Begin
  225. N := TakeIntValueInRangeFromConsole('Enter length value for array (value must be in range from ' + IntToStr(ARRAY_LENGTH_MIN) + ' to ' +
  226. IntToStr(ARRAY_LENGTH_MAX) + '): ', ARRAY_LENGTH_MIN, ARRAY_LENGTH_MAX);
  227. SetLength(Arr, N);
  228. For I := 0 To High(Arr) Do
  229. Begin
  230. Arr[I] := TakeIntValueInRangeFromConsole('Array A element ' + IntToStr(I + 1) +
  231. ' (value must be in range from ' + IntToStr(ARRAY_VALUES_MIN) + ' to ' + IntToStr(ARRAY_VALUES_MAX) + '): ',
  232. ARRAY_VALUES_MIN, ARRAY_VALUES_MAX);
  233. End;
  234.  
  235. ReadArrayFromConsole := Arr;
  236. End;
  237.  
  238. Function ReadArray(): TArray;
  239. Var
  240. ReadType: Integer;
  241. Arr: TArray;
  242. Begin
  243. WriteLn;
  244. WriteLn('How to read values for calculations?');
  245. WriteLn('0 - From keyboard (console)');
  246. WriteLn('1 - From file');
  247. ReadType := TakeIntValueInRangeFromConsole('Enter read type: ', SCAN_TYPE_MIN, SCAN_TYPE_MAX);
  248. If (ReadType = 1) Then
  249. Arr := ReadArrayFromFile()
  250. Else
  251. Arr := ReadArrayFromConsole();
  252.  
  253. ReadArray := Arr;
  254. End;
  255.  
  256. Function SaveResultIntoFile(Const Arr: TArray): Boolean;
  257. Var
  258. Saved: Boolean;
  259. FileToSave: TextFile;
  260. I: Integer;
  261. Begin
  262. Saved := True;
  263. TakeCorrectFile(FileToSave, False);
  264.  
  265. For I := 0 To Length(Arr) - 1 Do
  266. Begin
  267. Write(FileToSave, Arr[I]);
  268. Write(FileToSave, ' ');
  269. End;
  270. Close(FileToSave);
  271.  
  272. SaveResultIntoFile := Saved;
  273. End;
  274. Procedure PrintResultIntoConsole(Const Arr: TArray);
  275. Var
  276. I: Integer;
  277. Begin
  278. WriteLn;
  279. WriteLn('Sorted array:');
  280. For I := 0 To Length(Arr) - 1 Do
  281. Begin
  282. Write(Arr[I]);
  283. Write(' ');
  284. End;
  285. WriteLn;
  286. End;
  287. Procedure PrintResult(Const Arr: TArray);
  288. Var
  289. WriteType: Integer;
  290. Saved: Boolean;
  291. Begin
  292. Saved := False;
  293. WriteLn;
  294. WriteLn('Where post result?');
  295. WriteLn('0 - Only into console');
  296. WriteLn('1 - Only into file');
  297. WriteLn('2 - Into console and into file');
  298. WriteType := TakeIntValueInRangeFromConsole('Enter write type: ', PRINT_TYPE_MIN, PRINT_TYPE_MAX);
  299. Case WriteType Of
  300. 0:
  301. Begin
  302. PrintResultIntoConsole(Arr);
  303. End;
  304. 1:
  305. Begin
  306. Saved := SaveResultIntoFile(Arr);
  307. End;
  308. 2:
  309. Begin
  310. Saved := SaveResultIntoFile(Arr);
  311. PrintResultIntoConsole(Arr);
  312. End;
  313. End;
  314.  
  315. If (Saved) Then
  316. WriteLn('Result saved into file!');
  317. End;
  318.  
  319. Begin
  320. Var Arr: TArray;
  321. WriteLn('3. Sorting by simple insertion method.');
  322. Arr := ReadArray();
  323. SortArray(Arr);
  324. PrintResult(Arr);
  325. WriteLn('Press [ENTER] to close program...');
  326. ReadLn;
  327. End.
Advertisement
Add Comment
Please, Sign In to add comment