15 パズルは、 1 から 15 までのパネルを正しく並べ替えるゲームです。
uCells.pas
unit uCells;
interface
uses SysUtils, Extctrls, Graphics, Types;
const
MAX_ROW_COUNT = 4;
MAX_COL_COUNT = 4;
MAX_CELL_COUNT = 16;
EMPTY_CELL = -1;
type
TCellCollection = class;
TCellCanvas = class
private
FBox: TPaintBox;
FCellWidth: Integer;
FCellHeight: Integer;
FCellCollection: TCellCollection;
procedure DoDrawCell(X, Y: Integer; s: string);
procedure DrawLine;
procedure DrawCell; overload;
procedure DrawCell(TargetCellNum, EmptyCellNum: Integer); overload;
function GetClickedCellNumber(X, Y: Integer): Integer;
public
constructor Create(Box: TPaintBox);
destructor Destroy; override;
procedure Initialize;
procedure CellClick(X, Y: Integer);
end;
TCellCollection = class
private
FCells: array[0..MAX_CELL_COUNT-1] of Integer;
procedure Shuffle;
function GetCell(index: Integer): Integer;
public
procedure Initialize;
function GetEmptyCellNum: Integer;
procedure Exchange(x: Integer);
function IsExchange(x: Integer): Boolean;
property Cells[index: Integer]: Integer read GetCell; default;
end;
implementation
{ TFreeCanvas }
function GetCol(x: Integer): Integer;
begin
Result := x mod MAX_COL_COUNT;
end;
function GetRow(x: Integer): Integer;
begin
Result := x div MAX_ROW_COUNT;
end;
procedure TCellCanvas.CellClick(X, Y: Integer);
begin
if FCellCollection.IsExchange(GetClickedCellNumber(X, Y)) then begin
DrawCell(GetClickedCellNumber(X, Y), FCellCollection.GetEmptyCellNum);
FCellCollection.Exchange(GetClickedCellNumber(X, Y));
end;
end;
constructor TCellCanvas.Create(Box: TPaintBox);
begin
FBox := Box;
FCellCollection := TCellCollection.Create;
end;
destructor TCellCanvas.Destroy;
begin
FCellCollection.Free;
inherited;
end;
procedure TCellCanvas.DrawCell;
var
i, j, Count: Integer;
s: string;
begin
Count := 0;
for i := 0 to MAX_ROW_COUNT-1 do
for j := 0 to MAX_COL_COUNT-1 do begin
if FCellCollection[Count] = EMPTY_CELL then
s := ' '
else
s := IntToStr(FCellCollection[Count]);
DoDrawCell(j*FCellWidth+5, i*FCellHeight+5, s);
Inc(Count);
end;
end;
procedure TCellCanvas.DoDrawCell(X, Y: Integer; s: string);
begin
FBox.Canvas.TextOut(X, Y, s);
end;
procedure TCellCanvas.DrawCell(TargetCellNum, EmptyCellNum: Integer);
begin
DoDrawCell(GetCol(EmptyCellNum)*FCellWidth+5,
GetRow(EmptyCellNum)*FCellHeight+5,
IntToStr(FCellCollection[TargetCellNum]));
DoDrawCell(GetCol(TargetCellNum)*FCellWidth+5,
GetRow(TargetCellNum)*FCellHeight+5,
' ');
end;
procedure TCellCanvas.DrawLine;
var
i: Integer;
begin
FBox.Canvas.Pen.Color := clGray;
for i := 1 to MAX_COL_COUNT-1 do begin
FBox.Canvas.MoveTo(i*FCellWidth, 0);
FBox.Canvas.LineTo(i*FCellWidth, FBox.ClientHeight);
end;
for i := 1 to MAX_ROW_COUNT-1 do begin
FBox.Canvas.MoveTo(0, i*FCellHeight);
FBox.Canvas.LineTo(FBox.ClientWidth, i*FCellHeight);
end;
end;
function TCellCanvas.GetClickedCellNumber(X, Y: Integer): Integer;
var
Col, Row: Integer;
begin
Col := X div FCellWidth;
Row := Y div FCellHeight;
Result := Col + MAX_COL_COUNT*Row;
end;
procedure TCellCanvas.Initialize;
begin
FBox.Canvas.Brush.Color := clWhite;
FBox.Canvas.FillRect(FBox.ClientRect);
FCellWidth := FBox.ClientWidth div MAX_COL_COUNT;
FCellHeight := FBox.ClientHeight div MAX_ROW_COUNT;
FBox.Canvas.Font.Height := FCellHeight div 2;
FCellCollection.Initialize;
DrawLine;
DrawCell;
end;
{ TCellCollection }
procedure TCellCollection.Exchange(x: Integer);
var
tmp, num: Integer;
begin
num := GetEmptyCellNum;
tmp := FCells[x];
FCells[x] := FCells[num];
FCells[num] := tmp;
end;
function TCellCollection.GetCell(index: Integer): Integer;
begin
Result := FCells[index];
end;
function TCellCollection.GetEmptyCellNum: Integer;
var
i: Integer;
begin
Result := 0;
for i := 0 to High(FCells) do
if FCells[i] = EMPTY_CELL then begin
Result := i;
exit;
end;
end;
procedure TCellCollection.Initialize;
var
i: Integer;
begin
for i := 0 to High(FCells)-1 do
fCells[i] := i+1;
fCells[High(FCells)] := EMPTY_CELL;
Shuffle;
end;
function TCellCollection.IsExchange(x: Integer): Boolean;
var
Num, Row, Col,
ClickedRow, ClickedCol: Integer;
begin
Result := false;
Num := GetEmptyCellNum;
Row := GetRow(Num);
Col := GetCol(Num);
ClickedRow := GetRow(x);
ClickedCol := GetCol(x);
if ((Abs(Row-ClickedRow) = 0) and (Abs(Col-ClickedCol) = 1)) or
((Abs(Row-ClickedRow) = 1) and (Abs(Col-ClickedCol) = 0)) then
Result := true;
end;
procedure TCellCollection.Shuffle;
function HasAnswer: Boolean;
var
i, j, tmp, Count: Integer;
begin
Count := 0;
for i := 0 to High(FCells)-1 do begin
tmp := FCells[i];
for j := i+1 to High(FCells)-1 do
if tmp > FCells[j] then Inc(Count);
end;
Result := (Count mod 2) = 0;
end;
var
i, len, a, b, tmp: Integer;
begin
len := High(FCells);
for i := 0 to len do begin
a := Random(len);
b := Random(len);
tmp := FCells[a];
FCells[a] := FCells[b];
FCells[b] := tmp;
end;
if not HasAnswer then Shuffle;
end;
end.
Main.pas
unit Main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, uCells;
type
TForm1 = class(TForm)
PaintBox1: TPaintBox;
Button1: TButton;
PaintBox2: TPaintBox;
PaintBox3: TPaintBox;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure PaintBox3MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure PaintBox2MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
{ Private 宣言 }
FCellCanvas1: TCellCanvas;
FCellCanvas2: TCellCanvas;
FCellCanvas3: TCellCanvas;
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
Randomize;
FCellCanvas1 := TCellCanvas.Create(PaintBox1);
FCellCanvas2 := TCellCanvas.Create(PaintBox2);
FCellCanvas3 := TCellCanvas.Create(PaintBox3);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FCellCanvas1.Free;
FCellCanvas2.Free;
FCellCanvas3.Free;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
FCellCanvas1.Initialize;
FCellCanvas2.Initialize;
FCellCanvas3.Initialize;
end;
procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
FCellCanvas1.CellClick(X, Y);
end;
procedure TForm1.PaintBox2MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
FCellCanvas2.CellClick(X, Y);
end;
procedure TForm1.PaintBox3MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
FCellCanvas3.CellClick(X, Y);
end;
end.