tetris1.pas

Delphi编程┃Delphi游戏编程

unit Tetris1;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, ExtCtrls, Buttons, ComCtrls;

const
  GlassWidth=10;
  GlassHeight=23;

var
  GlassWorkSheet:    array [1..GlassHeight,1..GlassWidth] of Byte;
  OldGlassWorkSheet: array [1..GlassHeight,1..GlassWidth] of Byte;

type
  TFigureWorksheet=array [1..4,1..4] of Byte;

const
  Triada: TFigureWorksheet=
    ((0,1,0,0),
     (1,1,1,0),
     (0,0,0,0),
     (0,0,0,0));
  LCorner: TFigureWorksheet=
    ((1,1,1,0),
     (1,0,0,0),
     (0,0,0,0),
     (0,0,0,0));
  RCorner: TFigureWorksheet=
    ((1,1,1,0),
     (0,0,1,0),
     (0,0,0,0),
     (0,0,0,0));
  LZigzag: TFigureWorksheet=
    ((1,1,0,0),
     (0,1,1,0),
     (0,0,0,0),
     (0,0,0,0));
  RZigzag: TFigureWorksheet=
    ((0,1,1,0),
     (1,1,0,0),
     (0,0,0,0),
     (0,0,0,0));
  Stick: TFigureWorksheet=
    ((1,1,1,1),
     (0,0,0,0),
     (0,0,0,0),
     (0,0,0,0));
  Box: TFigureWorksheet=
    ((1,1,0,0),
     (1,1,0,0),
     (0,0,0,0),
     (0,0,0,0));

const
  FigureWorkSheet: TFigureWorksheet=
    ((0,0,0,0),
     (0,0,0,0),
     (0,0,0,0),
     (0,0,0,0));

const
  BarWidth= 14;
  BarHeight=14;

  NextBarWidth= 9;
  NextBarHeight=9;

const
  TopOfs=    6;
  LeftOfs=   5;
  FieldWidth=4;

const
  MaxFigureNumber=7;
  MaxCornerNumber=4;
  MaxFigureSize=  4;
  MaxFigureColor= 7;

type
  TMoveDirect=  (mdDown,mdLeft,mdRight);
  TFigureCorner=(fc00,fc90,fc180,fc270);

