俄罗斯方块源代码

.dfm
object Form1: TForm1
  Left = 175
  Top = 98
  BorderIcons = [biSystemMenu, biMinimize]
  BorderStyle = bsSingle
  Caption = 'Form1'
  ClientHeight = 409
  ClientWidth = 253
  Color = clGray
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  KeyPreview = True
  Menu = MainMenu1
  OldCreateOrder = False
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  OnKeyDown = FormKeyUp
  OnPaint = FormPaint
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 168
    Top = 40
    Width = 73
    Height = 57
    AutoSize = False
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clNavy
    Font.Height = -24
    Font.Name = 'MS Sans Serif'
    Font.Style = [fsBold]
    ParentFont = False
  end
  object Label2: TLabel
    Left = 168
    Top = 16
    Width = 73
    Height = 25
    AutoSize = False
    Caption = #24471#20998
    Color = clSilver
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clBlue
    Font.Height = -16
    Font.Name = 'MS Sans Serif'
    Font.Style = [fsBold]
    ParentColor = False
    ParentFont = False
    Transparent = True
  end
  object Label3: TLabel
    Left = 168
    Top = 104
    Width = 81
    Height = 73
    AutoSize = False
    Color = clPurple
    ParentColor = False
  end
  object Panel1: TPanel
    Left = 16
    Top = 16
    Width = 150
    Height = 300
    BevelOuter = bvLowered
    Color = clMoneyGreen
    TabOrder = 0
  end
  object Timer1: TTimer
    Enabled = False
    Interval = 550
    OnTimer = Timer1Timer
    Left = 224
    Top = 248
  end
  object MainMenu1: TMainMenu
    Left = 224
    Top = 280
    object N1: TMenuItem
      Caption = #28216#25103
      object N2: TMenuItem
        Caption = #24320#22987
        ShortCut = 119
        OnClick = N2Click
      end
      object N3: TMenuItem
        Caption = #20572#27490
        ShortCut = 113
        OnClick = N3Click
      end
      object N4: TMenuItem
        Caption = '-'
      end
      object N5: TMenuItem
        Caption = #26242#20572
        Enabled = False
        ShortCut = 116
        OnClick = N5Click
      end
      object N6: TMenuItem
        Caption = #32487#32493
        Enabled = False
        ShortCut = 117
        OnClick = N6Click
      end
    end
  end
end

.pas
unit rusianfrm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, Menus;
{type
  tpos=array [1..2] of integer;}
 type
 tcurshape=array[1..3,1..2]of integer;
 type
 tcont=array[-1..21,1..10] of boolean;
 type
  tclearlines=array[2..5] of integer;
