function Circle(n:Integer):string;
var aiRec:array of array of Integer;
iOutputCount,iX,iY,iXInc,iYInc:Integer;
str:string;
begin
SetLength(aiRec,n,n);
iX:=0;
iY:=0;
iXInc:=1;
iYInc:=0;
for iOutputCount:=1 to n*n do
begin
aiRec[iX,iY]:=iOutputCount;
if (iX+iXInc>6) or (iY+iYInc>6) or (iX+iXInc<0) or (iY+iYInc<0) or
(aiRec[iX+iXInc,iY+iYInc]<>0) then
begin
case iXInc of
1:
begin
iXInc:=0;
iYInc:=1;
end;
-1:
begin
iXInc:=0;
iYInc:=-1;
end;
else
begin
case iYInc of
1:
begin
iXInc:=-1;
iYInc:=0;
end;
-1:
begin
iXInc:=1;
iYInc:=0;
end;
end;
end;
end;
end;
iX:=iX+iXInc;
iY:=iY+iYInc;
end;
str:='';
for iY:=0 to n-1 do
begin
for iX:=0 to n-1 do
begin
str:=str+Format('%3d',[ aiRec[iX,iY]]);
end;
str:=str+#13#10;
end;
aiRec:=nil;
Result:=str;
end;
type
TSingleArray = array of Integer;
TData = array of array of Integer;
TForm1 = class(TForm)
btn1: TButton;
edt1: TEdit;
Label1: TLabel;
mmo1: TMemo;
procedure btn1Click(Sender: TObject);
private
{ Private declarations }
public
procedure Circle(aBegin, aSize, aLayer, aNum: Integer; var aData: TData);
function Matrix(aNum: Integer): TData;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{ TForm1 }
{ TForm1 }
procedure TForm1.Circle(aBegin, aSize, aLayer, aNum: Integer; var aData: TData);
var
i: integer;
vLeft, vRight, vTop, vBottom: TSingleArray;
procedure InitArray(aFirstNum: Integer; var aArray: TSingleArray);
var
i: Integer;
begin
for i := Low(aArray) to High(aArray) do
aArray[i] := aFirstNum + i;
end;
begin
SetLength(vLeft , aSize);
InitArray(aBegin , vLeft);
for i := 0 to aSize - 1 do
begin
aData[i + aLayer][aLayer] := vLeft[i];
aData[aNum - aLayer - 1][aLayer + i] := vBottom[i];
aData[aNum - aLayer - i - 1][aNum - aLayer - 1] := vRight[i];
aData[aLayer][aNum - aLayer - i - 1] := vTop[i];
end; //end for
end;
function TForm1.Matrix(aNum: Integer): TData;
var
vBegin, vLayer, I: integer;
begin
SetLength(Result, aNum, aNum);
I := aNum;
vBegin := 1;
vLayer := 0;
while I > 0 do
begin
Circle(vBegin, I, vLayer, aNum, Result);
Inc(vBegin, (I - 1) * 4);
Dec(I, 2);
Inc(vLayer);
end; //end while
end;
procedure TForm1.btn1Click(Sender: TObject);
var
Dat: TData;
i, j: integer;
S: string;
Size: integer;
begin
if (Edt1.Text = '') then
begin
MessageBox(0, '输入矩阵数字。', '错误', MB_OK + MB_ICONWARNING +
MB_TOPMOST);
exit;
end;
Size := StrToInt(Edt1.Text);
Dat := Matrix(Size);
for i := 0 to Size - 1 do
begin
S := '';
for j := 0 to Size - 1 do
begin
S := S + IntToStr(Dat[i][j]) + ',';
end;
mmo1.Lines.Add(S);
end;
end;
end.
Unit1.dfm
---
object Form1: TForm1
Left = 256
Top = 125
Width = 355
Height = 281
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
Left = 16
Top = 224
Width = 35
Height = 13
Caption = '输入N:'
end
object mmo1: TMemo
Left = 16
Top = 16
Width = 297
Height = 193
TabOrder = 0
end
object btn1: TButton
Left = 240
Top = 216
Width = 75
Height = 25
Caption = '显示'
TabOrder = 1
OnClick = btn1Click
end
object edt1: TEdit
Left = 56
Top = 224
Width = 121
Height = 21
TabOrder = 2
end
end