home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / fpkbin99.zip / DEMOS / MAGIC.PAS < prev    next >
Pascal/Delphi Source File  |  1998-10-12  |  2KB  |  89 lines
  1. {****************************************************************************
  2.  
  3.                    Copyright (c) 1994 by Florian Klämpfl
  4.  
  5.  ****************************************************************************}
  6.  
  7. { Demonstrationsprogramm zu FPKPascal }
  8. { berechnet magische Quadrate (Summe alle Spalten, Zeilen und }
  9. { Diagonalen ist gleich)                      }
  10. program magic;
  11.  
  12.   const
  13.      maxsize = 11;
  14.      
  15.   type
  16.      sqrtype = array[1..maxsize, 1..maxsize] of integer;
  17.      
  18.   var
  19.      square : sqrtype;
  20.      size, row, sum : integer;
  21.  
  22.   procedure makesquare(var sq : sqrtype;limit : integer);
  23.   
  24.     var
  25.        num,r,c : integer;
  26.  
  27.     begin
  28.        for r:=1 to limit do
  29.          for c:=1 to limit do 
  30.            sq[r, c] := 0;
  31.        if (limit and 1)<>0 then
  32.          begin
  33.             r:=(limit+1) div 2;
  34.             c:=limit;
  35.             for num:=1 to limit*limit do
  36.               begin
  37.                  if sq[r,c]<>0 then
  38.                    begin
  39.                       dec(r);
  40.                       if r<1 then 
  41.                         r:=r+limit;
  42.                       c:=c-2; 
  43.                       if c<1 then 
  44.                         c:=c+limit;
  45.                    end;
  46.                  sq[r,c]:=num;
  47.                  inc(r);
  48.                  if r>limit then 
  49.                    r:=r-limit;
  50.                  inc(c);
  51.                  if c>limit then 
  52.                    c:=c-limit;
  53.               end; 
  54.          end;
  55.      end;
  56.  
  57.   procedure writesquare(var sq : sqrtype;limit : integer);
  58.   
  59.     var 
  60.        row,col : integer;
  61.  
  62.     begin
  63.        for row:=1 to Limit do
  64.          begin
  65.            for col:=1 to (limit div 2) do
  66.           write(sq[row,2*col-1]:4,' ',sq[row,2*col]:4,' ');
  67.             writeln(sq[row,limit]:4);
  68.          end;
  69.     end;
  70.  
  71. begin
  72.   size:=3;
  73.   while (size<=maxsize) do
  74.     begin
  75.        writeln('Magisches Quadrat mit der Seitenlänge ',size);
  76.        writeln;
  77.        makesquare(square,size);
  78.        writesquare(square,size);
  79.        writeln;
  80.        sum:=0;
  81.        for row:=1 to size do
  82.          sum:=sum+square[row,1];
  83.        writeln('Summe in den Reihen, Spalten und Diagonalen = ', sum);
  84.        writeln;
  85.        writeln;
  86.        size:=size+2;
  87.     end;
  88. end.
  89.