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

[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 килобайт ) Кол-во скачиваний: 339

[alecsandr]

aдмины ну помогитe, вы жe знaeтe

[Lapp]

aдмины ну помогитe, вы жe знaeтe

Весомый аргумент )).

Напомни, что такое "магический квадрат". А лучше конкретно скажи, чего ты тут добиваешься.

[volvo]

Меня вот заинтересовало, что такое "четно-четный" магический квадрат. Четный - знаю, нечетный - понятно, по аналогии. А четно-четный - это должно быть нечто ужасное...

P.S. Заполнение магического квадрата на Паскале я выкладывал на форуме... По-моему, он работал и для четных и для нечетных N...

[Lapp]

А четно-четный - это должно быть нечто ужасное...

ага, меня это тоже несколько призадумало.. ))
Ждем пояснений автора!

[alecsandr]

чeтно-чeтный это мaгичeский квaдрaт с рaзмeрностью 4, 8, 12, 16 ... Всe что дeлится нa 4. А в прогe нужно, нaписaть прогрaмму пользовaтeль ввeл рaзмeрность, построился квaдрaт. А процeдурa чeтного у мeня нa пaскaлe рaботaeт, a нa дeлфи нeт(

[volvo]

А процeдурa чeтного у мeня нa пaскaлe рaботaeт, a нa дeлфи нeт(

Вот эта процедура работает и в Дельфи тоже: Создание магического квадрата

Вот так, например... (Показать/Скрыть)

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 }
    procedure Draw(p: boolean);
  end;

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

{$R *.dfm}

Procedure Swap(Var a, b: Integer);
 Var T: Integer;
 Begin
   T := a; a := b; b := T
 End;

Function CreateMagic(n: Integer): boolean;
 Var
   i, j, k, s, b, r, m: Integer;
   p: boolean;
 Begin
   p := True;

   If Odd(n) Then
     Begin
       i := 1; j := Succ(n div 2);
       For k := 1 To Sqr(n) do
         Begin
           a[i,j] := k;
           If k mod n = 0 Then Inc(i)
           Else
             Begin
               Dec(i); Inc(j);
               If i = 0 Then i := n;
               If j > n Then j := 1
             End
         End;
     End

   Else
     If n mod 4 = 0 Then
       Begin
         k := 1;
         For i := 1 To n Do
           For j := 1 To n Do
             Begin
               a[i, j] := k; Inc(k)
             End;
         j := 2; m := n div 2;
         For i := 1 To m Do
           For k := 1 To m Div 2 Do
             Begin
               If j = Succ(m) Then j := 2
               Else
                 If j = (m + 2) Then j := 1;
                 s := Succ(n - i); b := Succ(n - j);
                 Swap(a[i, j], a[s, b]);
                 Swap(a[i, b], a[s, j]);
                 Inc(j, 2)
             End
       End

     Else
       If n <> 2 Then
         Begin
           k := 1;
           For i := 1 To n Do
             For j := 1 To n Do
               Begin
                 a[i, j] := k; Inc(k)
               End;
           r := Pred(n div 2) div 2; m := n div 2;

           For i := 1 To m Do
             Begin
               j := i;
               For k := 1 To r Do
                 Begin
                   If j > m Then j := 1;
                   s := Succ(n - i); b := Succ(n - j);
                   Swap(a[i, j], a[s, b]);
                   Swap(a[i, b], a[s, j]);
                   Inc(j)
                 End
             End;

           i := 1; j := Succ®;
           For k := 1 To m Do
             Begin
               If j > m Then j := 1;
               s := Succ(n - i);
               Swap(a[i, j], a[s, j]);
               Inc(i); Inc(j)
             End;

           i := 1; j := r + 2;
           For k := 1 To m Do
             Begin
               If j > m Then j := 1;
               b := Succ(n - j);
               Swap(a[i, j], a[i, b]);
               Inc(i); Inc(j)
             End
         End

       Else p := False;

   result := p;
 End;

procedure TForm1.Draw(p: boolean);
var
  i, j: integer;
  n, sum: integer;
begin
   if p then
   begin
     n := StrToInt(Edit1.Text);
     with StringGrid1 do
       begin
         ColCount := n;
         RowCount := n;
         for i := 0 to pred(RowCount) do
           for j := 0 to pred(ColCount) do
           begin
             Cells[i, j] := IntToStr(a[i+1, j+1]);
           end;
       end;
     sum := (n * (sqr(n) + 1)) div 2;
     Edit2.Text := IntToStr(sum);
   end
   else
     ShowMessage('Не существует...');
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: integer;
begin
  Edit2.Clear;
  for i := 0 to StringGrid1.RowCount - 1 do
    for j := 0 to StringGrid1.ColCount - 1 do
      StringGrid1.Cells[i, j] := '';

  Draw(CreateMagic(StrToInt(Edit1.Text)));
end;

end.

[alecsandr]

я извиняюсь, но можeшь выложить aрхив с этим проeктом.

[volvo]

Могу. Только сразу говорю - он у тебя может не открыться. У меня D2009:

[alecsandr]

a можeшь кинуть ссылку нa 2009, a то у мeня 7 просто кaкую ссылку нe возьму ни однa нe пaшeт

[volvo]

Я не пользуюсь ломаными программами. У меня лицензионная версия.

[TarasBer]

В семёрке открывается, но с кодировками лажа.
Кстати, давно хотел спросить - почему программы, откомпилированные в семёрке, под вистой часто вместо русских букв показывают закорючки?

[alecsandr]

В семёрке открывается, но с кодировками лажа.
Кстати, давно хотел спросить - почему программы, откомпилированные в семёрке, под вистой часто вместо русских букв показывают закорючки?

тaк измeни кодировку, либо пeрeсохрaни в word

[TarasBer]

Блин, перегонкой через ворд я заниматься умею. Я о том, что если запустить то, что скачалось, то будут закорючки. И что делать с готовыми программами, которые у других показывают не те буквы?

[volvo]

И что делать с готовыми программами, которые у других показывают не те буквы?

Писать программы как положено. В частности - если программа рассчитана на работу у других - она по определению не должна считать, что у других такие же настройки системы, как и у разработчика. К примеру, язык для Non-Unicone приложений у меня выставлен в Hebrew, следовательно, если я запущу любое русифицированное приложение, работающее с ANSI - я увижу вопросики или кракозябры. Юникод с правильными шрифтами - будет отображаться нормально.