Quelltext
unit createms;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls;
type
TfrmCreateMagSquar = class(TForm)
gbSize: TGroupBox;
lblSize: TLabel;
edtSize: TEdit;
btnCreate: TButton;
btnCancel: TButton;
gbvariation: TGroupBox;
lblAdd: TLabel;
lblMult: TLabel;
edtAdd: TEdit;
edtMult: TEdit;
rgDirection: TRadioGroup;
rgRotate: TRadioGroup;
gbMirror: TGroupBox;
cbMirror: TCheckBox;
btnStandard: TButton;
function MultStr(Character:String;Multiplicator:word):String;
procedure EnableBtn;
procedure CreateOddMS;
procedure CreateQuartMS;
procedure CreateEvenMS;
procedure TestMagSquare;
procedure GetMaxLength;
procedure MagSquareOutput;
procedure GetRotIndex;
procedure edtSizeChange(Sender: TObject);
procedure edtAddChange(Sender: TObject);
procedure edtMultChange(Sender: TObject);
procedure btnCancelClick(Sender: TObject);
procedure btnCreateClick(Sender: TObject);
procedure edtSizeKeyPress(Sender: TObject; var Key: Char);
procedure edtAddKeyPress(Sender: TObject; var Key: Char);
procedure edtMultKeyPress(Sender: TObject; var Key: Char);
procedure btnStandardClick(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
frmCreateMagSquar: TfrmCreateMagSquar;
MagSquare:Array[0..99,0..99] of Word;
n:word;
size,a,b:byte;
AddVal,MultVal:Longint;
MaxLen:Byte;
SqrMagic:Boolean;
RotationIndex:Byte;
Item:String;
code:Integer;
implementation
uses output;
{$R *.DFM}
function tfrmCreateMagsquar.MultStr(Character:String;Multiplicator:Word):String;
var
resStr:String;
c:Byte;
begin
resstr:='';
if (multiplicator>0) and (character<>'') then for c:=1 to multiplicator do resstr:=resstr+character;
multstr:=resstr;
end;
procedure tfrmCreateMagsquar.GetRotIndex;
begin
if rgdirection.itemindex=0 then rotationindex:=rgrotate.ItemIndex else
begin
case rgrotate.ItemIndex of
0,2:rotationindex:=rgrotate.ItemIndex;
1:rotationindex:=3;
3:rotationindex:=1;
end;
end;
if cbmirror.checked=True then rotationindex:=rotationindex+4;
end;
procedure tfrmCreateMagsquar.GetMaxLength;
var
len:Byte;
begin
maxlen:=0;
for a:=0 to size-1 do
begin
for b:=0 to size-1 do
begin
len:=length(inttostr(multval*magsquare[a,b]+addval));
if len>maxlen then maxlen:=len;
end;
end;
end;
procedure tfrmCreateMagsquar.TestMagSquare;
var
sumh,sumv,sumd1,sumd2,sumc:LongInt;
begin
sumh:=0;
sumv:=0;
sumd1:=0;
sumd2:=0;
sumc:=(size*(Sqr(Size)+1)) div 2;
SqrMagic:=False;
for a:=0 to size-1 do
begin
for b:=0 to size-1 do
begin
sumh:=sumh+magsquare[b,a];
sumv:=sumv+magsquare[a,b];
end;
if (sumh=sumc) and (sumv=sumc) then
begin
sumh:=0;
sumv:=0;
end
else exit;
sumd1:=sumd1+magsquare[a,a];
sumd2:=sumd2+magsquare[a,size-a-1];
end;
if (sumd1=sumc) and (sumd2=sumc) then sqrmagic:=true;
end;
procedure tfrmCreateMagSquar.CreateOddMS;
var
helpsqr:Word;
halfsqr:byte;
begin
halfsqr:=Size div 2;
helpsqr:=2*size-1;
a:=size;
b:=1;
for n:=1 to Sqr(Size) do
begin
if a<=halfsqr then magsquare[a+size-halfsqr-1,b-halfsqr-1]:=n;
if a>helpsqr-halfsqr then magsquare[a-size-halfsqr-1,b-halfsqr-1]:=n;
if b<=halfsqr then magsquare[a-halfsqr-1,b+size-halfsqr-1]:=n;
if b>helpsqr-halfsqr then magsquare[a-halfsqr-1,b-size-halfsqr-1]:=n;
if ((a>halfsqr) and (a<=helpsqr-halfsqr)) and ((b>halfsqr) and (b<=helpsqr-halfsqr)) then magsquare[a-halfsqr-1,b-halfsqr-1]:=n;
if (n/size)=(n div size) then
begin
b:=b-size+2;
a:=a+size;
end
else
begin
a:=a-1;
b:=b+1;
end;
end;
end;
procedure tfrmCreateMagSquar.CreateQuartMS;
var
quart:Byte;
begin
n:=1;
quart:=size div 4;
for b:=0 to size-1 do
begin
for a:=0 to size-1 do
begin
magsquare[a,b]:=n;
if ((a<=quart-1) Or (a>size - quart -1)) and ((b<=quart-1) Or (b>size - quart -1)) then magsquare[a,b]:=Sqr(size)-n+1;
if ((a>quart-1) and (a<=size - quart -1)) and ((b>quart-1) and (b<=size - quart -1)) then magsquare[a,b]:=Sqr(size)-n+1;
n:=n+1;
end;
end;
end;
procedure tfrmCreateMagSquar.CreateEvenMS;
var
helpsqr,halfsqr:Byte;
h:Word;
begin
size:=size div 2;
halfsqr:=Size div 2;
helpsqr:=2*size-1;
a:=size;
b:=1;
for n:=1 to Sqr(Size) do
begin
if a<=halfsqr then
begin
magsquare[a+size-halfsqr-1,b-halfsqr-1]:=n;
magsquare[a+size-halfsqr-1+size,b-halfsqr-1+size]:=n+Sqr(size);
magsquare[a+size-halfsqr-1+size,b-halfsqr-1]:=n+2*Sqr(size);
magsquare[a+size-halfsqr-1,b-halfsqr-1+size]:=n+3*Sqr(size);
end;
if a>helpsqr-halfsqr then
begin
magsquare[a-size-halfsqr-1,b-halfsqr-1]:=n;
magsquare[a-size-halfsqr-1+size,b-halfsqr-1+size]:=n+Sqr(size);
magsquare[a-size-halfsqr-1+size,b-halfsqr-1]:=n+2*Sqr(size);
magsquare[a-size-halfsqr-1,b-halfsqr-1+size]:=n+3*Sqr(size);
end;
if b<=halfsqr then
begin
magsquare[a-halfsqr-1,b+size-halfsqr-1]:=n;
magsquare[a-halfsqr-1+size,b+size-halfsqr-1+size]:=n+Sqr(size);
magsquare[a-halfsqr-1+size,b+size-halfsqr-1]:=n+2*Sqr(size);
magsquare[a-halfsqr-1,b+size-halfsqr-1+size]:=n+3*Sqr(size);
end;
if b>helpsqr-halfsqr then
begin
magsquare[a-halfsqr-1,b-size-halfsqr-1]:=n;
magsquare[a-halfsqr-1+size,b-size-halfsqr-1+size]:=n+Sqr(size);
magsquare[a-halfsqr-1+size,b-size-halfsqr-1]:=n+2*Sqr(size);
magsquare[a-halfsqr-1,b-size-halfsqr-1+size]:=n+3*Sqr(size);
end;
if ((a>halfsqr) and (a<=helpsqr-halfsqr)) and ((b>halfsqr) and (b<=helpsqr-halfsqr)) then
begin
magsquare[a-halfsqr-1,b-halfsqr-1]:=n;
magsquare[a-halfsqr-1+size,b-halfsqr-1+size]:=n+Sqr(size);
magsquare[a-halfsqr-1+size,b-halfsqr-1]:=n+2*Sqr(size);
magsquare[a-halfsqr-1,b-halfsqr-1+size]:=n+3*Sqr(size);
end;
if (n/size)=(n div size) then
begin
b:=b-size+2;
a:=a+size;
end
else
begin
a:=a-1;
b:=b+1;
end;
end;
for a:=0 to halfsqr-1 do
begin
for b:=0 to size-1 do
begin
if b=halfsqr then
begin
h:=magsquare[a+1,b];
magsquare[a+1,b]:=magsquare[a+1,b+size];
magsquare[a+1,b+size]:=h;
end
else
begin
h:=magsquare[a,b];
magsquare[a,b]:=magsquare[a,b+size];
magsquare[a,b+size]:=h;
end;
if a>0 then
begin
h:=magsquare[a+size+halfsqr+1,b];
magsquare[a+size+halfsqr+1,b]:=magsquare[a+size+halfsqr+1,b+size];
magsquare[a+size+halfsqr+1,b+size]:=h;
end;
end;
end;
Size:=size * 2;
end;
procedure tfrmCreateMagSquar.EnableBtn;
begin
if (edtSize.text<>'') and (edtAdd.text<>'') and (edtMult.text<>'') then
begin
if (strtoint(edtSize.text)>2) then btnCreate.enabled:=true else btnCreate.enabled:=false;
end
else btnCreate.enabled:=false;
end;
procedure TfrmCreateMagSquar.MagSquareOutput;
var
line:String;
len:Byte;
begin
frmOutput.memMagSquar.Lines.Clear;
for b:=0 to size-1 do
begin
line:='';
for a:=0 to size-1 do
begin
case rotationindex of
0:str((Multval*magsquare[a,b]+addval):0,item);
1:str((Multval*magsquare[b,size-a-1]+addval):0,item);
2:str((Multval*magsquare[size-a-1,size-b-1]+addval):0,item);
3:str((Multval*magsquare[size-b-1,a]+addval):0,item);
4:str((Multval*magsquare[size-a-1,b]+addval):0,item);
5:str((Multval*magsquare[b,a]+addval):0,item);
6:str((Multval*magsquare[a,size-b-1]+addval):0,item);
7:str((Multval*magsquare[size-b-1,size-a-1]+addval):0,item);
end;
line:=concat(line,multstr(' ',maxlen-length(item)+1),item);
end;
delete(line,1,1);
frmOutput.memMagSquar.Lines.Add(Line);
end;
messagedlg('Die Seitensumme des Magischen Quadrates beträgt '+InttoStr((multval*Size*(Sqr(Size)+1) div 2)+size*addval)+'.',mtinformation,[mbOK],0);
frmOutput.show;
end;
procedure TfrmCreateMagSquar.edtSizeChange(Sender: TObject);
begin
EnableBtn;
end;
procedure TfrmCreateMagSquar.edtAddChange(Sender: TObject);
begin
EnableBtn;
end;
procedure TfrmCreateMagSquar.edtMultChange(Sender: TObject);
begin
EnableBtn
end;
procedure TfrmCreateMagSquar.btnCancelClick(Sender: TObject);
begin
close;
end;
procedure TfrmCreateMagSquar.btnCreateClick(Sender: TObject);
begin
val(edtsize.text,size,code);
val(edtAdd.text,AddVal,code);
val(edtMult.text,MultVal,code);
case (Size mod 4) of
0:createQuartMS;
1,3:createoddms;
2:createevenms;
end;
testmagsquare;
if sqrmagic=true then
begin
GetMaxLength;
getrotindex;
MagSquareOutput;
end
else messagedlg('Der Algorithmus hat kein echtes Magisches Quadrat erzeugt.',mterror,[mbok],0);
end;
procedure TfrmCreateMagSquar.edtSizeKeyPress(Sender: TObject;
var Key: Char);
begin
if not (Key in [#8,'0'..'9','-']) then Key:=#0;
end;
procedure TfrmCreateMagSquar.edtAddKeyPress(Sender: TObject;
var Key: Char);
begin
if not (Key in [#8,'0'..'9','-']) then Key:=#0;
end;
procedure TfrmCreateMagSquar.edtMultKeyPress(Sender: TObject;
var Key: Char);
begin
if not (Key in [#8,'0'..'9','-']) then Key:=#0;
end;
procedure TfrmCreateMagSquar.btnStandardClick(Sender: TObject);
begin
edtAdd.text:='0';
edtmult.text:='1';
cbMirror.checked:=false;
rgdirection.itemindex:=0;
rgrotate.itemindex:=0;
end;
end.
unit output;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, forms, Dialogs,
StdCtrls, Grids, DBGrids;
type
TfrmOutput = class(TForm)
memMagSquar: TMemo;
procedure formResize(Sender: tobject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
frmOutput: TfrmOutput;
implementation
{$R *.DFM}
procedure TfrmOutput.FormResize(Sender: tobject);
begin;
memmagsquar.height:=frmoutput.Height-51;
memmagsquar.width:=frmoutput.width-24;
end;
end.