//pas
//[email protected] DdiamondUnit;interfaceuses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, FuncUnit, StdCtrls, Buttons, ExtCtrls;type
TAspect = 0..3;const
cPointCount = 5;type
TDdiamond = record
rCount: Integer;
rPointList: array[0..cPointCount - 1] of TPoint;
rWidth: Integer;
rColor: TColor;
end;{$DEFINE DDIAMOND4}{$IFDEF DDIAMOND4}
const
cDdiamondCount = 7;
cDdiamondList: array[0..cDdiamondCount - 1] of TDdiamond =
(
(rCount: 4; rPointList: ((x: 0; y: 0), (x: 0; y: 1), (x: 1; y: 0), (x: 1; y: 1), (x: 0; y: 0)); rWidth: 2; rColor: clMaroon),
(rCount: 4; rPointList: ((x: 1; y: 0), (x: 1; y: 1), (x: 1; y: 2), (x: 2; y: 1), (x: 0; y: 0)); rWidth: 3; rColor: clGreen),
(rCount: 4; rPointList: ((x: 1; y: 0), (x: 1; y: 1), (x: 1; y: 2), (x: 2; y: 0), (x: 0; y: 0)); rWidth: 3; rColor: clOlive),
(rCount: 4; rPointList: ((x: 1; y: 0), (x: 1; y: 1), (x: 1; y: 2), (x: 2; y: 2), (x: 0; y: 0)); rWidth: 3; rColor: clNavy),
(rCount: 4; rPointList: ((x: 0; y: 1), (x: 1; y: 1), (x: 2; y: 1), (x: 3; y: 1), (x: 0; y: 0)); rWidth: 4; rColor: clPurple),
(rCount: 4; rPointList: ((x: 0; y: 1), (x: 1; y: 1), (x: 1; y: 2), (x: 2; y: 2), (x: 0; y: 0)); rWidth: 3; rColor: clTeal),
(rCount: 4; rPointList: ((x: 0; y: 2), (x: 1; y: 2), (x: 1; y: 1), (x: 2; y: 1), (x: 0; y: 0)); rWidth: 3; rColor: clGray)
);
{$ELSE}
const
cDdiamondCount = 28;
cDdiamondList: array[0..cDdiamondCount - 1] of TDdiamond =
(
(rCount: 1; rPointList: ((x: 0; y: 0), (x: 0; y: 0), (x: 0; y: 0), (x: 0; y: 0), (x: 0; y: 0)); rWidth: 1; rColor: clSilver),
(rCount: 2; rPointList: ((x: 0; y: 0), (x: 0; y: 1), (x: 0; y: 0), (x: 0; y: 0), (x: 0; y: 0)); rWidth: 2; rColor: clRed),
(rCount: 3; rPointList: ((x: 1; y: 0), (x: 1; y: 1), (x: 1; y: 2), (x: 0; y: 0), (x: 0; y: 0)); rWidth: 3; rColor: clLime),
(rCount: 3; rPointList: ((x: 1; y: 0), (x: 1; y: 1), (x: 0; y: 1), (x: 0; y: 0), (x: 0; y: 0)); rWidth: 3; rColor: clYellow),
(rCount: 4; rPointList: ((x: 0; y: 0), (x: 0; y: 1), (x: 1; y: 0), (x: 1; y: 1), (x: 0; y: 0)); rWidth: 2; rColor: clMaroon),
(rCount: 4; rPointList: ((x: 1; y: 0), (x: 1; y: 1), (x: 1; y: 2), (x: 2; y: 1), (x: 0; y: 0)); rWidth: 3; rColor: clGreen),
(rCount: 4; rPointList: ((x: 1; y: 0), (x: 1; y: 1), (x: 1; y: 2), (x: 2; y: 0), (x: 0; y: 0)); rWidth: 3; rColor: clOlive),
(rCount: 4; rPointList: ((x: 1; y: 0), (x: 1; y: 1), (x: 1; y: 2), (x: 2; y: 2), (x: 0; y: 0)); rWidth: 3; rColor: clNavy),
(rCount: 4; rPointList: ((x: 0; y: 1), (x: 1; y: 1), (x: 2; y: 1), (x: 3; y: 1), (x: 0; y: 0)); rWidth: 4; rColor: clPurple),
(rCount: 4; rPointList: ((x: 0; y: 1), (x: 1; y: 1), (x: 1; y: 2), (x: 2; y: 2), (x: 0; y: 0)); rWidth: 3; rColor: clTeal),
(rCount: 4; rPointList: ((x: 0; y: 2), (x: 1; y: 2), (x: 1; y: 1), (x: 2; y: 1), (x: 0; y: 0)); rWidth: 3; rColor: clGray),
(rCount: 5; rPointList: ((x: 2; y: 0), (x: 2; y: 1), (x: 2; y: 2), (x: 2; y: 3), (x: 2; y: 4)); rWidth: 5; rColor: clBlue),
(rCount: 5; rPointList: ((x: 2; y: 0), (x: 2; y: 1), (x: 2; y: 2), (x: 2; y: 3), (x: 3; y: 3)); rWidth: 4; rColor: clFuchsia),
(rCount: 5; rPointList: ((x: 2; y: 0), (x: 2; y: 1), (x: 2; y: 2), (x: 2; y: 3), (x: 3; y: 0)); rWidth: 4; rColor: clAqua),
(rCount: 5; rPointList: ((x: 0; y: 1), (x: 1; y: 0), (x: 1; y: 1), (x: 1; y: 2), (x: 2; y: 1)); rWidth: 3; rColor: clLtGray),
(rCount: 5; rPointList: ((x: 0; y: 0), (x: 0; y: 2), (x: 1; y: 0), (x: 1; y: 1), (x: 1; y: 2)); rWidth: 3; rColor: clDkGray),
(rCount: 5; rPointList: ((x: 0; y: 0), (x: 0; y: 1), (x: 1; y: 0), (x: 1; y: 1), (x: 1; y: 2)); rWidth: 3; rColor: clYellow),
(rCount: 5; rPointList: ((x: 0; y: 0), (x: 0; y: 1), (x: 1; y: 0), (x: 1; y: 1), (x: 0; y: 2)); rWidth: 3; rColor: clMoneyGreen),
(rCount: 5; rPointList: ((x: 0; y: 0), (x: 0; y: 1), (x: 0; y: 2), (x: 1; y: 1), (x: 2; y: 1)); rWidth: 3; rColor: clSkyBlue),
(rCount: 5; rPointList: ((x: 0; y: 0), (x: 0; y: 1), (x: 1; y: 1), (x: 1; y: 2), (x: 2; y: 1)); rWidth: 3; rColor: clCream),
(rCount: 5; rPointList: ((x: 0; y: 1), (x: 0; y: 2), (x: 1; y: 0), (x: 1; y: 1), (x: 2; y: 1)); rWidth: 3; rColor: clMedGray),
(rCount: 5; rPointList: ((x: 0; y: 1), (x: 1; y: 0), (x: 1; y: 1), (x: 1; y: 2), (x: 1; y: 3)); rWidth: 4; rColor: clMaroon),
(rCount: 5; rPointList: ((x: 0; y: 2), (x: 1; y: 0), (x: 1; y: 1), (x: 1; y: 2), (x: 1; y: 3)); rWidth: 4; rColor: clGreen),
(rCount: 5; rPointList: ((x: 1; y: 1), (x: 1; y: 2), (x: 1; y: 3), (x: 2; y: 0), (x: 2; y: 1)); rWidth: 4; rColor: clGreen),
(rCount: 5; rPointList: ((x: 1; y: 0), (x: 1; y: 1), (x: 1; y: 2), (x: 2; y: 2), (x: 2; y: 3)); rWidth: 4; rColor: clOlive),
(rCount: 5; rPointList: ((x: 0; y: 0), (x: 1; y: 0), (x: 1; y: 1), (x: 2; y: 1), (x: 2; y: 2)); rWidth: 3; rColor: clNavy),
(rCount: 5; rPointList: ((x: 0; y: 0), (x: 0; y: 1), (x: 1; y: 1), (x: 2; y: 1), (x: 2; y: 2)); rWidth: 3; rColor: clPurple),
(rCount: 5; rPointList: ((x: 0; y: 1), (x: 0; y: 2), (x: 1; y: 1), (x: 2; y: 0), (x: 2; y: 1)); rWidth: 3; rColor: clTeal)
);
{$ENDIF}type
TFormDdiamond = class(TForm)
PanelButton: TPanel;
BitBtnExit: TBitBtn;
PanelClient: TPanel;
ImageOne: TImage;
BitBtnNew: TBitBtn;
EditKey: TEdit;
TimerOne: TTimer;
BitBtnPause: TBitBtn;
PanelSum: TPanel;
LabelSpeed: TLabel;
LabelSuccess: TLabel;
EditSpeed: TEdit;
EditSuccess: TEdit;
ImageTwo: TImage;
BitBtnPlay: TBitBtn;
LabelMaxUserName: TLabel;
EditMaxUserName: TEdit;
LabelMaxSuccess: TLabel;
EditMaxSuccess: TEdit;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure EditEnter(Sender: TObject);
procedure EditExit(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure BitBtnExitClick(Sender: TObject);
procedure PanelButtonResize(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure BitBtnNewClick(Sender: TObject);
procedure TimerOneTimer(Sender: TObject);
procedure FormKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure ImageOneClick(Sender: TObject);
procedure BitBtnPauseClick(Sender: TObject);
procedure PanelSumResize(Sender: TObject);
procedure BitBtnPlayClick(Sender: TObject);
private
{ Private declarations }
///////Begin Standard
FStringList: TStringList; //参数文本
FOldColor: TColor; //旧颜色
FCaption: TCaption;
FReadOnlyColor: TColor;
FFocusColor: TColor;
///////End Standard
///////Begin Ddiamond
FPointList: array of array of TColor;
FColCount: Integer;
FRowCount: Integer;
FPointWidth: Integer;
FPointHeight: Integer;
FIndex: Integer;
FCol: Integer;
FRow: Integer;
FAspect: TAspect;
FKeyDown: Boolean;
FPlaying: Boolean;
FSuccess: Integer;
FSpeed: Integer;
FNextIndex: Integer;
FNextAspect: Integer;
FMaxSuccess: Integer;
FMaxUserName: string;
///////End Ddiamond
private
///////Begin Standard
procedure SetCaption(const Value: TCaption);
///////End Standard
///////Begin Ddiamond
procedure InitMap;
procedure DrawMap;
procedure StartDdiamond;
procedure NextDdiamond;
procedure DrawPoint(mCol, mRow: Integer; mColor: TColor; mChange: Boolean);
function GetPointList(mCol, mRow: Integer): TColor;
procedure SetPointList(mCol, mRow: Integer; const Value: TColor);
procedure DrawDdiamond(mCol, mRow: Integer; mIndex: Integer; mAspect: TAspect; mShow: Boolean; mChange: Boolean); //放块
function TryDdiamond(mCol, mRow: Integer; mIndex: Integer; mAspect: TAspect): Boolean; //测试是否可以放块
procedure FreeLine; //消行
procedure SetPlaying(const Value: Boolean);
procedure SetSpeed(const Value: Integer);
procedure SetSuccess(const Value: Integer);
procedure SetMaxSuccess(const Value: Integer);
procedure SetMaxUserName(const Value: string);
///////End Ddiamond
public
{ Public declarations }
///////Begin Standard
property RCaption: TCaption read FCaption write SetCaption; //模块标题
property RReadOnlyColor: TColor read FReadOnlyColor write FReadOnlyColor; //只读色
property RFocusColor: TColor read FFocusColor write FFocusColor; //焦点色
///////End Standard
///////Begin Ddiamond
property RPointList[mCol: Integer; mRow: Integer]: TColor read GetPointList write SetPointList; default; //点列表
property RColCount: Integer read FColCount write FColCount; //列数
property RRowCount: Integer read FRowCount write FRowCount; //行数
property RPointWidth: Integer read FPointWidth write FPointWidth; //点宽度
property RPointHeight: Integer read FPointHeight write FPointHeight; //点高度
property RPlaying: Boolean read FPlaying write SetPlaying; //是否游戏中
property RSuccess: Integer read FSuccess write SetSuccess; //成绩
property RMaxSuccess: Integer read FMaxSuccess write SetMaxSuccess; //最好成绩
property RMaxUserName: string read FMaxUserName write SetMaxUserName; //最好用户
property RSpeed: Integer read FSpeed write SetSpeed; //速度
///////End Ddiamond
published
{ Published declarations }
end;//var//
// FormDdiamond: TFormDdiamond;//implementation{$R *.dfm}uses
Math;procedure TFormDdiamond.SetCaption(const Value: TCaption);
begin
FCaption := Value;
Caption := FCaption;
end;procedure TFormDdiamond.FormCreate(Sender: TObject);
begin
Randomize;
FStringList := TStringList.Create;
PanelButtonResize(PanelButton);
EditSuccess.Text := '';
EditSpeed.Text := '';
end;procedure TFormDdiamond.FormDestroy(Sender: TObject);
begin
FStringList.Free;
end;procedure TFormDdiamond.EditEnter(Sender: TObject);
begin
FOldColor := TEdit(Sender).Color;
if TEdit(Sender).Color = FReadOnlyColor then
TEdit(Sender).Color := TEdit(Sender).Color xor FFocusColor
else TEdit(Sender).Color := FFocusColor;
end;procedure TFormDdiamond.EditExit(Sender: TObject);
begin
TEdit(Sender).Color := FOldColor;
end;procedure TFormDdiamond.FormShow(Sender: TObject);
begin
SetLength(FPointList, FColCount, FRowCount);
ImageOne.Picture.Bitmap.Width := FColCount * FPointWidth;
ImageOne.Picture.Bitmap.Height := FRowCount * FPointHeight;
RPlaying := False;
BitBtnPause.Visible := False;
BitBtnPlay.Visible := False;
WinControlModified(False, PanelSum, FReadOnlyColor, []);
ImageTwo.Width := cPointCount * 10;
ImageTwo.Height := cPointCount * 10;
end;procedure TFormDdiamond.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
if FPlaying then begin
if FMaxSuccess < FSuccess then begin
RPlaying := False;
RMaxUserName := InputBox('Input', 'your name', RMaxUserName);
RMaxSuccess := FSuccess;
end;
end;
end;procedure TFormDdiamond.BitBtnExitClick(Sender: TObject);
begin
if (Sender is TWinControl) and TWinControl(Sender).Visible then
TWinControl(Sender).SetFocus;
Close;
end;procedure TFormDdiamond.PanelButtonResize(Sender: TObject);
begin
WinControlButton(TWinControl(Sender), 75, 25, 6);
end;procedure TFormDdiamond.DrawMap;
var
I, J: Integer;
begin
for J := 0 to FRowCount - 1 do
for I := 0 to FColCount - 1 do
DrawPoint(I, J, FPointList[I, J], True);
end;procedure TFormDdiamond.DrawPoint(mCol, mRow: Integer; mColor: TColor; mChange: Boolean);
begin
if (mCol < 0) or (mCol >= FColCount) then Exit;
if (mRow < 0) or (mRow >= FRowCount) then Exit;
ImageOne.Picture.Bitmap.Canvas.Brush.Color := mColor;
if mColor = clWindow then
ImageOne.Picture.Bitmap.Canvas.FillRect(Rect(
mCol * FPointWidth, mRow * FPointHeight,
(mCol + 1) * FPointWidth, (mRow + 1) * FPointHeight))
else ImageOne.Picture.Bitmap.Canvas.Rectangle(
mCol * FPointWidth, mRow * FPointHeight,
(mCol + 1) * FPointWidth, (mRow + 1) * FPointHeight);
if mChange then FPointList[mCol, mRow] := mColor;
end;function TFormDdiamond.GetPointList(mCol, mRow: Integer): TColor;
begin
Result := clWindow;
if (mCol < 0) or (mCol >= FColCount) then Exit;
if (mRow < 0) or (mRow >= FRowCount) then Exit;
Result := FPointList[mCol, mRow];
end;procedure TFormDdiamond.SetPointList(mCol, mRow: Integer;
const Value: TColor);
begin
if (mCol < 0) or (mCol >= FColCount) then Exit;
if (mRow < 0) or (mRow >= FRowCount) then Exit;
FPointList[mCol, mRow] := Value;
DrawPoint(mCol, mRow, FPointList[mCol, mRow], True);
end;procedure TFormDdiamond.InitMap;
var
I, J: Integer;
begin
for J := 0 to FRowCount - 1 do
for I := 0 to FColCount - 1 do
FPointList[I, J] := clWindow;
RSuccess := 0;
RSpeed := 0;
EditKey.SetFocus;
PanelButtonResize(PanelButton);
FNextIndex := Random(cDdiamondCount);
FNextAspect := Random(4);
end;procedure TFormDdiamond.DrawDdiamond(mCol, mRow, mIndex: Integer;
mAspect: TAspect; mShow: Boolean; mChange: Boolean);
var
I: Integer;
vColor: TColor;
begin
vColor := Iif(mShow, cDdiamondList[mIndex].rColor, clWindow);
case mAspect of
0: for I := 0 to cDdiamondList[mIndex].rCount - 1 do
DrawPoint(
mCol + cDdiamondList[mIndex].rPointList[I].X,
mRow + cDdiamondList[mIndex].rPointList[I].Y, vColor, mChange);
1: for I := 0 to cDdiamondList[mIndex].rCount - 1 do
DrawPoint(
mCol + cDdiamondList[mIndex].rWidth - 1 - cDdiamondList[mIndex].rPointList[I].Y,
mRow + cDdiamondList[mIndex].rPointList[I].X, vColor, mChange);
2: for I := 0 to cDdiamondList[mIndex].rCount - 1 do
DrawPoint(
mCol + cDdiamondList[mIndex].rWidth - 1 - cDdiamondList[mIndex].rPointList[I].X,
mRow + cDdiamondList[mIndex].rWidth - 1 - cDdiamondList[mIndex].rPointList[I].Y, vColor, mChange);
3: for I := 0 to cDdiamondList[mIndex].rCount - 1 do
DrawPoint(
mCol + cDdiamondList[mIndex].rPointList[I].Y,
mRow + cDdiamondList[mIndex].rWidth - 1 - cDdiamondList[mIndex].rPointList[I].X, vColor, mChange);
end;
end;function TFormDdiamond.TryDdiamond(mCol, mRow: Integer; mIndex: Integer;
mAspect: TAspect): Boolean;
var
I: Integer;
begin
Result := True;
case mAspect of
0: for I := 0 to cDdiamondList[mIndex].rCount - 1 do
if (mCol + cDdiamondList[mIndex].rPointList[I].X < 0) or
(mCol + cDdiamondList[mIndex].rPointList[I].X >= FColCount) or
(mRow + cDdiamondList[mIndex].rPointList[I].Y < 0) or
(mRow + cDdiamondList[mIndex].rPointList[I].Y >= FRowCount) or
(FPointList[
mCol + cDdiamondList[mIndex].rPointList[I].X,
mRow + cDdiamondList[mIndex].rPointList[I].Y] <> clWindow) then begin
Result := False;
Break;
end;
1: for I := 0 to cDdiamondList[mIndex].rCount - 1 do
if (mCol + cDdiamondList[mIndex].rWidth - 1 - cDdiamondList[mIndex].rPointList[I].Y < 0) or
(mCol + cDdiamondList[mIndex].rWidth - 1 - cDdiamondList[mIndex].rPointList[I].Y >= FColCount) or
(mRow + cDdiamondList[mIndex].rPointList[I].X < 0) or
(mRow + cDdiamondList[mIndex].rPointList[I].X >= FRowCount) or
(FPointList[
mCol + cDdiamondList[mIndex].rWidth - 1 - cDdiamondList[mIndex].rPointList[I].Y,
mRow + cDdiamondList[mIndex].rPointList[I].X] <> clWindow) then begin
Result := False;
Break;
end;
2: for I := 0 to cDdiamondList[mIndex].rCount - 1 do
if (mCol + cDdiamondList[mIndex].rWidth - 1 - cDdiamondList[mIndex].rPointList[I].X < 0) or
(mCol + cDdiamondList[mIndex].rWidth - 1 - cDdiamondList[mIndex].rPointList[I].X >= FColCount) or
(mRow + cDdiamondList[mIndex].rWidth - 1 - cDdiamondList[mIndex].rPointList[I].Y < 0) or
(mRow + cDdiamondList[mIndex].rWidth - 1 - cDdiamondList[mIndex].rPointList[I].Y >= FRowCount) or
(FPointList[
mCol + cDdiamondList[mIndex].rWidth - 1 - cDdiamondList[mIndex].rPointList[I].X,
mRow + cDdiamondList[mIndex].rWidth - 1 - cDdiamondList[mIndex].rPointList[I].Y] <> clWindow) then begin
Result := False;
Break;
end;
3: for I := 0 to cDdiamondList[mIndex].rCount - 1 do
if (mCol + cDdiamondList[mIndex].rPointList[I].Y < 0) or
(mCol + cDdiamondList[mIndex].rPointList[I].Y >= FColCount) or
(mRow + cDdiamondList[mIndex].rWidth - 1 - cDdiamondList[mIndex].rPointList[I].X < 0) or
(mRow + cDdiamondList[mIndex].rWidth - 1 - cDdiamondList[mIndex].rPointList[I].X >= FRowCount) or
(FPointList[
mCol + cDdiamondList[mIndex].rPointList[I].Y,
mRow + cDdiamondList[mIndex].rWidth - 1 - cDdiamondList[mIndex].rPointList[I].X] <> clWindow) then begin
Result := False;
Break;
end;
end;
end;procedure TFormDdiamond.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
{$J+}
const
I: Cardinal = 0;
{$J-}
var
vCol: Integer;
vRow: Integer;
vMoveCol: Integer;
vMoveRow: Integer;
vAspect: Integer;
begin
if Key = VK_PAUSE then begin
RPlaying := not FPlaying;
Exit;
end;
if not FPlaying then Exit;
if FKeyDown then begin
Inc(I, 100);
if I > TimerOne.Interval then begin
Key := VK_DOWN;
I := 0;
end;
end else I := 0;;
FKeyDown := True;
vAspect := FAspect;
vMoveCol := 0;
vMoveRow := 0;
case Key of
VK_UP, VK_NUMPAD5: if vAspect + 1 <= 3 then Inc(vAspect) else vAspect := 0;
VK_DOWN, VK_NUMPAD2: vMoveRow := +1;
VK_LEFT, VK_NUMPAD4: vMoveCol := -1;
VK_RIGHT, VK_NUMPAD6: vMoveCol := +1;
VK_NUMPAD1: begin
vMoveRow := +1;
vMoveCol := -1;
end;
VK_NUMPAD3: begin
vMoveRow := +1;
vMoveCol := +1;
end;
end;
vCol := FCol + vMoveCol;
vRow := FRow + vMoveRow;
if TryDdiamond(vCol, vRow, FIndex, vAspect) then begin
DrawDdiamond(FCol, FRow, FIndex, FAspect, False, False);
FCol := vCol;
FRow := vRow;
FAspect := vAspect;
DrawDdiamond(FCol, FRow, FIndex, FAspect, True, False);
end else if (vMoveCol = 0) and (vMoveRow > 0) then begin
DrawDdiamond(FCol, FRow, FIndex, FAspect, True, True);
StartDdiamond;
end;
end;procedure TFormDdiamond.BitBtnNewClick(Sender: TObject);
begin
if (Sender is TWinControl) and TWinControl(Sender).Visible then
TWinControl(Sender).SetFocus;
InitMap;
DrawMap;
RPlaying := True;
StartDdiamond;
end;procedure TFormDdiamond.StartDdiamond;
begin
FreeLine;
FIndex := FNextIndex;
FAspect := FNextAspect;
FCol := FColCount div 2 - cDdiamondList[FIndex].rWidth;
FRow := 0;
if not TryDdiamond(FCol, FRow, FIndex, FAspect) then begin
RPlaying := False;
BitBtnPause.Visible := False;
BitBtnPlay.Visible := False;
ShowMessage('Game Over');
if FMaxSuccess < FSuccess then begin
RMaxUserName := InputBox('Input', 'your name', RMaxUserName);
RMaxSuccess := FSuccess;
end;
Exit;
end;
DrawDdiamond(FCol, FRow, FIndex, FAspect, True, False);
FNextIndex := Random(cDdiamondCount);
FNextAspect := Random(4);
NextDdiamond;
end;procedure TFormDdiamond.TimerOneTimer(Sender: TObject);
var
vKey: Word;
begin
vKey := VK_DOWN;
FormKeyDown(Self, vKey, []);
end;procedure TFormDdiamond.FormKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
FKeyDown := False;
end;procedure TFormDdiamond.ImageOneClick(Sender: TObject);
begin
EditKey.SetFocus;
end;procedure TFormDdiamond.SetPlaying(const Value: Boolean);
begin
FPlaying := Value;
TimerOne.Enabled := FPlaying;
BitBtnPause.Visible := FPlaying;
BitBtnPlay.Visible := not FPlaying;
EditKey.SetFocus;
PanelButtonResize(PanelButton);
end;procedure TFormDdiamond.BitBtnPauseClick(Sender: TObject);
begin
if (Sender is TWinControl) and TWinControl(Sender).Visible then
TWinControl(Sender).SetFocus;
RPlaying := False;
end;procedure TFormDdiamond.FreeLine;
var
I, J, K: Integer;
B: Boolean;
begin
J := FRowCount - 1;
while J >= 0 do begin
B := True;
for I := 0 to FColCount - 1 do
if FPointList[I, J] = clWindow then begin
B := False;
Break;
end;
if B then begin
RSuccess := FSuccess + FColCount;
for I := 0 to FColCount - 1 do RPointList[I, J] := clWindow;
for K := J downto 1 do
for I := 0 to FColCount - 1 do
RPointList[I, K] := RPointList[I, K - 1];
end else Dec(J);
end;
end;procedure TFormDdiamond.PanelSumResize(Sender: TObject);
begin
EditSuccess.Left := TWinControl(Sender).ClientWidth - EditSuccess.Width - 5;
LabelSuccess.Left := EditSuccess.Left - LabelSuccess.Width - 5;
EditMaxUserName.Left := LabelSuccess.Left - EditMaxUserName.Width - 5;
LabelMaxUserName.Left := EditMaxUserName.Left - LabelMaxUserName.Width - 5;
EditSpeed.Left := EditSuccess.Left;
LabelSpeed.Left := LabelSuccess.Left;
EditMaxSuccess.Left := LabelSpeed.Left - EditMaxSuccess.Width - 5;
LabelMaxSuccess.Left := EditMaxSuccess.Left - LabelMaxSuccess.Width - 5;
end;procedure TFormDdiamond.SetSpeed(const Value: Integer);
begin
FSpeed := Min(Value, 9);
EditSpeed.Text := IntToStr(FSpeed);
TimerOne.Interval := 1000 - (FSpeed * 100);
end;procedure TFormDdiamond.SetSuccess(const Value: Integer);
begin
FSuccess := Value;
if FSuccess mod (20 * FColCount) = 0 then RSpeed := FSpeed + 1;
EditSuccess.Text := IntToStr(FSuccess);
end;procedure TFormDdiamond.NextDdiamond;
var
I: Integer;
begin
ImageTwo.Canvas.Brush.Color := clWindow;
ImageTwo.Canvas.FillRect(Rect(0, 0, ImageTwo.Width, ImageTwo.Height));
ImageTwo.Canvas.Brush.Color := cDdiamondList[FNextIndex].rColor;
case FNextAspect of
0: for I := 0 to cDdiamondList[FNextIndex].rCount - 1 do
ImageTwo.Picture.Bitmap.Canvas.Rectangle(
cDdiamondList[FNextIndex].rPointList[I].X * 10,
cDdiamondList[FNextIndex].rPointList[I].Y * 10,
(cDdiamondList[FNextIndex].rPointList[I].X + 1) * 10,
(cDdiamondList[FNextIndex].rPointList[I].Y + 1) * 10);
1: for I := 0 to cDdiamondList[FNextIndex].rCount - 1 do
ImageTwo.Picture.Bitmap.Canvas.Rectangle(
(cDdiamondList[FNextIndex].rWidth - 1 - cDdiamondList[FNextIndex].rPointList[I].Y) * 10,
cDdiamondList[FNextIndex].rPointList[I].X * 10,
(cDdiamondList[FNextIndex].rWidth - 1 - cDdiamondList[FNextIndex].rPointList[I].Y + 1) * 10,
(cDdiamondList[FNextIndex].rPointList[I].X + 1) * 10);
2: for I := 0 to cDdiamondList[FNextIndex].rCount - 1 do
ImageTwo.Picture.Bitmap.Canvas.Rectangle(
(cDdiamondList[FNextIndex].rWidth - 1 - cDdiamondList[FNextIndex].rPointList[I].X) * 10,
(cDdiamondList[FNextIndex].rWidth - 1 - cDdiamondList[FNextIndex].rPointList[I].Y) * 10,
(cDdiamondList[FNextIndex].rWidth - 1 - cDdiamondList[FNextIndex].rPointList[I].X + 1) * 10,
(cDdiamondList[FNextIndex].rWidth - 1 - cDdiamondList[FNextIndex].rPointList[I].Y + 1) * 10);
3: for I := 0 to cDdiamondList[FNextIndex].rCount - 1 do
ImageTwo.Picture.Bitmap.Canvas.Rectangle(
cDdiamondList[FNextIndex].rPointList[I].Y * 10,
(cDdiamondList[FNextIndex].rWidth - 1 - cDdiamondList[FNextIndex].rPointList[I].X) * 10,
(cDdiamondList[FNextIndex].rPointList[I].Y + 1) * 10,
(cDdiamondList[FNextIndex].rWidth - 1 - cDdiamondList[FNextIndex].rPointList[I].X + 1) * 10);
end;
end;procedure TFormDdiamond.BitBtnPlayClick(Sender: TObject);
begin
if (Sender is TWinControl) and TWinControl(Sender).Visible then
TWinControl(Sender).SetFocus;
RPlaying := True;
end;procedure TFormDdiamond.SetMaxSuccess(const Value: Integer);
begin
FMaxSuccess := Value;
EditMaxSuccess.Text := IntToStr(FMaxSuccess);
end;procedure TFormDdiamond.SetMaxUserName(const Value: string);
begin
FMaxUserName := Iif(Value = '', '<无>', Value);
EditMaxUserName.Text := FMaxUserName;
end;end.//dfm
object FormDdiamond: TFormDdiamond
Left = 106
Top = -9
Width = 528
Height = 579
Caption = 'FormDdiamond'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
KeyPreview = True
OldCreateOrder = False
OnClose = FormClose
OnCreate = FormCreate
OnDestroy = FormDestroy
OnKeyDown = FormKeyDown
OnKeyUp = FormKeyUp
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 13
object PanelButton: TPanel
Left = 0
Top = 526
Width = 520
Height = 26
Align = alBottom
BevelOuter = bvNone
ParentColor = True
TabOrder = 1
OnResize = PanelButtonResize
object BitBtnExit: TBitBtn
Left = 440
Top = 1
Width = 75
Height = 25
Caption = '退出(&X)'
TabOrder = 0
TabStop = False
OnClick = BitBtnExitClick
end
object BitBtnNew: TBitBtn
Left = 373
Top = 1
Width = 75
Height = 25
Caption = '新建(&N)'
TabOrder = 1
TabStop = False
OnClick = BitBtnNewClick
end
object BitBtnPause: TBitBtn
Left = 301
Top = 1
Width = 75
Height = 25
Caption = '暂停(&l)'
TabOrder = 2
OnClick = BitBtnPauseClick
end
object BitBtnPlay: TBitBtn
Left = 221
Top = 1
Width = 75
Height = 25
Caption = '开始(&B)'
TabOrder = 3
OnClick = BitBtnPlayClick
end
end
object PanelClient: TPanel
Left = 0
Top = 0
Width = 520
Height = 469
Align = alClient
BevelOuter = bvNone
TabOrder = 0
TabStop = True
object ImageOne: TImage
Left = 0
Top = 0
Width = 520
Height = 469
Align = alClient
Stretch = True
OnClick = ImageOneClick
end
object EditKey: TEdit
Left = -16
Top = -31
Width = 25
Height = 21
ReadOnly = True
TabOrder = 0
end
end
object PanelSum: TPanel
Left = 0
Top = 469
Width = 520
Height = 57
Align = alBottom
BevelOuter = bvNone
ParentColor = True
TabOrder = 2
OnResize = PanelSumResize
object LabelSpeed: TLabel
Left = 426
Top = 9
Width = 22
Height = 13
Caption = '速度'
FocusControl = EditSpeed
Transparent = True
end
object LabelSuccess: TLabel
Left = 427
Top = 34
Width = 22
Height = 13
Caption = '成绩'
FocusControl = EditSuccess
Transparent = True
end
object ImageTwo: TImage
Left = 0
Top = 1
Width = 40
Height = 40
Transparent = True
end
object LabelMaxUserName: TLabel
Left = 317
Top = 9
Width = 44
Height = 13
Caption = '最酷玩家'
FocusControl = EditMaxUserName
Transparent = True
end
object LabelMaxSuccess: TLabel
Left = 318
Top = 34
Width = 44
Height = 13
Caption = '最酷成绩'
FocusControl = EditMaxSuccess
Transparent = True
end
object EditSpeed: TEdit
Left = 453
Top = 5
Width = 57
Height = 21
TabOrder = 1
Text = 'EditSpeed'
OnEnter = EditEnter
OnExit = EditExit
end
object EditSuccess: TEdit
Left = 453
Top = 29
Width = 57
Height = 21
TabOrder = 3
Text = 'EditSuccess'
OnEnter = EditEnter
OnExit = EditExit
end
object EditMaxUserName: TEdit
Left = 373
Top = 5
Width = 50
Height = 21
TabOrder = 0
Text = 'EditMaxUserName'
OnEnter = EditEnter
OnExit = EditExit
end
object EditMaxSuccess: TEdit
Left = 373
Top = 29
Width = 50
Height = 21
TabOrder = 2
Text = 'EditMaxSuccess'
OnEnter = EditEnter
OnExit = EditExit
end
end
object TimerOne: TTimer
Enabled = False
OnTimer = TimerOneTimer
end
end//dpr
program DdiamondApp;uses
Forms,
Classes,
Graphics,
SysUtils,
DdiamondUnit in 'DdiamondUnit.pas' {FormDdiamond};{$R *.res}var
FormDdiamond: TFormDdiamond;
begin
Application.Initialize;
Application.CreateForm(TFormDdiamond, FormDdiamond);
FormDdiamond.RCaption := '方块游戏';
FormDdiamond.RReadOnlyColor := clRed;
FormDdiamond.RFocusColor := clGreen;
FormDdiamond.RColCount := 15;
FormDdiamond.RRowCount := 20;
FormDdiamond.RPointWidth := 16;
FormDdiamond.RPointHeight := 16;
FormDdiamond.RSuccess := 100;
FormDdiamond.RSpeed := 1;
if FileExists('Ddiamond.txt') then
with TStringList.Create do try
LoadFromFile('Ddiamond.txt');
FormDdiamond.RMaxSuccess := StrToIntDef(Values['RMaxSuccess'], 10);
FormDdiamond.RMaxUserName := Values['RMaxUserName'];
FormDdiamond.Width := StrToIntDef(Values['Width'], 10);
FormDdiamond.Left := StrToIntDef(Values['Left'], 10);
FormDdiamond.Top := StrToIntDef(Values['Top'], 10);
FormDdiamond.Height := StrToIntDef(Values['Height'], 10);
finally
Free;
end
else begin
FormDdiamond.RMaxSuccess := 10;
FormDdiamond.RMaxUserName := 'zswang';
end;
Application.Run;
with TStringList.Create do try
Values['RMaxSuccess'] := IntToStr(FormDdiamond.RMaxSuccess);
Values['RMaxUserName'] := FormDdiamond.RMaxUserName;
Values['Width'] := IntToStr(FormDdiamond.Width);
Values['Left'] := IntToStr(FormDdiamond.Left);
Values['Top'] := IntToStr(FormDdiamond.Top);
Values['Height'] := IntToStr(FormDdiamond.Height);
SaveToFile('Ddiamond.txt');
finally
Free;
end
end.
//[email protected] DdiamondUnit;interfaceuses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, FuncUnit, StdCtrls, Buttons, ExtCtrls;type
TAspect = 0..3;const
cPointCount = 5;type
TDdiamond = record
rCount: Integer;
rPointList: array[0..cPointCount - 1] of TPoint;
rWidth: Integer;
rColor: TColor;
end;{$DEFINE DDIAMOND4}{$IFDEF DDIAMOND4}
const
cDdiamondCount = 7;
cDdiamondList: array[0..cDdiamondCount - 1] of TDdiamond =
(
(rCount: 4; rPointList: ((x: 0; y: 0), (x: 0; y: 1), (x: 1; y: 0), (x: 1; y: 1), (x: 0; y: 0)); rWidth: 2; rColor: clMaroon),
(rCount: 4; rPointList: ((x: 1; y: 0), (x: 1; y: 1), (x: 1; y: 2), (x: 2; y: 1), (x: 0; y: 0)); rWidth: 3; rColor: clGreen),
(rCount: 4; rPointList: ((x: 1; y: 0), (x: 1; y: 1), (x: 1; y: 2), (x: 2; y: 0), (x: 0; y: 0)); rWidth: 3; rColor: clOlive),
(rCount: 4; rPointList: ((x: 1; y: 0), (x: 1; y: 1), (x: 1; y: 2), (x: 2; y: 2), (x: 0; y: 0)); rWidth: 3; rColor: clNavy),
(rCount: 4; rPointList: ((x: 0; y: 1), (x: 1; y: 1), (x: 2; y: 1), (x: 3; y: 1), (x: 0; y: 0)); rWidth: 4; rColor: clPurple),
(rCount: 4; rPointList: ((x: 0; y: 1), (x: 1; y: 1), (x: 1; y: 2), (x: 2; y: 2), (x: 0; y: 0)); rWidth: 3; rColor: clTeal),
(rCount: 4; rPointList: ((x: 0; y: 2), (x: 1; y: 2), (x: 1; y: 1), (x: 2; y: 1), (x: 0; y: 0)); rWidth: 3; rColor: clGray)
);
{$ELSE}
const
cDdiamondCount = 28;
cDdiamondList: array[0..cDdiamondCount - 1] of TDdiamond =
(
(rCount: 1; rPointList: ((x: 0; y: 0), (x: 0; y: 0), (x: 0; y: 0), (x: 0; y: 0), (x: 0; y: 0)); rWidth: 1; rColor: clSilver),
(rCount: 2; rPointList: ((x: 0; y: 0), (x: 0; y: 1), (x: 0; y: 0), (x: 0; y: 0), (x: 0; y: 0)); rWidth: 2; rColor: clRed),
(rCount: 3; rPointList: ((x: 1; y: 0), (x: 1; y: 1), (x: 1; y: 2), (x: 0; y: 0), (x: 0; y: 0)); rWidth: 3; rColor: clLime),
(rCount: 3; rPointList: ((x: 1; y: 0), (x: 1; y: 1), (x: 0; y: 1), (x: 0; y: 0), (x: 0; y: 0)); rWidth: 3; rColor: clYellow),
(rCount: 4; rPointList: ((x: 0; y: 0), (x: 0; y: 1), (x: 1; y: 0), (x: 1; y: 1), (x: 0; y: 0)); rWidth: 2; rColor: clMaroon),
(rCount: 4; rPointList: ((x: 1; y: 0), (x: 1; y: 1), (x: 1; y: 2), (x: 2; y: 1), (x: 0; y: 0)); rWidth: 3; rColor: clGreen),
(rCount: 4; rPointList: ((x: 1; y: 0), (x: 1; y: 1), (x: 1; y: 2), (x: 2; y: 0), (x: 0; y: 0)); rWidth: 3; rColor: clOlive),
(rCount: 4; rPointList: ((x: 1; y: 0), (x: 1; y: 1), (x: 1; y: 2), (x: 2; y: 2), (x: 0; y: 0)); rWidth: 3; rColor: clNavy),
(rCount: 4; rPointList: ((x: 0; y: 1), (x: 1; y: 1), (x: 2; y: 1), (x: 3; y: 1), (x: 0; y: 0)); rWidth: 4; rColor: clPurple),
(rCount: 4; rPointList: ((x: 0; y: 1), (x: 1; y: 1), (x: 1; y: 2), (x: 2; y: 2), (x: 0; y: 0)); rWidth: 3; rColor: clTeal),
(rCount: 4; rPointList: ((x: 0; y: 2), (x: 1; y: 2), (x: 1; y: 1), (x: 2; y: 1), (x: 0; y: 0)); rWidth: 3; rColor: clGray),
(rCount: 5; rPointList: ((x: 2; y: 0), (x: 2; y: 1), (x: 2; y: 2), (x: 2; y: 3), (x: 2; y: 4)); rWidth: 5; rColor: clBlue),
(rCount: 5; rPointList: ((x: 2; y: 0), (x: 2; y: 1), (x: 2; y: 2), (x: 2; y: 3), (x: 3; y: 3)); rWidth: 4; rColor: clFuchsia),
(rCount: 5; rPointList: ((x: 2; y: 0), (x: 2; y: 1), (x: 2; y: 2), (x: 2; y: 3), (x: 3; y: 0)); rWidth: 4; rColor: clAqua),
(rCount: 5; rPointList: ((x: 0; y: 1), (x: 1; y: 0), (x: 1; y: 1), (x: 1; y: 2), (x: 2; y: 1)); rWidth: 3; rColor: clLtGray),
(rCount: 5; rPointList: ((x: 0; y: 0), (x: 0; y: 2), (x: 1; y: 0), (x: 1; y: 1), (x: 1; y: 2)); rWidth: 3; rColor: clDkGray),
(rCount: 5; rPointList: ((x: 0; y: 0), (x: 0; y: 1), (x: 1; y: 0), (x: 1; y: 1), (x: 1; y: 2)); rWidth: 3; rColor: clYellow),
(rCount: 5; rPointList: ((x: 0; y: 0), (x: 0; y: 1), (x: 1; y: 0), (x: 1; y: 1), (x: 0; y: 2)); rWidth: 3; rColor: clMoneyGreen),
(rCount: 5; rPointList: ((x: 0; y: 0), (x: 0; y: 1), (x: 0; y: 2), (x: 1; y: 1), (x: 2; y: 1)); rWidth: 3; rColor: clSkyBlue),
(rCount: 5; rPointList: ((x: 0; y: 0), (x: 0; y: 1), (x: 1; y: 1), (x: 1; y: 2), (x: 2; y: 1)); rWidth: 3; rColor: clCream),
(rCount: 5; rPointList: ((x: 0; y: 1), (x: 0; y: 2), (x: 1; y: 0), (x: 1; y: 1), (x: 2; y: 1)); rWidth: 3; rColor: clMedGray),
(rCount: 5; rPointList: ((x: 0; y: 1), (x: 1; y: 0), (x: 1; y: 1), (x: 1; y: 2), (x: 1; y: 3)); rWidth: 4; rColor: clMaroon),
(rCount: 5; rPointList: ((x: 0; y: 2), (x: 1; y: 0), (x: 1; y: 1), (x: 1; y: 2), (x: 1; y: 3)); rWidth: 4; rColor: clGreen),
(rCount: 5; rPointList: ((x: 1; y: 1), (x: 1; y: 2), (x: 1; y: 3), (x: 2; y: 0), (x: 2; y: 1)); rWidth: 4; rColor: clGreen),
(rCount: 5; rPointList: ((x: 1; y: 0), (x: 1; y: 1), (x: 1; y: 2), (x: 2; y: 2), (x: 2; y: 3)); rWidth: 4; rColor: clOlive),
(rCount: 5; rPointList: ((x: 0; y: 0), (x: 1; y: 0), (x: 1; y: 1), (x: 2; y: 1), (x: 2; y: 2)); rWidth: 3; rColor: clNavy),
(rCount: 5; rPointList: ((x: 0; y: 0), (x: 0; y: 1), (x: 1; y: 1), (x: 2; y: 1), (x: 2; y: 2)); rWidth: 3; rColor: clPurple),
(rCount: 5; rPointList: ((x: 0; y: 1), (x: 0; y: 2), (x: 1; y: 1), (x: 2; y: 0), (x: 2; y: 1)); rWidth: 3; rColor: clTeal)
);
{$ENDIF}type
TFormDdiamond = class(TForm)
PanelButton: TPanel;
BitBtnExit: TBitBtn;
PanelClient: TPanel;
ImageOne: TImage;
BitBtnNew: TBitBtn;
EditKey: TEdit;
TimerOne: TTimer;
BitBtnPause: TBitBtn;
PanelSum: TPanel;
LabelSpeed: TLabel;
LabelSuccess: TLabel;
EditSpeed: TEdit;
EditSuccess: TEdit;
ImageTwo: TImage;
BitBtnPlay: TBitBtn;
LabelMaxUserName: TLabel;
EditMaxUserName: TEdit;
LabelMaxSuccess: TLabel;
EditMaxSuccess: TEdit;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure EditEnter(Sender: TObject);
procedure EditExit(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure BitBtnExitClick(Sender: TObject);
procedure PanelButtonResize(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure BitBtnNewClick(Sender: TObject);
procedure TimerOneTimer(Sender: TObject);
procedure FormKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure ImageOneClick(Sender: TObject);
procedure BitBtnPauseClick(Sender: TObject);
procedure PanelSumResize(Sender: TObject);
procedure BitBtnPlayClick(Sender: TObject);
private
{ Private declarations }
///////Begin Standard
FStringList: TStringList; //参数文本
FOldColor: TColor; //旧颜色
FCaption: TCaption;
FReadOnlyColor: TColor;
FFocusColor: TColor;
///////End Standard
///////Begin Ddiamond
FPointList: array of array of TColor;
FColCount: Integer;
FRowCount: Integer;
FPointWidth: Integer;
FPointHeight: Integer;
FIndex: Integer;
FCol: Integer;
FRow: Integer;
FAspect: TAspect;
FKeyDown: Boolean;
FPlaying: Boolean;
FSuccess: Integer;
FSpeed: Integer;
FNextIndex: Integer;
FNextAspect: Integer;
FMaxSuccess: Integer;
FMaxUserName: string;
///////End Ddiamond
private
///////Begin Standard
procedure SetCaption(const Value: TCaption);
///////End Standard
///////Begin Ddiamond
procedure InitMap;
procedure DrawMap;
procedure StartDdiamond;
procedure NextDdiamond;
procedure DrawPoint(mCol, mRow: Integer; mColor: TColor; mChange: Boolean);
function GetPointList(mCol, mRow: Integer): TColor;
procedure SetPointList(mCol, mRow: Integer; const Value: TColor);
procedure DrawDdiamond(mCol, mRow: Integer; mIndex: Integer; mAspect: TAspect; mShow: Boolean; mChange: Boolean); //放块
function TryDdiamond(mCol, mRow: Integer; mIndex: Integer; mAspect: TAspect): Boolean; //测试是否可以放块
procedure FreeLine; //消行
procedure SetPlaying(const Value: Boolean);
procedure SetSpeed(const Value: Integer);
procedure SetSuccess(const Value: Integer);
procedure SetMaxSuccess(const Value: Integer);
procedure SetMaxUserName(const Value: string);
///////End Ddiamond
public
{ Public declarations }
///////Begin Standard
property RCaption: TCaption read FCaption write SetCaption; //模块标题
property RReadOnlyColor: TColor read FReadOnlyColor write FReadOnlyColor; //只读色
property RFocusColor: TColor read FFocusColor write FFocusColor; //焦点色
///////End Standard
///////Begin Ddiamond
property RPointList[mCol: Integer; mRow: Integer]: TColor read GetPointList write SetPointList; default; //点列表
property RColCount: Integer read FColCount write FColCount; //列数
property RRowCount: Integer read FRowCount write FRowCount; //行数
property RPointWidth: Integer read FPointWidth write FPointWidth; //点宽度
property RPointHeight: Integer read FPointHeight write FPointHeight; //点高度
property RPlaying: Boolean read FPlaying write SetPlaying; //是否游戏中
property RSuccess: Integer read FSuccess write SetSuccess; //成绩
property RMaxSuccess: Integer read FMaxSuccess write SetMaxSuccess; //最好成绩
property RMaxUserName: string read FMaxUserName write SetMaxUserName; //最好用户
property RSpeed: Integer read FSpeed write SetSpeed; //速度
///////End Ddiamond
published
{ Published declarations }
end;//var//
// FormDdiamond: TFormDdiamond;//implementation{$R *.dfm}uses
Math;procedure TFormDdiamond.SetCaption(const Value: TCaption);
begin
FCaption := Value;
Caption := FCaption;
end;procedure TFormDdiamond.FormCreate(Sender: TObject);
begin
Randomize;
FStringList := TStringList.Create;
PanelButtonResize(PanelButton);
EditSuccess.Text := '';
EditSpeed.Text := '';
end;procedure TFormDdiamond.FormDestroy(Sender: TObject);
begin
FStringList.Free;
end;procedure TFormDdiamond.EditEnter(Sender: TObject);
begin
FOldColor := TEdit(Sender).Color;
if TEdit(Sender).Color = FReadOnlyColor then
TEdit(Sender).Color := TEdit(Sender).Color xor FFocusColor
else TEdit(Sender).Color := FFocusColor;
end;procedure TFormDdiamond.EditExit(Sender: TObject);
begin
TEdit(Sender).Color := FOldColor;
end;procedure TFormDdiamond.FormShow(Sender: TObject);
begin
SetLength(FPointList, FColCount, FRowCount);
ImageOne.Picture.Bitmap.Width := FColCount * FPointWidth;
ImageOne.Picture.Bitmap.Height := FRowCount * FPointHeight;
RPlaying := False;
BitBtnPause.Visible := False;
BitBtnPlay.Visible := False;
WinControlModified(False, PanelSum, FReadOnlyColor, []);
ImageTwo.Width := cPointCount * 10;
ImageTwo.Height := cPointCount * 10;
end;procedure TFormDdiamond.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
if FPlaying then begin
if FMaxSuccess < FSuccess then begin
RPlaying := False;
RMaxUserName := InputBox('Input', 'your name', RMaxUserName);
RMaxSuccess := FSuccess;
end;
end;
end;procedure TFormDdiamond.BitBtnExitClick(Sender: TObject);
begin
if (Sender is TWinControl) and TWinControl(Sender).Visible then
TWinControl(Sender).SetFocus;
Close;
end;procedure TFormDdiamond.PanelButtonResize(Sender: TObject);
begin
WinControlButton(TWinControl(Sender), 75, 25, 6);
end;procedure TFormDdiamond.DrawMap;
var
I, J: Integer;
begin
for J := 0 to FRowCount - 1 do
for I := 0 to FColCount - 1 do
DrawPoint(I, J, FPointList[I, J], True);
end;procedure TFormDdiamond.DrawPoint(mCol, mRow: Integer; mColor: TColor; mChange: Boolean);
begin
if (mCol < 0) or (mCol >= FColCount) then Exit;
if (mRow < 0) or (mRow >= FRowCount) then Exit;
ImageOne.Picture.Bitmap.Canvas.Brush.Color := mColor;
if mColor = clWindow then
ImageOne.Picture.Bitmap.Canvas.FillRect(Rect(
mCol * FPointWidth, mRow * FPointHeight,
(mCol + 1) * FPointWidth, (mRow + 1) * FPointHeight))
else ImageOne.Picture.Bitmap.Canvas.Rectangle(
mCol * FPointWidth, mRow * FPointHeight,
(mCol + 1) * FPointWidth, (mRow + 1) * FPointHeight);
if mChange then FPointList[mCol, mRow] := mColor;
end;function TFormDdiamond.GetPointList(mCol, mRow: Integer): TColor;
begin
Result := clWindow;
if (mCol < 0) or (mCol >= FColCount) then Exit;
if (mRow < 0) or (mRow >= FRowCount) then Exit;
Result := FPointList[mCol, mRow];
end;procedure TFormDdiamond.SetPointList(mCol, mRow: Integer;
const Value: TColor);
begin
if (mCol < 0) or (mCol >= FColCount) then Exit;
if (mRow < 0) or (mRow >= FRowCount) then Exit;
FPointList[mCol, mRow] := Value;
DrawPoint(mCol, mRow, FPointList[mCol, mRow], True);
end;procedure TFormDdiamond.InitMap;
var
I, J: Integer;
begin
for J := 0 to FRowCount - 1 do
for I := 0 to FColCount - 1 do
FPointList[I, J] := clWindow;
RSuccess := 0;
RSpeed := 0;
EditKey.SetFocus;
PanelButtonResize(PanelButton);
FNextIndex := Random(cDdiamondCount);
FNextAspect := Random(4);
end;procedure TFormDdiamond.DrawDdiamond(mCol, mRow, mIndex: Integer;
mAspect: TAspect; mShow: Boolean; mChange: Boolean);
var
I: Integer;
vColor: TColor;
begin
vColor := Iif(mShow, cDdiamondList[mIndex].rColor, clWindow);
case mAspect of
0: for I := 0 to cDdiamondList[mIndex].rCount - 1 do
DrawPoint(
mCol + cDdiamondList[mIndex].rPointList[I].X,
mRow + cDdiamondList[mIndex].rPointList[I].Y, vColor, mChange);
1: for I := 0 to cDdiamondList[mIndex].rCount - 1 do
DrawPoint(
mCol + cDdiamondList[mIndex].rWidth - 1 - cDdiamondList[mIndex].rPointList[I].Y,
mRow + cDdiamondList[mIndex].rPointList[I].X, vColor, mChange);
2: for I := 0 to cDdiamondList[mIndex].rCount - 1 do
DrawPoint(
mCol + cDdiamondList[mIndex].rWidth - 1 - cDdiamondList[mIndex].rPointList[I].X,
mRow + cDdiamondList[mIndex].rWidth - 1 - cDdiamondList[mIndex].rPointList[I].Y, vColor, mChange);
3: for I := 0 to cDdiamondList[mIndex].rCount - 1 do
DrawPoint(
mCol + cDdiamondList[mIndex].rPointList[I].Y,
mRow + cDdiamondList[mIndex].rWidth - 1 - cDdiamondList[mIndex].rPointList[I].X, vColor, mChange);
end;
end;function TFormDdiamond.TryDdiamond(mCol, mRow: Integer; mIndex: Integer;
mAspect: TAspect): Boolean;
var
I: Integer;
begin
Result := True;
case mAspect of
0: for I := 0 to cDdiamondList[mIndex].rCount - 1 do
if (mCol + cDdiamondList[mIndex].rPointList[I].X < 0) or
(mCol + cDdiamondList[mIndex].rPointList[I].X >= FColCount) or
(mRow + cDdiamondList[mIndex].rPointList[I].Y < 0) or
(mRow + cDdiamondList[mIndex].rPointList[I].Y >= FRowCount) or
(FPointList[
mCol + cDdiamondList[mIndex].rPointList[I].X,
mRow + cDdiamondList[mIndex].rPointList[I].Y] <> clWindow) then begin
Result := False;
Break;
end;
1: for I := 0 to cDdiamondList[mIndex].rCount - 1 do
if (mCol + cDdiamondList[mIndex].rWidth - 1 - cDdiamondList[mIndex].rPointList[I].Y < 0) or
(mCol + cDdiamondList[mIndex].rWidth - 1 - cDdiamondList[mIndex].rPointList[I].Y >= FColCount) or
(mRow + cDdiamondList[mIndex].rPointList[I].X < 0) or
(mRow + cDdiamondList[mIndex].rPointList[I].X >= FRowCount) or
(FPointList[
mCol + cDdiamondList[mIndex].rWidth - 1 - cDdiamondList[mIndex].rPointList[I].Y,
mRow + cDdiamondList[mIndex].rPointList[I].X] <> clWindow) then begin
Result := False;
Break;
end;
2: for I := 0 to cDdiamondList[mIndex].rCount - 1 do
if (mCol + cDdiamondList[mIndex].rWidth - 1 - cDdiamondList[mIndex].rPointList[I].X < 0) or
(mCol + cDdiamondList[mIndex].rWidth - 1 - cDdiamondList[mIndex].rPointList[I].X >= FColCount) or
(mRow + cDdiamondList[mIndex].rWidth - 1 - cDdiamondList[mIndex].rPointList[I].Y < 0) or
(mRow + cDdiamondList[mIndex].rWidth - 1 - cDdiamondList[mIndex].rPointList[I].Y >= FRowCount) or
(FPointList[
mCol + cDdiamondList[mIndex].rWidth - 1 - cDdiamondList[mIndex].rPointList[I].X,
mRow + cDdiamondList[mIndex].rWidth - 1 - cDdiamondList[mIndex].rPointList[I].Y] <> clWindow) then begin
Result := False;
Break;
end;
3: for I := 0 to cDdiamondList[mIndex].rCount - 1 do
if (mCol + cDdiamondList[mIndex].rPointList[I].Y < 0) or
(mCol + cDdiamondList[mIndex].rPointList[I].Y >= FColCount) or
(mRow + cDdiamondList[mIndex].rWidth - 1 - cDdiamondList[mIndex].rPointList[I].X < 0) or
(mRow + cDdiamondList[mIndex].rWidth - 1 - cDdiamondList[mIndex].rPointList[I].X >= FRowCount) or
(FPointList[
mCol + cDdiamondList[mIndex].rPointList[I].Y,
mRow + cDdiamondList[mIndex].rWidth - 1 - cDdiamondList[mIndex].rPointList[I].X] <> clWindow) then begin
Result := False;
Break;
end;
end;
end;procedure TFormDdiamond.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
{$J+}
const
I: Cardinal = 0;
{$J-}
var
vCol: Integer;
vRow: Integer;
vMoveCol: Integer;
vMoveRow: Integer;
vAspect: Integer;
begin
if Key = VK_PAUSE then begin
RPlaying := not FPlaying;
Exit;
end;
if not FPlaying then Exit;
if FKeyDown then begin
Inc(I, 100);
if I > TimerOne.Interval then begin
Key := VK_DOWN;
I := 0;
end;
end else I := 0;;
FKeyDown := True;
vAspect := FAspect;
vMoveCol := 0;
vMoveRow := 0;
case Key of
VK_UP, VK_NUMPAD5: if vAspect + 1 <= 3 then Inc(vAspect) else vAspect := 0;
VK_DOWN, VK_NUMPAD2: vMoveRow := +1;
VK_LEFT, VK_NUMPAD4: vMoveCol := -1;
VK_RIGHT, VK_NUMPAD6: vMoveCol := +1;
VK_NUMPAD1: begin
vMoveRow := +1;
vMoveCol := -1;
end;
VK_NUMPAD3: begin
vMoveRow := +1;
vMoveCol := +1;
end;
end;
vCol := FCol + vMoveCol;
vRow := FRow + vMoveRow;
if TryDdiamond(vCol, vRow, FIndex, vAspect) then begin
DrawDdiamond(FCol, FRow, FIndex, FAspect, False, False);
FCol := vCol;
FRow := vRow;
FAspect := vAspect;
DrawDdiamond(FCol, FRow, FIndex, FAspect, True, False);
end else if (vMoveCol = 0) and (vMoveRow > 0) then begin
DrawDdiamond(FCol, FRow, FIndex, FAspect, True, True);
StartDdiamond;
end;
end;procedure TFormDdiamond.BitBtnNewClick(Sender: TObject);
begin
if (Sender is TWinControl) and TWinControl(Sender).Visible then
TWinControl(Sender).SetFocus;
InitMap;
DrawMap;
RPlaying := True;
StartDdiamond;
end;procedure TFormDdiamond.StartDdiamond;
begin
FreeLine;
FIndex := FNextIndex;
FAspect := FNextAspect;
FCol := FColCount div 2 - cDdiamondList[FIndex].rWidth;
FRow := 0;
if not TryDdiamond(FCol, FRow, FIndex, FAspect) then begin
RPlaying := False;
BitBtnPause.Visible := False;
BitBtnPlay.Visible := False;
ShowMessage('Game Over');
if FMaxSuccess < FSuccess then begin
RMaxUserName := InputBox('Input', 'your name', RMaxUserName);
RMaxSuccess := FSuccess;
end;
Exit;
end;
DrawDdiamond(FCol, FRow, FIndex, FAspect, True, False);
FNextIndex := Random(cDdiamondCount);
FNextAspect := Random(4);
NextDdiamond;
end;procedure TFormDdiamond.TimerOneTimer(Sender: TObject);
var
vKey: Word;
begin
vKey := VK_DOWN;
FormKeyDown(Self, vKey, []);
end;procedure TFormDdiamond.FormKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
FKeyDown := False;
end;procedure TFormDdiamond.ImageOneClick(Sender: TObject);
begin
EditKey.SetFocus;
end;procedure TFormDdiamond.SetPlaying(const Value: Boolean);
begin
FPlaying := Value;
TimerOne.Enabled := FPlaying;
BitBtnPause.Visible := FPlaying;
BitBtnPlay.Visible := not FPlaying;
EditKey.SetFocus;
PanelButtonResize(PanelButton);
end;procedure TFormDdiamond.BitBtnPauseClick(Sender: TObject);
begin
if (Sender is TWinControl) and TWinControl(Sender).Visible then
TWinControl(Sender).SetFocus;
RPlaying := False;
end;procedure TFormDdiamond.FreeLine;
var
I, J, K: Integer;
B: Boolean;
begin
J := FRowCount - 1;
while J >= 0 do begin
B := True;
for I := 0 to FColCount - 1 do
if FPointList[I, J] = clWindow then begin
B := False;
Break;
end;
if B then begin
RSuccess := FSuccess + FColCount;
for I := 0 to FColCount - 1 do RPointList[I, J] := clWindow;
for K := J downto 1 do
for I := 0 to FColCount - 1 do
RPointList[I, K] := RPointList[I, K - 1];
end else Dec(J);
end;
end;procedure TFormDdiamond.PanelSumResize(Sender: TObject);
begin
EditSuccess.Left := TWinControl(Sender).ClientWidth - EditSuccess.Width - 5;
LabelSuccess.Left := EditSuccess.Left - LabelSuccess.Width - 5;
EditMaxUserName.Left := LabelSuccess.Left - EditMaxUserName.Width - 5;
LabelMaxUserName.Left := EditMaxUserName.Left - LabelMaxUserName.Width - 5;
EditSpeed.Left := EditSuccess.Left;
LabelSpeed.Left := LabelSuccess.Left;
EditMaxSuccess.Left := LabelSpeed.Left - EditMaxSuccess.Width - 5;
LabelMaxSuccess.Left := EditMaxSuccess.Left - LabelMaxSuccess.Width - 5;
end;procedure TFormDdiamond.SetSpeed(const Value: Integer);
begin
FSpeed := Min(Value, 9);
EditSpeed.Text := IntToStr(FSpeed);
TimerOne.Interval := 1000 - (FSpeed * 100);
end;procedure TFormDdiamond.SetSuccess(const Value: Integer);
begin
FSuccess := Value;
if FSuccess mod (20 * FColCount) = 0 then RSpeed := FSpeed + 1;
EditSuccess.Text := IntToStr(FSuccess);
end;procedure TFormDdiamond.NextDdiamond;
var
I: Integer;
begin
ImageTwo.Canvas.Brush.Color := clWindow;
ImageTwo.Canvas.FillRect(Rect(0, 0, ImageTwo.Width, ImageTwo.Height));
ImageTwo.Canvas.Brush.Color := cDdiamondList[FNextIndex].rColor;
case FNextAspect of
0: for I := 0 to cDdiamondList[FNextIndex].rCount - 1 do
ImageTwo.Picture.Bitmap.Canvas.Rectangle(
cDdiamondList[FNextIndex].rPointList[I].X * 10,
cDdiamondList[FNextIndex].rPointList[I].Y * 10,
(cDdiamondList[FNextIndex].rPointList[I].X + 1) * 10,
(cDdiamondList[FNextIndex].rPointList[I].Y + 1) * 10);
1: for I := 0 to cDdiamondList[FNextIndex].rCount - 1 do
ImageTwo.Picture.Bitmap.Canvas.Rectangle(
(cDdiamondList[FNextIndex].rWidth - 1 - cDdiamondList[FNextIndex].rPointList[I].Y) * 10,
cDdiamondList[FNextIndex].rPointList[I].X * 10,
(cDdiamondList[FNextIndex].rWidth - 1 - cDdiamondList[FNextIndex].rPointList[I].Y + 1) * 10,
(cDdiamondList[FNextIndex].rPointList[I].X + 1) * 10);
2: for I := 0 to cDdiamondList[FNextIndex].rCount - 1 do
ImageTwo.Picture.Bitmap.Canvas.Rectangle(
(cDdiamondList[FNextIndex].rWidth - 1 - cDdiamondList[FNextIndex].rPointList[I].X) * 10,
(cDdiamondList[FNextIndex].rWidth - 1 - cDdiamondList[FNextIndex].rPointList[I].Y) * 10,
(cDdiamondList[FNextIndex].rWidth - 1 - cDdiamondList[FNextIndex].rPointList[I].X + 1) * 10,
(cDdiamondList[FNextIndex].rWidth - 1 - cDdiamondList[FNextIndex].rPointList[I].Y + 1) * 10);
3: for I := 0 to cDdiamondList[FNextIndex].rCount - 1 do
ImageTwo.Picture.Bitmap.Canvas.Rectangle(
cDdiamondList[FNextIndex].rPointList[I].Y * 10,
(cDdiamondList[FNextIndex].rWidth - 1 - cDdiamondList[FNextIndex].rPointList[I].X) * 10,
(cDdiamondList[FNextIndex].rPointList[I].Y + 1) * 10,
(cDdiamondList[FNextIndex].rWidth - 1 - cDdiamondList[FNextIndex].rPointList[I].X + 1) * 10);
end;
end;procedure TFormDdiamond.BitBtnPlayClick(Sender: TObject);
begin
if (Sender is TWinControl) and TWinControl(Sender).Visible then
TWinControl(Sender).SetFocus;
RPlaying := True;
end;procedure TFormDdiamond.SetMaxSuccess(const Value: Integer);
begin
FMaxSuccess := Value;
EditMaxSuccess.Text := IntToStr(FMaxSuccess);
end;procedure TFormDdiamond.SetMaxUserName(const Value: string);
begin
FMaxUserName := Iif(Value = '', '<无>', Value);
EditMaxUserName.Text := FMaxUserName;
end;end.//dfm
object FormDdiamond: TFormDdiamond
Left = 106
Top = -9
Width = 528
Height = 579
Caption = 'FormDdiamond'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
KeyPreview = True
OldCreateOrder = False
OnClose = FormClose
OnCreate = FormCreate
OnDestroy = FormDestroy
OnKeyDown = FormKeyDown
OnKeyUp = FormKeyUp
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 13
object PanelButton: TPanel
Left = 0
Top = 526
Width = 520
Height = 26
Align = alBottom
BevelOuter = bvNone
ParentColor = True
TabOrder = 1
OnResize = PanelButtonResize
object BitBtnExit: TBitBtn
Left = 440
Top = 1
Width = 75
Height = 25
Caption = '退出(&X)'
TabOrder = 0
TabStop = False
OnClick = BitBtnExitClick
end
object BitBtnNew: TBitBtn
Left = 373
Top = 1
Width = 75
Height = 25
Caption = '新建(&N)'
TabOrder = 1
TabStop = False
OnClick = BitBtnNewClick
end
object BitBtnPause: TBitBtn
Left = 301
Top = 1
Width = 75
Height = 25
Caption = '暂停(&l)'
TabOrder = 2
OnClick = BitBtnPauseClick
end
object BitBtnPlay: TBitBtn
Left = 221
Top = 1
Width = 75
Height = 25
Caption = '开始(&B)'
TabOrder = 3
OnClick = BitBtnPlayClick
end
end
object PanelClient: TPanel
Left = 0
Top = 0
Width = 520
Height = 469
Align = alClient
BevelOuter = bvNone
TabOrder = 0
TabStop = True
object ImageOne: TImage
Left = 0
Top = 0
Width = 520
Height = 469
Align = alClient
Stretch = True
OnClick = ImageOneClick
end
object EditKey: TEdit
Left = -16
Top = -31
Width = 25
Height = 21
ReadOnly = True
TabOrder = 0
end
end
object PanelSum: TPanel
Left = 0
Top = 469
Width = 520
Height = 57
Align = alBottom
BevelOuter = bvNone
ParentColor = True
TabOrder = 2
OnResize = PanelSumResize
object LabelSpeed: TLabel
Left = 426
Top = 9
Width = 22
Height = 13
Caption = '速度'
FocusControl = EditSpeed
Transparent = True
end
object LabelSuccess: TLabel
Left = 427
Top = 34
Width = 22
Height = 13
Caption = '成绩'
FocusControl = EditSuccess
Transparent = True
end
object ImageTwo: TImage
Left = 0
Top = 1
Width = 40
Height = 40
Transparent = True
end
object LabelMaxUserName: TLabel
Left = 317
Top = 9
Width = 44
Height = 13
Caption = '最酷玩家'
FocusControl = EditMaxUserName
Transparent = True
end
object LabelMaxSuccess: TLabel
Left = 318
Top = 34
Width = 44
Height = 13
Caption = '最酷成绩'
FocusControl = EditMaxSuccess
Transparent = True
end
object EditSpeed: TEdit
Left = 453
Top = 5
Width = 57
Height = 21
TabOrder = 1
Text = 'EditSpeed'
OnEnter = EditEnter
OnExit = EditExit
end
object EditSuccess: TEdit
Left = 453
Top = 29
Width = 57
Height = 21
TabOrder = 3
Text = 'EditSuccess'
OnEnter = EditEnter
OnExit = EditExit
end
object EditMaxUserName: TEdit
Left = 373
Top = 5
Width = 50
Height = 21
TabOrder = 0
Text = 'EditMaxUserName'
OnEnter = EditEnter
OnExit = EditExit
end
object EditMaxSuccess: TEdit
Left = 373
Top = 29
Width = 50
Height = 21
TabOrder = 2
Text = 'EditMaxSuccess'
OnEnter = EditEnter
OnExit = EditExit
end
end
object TimerOne: TTimer
Enabled = False
OnTimer = TimerOneTimer
end
end//dpr
program DdiamondApp;uses
Forms,
Classes,
Graphics,
SysUtils,
DdiamondUnit in 'DdiamondUnit.pas' {FormDdiamond};{$R *.res}var
FormDdiamond: TFormDdiamond;
begin
Application.Initialize;
Application.CreateForm(TFormDdiamond, FormDdiamond);
FormDdiamond.RCaption := '方块游戏';
FormDdiamond.RReadOnlyColor := clRed;
FormDdiamond.RFocusColor := clGreen;
FormDdiamond.RColCount := 15;
FormDdiamond.RRowCount := 20;
FormDdiamond.RPointWidth := 16;
FormDdiamond.RPointHeight := 16;
FormDdiamond.RSuccess := 100;
FormDdiamond.RSpeed := 1;
if FileExists('Ddiamond.txt') then
with TStringList.Create do try
LoadFromFile('Ddiamond.txt');
FormDdiamond.RMaxSuccess := StrToIntDef(Values['RMaxSuccess'], 10);
FormDdiamond.RMaxUserName := Values['RMaxUserName'];
FormDdiamond.Width := StrToIntDef(Values['Width'], 10);
FormDdiamond.Left := StrToIntDef(Values['Left'], 10);
FormDdiamond.Top := StrToIntDef(Values['Top'], 10);
FormDdiamond.Height := StrToIntDef(Values['Height'], 10);
finally
Free;
end
else begin
FormDdiamond.RMaxSuccess := 10;
FormDdiamond.RMaxUserName := 'zswang';
end;
Application.Run;
with TStringList.Create do try
Values['RMaxSuccess'] := IntToStr(FormDdiamond.RMaxSuccess);
Values['RMaxUserName'] := FormDdiamond.RMaxUserName;
Values['Width'] := IntToStr(FormDdiamond.Width);
Values['Left'] := IntToStr(FormDdiamond.Left);
Values['Top'] := IntToStr(FormDdiamond.Top);
Values['Height'] := IntToStr(FormDdiamond.Height);
SaveToFile('Ddiamond.txt');
finally
Free;
end
end.
0XX
1 XX
2
3 0123
0XX
1 X
2 X
3 X
如果你想加方块自己试
//修改(rCount: 4; rPointList: ((x: 0; y: 0), (x: 0; y: 1), (x: 1; y: 0), (x: 1; y: 1), (x: 0; y: 0)); rWidth: 2; rColor: clMaroon),//把{$DEFINE DDIAMOND4}屏蔽
//就可以看到我示范的修改
//小键盘也可以操作支持斜着走
unit FuncUnit;interfaceuses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, ExtCtrls;function Iif(mBool: Boolean; mDataA, mDataB: Variant): Variant;procedure WinControlButton(mWinControl: TWinControl;
mButtonWidth, mButtonHeight, mSpaceWidth: Integer;
mAlignment: TAlignment = taRightJustify;
mIsCalcTop: Boolean = False);procedure WinControlModified(mModified: Boolean; mWinControl: TWinControl;
mReadOnlyColor: TColor; mControls: array of TControl;
mDefaultColor: TColor = clWindow);procedure ControlModified(mModified: Boolean; mReadOnlyColor: TColor;
mControl: TControl; mDefaultColor: TColor = clWindow);implementationfunction Iif(mBool: Boolean; mDataA, mDataB: Variant): Variant;
begin
if mBool then
Result := mDataA
else Result := mDataB;
end; { Iif }procedure WinControlButton(mWinControl: TWinControl;
mButtonWidth, mButtonHeight, mSpaceWidth: Integer;
mAlignment: TAlignment = taRightJustify;
mIsCalcTop: Boolean = False); function fIsButton(mControl: TControl): Boolean;
begin
Result := (mControl is TSpeedButton) or (mControl is TButton) or
(mControl is TBitBtn);
end; { fIsButton }var
I, J, K, vLeft, vTop: Integer;
begin
with mWinControl do begin
K := 0;
for I := 0 to Pred(ControlCount) do
if fIsButton(Controls[I]) and Controls[I].Visible then Inc(K);
vTop := (ClientHeight - mButtonHeight) div 2;
case mAlignment of
taRightJustify: vLeft := (ClientWidth - (mButtonWidth * K + Pred(K) * mSpaceWidth));
taCenter: vLeft := (ClientWidth - (mButtonWidth * K + Pred(K) * mSpaceWidth)) div 2;
else vLeft := mSpaceWidth;
end;
J := 0;
for I := Pred(ControlCount) downto 0 do
if fIsButton(Controls[I]) and Controls[I].Visible then begin
Controls[I].Left := vLeft;
if mIsCalcTop then Controls[I].Top := vTop;
Controls[I].Width := mButtonWidth;
vLeft := vLeft + mButtonWidth + mSpaceWidth;
Inc(J); if J > K then Break;
end;
end; { with }
end; { WinControlButton }procedure WinControlModified(mModified: Boolean; mWinControl: TWinControl;
mReadOnlyColor: TColor; mControls: array of TControl;
mDefaultColor: TColor = clWindow);
var
I, J: Integer;
B: Boolean;
begin
with mWinControl do for I := 0 to Pred(ControlCount) do begin
B := False;
for J := Low(mControls) to High(mControls) do
if Controls[I] = mControls[J] then begin
B := True;
Break;
end;
if B then Continue;
ControlModified(mModified, mReadOnlyColor, Controls[I], mDefaultColor);
end;
end; { WinControlModified }procedure ControlModified(mModified: Boolean; mReadOnlyColor: TColor;
mControl: TControl; mDefaultColor: TColor = clWindow);
begin
if mControl.ClassName = 'TEdit' then begin
TEdit(mControl).ReadOnly := not mModified;
TEdit(mControl).Color := Iif(mModified, mDefaultColor, mReadOnlyColor);
TEdit(mControl).TabStop := mModified;
end else if mControl.ClassName = 'TMemo' then begin
TMemo(mControl).ReadOnly := not mModified;
TMemo(mControl).Color := Iif(mModified, mDefaultColor, mReadOnlyColor);
TMemo(mControl).TabStop := mModified;
end;
end;end.
代码太长了2000千行编辑器都不能支持了只好用edit
后来改进又改进只用了200行
快毕业时转为turbo pascal6.0成功
上班时转为VF5.0成功
现在转为Delphi6.0成功
是用于调用
所以dpr有点别扭
字体&图片都是动态配置
觉得界面不好看
请自己修改一下
估计几百行左右
人工智能也要编程实现
计算机自己Play
每一个方块每一个方向每一个转动都写了一堆
to programmer(沙漠飞来一条龙):
高处很寒冷吧
快加件衣服小心感冒
我认为你应该用class来实现核心算法
我都不信!to UglyUgly(丑丑):
你没有看见我已经很类了没有想玩玩人工智能吗?
来看看吧，功能已经很完善了，才200多行，还可以更少
来看看吧，功能已经很完善了，才200多行，还可以更少
来看看吧，功能已经很完善了，才200多行，还可以更少
来看看吧，功能已经很完善了，才200多行，还可以更少
来看看吧，功能已经很完善了，才200多行，还可以更少
来看看吧，功能已经很完善了，才200多行，还可以更少
来看看吧，功能已经很完善了，才200多行，还可以更少
来看看吧，功能已经很完善了，才200多行，还可以更少
&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&//Elos方块类 V2.0
//张亚俊 2001.5
//[email protected]
//经过多次的思考得到的算法,当然可能还存在BUG
//此类仅实现了内部功能!
//在这基础上再加思考很容易实现程序的全部功能
/************主程序部分参考************
注:其中[]中的为Elos类中的过程
1).时钟跳动的过程
[will_chang(0,1)能否下落]---Y--->[do_chang(0,1)下落]
|
N
|
[gameover()游戏是否结束]---提示,消毁timer
|
N
|
[do_cancle()消去满行]
[用count返回得分并显示]
[do_ini()得到下一个方块]
(显示方块[maps]得到地图)
[下下个方块的预先显示]
2).按键控制过程
←(左移):[will_chang(-1,0)能否左移]--Y--->[do_chang(-1,0)左移]
→(右移):[will_chang(1,0)能否右移]---Y--->[do_chang(1,0)右移]
↓(下落):[will_chang(0,1)能否下落]---Y--->[do_chang(0,1)下落]
↑(变形):[will_up()能否变形] ---Y--->[do_up()变形]
*************************************/#include "stdafx.h"
#include "Elos.h"#ifdef _DEBUG
#undef THIS_FILE
static char THIS_FILE[]=__FILE__;
#define new DEBUG_NEW
#endifCElos::CElos()//方块资源
{
//标准方块 | # 7 L S Z |-
source[0][0]="21222324";source[0][1]="12223242";source[0][2]="21222324";source[0][3]="12223242";//|
source[1][0]="12132223";source[1][1]="12132223";source[1][2]="12132223";source[1][3]="12132223";//#
source[2][0]="21222332";source[2][1]="11213122";source[2][2]="21222312";source[2][3]="21122232";//|-
source[3][0]="21313233";source[3][1]="31122232";source[3][2]="21222333";source[3][3]="11213112";//7
source[4][0]="21222333";source[4][1]="11213112";source[4][2]="21313233";source[4][3]="31122232";//L
source[5][0]="11122223";source[5][1]="12212231";source[5][2]="11122223";source[5][3]="12212231";//S
source[6][0]="12132122";source[6][1]="11212232";source[6][2]="12132122";source[6][3]="11212232";//Z
//非标准方块 . -- ┏ ---
source[7][0]="21212121";source[7][1]="21212121";source[7][2]="21212121";source[7][3]="21212121";//.
source[8][0]="21312131";source[8][1]="21222122";source[8][2]="21312131";source[8][3]="31323132";//--
source[9][0]="21312222";source[9][1]="21313232";source[9][2]="31223232";source[9][3]="21223232";//┏
source[10][0]="11213111";source[10][1]="21222321";source[10][2]="11213111";source[10][3]="21222321";//---
}void CElos::do_chang(int x, int y)//移动
{
int i;
bool flag=false;
for(i=0;i<4;i++)map[it[i][1]+ity][it[i][0]+itx]=false;
ity+=y;itx+=x; //参照点位置移动
for(i=0;i<4;i++)map[it[i][1]+ity][it[i][0]+itx]=true;
if(y==1)++nextnum; //下落次数
}bool CElos::will_chang(int x, int y)//测试能否移动
{
int i;
bool falg=false;
int tempitx,tempity;
tempitx=itx; tempity=ity;
tempitx+=x; tempity+=y;
for(i=0;i<4;i++)map[it[i][1]+ity][it[i][0]+itx]=false;
for(i=0;i<4;i++)
{
if (tempitx+it[i][0]<1 || tempitx+it[i][0]>=11) falg=true; //X越界
if (tempity+it[i][1]<1 || tempity+it[i][1]>=21) falg=true; //Y越界
if (map[it[i][1]+tempity][it[i][0]+tempitx]) falg=true;//有阻碍物
}
for(i=0;i<4;i++)map[it[i][1]+ity][it[i][0]+itx]=true;
if(falg)return false;
return true;
}void CElos::do_up()//变形
{
int i;
char temp[8];
for(i=0;i<4;i++)map[it[i][1]+ity][it[i][0]+itx]=false;
if(++trndY>=4)trndY=0;
strcpy(temp,source[trndX][trndY]);
for(i=0;i<4;i++)
{
it[i][0]=temp[i*2]-'0';
it[i][1]=temp[(i+1)*2-1]-'0';
map[it[i][1]+ity][it[i][0]+itx]=true;
}
}bool CElos::will_up()//测试能否变形
{
int i;
bool falg=false;
int tempit[4][2],temprndY;
CString temp;
temprndY=rndY;
if(++temprndY>=4)temprndY=0;
temp=source[rndX][temprndY];//获取下一个方块资源
for(i=0;i<4;i++)map[it[i][1]+ity][it[i][0]+itx]=false;//先使当前方块消失
//虚变形
for(i=0;i<4;i++)
{
tempit[i][0]=temp[i*2]-'0';
tempit[i][1]=temp[(i+1)*2-1]-'0';
if (itx+tempit[i][0]<=0 || itx+tempit[i][0]>=11) falg=true; //X越界
if (ity+tempit[i][1]<=0 || ity+tempit[i][1]>=21) falg=true; //Y越界
if (map[tempit[i][1]+ity][tempit[i][0]+itx]) falg=true;//有阻碍物
}
for(i=0;i<4;i++)map[it[i][1]+ity][it[i][0]+itx]=true;//还原消失方块
if(falg)return false;
return true;
}void CElos::do_ini()//每个方块的初使化
{
CString temp;
int i;
itx=3;ity=0; //参考坐标值
nextnum=0; //下落次数初使化
trndX=rndX;
trndY=rndY;
CTime t = CTime::GetCurrentTime();
rndX=(rand()+t.GetSecond()) % 7;
rndY=(rand()+t.GetSecond()) % 4;
more=false;
if(more)rndX=rand() % 11;
temp=source[trndX][trndY];
for(i=0;i<4;i++)
{
it[i][0]=temp[i*2]-'0';
it[i][1]=temp[(i+1)*2-1]-'0';
map[it[i][1]+ity][it[i][0]+itx]=true;
}
}void CElos::reset() //游戏开始
{
//初使化地图
int i,j;
for(i=0;i<=21;i++)
for(j=0;j<=11;j++)
map[i][j]=true;
for(i=1;i<=20;i++)
for(j=1;j<=10;j++)
map[i][j]=false;
countnumber=0;
CTime t = CTime::GetCurrentTime();
rndX=(rand()+t.GetSecond()) % 7;
rndY=(rand()+t.GetSecond()) % 4;
do_ini(); //第一个方块初使化
more=false;//不显示非标准方块.-┏
}void CElos::do_cancle()//消去
{
int i,j,n,k,l,c=0;
for(i=20;i>=1;i--)
{
n=0;
for(j=1;j<=10;j++)if(map[i][j])++n;//检查是否满行
if(n==10)
{
for(k=1;k<=10;k++)map[i][k]=false;//消去一行
for(k=i;k>1;k--) //消去行的上部下移
for(l=1;l<=10;l++)
map[k][l]=map[k-1][l];
for(k=1;k<=10;k++)map[1][k]=false;
i++;c++;
}
}
switch(c)
{
case 1:countnumber+=1;break;
case 2:countnumber+=3;break;
case 3:countnumber+=7;break;
case 4:countnumber+=15;break;
}
}CString CElos::count()//得到分数
{
CString coun="";
int n=countnumber;
while(n>=1)
{
coun=char(((n-(n/10)*10)+'0'))+coun;
n/=10;
}
switch(strlen(coun))
{
case 0:coun="0000" ;break;
case 1:coun="000"+coun;break;
case 2:coun="00"+coun ;break;
case 3:coun="0"+coun ;break;
}
return coun;
}int CElos::count(int n)//重载得分
{
return countnumber;
}CString CElos::maps() //返回地图的值
{
CString ReturnMap;
int i,j;
ReturnMap="";
for(i=1;i<=20;i++)
for(j=1;j<=10;j++)
if(map[i][j])ReturnMap=ReturnMap+'1';
else ReturnMap=ReturnMap+'0';
return ReturnMap;
}CString CElos::nextit()//返回下一个要显示的方块
{
return source[rndX][rndY];
}bool CElos::gameover()//游戏是否结束
{
if(nextnum==0)return true;
return false;
}void CElos::getmore()//可以有非标准方块.--┏ ---
{
more=true;
}bool CElos::savagame()
{
CString data;
int i;
data=count();//前4个字节是得分
for(i=0;i<4;i++)map[it[i][1]+ity][it[i][0]+itx]=false;//先使当前方块消失
data+=maps();
for(i=0;i<4;i++)map[it[i][1]+ity][it[i][0]+itx]=true;//显示当前方块
CFileDialog dlg( TRUE,_T("els"),_T("*.els"),
OFN_HIDEREADONLY|OFN_OVERWRITEPROMPT,
_T("俄罗斯方块文件(*.els)|*.els|"));
if(IDOK==dlg.DoModal())
{
CStdioFile file;
if(file.Open(dlg.GetFileName(),CFile::modeWrite|CFile::typeText|CFile::modeCreate)==0)
return false; //保存失败
file.WriteString(data);
file.Close();
}
else return false;
return true;//文件SAVE成功
}bool CElos::loadgame()
{
CString loadstr;
CFileDialog dlg( TRUE,_T("els"),_T("*.els"),
OFN_HIDEREADONLY|OFN_OVERWRITEPROMPT,
_T("俄罗斯方块文件(*.els)|*.els|"));
if(IDOK==dlg.DoModal())
{
CStdioFile file;
if(file.Open(dlg.GetFileName(),CFile::modeRead|CFile::typeText)==0)
return false; //保存失败
file.ReadString(loadstr);
file.Close();
}
else return false;
reset();
int i,j;
CString s;
s=loadstr.Mid(0,4);
for(i=0;i<4;i++) //得到总分
{
countnumber*=10;
countnumber+=(s[i]-'0');
}
for(i=0;i<20;i++)
for(j=0;j<10;j++)
if(loadstr.Mid(i*10+j+4,1)=="1")map[i+1][j+1]=true;
return true;//文件LOAD成功
}CElos::~CElos()
{}
using System;
using System.Drawing;namespace Russia
{
/// <summary>
///
/// </summary>
public class DiamondManager
{
private int Level;
private int Score;
private bool Drawing = false; private Graphics gm,gp;
private Organize preOrganize;
private Organize MainOrganize;
private System.Timers.Timer timer = new System.Timers.Timer();
private System.Windows.Forms.Panel pm, pp; public static System.Collections.ArrayList diamondList = new System.Collections.ArrayList();
public System.Windows.Forms.Panel panelMain
{
set
{
pm = value;
}
} public System.Windows.Forms.Panel panelPreview
{
set
{
pp = value;
}
} public Graphics gMain
{
set
{
gm = value;
}
} public Graphics gPreview
{
set
{
gp = value;
}
} private Organize CreateRandomOrganize()
{
Random random = new Random();
switch(random.Next(0,7))
{
case 0 :
return new DiamondL();
case 1 :
return new DiamondLine();
case 2 :
return new DiamondLM();
case 3 :
return new DiamondSquare();
case 4 :
return new DiamondT();
case 5 :
return new DiamondZ();
case 6 :
return new DiamondZM();
default:
return null;
}
} public void Start()
{
preOrganize = this.CreateRandomOrganize();
//preOrganize.graphics = gp;
//preOrganize.Draw(); timer.Enabled = true;
} private void Run()
{
this.MainOrganize = this.preOrganize;
for(int i = 0; i < 4; i++)
{
Point p = new Point();
p = this.preOrganize.diamond[i].Location;
p.X += 4;
p.Y -= 4;
this.MainOrganize.diamond[i].Location = p;
}
this.Draw(); this.pp.Refresh();
preOrganize = this.CreateRandomOrganize();
//preOrganize.graphics = gp;
//preOrganize.Draw();
} public void Pause()
{
timer.Enabled = false;
} public void End()
{
} public DiamondManager()
{
//
// TODO: Add constructor logic here
//
Level = 1;
Score = 0;
timer.Interval = 300;
timer.Tick += new EventHandler(timer_Tick);
}
private void timer_Tick(object sender, System.EventArgs e)
{
if(this.MainOrganize != null)
{
if(this.IsBottom(this.MainOrganize))
{
for(int i = 0; i < 4; i++)
{
diamondList.Add(this.MainOrganize.diamond[i]);
}
this.MainOrganize = null;
if(this.IsDead())
{
//pm.Refresh();
timer.Enabled = false;
this.Draw();
return;
}
this.ClearRow();
this.Draw();
}
this.DropDown();
}
else
{
Run();
}
} private void ClearRow()
{
System.Collections.IEnumerator diamondEnumerator = DiamondManager.diamondList.GetEnumerator();
for(int i = 0; i < 20; i++)
{
if(IsNeedClear(i))
{
Point p = new Point();
p.Y = i; for(int j = 0; j < 10; j++)
{
p.X = j;
while(diamondEnumerator.MoveNext())
{
if(((CDiamond)diamondEnumerator.Current).Location == p)
{
DiamondManager.diamondList.Remove(diamondEnumerator.Current);
break;
}
}
diamondEnumerator.Reset();
}
this.Draw();
}
}
} private bool IsNeedClear(int row)
{
System.Collections.IEnumerator diamondEnumerator = DiamondManager.diamondList.GetEnumerator();
Point p = new Point();
int count = 0;
p.Y = row;
for(int i = 0; i < 10; i++)
{
p.X = i;
while(diamondEnumerator.MoveNext())
{ if(((CDiamond)diamondEnumerator.Current).Location == p)
{
count++;
}
}
diamondEnumerator.Reset();
}
if(count == 10)
{
return true;
}
else
{
return false;
}
} private bool IsDead()
{
for(int i = 0; i < 4; i++)
{
Point tempP;
System.Collections.IEnumerator diamondEnumerator = diamondList.GetEnumerator();
while(diamondEnumerator.MoveNext())
{
tempP = ((CDiamond)diamondEnumerator.Current).Location;
if(tempP.Y == 0)
return true;
}
}
return false;
} private int IsPassLevel()
{
return 0;
} private bool IsBottom(Organize organize)
{
for(int i = 0; i < 4; i++)
{
Point tempP,tempP2;
tempP = organize.diamond[i].Location;
if(tempP.Y == 19)
return true;
System.Collections.IEnumerator diamondEnumerator = diamondList.GetEnumerator();
while(diamondEnumerator.MoveNext())
{
tempP = organize.diamond[i].Location;
tempP2 = ((CDiamond)diamondEnumerator.Current).Location;
if(tempP.Y + 1 == tempP2.Y && tempP.X == tempP2.X)
return true;
}
}
return false;
}
private bool IsRight(Organize organize)
{
for(int i = 0; i < 4; i++)
{
Point tempP,tempP2;
tempP = organize.diamond[i].Location;
if(tempP.X + 1 > 9)
return true;
System.Collections.IEnumerator diamondEnumerator = diamondList.GetEnumerator();
while(diamondEnumerator.MoveNext())
{
tempP = organize.diamond[i].Location;
tempP2 = ((CDiamond)diamondEnumerator.Current).Location;
if(tempP.X + 1 == tempP2.X && tempP.Y == tempP2.Y)
return true;
}
}
return false;
} private bool IsLeft(Organize organize)
{
for(int i = 0; i < 4; i++)
{
Point tempP,tempP2;
tempP = organize.diamond[i].Location;
if(tempP.X == 0)
return true;
System.Collections.IEnumerator diamondEnumerator = diamondList.GetEnumerator();
while(diamondEnumerator.MoveNext())
{
tempP = organize.diamond[i].Location;
tempP2 = ((CDiamond)diamondEnumerator.Current).Location;
if(tempP.X - 1 == tempP2.X && tempP.Y == tempP2.Y)
return true;
}
}
return false;
} public void MoveRight()
{
if(this.MainOrganize != null && !this.IsRight(this.MainOrganize))
{
this.MainOrganize.MoveRight();
this.Draw();
}
} public void MoveLeft()
{
if(this.MainOrganize != null && !this.IsLeft(this.MainOrganize))
{
this.MainOrganize.MoveLeft();
this.Draw();
}
}
public void DropDown()
{
if(this.MainOrganize != null && !this.IsBottom(this.MainOrganize))
{
this.MainOrganize.DropDown();
this.Draw();
}
} public void Roll()
{
if(this.MainOrganize != null && !this.IsBottom(this.MainOrganize))
{
this.MainOrganize.Roll();
this.Draw();
}
} public void Draw()
{
if(!Drawing && this.MainOrganize != null)
{
Drawing = true;
Image memImg = new Bitmap(204,400);
Graphics memGraph = Graphics.FromImage(memImg);
SolidBrush brush = new SolidBrush(Color.White);
memGraph.FillRectangle(brush,0,0,204,400);
this.MainOrganize.Draw(memGraph);
System.Collections.IEnumerator diamondEnumerator = diamondList.GetEnumerator();
while(diamondEnumerator.MoveNext())
{
SolidBrush abrush = new SolidBrush(((CDiamond)diamondEnumerator.Current).DiamondColor);
memGraph.FillRectangle(abrush,((CDiamond)diamondEnumerator.Current).Location.X * 20,((CDiamond)diamondEnumerator.Current).Location.Y * 20,20,20);
}
gm.DrawImageUnscaled(memImg, 0, 0,204,400);
memGraph.Dispose();
Drawing = false;
}
}
}
}