unit1.pas

delphi写的俄罗斯方块

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, Menus, T_TETRIS, ComCtrls, StdCtrls,KvLabel;

type
   TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    S1: TMenuItem;
    T1: TMenuItem;
    Z1: TMenuItem;
    N2: TMenuItem;
    X1: TMenuItem;
    Timer1: TTimer;
    Label4: TLabel;
    LDL: TLabel;
    Label7: TLabel;
    LDLT: TLabel;
    Label9: TLabel;
    LSCO: TLabel;
    Panel1: TPanel;
    TETRIS1: TTETRIS;
    H1: TMenuItem;
    A1: TMenuItem;
    KvLabel1: TKvLabel;
    O1: TMenuItem;
    O2: TMenuItem;
    Bevel1: TBevel;
    Image1: TImage;
    N3: TMenuItem;
    N4: TMenuItem;
    procedure X1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure S1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure T1Click(Sender: TObject);
    procedure Z1Click(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure O2Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    SCORE:LONGINT;
    PROCEDURE ADD_NOISE;
    { Private declarations }
  public
    LEVEL:INTEGER;
    NUMLINE:INTEGER;
    PROCEDURE SET_SCR(SPEED,SN:INTEGER);
    { Public declarations }
  end;

var
  Form1: TForm1;
  sume:integer;
implementation
uses unit2,unit3;
{$R *.DFM}
PROCEDURE TFORM1.ADD_NOISE;
 VAR
  R1:INTEGER;
 BEGIN
  IF NUMLINE<80 THEN
   R1:=30
  ELSE
   IF NUMLINE<105 THEN
    R1:=20
   ELSE
   IF NUMLINE<120 THEN
    R1:=15
   ELSE
    R1:=10;
  IF RANDOM(R1)<=R1 DIV 2 THEN
   TETRIS1.SET_PIECE(RANDOM(9),-1,RGB(125,125,125));
  IF LEVEL>7 THEN
   BEGIN
    IF RANDOM(R1)=0 THEN
     TETRIS1.INSERT_LINE(RANDOM(9),RGB(RANDOM(200)+55,RANDOM(200)+55,RANDOM(200)+55));
   END;
  IF LEVEL>8 THEN
   BEGIN
    IF RANDOM(R1)<=R1 DIV 2 THEN
     TETRIS1.SET_PIECE(RANDOM(9),RANDOM(19)+1,RGB(125,125,125));
   END;
 END;

PROCEDURE TFORM1.SET_SCR(SPEED,SN:INTEGER);
 BEGIN
  TIMER1.ENABLED:=FALSE;
  TIMER1.INTERVAL:=SPEED;
  //SHOWMESSAGE('你升级了...'+#13+'障碍行 = '+INTTOSTR(TETRIS1.GET_FREE_LINES(TRUE)));
  IF SN<7 THEN
   TETRIS1.SCREENNUMBER:=SN
  ELSE
   TETRIS1.SCREENNUMBER:=0;
   tetris1.NEW_GAME;
   TIMER1.ENABLED:=TRUE;
   LEVEL:=SN;
 END;

procedure TForm1.X1Click(Sender: TObject);
begin
 close;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 tetris1.MOVE_PREVIEW(50,50);
 LEVEL:=0;
 NUMLINE:=0;
 t1.Enabled:=false;
 z1.Enabled:=false;
 TIMER1.INTERVAL:=1000;
 form1.Left:=round((screen.Width-form1.Width)/2);
 form1.top:=round((screen.Height-form1.Height)/2);
end;

procedure TForm1.S1Click(Sender: TObject);
begin
 //tetris1.ShowNextpiece:=CheckBox3.Checked;
 LSCO.Caption:='0';
 LDLT.Caption:='0';
 ldl.Caption:='0';
 TETRIS1.SCREENNUMBER:=0;
 SCORE:=0;
 sume:=0;
 TETRIS1.NEW_GAME;
 form3.SpeedButton3Click(form1);
 //TIMER1.ENABLED:=TRUE;
 //s1.Enabled:=false;
 //t1.Enabled:=true;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
 try
 CASE TETRIS1.MOVE_DOWN OF
  0:BEGIN
    END;
  1:BEGIN
     //INC(SCORE,TETRIS1.GET_FREE_LINES(FALSE));
     //LCP.CAPTION:=INTTOSTR(TETRIS1.NUMBEROFPIECES);
     LDL.CAPTION:=INTTOSTR(TETRIS1.LASTDELETEDLINE);
     INC(SCORE,50*TETRIS1.LASTDELETEDLINE);
     INC(NUMLINE,TETRIS1.LASTDELETEDLINE);
     INC(sume,TETRIS1.LASTDELETEDLINE);
     LDLT.CAPTION:=INTTOSTR(sume);
     IF (NUMLINE>=10) AND (LEVEL=0) THEN
      SET_SCR(896,1)
     ELSE
      IF (NUMLINE>=28) AND (LEVEL=1) THEN
       SET_SCR(792,2)
      ELSE
       IF (NUMLINE>=40) AND (LEVEL=2) THEN
        SET_SCR(688,3)
       ELSE
        IF (NUMLINE>=58) AND (LEVEL=3) THEN
         SET_SCR(584,4)
        ELSE
         IF (NUMLINE>=78) AND (LEVEL=4) THEN
          SET_SCR(480,5)
         ELSE
          IF (NUMLINE>=98) AND (LEVEL=5) THEN
           SET_SCR(376,6)
          ELSE
           IF (NUMLINE>=118) AND (LEVEL=6) THEN
            SET_SCR(272,7)
           ELSE
            IF (NUMLINE>=138) AND (LEVEL=7) THEN
             SET_SCR(168,8)
            ELSE
             IF (NUMLINE>=168) AND (LEVEL=8) THEN
              SET_SCR(64,9);
      IF LEVEL>4 THEN
       ADD_NOISE;
    END;
  2:BEGIN
     TIMER1.ENABLED:=FALSE;
     SHOWMESSAGE('不要难过,请重新来过!');
     t1.Enabled:=false;
     z1.Enabled:=false;
     s1.Enabled:=true;
     LSCO.Caption:='0';
     LDLT.Caption:='0';
     ldl.Caption:='0';
    END;
 END;
 finally
 end;
 LSCO.CAPTION:=INTTOSTR(SCORE);
end;

procedure TForm1.T1Click(Sender: TObject);
begin
if t1.Checked=true then
  begin
  timer1.Enabled:=true;
  t1.Checked:=false;
  end
 else
  begin
  timer1.Enabled :=false;
  tetris1.Refresh;
  t1.Checked :=true;
  end;
end;

procedure TForm1.Z1Click(Sender: TObject);
begin
 TETRIS1.SCREENNUMBER:=0;
 SCORE:=0;
 LEVEL:=0;
 NUMLINE:=0;
 TETRIS1.NEW_GAME;
 timer1.Enabled :=false;
 s1.Enabled:=true;
 t1.Checked:=false;
 t1.Enabled:=false;
 z1.Enabled:=false;
 end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
 case key of
  27: t1.Click();
  vk_left:TETRIS1.MOVE_LEFT;
  vk_right:TETRIS1.MOVE_RIGHT;
  vk_up:TETRIS1.ROTATE_LEFT;
  96:TETRIS1.ROTATE_RIGHT;
  vk_down:TETRIS1.SEND_BOTTOM;
 end;
end;

procedure TForm1.O2Click(Sender: TObject);
begin
 form3.ShowModal;
end;

procedure TForm1.N4Click(Sender: TObject);
begin
 if n4.Checked then
  n4.Checked:=false
 else
  n4.Checked:=true;
tetris1.ShowNextpiece:=n4.Checked;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
timer1.Enabled:=false;
end;

end.