type
  TTetro1 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Timer1: TTimer;
    Bevel3: TBevel;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    SpeedButton4: TSpeedButton;
    SpeedButton5: TSpeedButton;
    SpeedButton6: TSpeedButton;
    SpeedButton7: TSpeedButton;
    SpeedButton8: TSpeedButton;
    Bevel1: TBevel;
    Bevel2: TBevel;
    SpeedButton9: TSpeedButton;
    Bevel4: TBevel;
    procedure FormPaint(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure SpeedButton8Click(Sender: TObject);
    procedure SpeedButton5Click(Sender: TObject);
    procedure SpeedButton6Click(Sender: TObject);
    procedure SpeedButton7Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure SpeedButton4Click(Sender: TObject);
    procedure SpeedButton9Click(Sender: TObject);
  private
  public
    Level:        Byte;
    Score:        Longint;
    ReentTimer:   Boolean;
    ReentKeys:    Boolean;

    FigureActive: Boolean;
    FigureType:   Byte;
    FigureX:      Byte;
    FigureY:      Byte;
    FigureCorner: TFigureCorner;
    FigureMove:   TMoveDirect;

    FirstColor:   Byte;
    SecondColor:  Byte;
    FirstFigure:  Byte;
    SecondFigure: Byte;

    NextTopOfs:   Integer;
    NextLeftOfs:  Integer;

    RedrawSheet:  Boolean;

    function  FigureXSize: Byte;
    function  FigureYSize: Byte;
    procedure GenerateNewFigure;
    procedure ClearFigureIntoGlass;
    function  PutFigureIntoGlass(MoveDirect: TMoveDirect): Boolean;
    procedure RotateFigure;
    procedure ScanFillLines;
    procedure SetFigureColor;
  end;

var
  Tetro1: TTetro1;

implementation

uses Tetris2;

{$R *.DFM}

procedure TTetro1.FormPaint(Sender: TObject);
var
  X1,Y1,X2,Y2: Integer;
  NewRect:     TRect;
  I,J:         Byte;
  CurSheet:    TFigureWorksheet;
  NextColor:   TColor;
begin
  if RedrawSheet then FillChar(OldGlassWorkSheet,SizeOf(OldGlassWorkSheet),#255);
  for I := 1 to GlassHeight do
    for J := 1 to GlassWidth do begin
      if GlassWorkSheet[I,J]=OldGlassWorkSheet[I,J] then Continue;
      X1 := LeftOfs+(J-1)*BarWidth;
      X2 := X1+BarWidth;
      Y1 := TopOfs+(I-1)*BarHeight;
      Y2 := Y1+BarHeight;
      case GlassWorkSheet[I,J] of
        0: Canvas.Brush.Color := clNavy;
        1: Canvas.Brush.Color := clSilver;
        2: Canvas.Brush.Color := clRed;
        3: Canvas.Brush.Color := clLime;
        4: Canvas.Brush.Color := clBlue;
        5: Canvas.Brush.Color := clFuchsia;
        6: Canvas.Brush.Color := clAqua;
        7: Canvas.Brush.Color := clYellow;
        8: Canvas.Brush.Color := clWhite;
      end;
      if GlassWorkSheet[I,J]>0 then begin
        NewRect := Rect(X1+1,Y1+1,X2-1,Y2-1);
        Canvas.FillRect(NewRect);
        Canvas.Pen.Color := clGray;
        Canvas.MoveTo(X1,Y1);
        Canvas.LineTo(X1,Y2-1);
        Canvas.LineTo(X2-1,Y2-1);
        Canvas.Pen.Color := clWhite;
        Canvas.LineTo(X2-1,Y1);
        Canvas.LineTo(X1,Y1);
      end
      else begin
        NewRect := Rect(X1,Y1,X2,Y2);
        Canvas.FillRect(NewRect);
      end;
    end;
  case FirstFigure of
    0: Move(Triada,CurSheet,SizeOf(CurSheet));
    1: Move(LCorner,CurSheet,SizeOf(CurSheet));
    2: Move(RCorner,CurSheet,SizeOf(CurSheet));
    3: Move(LZigzag,CurSheet,SizeOf(CurSheet));
    4: Move(RZigzag,CurSheet,SizeOf(CurSheet));
    5: Move(Stick,CurSheet,SizeOf(CurSheet));
    6: Move(Box,CurSheet,SizeOf(CurSheet));
  end;
  case FirstColor of
    0: NextColor := clNavy;
    1: NextColor := clSilver;
    2: NextColor := clRed;
    3: NextColor := clLime;
    4: NextColor := clBlue;
    5: NextColor := clFuchsia;
    6: NextColor := clAqua;
    7: NextColor := clYellow;
    8: NextColor := clWhite;
  end;
  for I := 1 to MaxFigureSize-2 do
    for J := 1 to MaxFigureSize do begin
      X1 := NextLeftOfs+(J-1)*NextBarWidth;
      X2 := X1+NextBarWidth;
      Y1 := NextTopOfs+(I-1)*NextBarHeight;
      Y2 := Y1+NextBarHeight;
      if CurSheet[I,J]>0 then begin
        NewRect := Rect(X1+1,Y1+1,X2-1,Y2-1);
        Canvas.Brush.Color := NextColor;
        Canvas.FillRect(NewRect);
        Canvas.Pen.Color := clGray;
        Canvas.MoveTo(X1,Y1);
        Canvas.LineTo(X1,Y2-1);
        Canvas.LineTo(X2-1,Y2-1);
        Canvas.Pen.Color := clWhite;
        Canvas.LineTo(X2-1,Y1);
        Canvas.LineTo(X1,Y1);
      end
      else begin
        Canvas.Brush.Color := clSilver;
        NewRect := Rect(X1,Y1,X2,Y2);
        Canvas.FillRect(NewRect);
      end;
    end;
  Move(GlassWorkSheet,OldGlassWorkSheet,SizeOf(OldGlassWorkSheet));
end;

function TTetro1.FigureXSize: Byte;
var
  I,J,K: Byte;
begin
  K := 0;
  for J := 1 to MaxFigureSize do
    for I := 1 to MaxFigureSize do
      if FigureWorkSheet[J,I]>0 then
        if K<I then K := I;
  FigureXSize := K;
end;

function TTetro1.FigureYSize: Byte;
var
  I,J,K: Byte;
begin
  K := 0;
  for J := 1 to MaxFigureSize do
    for I := 1 to MaxFigureSize do
      if FigureWorkSheet[J,I]>0 then
        if K<J then K := J;
  FigureYSize := K;
end;

procedure TTetro1.GenerateNewFigure;
begin
  Timer1.Enabled := False;
  SecondFigure := FirstFigure;
  SecondColor := FirstColor;
  FigureType := SecondFigure;
  FigureX := 5;
  FigureY := 0;
  FigureCorner := fc270;
  FillChar(FigureWorkSheet,SizeOf(FigureWorkSheet),0);
  case FigureType of
    0: Move(Triada,FigureWorkSheet,SizeOf(FigureWorkSheet));
    1: Move(LCorner,FigureWorkSheet,SizeOf(FigureWorkSheet));
    2: Move(RCorner,FigureWorkSheet,SizeOf(FigureWorkSheet));
    3: Move(LZigzag,FigureWorkSheet,SizeOf(FigureWorkSheet));
    4: Move(RZigzag,FigureWorkSheet,SizeOf(FigureWorkSheet));
    5: Move(Stick,FigureWorkSheet,SizeOf(FigureWorkSheet));
    6: Move(Box,FigureWorkSheet,SizeOf(FigureWorkSheet));
  end;
  SetFigureColor;
  FigureMove := mdDown;
  FirstFigure := Random(MaxFigureNumber);
  FirstColor := Random(MaxFigureColor)+1;
  Timer1.Enabled := True;
end;

procedure TTetro1.ClearFigureIntoGlass;
var
  I,J: Byte;
begin
  for J := 1 to FigureYSize do
    for I := 1 to FigureXSize do
      if FigureWorkSheet[J,I]>0 then
        GlassWorkSheet[FigureY+J,FigureX+I] := 0;
end;

function TTetro1.PutFigureIntoGlass(MoveDirect: TMoveDirect): Boolean;
var
  I,J: Byte;
begin
  PutFigureIntoGlass := True;
  if (FigureY+FigureYSize>GlassHeight) and (MoveDirect=mdDown) then begin
    Dec(FigureY);
    PutFigureIntoGlass := False;
    Exit;
  end
  else
    while (FigureX+FigureXSize>GlassWidth) and (MoveDirect=mdDown) do
       Dec(FigureX);
    for J := 1 to FigureYSize do begin
      for I := 1 to FigureXSize do begin
        if (FigureWorkSheet[J,I]>0) and
          (GlassWorkSheet[FigureY+J,FigureX+I]>0) then begin
          PutFigureIntoGlass := False;
          case MoveDirect of
            mdDown:  Dec(FigureY);
            mdRight: Dec(FigureX);
            mdLeft:  Inc(FigureX);
          end;
          Exit;
        end;
      end;
    end;
  for J := 1 to FigureYSize do
    for I := 1 to FigureXSize do
      if FigureWorkSheet[J,I]>0 then
        GlassWorkSheet[FigureY+J,FigureX+I] := FigureWorkSheet[J,I];
  RedrawSheet := False;
  FormPaint(Self);