在網上發現一篇60行javascript超經典俄羅斯方塊代碼，值得學習，轉為Delphi如下，有詳細注釋，不再另講解：
unit Block_Unit;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Grids, Vcl.ExtCtrls;
type
TBlockForm = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormPaint(Sender: TObject);
private
procedure WMMyKey(var Msg: TWMKeyDown); message WM_KEYDOWN;
public
end;
type
TIntArr=array of TArray<Integer>;
type TBlock=record
x,y,s:Integer;
fk:array [0..3] of Integer;//fk記錄方塊，4X4二進制矩陣
end;
var
BlockForm: TBlockForm;
Map:array of Integer;
Tetris: TIntArr= [[$6600],//方塊，二進制資料顯示方塊
[$2222, $0f00],//I型
[$c600, $2640],//Z型
[$6c00, $4620],//反Z型
[$4460, $2e0, $6220, $740],//L型
[$2260, $0e20, $6440, $4700], //反L型
[$2620, $720, $2320, $2700]]; //T型;
pos,bak:TBlock;//pos當前方塊資料，bak備份當前方塊資料
dia:TArray<Integer>;
rs:TResourceStream;
procedure Rotate(r:Integer);
procedure GameStart;
procedure UpdateMap(b:Boolean);
function HaveBlock:Boolean;
procedure BlockMove(r:Integer);
implementation
uses Vcl.Imaging.jpeg;
var
Green,Red:TJPEGImage;
{$R *.dfm}
{此游戲的核心思路是用二進制來記錄整個界面的變化，
每個方塊設定為4X4的二進制矩陣，整個游戲界面設定為10列、22行，}
{初始化方塊}
procedure GameStart;
begin
dia:=Tetris[Random(7)];//隨機方塊類別
pos.x:=4;//初始位置
pos.y:=0;
pos.s:=Random(Length(dia));//隨機方塊形態
bak:=pos;
Rotate(0);
end;
{方塊旋轉}
procedure Rotate(r:Integer);
var
f,i:Integer;
begin
//根據方塊的形態多少來依次旋轉方塊
pos.s:=(pos.s+r) mod Length(dia);
f:=dia[pos.s];
for i:= 0 to 3 do
//旋轉變換
pos.fk[i]:=(f shr (12-i*4) and $F) shl (8-pos.x);
updateMap(HaveBlock);
end;
{更新界面}
procedure UpdateMap(b:Boolean);
begin
if b=False then
begin
bak:=pos;
BlockForm.Repaint;
end;
end;
{判斷障礙物}
function HaveBlock:Boolean;
var
i:Integer;
begin
Result:=False;
for I := 0 to 3 do
if pos.fk[i] and Map[pos.y+i]<>0 then
begin
pos:=bak;
Result:=True;
Break;
end;
end;
{游戲結束}
procedure GameOver;
begin
BlockForm.Timer1.Enabled:=False;
ShowMessage('GameOver!');
end;
{游戲運行，關鍵代碼}
procedure BlockDown;
begin
Inc(pos.y);
if HaveBlock then
begin
for var i:Integer:= 0 to 3 do
begin
if pos.y+i>=22 then Break;
Map[pos.y+i]:=Map[pos.y+i] or pos.fk[i];//“或”操作來改變資料
if Map[pos.y+i]=$FFF then//二進制表示滿行
begin
Delete(Map,pos.y+i,1);//消除滿行
Insert([$801],Map,0);//插入空行
end;
end;
if Map[1]<>$801 then//第一行不為空游戲結束
GameOver;
GameStart;
end;
UpdateMap(False);
end;
{方塊左右移動，-1為左，1為右}
procedure BlockMove(r:Integer);
var
i:Integer;
begin
Inc(pos.x,r);
for I := 0 to 3 do
begin
if r=1 then
pos.fk[i]:=pos.fk[i] shr 1
else
pos.fk[i]:=pos.fk[i] shl 1;
end;
UpdateMap(HaveBlock);
end;
procedure TBlockForm.Button1Click(Sender: TObject);
begin
//$801的二進制為100000000001
for var I:Integer := 0 to 21 do Map[i]:=$801;
Map[22]:=$FFF;
//以上代碼利用二進制初始化游戲界面，即為
//100000000001
//100000000001
//............
//111111111111
GameStart;
Button1.Enabled:=False;
end;
procedure TBlockForm.FormCreate(Sender: TObject);
var
st:TMemoryStream;
begin
DoubleBuffered:=True;
SetLength(Map,23);//設定共23行，其中最后一行為判斷是否觸呼叫
Randomize;
rs := TResourceStream.Create(HInstance, 'Green', RT_RCDATA);
Green:=TJPEGImage.Create;
Red:=TJPEGImage.Create;
Green.LoadFromStream(rs);
rs.Free;
rs:=TResourceStream.Create(HInstance, 'Red', RT_RCDATA);
Red.LoadFromStream(rs);
rs.Free;
end;
procedure TBlockForm.WMMyKey(var Msg: TWMKeyDown);
begin
//輸入法要切換成英文，只能發送給有焦點的Form來回應
if (Msg.CharCode=VK_UP)or(Msg.CharCode=ord('W')) then Rotate(1);
if (Msg.CharCode=VK_DOWN)or(Msg.CharCode =ord('S') ) then BlockDown;
if (Msg.CharCode=VK_LEFT)or(Msg.CharCode = 65) then BlockMove(-1);
if (Msg.CharCode=VK_RIGHT)or(Msg.CharCode =ord('D')) then BlockMove(1);
if Msg.CharCode=VK_ESCAPE then //使Button起作用
begin
Button1.Enabled:=true;
Button1.SetFocus;
end;
end;
procedure TBlockForm.FormPaint(Sender: TObject);
var
i,j,k:Integer;
begin
Canvas.Brush.Style:=bsSolid;
Canvas.Brush.Color:=RGB(255,255,255);
Canvas.FillRect(Rect(0,0,150,330));
for I := 0 to 21 do
begin
for j := 0 to 9 do
begin
k:=Map[i] shr (10-j) and 1;//判斷是否觸底，觸底則變綠
if k=1 then
//Canvas.FillRect(Rect(j*15+1,i*15+1,j*15+14,i*15+14));
Canvas.Draw(j*15+1,i*15+1,Green);
end;
end;
Canvas.Brush.Color:=RGB(255,0,0);
for I :=0 to 3 do
begin
for j := 0 to 9 do
begin
k:=bak.fk[i] shr (10-j) and 1;
if k=1 then//不觸底則以紅色來畫方塊
Canvas.Draw(j*15+1,(i+bak.y)*15+1,Red);
//Canvas.FillRect(Rect(j*15+1,(i+bak.y)*15+1,j*15+14,(i+bak.y)*15+14));
end;
end;
end;
procedure TBlockForm.Timer1Timer(Sender: TObject);
begin
BlockDown;
end;
end.
//其中Red、Green兩個圖片大小為15X15像素的資源，如不用資源檔案，可以去掉Draw，改用FillRect，
轉載請註明出處，本文鏈接：https://www.uj5u.com/houduan/295955.html
標籤：Delphi