magic.pp 2.3 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697
  1. {
  2. This file is part of the Free Pascal run time library.
  3. Copyright (c) 1993-98 by Florian Klaempfl
  4. Magic Square Example
  5. See the file COPYING.FPC, included in this distribution,
  6. for details about the copyright.
  7. This program is distributed in the hope that it will be useful,
  8. but WITHOUT ANY WARRANTY; without even the implied warranty of
  9. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  10. **********************************************************************}
  11. program magic;
  12. {
  13. Calculate a magic square (sum of the row, colums and diagonals is equal
  14. }
  15. const
  16. maxsize = 11;
  17. type
  18. sqrtype = array[1..maxsize, 1..maxsize] of longint;
  19. var
  20. square : sqrtype;
  21. size, row, sum : longint;
  22. procedure makesquare(var sq : sqrtype;limit : longint);
  23. var
  24. num,r,c : longint;
  25. begin
  26. for r:=1 to limit do
  27. for c:=1 to limit do
  28. sq[r, c] := 0;
  29. if (limit and 1)<>0 then
  30. begin
  31. r:=(limit+1) div 2;
  32. c:=limit;
  33. for num:=1 to limit*limit do
  34. begin
  35. if sq[r,c]<>0 then
  36. begin
  37. dec(r);
  38. if r<1 then
  39. inc(r,limit);
  40. dec(c,2);
  41. if c<1 then
  42. inc(c,limit);
  43. end;
  44. sq[r,c]:=num;
  45. inc(r);
  46. if r>limit then
  47. dec(r,limit);
  48. inc(c);
  49. if c>limit then
  50. dec(c,limit);
  51. end;
  52. end;
  53. end;
  54. procedure writesquare(var sq : sqrtype;limit : longint);
  55. var
  56. row,col : longint;
  57. begin
  58. for row:=1 to Limit do
  59. begin
  60. for col:=1 to (limit div 2) do
  61. write(sq[row,2*col-1]:4,' ',sq[row,2*col]:4,' ');
  62. writeln(sq[row,limit]:4);
  63. end;
  64. end;
  65. begin
  66. size:=3;
  67. while (size<=maxsize) do
  68. begin
  69. writeln('Magic Square with size ',size);
  70. writeln;
  71. makesquare(square,size);
  72. writesquare(square,size);
  73. writeln;
  74. sum:=0;
  75. for row:=1 to size do
  76. inc(sum,square[row,1]);
  77. writeln('Sum of the rows,columns and diagonals = ', sum);
  78. writeln;
  79. writeln;
  80. inc(size,2);
  81. end;
  82. end.