Как написать код программы, подбирающей магический квадрат 5х5 перебором? - VBA

Program MagicSquares; 
 
{Построение магических квадратов} 
 
Uses CRT; 
Type a_type=array[1..50,1..50] of integer; 
Var i,j,n:integer; 
a:a_type; 
t:boolean; 
{логическая переменная true (правда) или false (ложь)} 
x,y:integer; 
Label 1; 
{метка} 
Procedure Print(n:integer; a:a_type); 
{процедура вывода} 
Var i,j:integer; 
Begin 
for i:=1 to n do begin 
for j:=1 to n do write(a[i,j]:4); 
writeln(''); 
end; 
end; 
Procedure WinSh(x1,y1,x2,y2,col1,col2:word); 
{процедура вывода окна} 
Begin 
TextBackGround(black); 
Window (x1+1,y1+1,x2+1,y2+1); 
{тень - черный прямоугольник} 
ClrScr; 
TextBackGround(col1); 
Window(x1,y1,x2,y2); 
ClrScr; 
TextColor(col2); 
{рисование рамки} 
GotoXY(2, 1); write('г'); 
for i:=1 to x2-x1-2 do write('='); 
GotoXY(x2-x1,1); write('='); 
GotoXY(2,y2-y1+1); 
write('L'); for i:=1 to x2-x1-2 do write('='); 
GotoXY(x2-x1,y2-y1+1); write('-'); 
for j:=2 to y2-y1 do begin 
 GotoXY(2,j); write('¦'); 
 GotoXY(x2-x1,j); write('¦'); 
 end; 
End; 
Procedure OddMagic(n:integer; var a:a_type); 
{Процедура формирования магического квадрата при нечетном n. Описание алгоритма в сопроводительной записке } 
Var 
i,j,k:integer; 
p,l:integer; 
Begin 
for i:=1 to n do 
for j:=1 to n do a[i,j]:=0; 
j:=n div 2 +1; p:=sqr(n); i:=1; a[i,j]:=1; 
for l:=2 to p do begin 
i:=i-1; 
j:=j+1; 
if (i=0) and (j<>n+1) then i:=n; 
if (j=n+1) and (i<>0) then j:=1; 
if ((i=0) and (j=n+1)) or (a[i,j]<>0) then 
{важен порядок условий!} 
begin 
 i:=i+2; 
 j:=j-1; 
 end; 