type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Timer1: TTimer;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormKeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Timer1Timer(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure N6Click(Sender: TObject);
    procedure FormPaint(Sender: TObject);
  private
    { Private declarations }
  public
   procedure drawshape(canvas1:tcontrolcanvas;a:tpoint;shape1:tcurshape;isclear:bool);
   procedure rerote(var a:tcurshape);
   procedure fillcurshape1(shapecode:integer;var ab:tcurshape);
   procedure getshapesuperxy(a:tpoint;b:tcurshape;var minx,miny,maxx,maxy:integer);
   function  getnewpos(var a:tpoint):integer;
   function  locate(var a:tcurshape;var b:tcont):integer;
   function  isexist(var a:tpoint;b:tcurshape;c:tcont):integer;
   function  isfullline(b:integer;l:integer;c:tcont;var f:tclearlines):integer;
   procedure clearlines(a:tclearlines;b:integer);
   procedure redraw1();
   function  putup():integer;
   procedure initc();
   function  islost():integer;
   procedure drawnextshape();
   procedure goleftright(lr:integer;a:tpoint;b:tcurshape);
  
    { Public declarations }
  end;
const line:integer=1;
const rightgun:integer=2;
const leftgun:integer=3;
const rightgene:integer=4;
const leftgene:integer=5;
const threesharpe:integer=6;
const square:integer=7;
const atomsize:integer=15;
var
  Form1: TForm1;
  ContCanvas:tcontrolcanvas;
  shape :array[1..7,1..3,1..2] of integer;
  curpos:tpoint;
  curshape:tcurshape;
  cont:tcont;
  isruning,score,nextshape:integer;
implementation

{$R *.dfm}
function tform1.islost():integer; //是否已填到顶格
var
i:integer;
begin
islost:=0;
for i:=0 to 9 do
begin
if cont[0][i] then
begin
islost:=1;
break;
end;
end;
end;
procedure tform1.initc(); //初始化容器和当前块位置
var
i,j:integer;
begin
isruning:=1;
score:=0;
 for i:=0 to 19 do
    for j:=0 to 9 do
      cont[i][j]:=false;
    curpos.x:=5;
    curpos.y:=0;
    randomize;
    i:=(random(3000)+1) mod 7+1;
    nextshape:=(random(2800)+1) mod 7+1;
    self.drawnextshape ;
  fillcurshape1(i,curshape);
end;
procedure TForm1.FormCreate(Sender: TObject);
var
containerhdc:hdc;
begin
    shape[line][1][1]:=1;   //        条形
    shape[line][1][2]:=0;     //
    shape[line][2][1]:=-1;      //
    shape[line][2][2]:=0;        //
    shape[line][3][1]:=-2;        //
    shape[line][3][2]:=0;          //

    shape[rightgun][1][1]:=0;      //
    shape[rightgun][1][2]:=-1;      //
    shape[rightgun][2][1]:=0;       //
    shape[rightgun][2][2]:=1;       //L
    shape[rightgun][3][1]:=1;       //
    shape[rightgun][3][2]:=1;       //

    shape[leftgun][1][1]:=0;       //
    shape[leftgun][1][2]:=-1;        //
    shape[leftgun][2][1]:=0;         //
    shape[leftgun][2][2]:=1;         //反L
    shape[leftgun][3][1]:=-1;        //
    shape[leftgun][3][2]:=1;         //

    shape[rightgene][1][1]:=0;       //
    shape[rightgene][1][2]:=-1;        //
    shape[rightgene][2][1]:=1;         //
    shape[rightgene][2][2]:=0;         //
    shape[rightgene][3][1]:=1;        //
    shape[rightgene][3][2]:=1;         //

    shape[leftgene][1][1]:=0;       //
    shape[leftgene][1][2]:=-1;        //
    shape[leftgene][2][1]:=-1;         //
    shape[leftgene][2][2]:=0;         //
    shape[leftgene][3][1]:=-1;        //
    shape[leftgene][3][2]:=1;         //

    shape[threesharpe][1][1]:=-1;       //
    shape[threesharpe][1][2]:=0;        //
    shape[threesharpe][2][1]:=1;         //
    shape[threesharpe][2][2]:=0;         //
    shape[threesharpe][3][1]:=0;        //
    shape[threesharpe][3][2]:=1;         //

    shape[square][1][1]:=1;       //
    shape[square][1][2]:=0;        //
    shape[square][2][1]:=0;         //
    shape[square][2][2]:=1;         //
    shape[square][3][1]:=1;        //
    shape[square][3][2]:=1;         //
  containerhdc:=getdc(panel1.Handle);
  ContCanvas:=tcontrolcanvas.Create ;
  ContCanvas.Handle:=containerhdc;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
ContCanvas.FreeHandle ;
ContCanvas.Free;
end;
procedure tform1.goleftright(lr:integer;a:tpoint;b:tcurshape);//控制向左，右移
var
i:integer;
begin
self.drawshape(ContCanvas,curpos,curshape,true);
a.X:=a.X+lr;
i:=self.isexist(a,b,cont);
if i<>1 then
begin
if i=2 then
curpos.x:=a.x
else
if (curpos.x>=1) and (lr=-1) or (curpos.x<9) and (lr=1) then
curpos.x:=curpos.x+lr;
end;
self.drawshape(ContCanvas,curpos,curshape,false);
end;

procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
a,f:tpoint;
b:tcurshape;
i,j,m,n:integer;
begin
if isruning<>1 then
exit;
a.x:=curpos.x;
a.y:=curpos.y;
for i:=1 to 3 do
begin
b[i][1]:=curshape[i][1];
b[i][2]:=curshape[i][2];
end;
case key of
37:
begin
self.goleftright(-1,a,b);
end;
38,16: //旋转
begin
self.drawshape(ContCanvas,curpos,curshape,true);
self.rerote(curshape);
i:=self.isexist(a,curshape,cont);
if (i<>1) then
begin
if i=2 then
curpos.x:=a.x;
end;
 self.drawshape(ContCanvas,curpos,curshape,false);
 self.putup ;
 end;
39:
begin
self.goleftright(1,a,b);
end;
40:
begin
timer1.Interval:=1;
end;
end;
end;

function tform1.isfullline(b:integer;l:integer;c:tcont;var f:tclearlines):integer;
var//检测有几行填满
i,j,m:integer;
begin
m:=0;
for i:=b downto l do
begin
for j:=0 to 9 do
begin
if not c[i][j] then
break;
end;
if j>9 then
begin
f[2+m]:=i;
m:=m+1;
score:=score+100;
label1.Caption:=inttostr(score);
end;
end;
result:=m-1;
end;
procedure tform1.fillcurshape1(shapecode:integer;var ab:tcurshape);//填充当前形状
var
i:integer;
begin
  if (shapecode>0) and (shapecode<=7) then
  begin
  for i:=1 to 3 do
  begin
  ab[i][1]:=shape[shapecode][i][1];
  ab[i][2]:=shape[shapecode][i][2];
  end;
  end;
end;
procedure tform1.clearlines(a:tclearlines;b:integer);//取消容器中某几行的填充态
var
i,j,m:integer;
begin
j:=1;
for i:= a[j+1]-1 downto 1 do
begin
if j-1< b then
begin
if i=a[j+2]-1 then
j:=j+1;
end;
if (i<>a[j+2])or (b=0) then
begin
for m:=0 to 9 do
cont[i+j][m]:=cont[i][m];
end;
end;
end;

procedure tform1.redraw1(); //用于形状被覆盖后恢复
var
i,j:integer;
rect1:trect;
begin
ContCanvas.brush.Color:=rgb(255,125,125);
for i:=19 downto 1 do
for j:=0 to 9 do
begin
if cont[i][j] then
begin
rect1.Left:=j*atomsize;
rect1.Top:=i*atomsize;
rect1.Right:=rect1.Left+atomsize;
rect1.Bottom:=rect1.Top+atomsize;
with ContCanvas do
begin
FillRect(rect1);
end;
end;
end;
end;

function tform1.getnewpos(var a:tpoint):integer;
var
a1,b,c,f:integer;
p:tpoint;
i:integer;
begin
end;
function tform1.isexist(var a:tpoint;b:tcurshape;c:tcont):integer;
var   //检测当前位置是否已被填充
i,j,m,n:integer;
begin
m:=0;
for i:=1 to 3 do
begin
if (c[a.y][a.x]) or (c[a.y+b[i][2]][a.x+b[i][1]])or(a.x+b[i][1]<0) or(a.x+b[i][1]>9) then
begin
if c[a.y][a.x+b[i][1]] then
m:=0
else
if a.x+b[i][1]<0 then
begin
m:=1;
end
else
if a.x+b[i][1]>9 then
begin
m:=2;
end;
break;
end;
end;
if i>3 then
begin
result:=0;
exit;
end
else
if m<>0 then
begin
self.getshapesuperxy(a,b,i,j,m,n);
if i<0 then
 begin
 a.x:=a.x-i;
 result:=2;
 exit;
 end
 else
 if m>9 then
 begin
 a.x:=a.x+9-m;
 result:=2;
 exit;
 end;
 end;
 result:=1;
end;

function tform1.putup():integer;//放置方块
var
i,j,m,n:integer;
c:tclearlines;
a:tpoint;
begin
 result:=0;
 if self.locate(curshape,cont)=1 then
 begin
 result:=1;
 self.getshapesuperxy(curpos,curshape,i,j,m,n);
 i:=self.isfullline(n,j,cont,c);
 if i<>-1 then
 begin
  self.clearlines(c,i);
 with ContCanvas do
 begin
 brush.Color:=panel1.Color;
 fillrect(panel1.ClientRect);
 end;
  self.redraw1 ;
end;
 if self.islost=0 then
 begin
 curpos.x:=5;
 curpos.y:=0;
 self.fillcurshape1(nextshape,curshape);
 randomize;
 nextshape:=(random(3000)+1) mod 7+1;
  self.drawnextshape ;
 timer1.Enabled:=false;
 sleep(1000);
 timer1.Enabled:=true;
 end
 else
  begin
  timer1.Enabled:=false;
  isruning:=0;
  end;
 end;

end;

procedure tform1.getshapesuperxy(a:tpoint;b:tcurshape;var minx,miny,maxx,maxy:integer);
var     //得到当前形状的边界横纵坐标
i:integer;
begin
   minx:=50;
   miny:=50;
   maxx:=0;
   maxy:=0;
   for i:=1 to 3 do
   begin
   if a.x+b[i][1]>maxx then
   maxx:=a.x+b[i][1];
   if a.x+b[i][1]<minx then
   minx:=a.x+b[i][1];
   if a.y+b[i][2]>maxy then
   maxy:=a.y+b[i][2];
   if a.y+b[i][2]<miny then
   miny:=a.y+b[i][2];
   end;
end;

function tform1.locate(var a:tcurshape;var b:tcont):integer;
var     //检测是否可以放下
i,j,m,n,addx,addy:integer;
begin
self.getshapesuperxy(curpos,a,i,j,m,n);
if n=19 then
begin
b[curpos.y][curpos.x]:=true;
for i:=1 to 3 do
b[curpos.y+a[i][2]][curpos.x+a[i][1]]:=true;
result:=1;
exit;
end;
{if b[curpos.y+1][curpos.x] then
begin
b[curpos.y][curpos.x]:=true;
for i:=1 to 3 do
b[curpos.y+a[i][2]][curpos.x+a[i][1]]:=true;
result:=1;
exit;
end;}
for i:=0 to 3 do
begin
if i=0 then
begin
addx:=0;
addy:=1;
end
else
begin
addx:=a[i][1];
addy:=a[i][2]+1;
end;
if b[curpos.y+addy][curpos.x+addx] then
begin
 b[curpos.y][curpos.x]:=true;
for j:=1 to 3 do
b[curpos.y+a[j][2]][curpos.x+a[j][1]]:=true;
result:=1;
exit;
end;
end;
result:=0;
end;

procedure tform1.drawshape(canvas1:tcontrolcanvas; a:tpoint;shape1:tcurshape;isclear:bool);
var
rect1:trect;
i:integer;
begin
if isclear then
canvas1.Brush.Color:=panel1.Color
else
canvas1.Brush.Color:=rgb(255,125,125);
 with canvas1 do
 begin
 rect1.Left:=a.x*atomsize;
 rect1.Top:=a.y*atomsize;
 rect1.Right:=rect1.Left+atomsize;
 rect1.Bottom:=rect1.top+atomsize;
 FillRect(rect1);
 for i:=1 to 3 do
begin
 rect1.Left:=(a.x+shape1[i][1])*atomsize;
 rect1.Top:=(a.y+shape1[i][2])*atomsize;
 rect1.Right:=rect1.Left+atomsize;
 rect1.Bottom:=rect1.top+atomsize;
 FillRect(rect1);
 end;
end;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
timer1.Interval:=550;
if self.putup=0 then
begin
self.drawshape(ContCanvas,curpos,curshape,true);
curpos.y:=curpos.y+1;
self.drawshape(ContCanvas,curpos,curshape,false);
end;
end;

procedure tform1.rerote(var a:tcurshape);//旋转
var
i,m:integer;
begin
for i:=1 to 3 do
begin
m:=a[i][1];
a[i][1]:=-a[i][2];
a[i][2]:=m;
end;
end;

procedure TForm1.N2Click(Sender: TObject);
begin
n5.Enabled:=true;
with ContCanvas do
begin
brush.Color:=panel1.Color ;
fillrect(panel1.ClientRect);
end;
self.initc ;
timer1.Enabled:=true;
end;

procedure TForm1.N3Click(Sender: TObject);
var
i,j:integer;
begin
n5.Enabled:=false;
n6.Enabled:=false;
timer1.Enabled:=false;
with ContCanvas do
begin
brush.Color:=panel1.Color ;
fillrect(panel1.ClientRect);
end;
for i:=0 to 19 do
    for j:=0 to 9 do
      cont[i][j]:=false;
    curpos.x:=5;
    curpos.y:=0;
isruning:=0;
end;

procedure TForm1.N5Click(Sender: TObject);
begin
isruning:=0;
timer1.Enabled:=false;
n5.Enabled:=false;
n6.Enabled:=true;
end;

procedure TForm1.N6Click(Sender: TObject);
begin
isruning:=1;
n5.Enabled:=true;
n6.Enabled:=false;
timer1.Enabled:=true;
end;
procedure TForm1.FormPaint(Sender: TObject);
begin
panel1.Repaint ;
self.redraw1 ;
self.drawnextshape ;
end;

procedure tform1.drawnextshape();
var
a:tpoint;
b:tcurshape;
begin
a.x:=3;
a.y:=2;
self.fillcurshape1(nextshape,b);
 with label3.Canvas  do
 begin
 brush.Color:=label3.Color ;
 fillrect(label3.ClientRect);
 end;
self.drawshape(tcontrolcanvas(label3.Canvas),a,b,false);
end;
end.
{}
{self.getshapesuperxy(a,curshape,a1,b,c,f);
if (cont[a[2]][a1]) and not(cont[a[2]][c+1]) and not(cont[a[2]][c-1])and not(cont[a[2]][c])and(c<9) then
 begin
 a[1]:=a[1]+1;
 result:=2;
 exit;
 end;
 if ((cont[a[2]][c]) or(cont[a[2]][c-1]))and not(cont[a[2]][a1])and (a1>0) then
 begin
 a[1]:=a[1]-1;
 if(cont[a[2]][c-1])and(a1>1) then
 a[1]:=a[1]-1;
 result:=2;
 exit;
 end;
 if (a1<0) then
 begin
 p[1]:=a[1]-a1;
 p[2]:=a[2];
 if(a[1]=curpos.x) then
 begin
 i:=self.getnewpos(p);
 if i=2 then
 begin
 a[1]:=a[1]-a1;
 result:=1;
 exit;
 end;
 end;
 end
 else
 if (c>9) then
 begin
 p[1]:=a[1]+9-c;
 if(a[1]=curpos.x) then
 begin
 if self.getnewpos(p)=2 then
 begin
 a[1]:=a[1]+9-c;
 result:=1;
 exit;
 end;
 end;
end;
 result:=0; }
 //if self.isexist(a,curshape,cont)