Магические Квадраты, Проблема с четностью Опции

[alecsandr]

Помогите кто может, просто когда ничетный строит номально, четно-четный тоже хорошо, а четный не хочет пахать((

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, XPMan, StdCtrls, Grids;
type matr=array[1..50,1..50] of integer;
type
  TForm1 = class(TForm)
    Label2: TLabel;
    Label4: TLabel;
    StringGrid1: TStringGrid;
    Edit2: TEdit;
    Edit1: TEdit;
    Button1: TButton;
    XPManifest1: TXPManifest;
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  a:matr;
  z:boolean;
implementation

{$R *.dfm}

Procedure OddMagic(n2:integer; var a1:matr);
{Ïðîöåäóðà ôîðìèðîâàíèÿ ìàãè÷åñêîãî êâàäðàòà ïðè íå÷åòíîì n.}
Var
i,j,k:integer;
p,l:integer;
Begin
for j:=1 to n2 do
 for i:=1 to n2 do
  a[i,j]:=0;
  i:=n2 div 2 +1;
  p:=sqr(n2);
  j:=1;
  a1[i,j]:=1;
  for l:=2 to p do
   begin
	j:=j-1;
	i:=i+1;
	if (j=0) and (i<>n2+1) then
	 j:=n2;
	 if (i=n2+1) and (j<>0) then
	  i:=1;
      if ((j=0) and (i=n2+1)) or (a1[i,j]<>0) then
		begin
		 j:=j+2;
		 i:=i-1;
		end;
	a1[i,j]:=l;
   end;
end;

Procedure Two (n:integer; var a:matr);
{Ïðîöåäóðà ïîñòðîåíèÿ êâàäðàòà ïðè n îáû÷íîé ÷åòíîñòè: n=6,10,14,18...}
Var
u,i,j,k,m,z:integer;
b:matr;
Begin
u:= n div 2;
m:=(u-1) div 2;
OddMagic(u,b); 
{âûçîâ ïðîöåäóðû ïîñòðîåíèÿ êâàäðàòà ïðè íå÷åò-íîì u}
k:=u*u;
for i:=1 to n do
for j:=1 to n do begin
if (i>=1) and (i<=u) and (j>=1) and (j<=u) then 
a[i,j]:=b[i,j];
if (i>=u+1) and (i<=n) and (j>=u+1) and (j<=n) then 
a[i,j]:=b[i-u,j-u]+k;
if (i>=1) and (i<=u) and (j>=u+1) and (j<=n) then 
a[i,j]:=b[i,j-u]+2*k;
if (i>=u+1) and (i<=n) and (j>=1) and (j<=u) then 
a[i,j]:=b[i-u,j]+3*k;
end;
for i:=1 to u do
if i=u div 2+1 then 
begin
j:= u div 2+1;
for k:=1 to m do 
begin
z:=a[i,j]; 
{îáìåí äàííûìè}
a[i,j]:=a[i+u,j];
a[i+u,j]:=z;
j:=j-1
end;
end
else 
begin
j:=1;
for k:=1 to m do
 begin
z:=a[i,j]; 
{îáìåí äàííûìè}
a[i,j]:=a[i+u,j];
a[i+u,j]:=z;
j:=j+1
end;
end;
j:=n;
for k:=1 to m-1 do 
begin
for i:=1 to u do 
begin
z:=a[i,j]; a[i,j]:=a[i+u,j]; a[i+u,j]:=z; 
{îáìåí äàííûìè}
end;
j:=j-1
end;
end;

Procedure Four(n2:integer; var a1:matr);
{Ïðîöåäóðà ïîñòðîåíèÿ êâàäðàòà ïðè n äâîéíîé ÷åòíîñòè: n=4,8,12,16...}
Var i,j,k:integer;
p,l:integer;
i1,j1,x,y:integer;
Begin
l:=0;
 p:=n2*n2;
 for j:=1 to n2 do
  for i:=1 to n2 do
   begin
    a1[i,j]:=l;
	inc(l)
   end;
  j:=2;
  while i<=n2-2 do
   begin
	if j mod 4=0 then
	 i:=4
	else
	 i:=2;
  while i<=n2-2 do
   begin
	for i1:=0 to 1 do
	 for j1:=0 to 1 do
	  begin
	   y:=j+i1;
	   x:=i+j1;
	   a[y,x]:=p-a[y,x]+1;
      end;
     i:=i+4;
   end;
  j:=j+2
  end;
  k:=4;
  while k<=n2-4 do
   begin
    a1[1,k]:=p-a1[1,k]+1;
	a1[1,k+1]:=p-a1[1,k+1]+1;
	a1[n2,k]:=p-a1[n2,k]+1;
	a1[n2,k+1]:=p-a1[n2,k+1]+1;
	a1[k,1]:=p-a1[k,1]+1;
	a1[k+1,1]:=p-a1[k+1,1]+1;
	a1[k,n2]:=p-a1[k,n2]+1;
	a1[k+1,n2]:=p-a1[k+1,n2]+1;
	k:=k+4
   end;
  a1[1,1]:=p-a1[1,1]+1;
  a1[n2,n2]:=p-a1[n2,n2]+1;
  a1[1,n2]:=p-a1[1,n2]+1;
  a1[n2,1]:=p-a1[n2,1]+1;
end;

procedure process(var a1:matr);
var
    n1,m:integer;
    i,j,k:Integer;
    p,l:Integer;
    i1,j1,x,y:Integer;
Begin
if length(form1.Edit1.Text)=0 then
 begin
  MessageDlg('Íàäî ââåñòè ðàçìåðíîñòü',mtInformation,[mbOk],0);
  z:=false;
  exit;
 end;
n1:=StrtoInt(form1.Edit1.Text);
if odd(n1) then   // íå÷åòíûé
 OddMagic(n1,a1)
 else
 if n1 mod 4=0 then
  Four(n1,a1)
 else
  Two(n1,a1);
end;

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
case Key of
'0'..'9',#8:;
else key:=chr(0);
end;
end;


procedure TForm1.Button1Click(Sender: TObject);
var i,j,sum:integer;
begin
form1.Edit2.Clear;
for i:=0 to form1.StringGrid1.RowCount-1 do
 for j:=0 to form1.StringGrid1.ColCount-1 do
   form1.StringGrid1.Cells[i,j]:='';
z:=true;
Process(a);
if z then
Begin
form1.StringGrid1.ColCount:=strtoint(form1.Edit1.Text);
form1.StringGrid1.RowCount:=strtoint(form1.Edit1.Text);
for i:=0 to form1.StringGrid1.RowCount-1 do
 for j:=0 to form1.StringGrid1.ColCount-1 do
 form1.StringGrid1.Cells[i,j]:=inttostr(a[i+1,j+1]);
sum:=(strtoint(form1.Edit1.Text)*(strtoint(form1.Edit1.Text)*strtoint(form1.Edit1.Text)+1)) div 2;
form1.Edit2.Text:=inttostr(sum);
end
else
exit;
end;

end.

 Маг_квадрат___копия.rar ( 12.06 килобайт ) Кол-во скачиваний: 420