a[i,j]:=l; 
end; 
end; 
Procedure Two (n:integer; var a:a_type); 
{Процедура построения квадрата при n обычной четности: n=6,10,14,18...} 
Var 
u,i,j,k,m,z:integer; 
b:a_type; 
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(n:integer; var a:a_type); 
{Процедура построения квадрата при n двойной четности: n=4,8,12,16...} 
Var i,j,k:integer; 
p,l:integer; 
i1,j1,x,y:integer; 
Begin 
l:=1; p:=n*n; 
for i:=1 to n do 
for j:=1 to n do begin 
a[i,j]:=l; 
inc(l) 
{l:=l+1} 
end; 
i:=2; 
while i<=n-2 do begin 
if i mod 4=0 then j:=4 
else j:=2; 
while j<=n-2 do begin 
for i1:=0 to 1 do 
for j1:=0 to 1 do begin 
y:=i+i1; x:=j+j1; 
a[y,x]:=p-a[y,x]+1; 
end; 
j:=j+4; 
end; 
i:=i+2 
end; 
k:=4; 
while k<=n-4 do begin 
a[1,k]:=p-a[1,k]+1; a[1,k+1]:=p-a[1,k+1]+1; 
a[n,k]:=p-a[n,k]+1; a[n,k+1]:=p-a[n,k+1]+1; 
a[k,1]:=p-a[k,1]+1; a[k+1,1]:=p-a[k+1,1]+1; 
a[k,n]:=p-a[k,n]+1; a[k+1,n]:=p-a[k+1,n]+1; 
k:=k+4 
end; 
a[1,1]:=p-a[1,1]+1; 
a[n,n]:=p-a[n,n]+1; 
a[1,n]:=p-a[1,n]+1; 
a[n,1]:=p-a[n,1]+1; 
end; 
Procedure Test(n:integer; a:a_type; var t:boolean; var x,y:integer); 
{Процедура проверки сумм по строкам, столбцам и диагоналям квад-рата} 
Var s,z:array [1..50] of integer; 
{массивы для записи сумм по строкам и столбцам} 
sd,zd:integer; 
i,j,k:integer; 
sum:integer; 
Begin 
sum:=n*(n*n+1) div 2; 
for k:=1 to n do begin 
s[k]:=0; 
z[k]:=0 
end; 
sd:=0; zd:=0; 
for i:=1 to n do 
for j:=1 to n do begin 
s[i]:=s[i]+a[i,j]; 
z[j]:=z[j]+a[i,j] 
end; 
for k:=1 to n do begin 
sd:=sd+a[k,k]; 
zd:=zd+a[k,n-k+1]; 
end; 
k:=1; t:=true; 
while (k<=n) and (t) do begin 
if s[k]<>sum then begin 
t:=false; 
{ошибка по строкам} 
y:=1; 
x:=k 
{номер строки} 
end; 
k:=k+1 
end; 
if (t) then begin 
k:=1; 
while (k<=n) and (t) do begin 
if z[k]<>sum then begin 
t:=false; 
{ошибка по столбцам} 
y:=2; 
x:=k 
{номер столбца} 
end; 
k:=k+1 
end; 
end; 
if (t) then if sd<>sum then begin 
t:=false; 
{ошибка по главной диагонали} 
y:=3; 
x:=0; 
end; 
if (t) then if zd<>sum then begin 
t:=false; 
{ошибка по побочной диагонали} 
y:=4; 
x:=0; 
end; 
if t then writeln('Тест прошел успешно'); 
End; 
 
Begin 
{Основная программа} 
1: 
TextBackGround(blue); 
ClrScr; 
WinSh(20,3,60,6,blue,white); 
GotoXY(9,2); write('Магический квадрат'); 
GotoXY(10,3); write('(c) 2006 г.'); 
Window(1,1,80,25); TextColor(yellow); TextBackGround(blue); 
GotoXY(60,18); write(' 8 ¦ 1 ¦ 6'); 
GotoXY(60,19); write('===+===+==='); 
GotoXY(60,20); write(' 3 ¦ 5 ¦ 7'); 
GotoXY(60,21); write('===+===+==='); 
GotoXY(60,22); write(' 4 ¦ 9 ¦ 2'); 
TextColor(white); TextBackGround(white); 
for x:=2 to 79 do begin 
GotoXY(x,25); 
write(' '); 
end; 
GotoXY(5,25); 
write('Размерность =0 - конец работы программы. Рекомендуем размерность от 3 до 19'); 
Winsh(30,10,50,12,cyan,white); 
repeat 
TextColor(white); 
GotoXY(4,2); write('Размерность=');readln(n); 
until (n<>1) and (n<>2); 
{квадрат для n=1 и для n=2 строить нельзя} 
if n=0 then halt; 
{выход из программы} 
{Если n-нечетно, то OddMag, иначе ...} 
if odd(n) then OddMagic(n,a) 
else if n mod 4=0 then Four(n,a) 
else Two(n,a); 
TextBackGround(blue); 
Window(1,1,80,25); 
ClrScr; 
TextColor(yellow); 
ClrScr; 
{вывод} 
Writeln('Магический квадрат ',n,'x',n); 
Print(n,a); 
writeln(''); 
Test(n,a,t,x,y); 
{Процедура тестирования квадрата} 
if (t) then 
writeln('Суммы по столбцам, строкам и диагоналям =',n*(n*n+1) div 2) 
else begin 
writeln('Ошибка'); 
case y of 
1: writeln('Ошибка в строке ',x); 
2: writeln('Ошибка в столбце ',x); 
3: writeln('Ошибка по главной диагонали'); 
4: writeln('Ошибка по побочной диагонали') 
end; 
end; 
readln; 
goto 1; 
End.