t_tetris.pas

delphi写的俄罗斯方块

// CONTROLLA (ED ELIMINA) LE RIGHE PIENE
FUNCTION TTETRIS.FULL_LINES(DA:INTEGER):INTEGER;

 FUNCTION ISFULL(RIGA:INTEGER):BOOLEAN;
  VAR
   B:BOOLEAN;
   X:INTEGER;
  BEGIN
   IF (RIGA<0) OR (RIGA>TETRIS_LINES) THEN
    ISFULL:=FALSE
   ELSE
    BEGIN
     B:=TRUE;
     FOR X:=0 TO TETRIS_COLUMNS DO
      B:=B AND (VET[X,RIGA]<>NULL_COLOR);
     ISFULL:=B;
    END;
  END;

 PROCEDURE DELETE_FULL_LINE(DA:INTEGER);
  VAR
   A,B:INTEGER;
  BEGIN
   FOR B:=DA DOWNTO 1 DO
    FOR A:=0 TO TETRIS_COLUMNS DO
     VET[A,B]:=VET[A,B-1];
   FOR A:=0 TO TETRIS_COLUMNS DO
    VET[A,0]:=NULL_COLOR;
  END;

 VAR
  B,A:INTEGER;
 BEGIN
  B:=0;
  FOR A:=DA TO DA+3 DO
   IF ISFULL(A) THEN
    BEGIN
     INC(B);
     DELETE_FULL_LINE(A);
    END;
  IF B>0 THEN
   PAINT;
  FULL_LINES:=B;
 END;

//RESTITUISCE 0 SE IL PEZZO E' STATO ABBASSATO
//            1 SE SI E' FERMATO
//            2 SE DOPO CHE SI E' FERMATO E' FINITA LA PARTITA
FUNCTION TTETRIS.MOVE_DOWN:INTEGER;
 VAR
  B:BOOLEAN;
  RE:INTEGER;
 BEGIN
  B:=CAN_MOVE(0,CX,CY);
  IF B THEN
   BEGIN
    DISEGNA_PEZZO(CX,CY,FALSE);
    CY:=CY+1; //ABBASSA IL PEZZO
    DISEGNA_PEZZO(CX,CY,TRUE);
    RE:=0;
   END
  ELSE
   BEGIN
    RE:=1;
    // FERMA IL PEZZO E SALVA COLORI E POSIZIONI
    SALVA_PEZZO(CX,CY);
    // CONTROLLA RIGHE PIENE
    DELETED_L:=FULL_LINES(CY);
    //REINIZIALIZZA IL NUOVO PEZZO
    CX:=TETRIS_COLUMNS DIV 2;
    CY:=-1;
    PIECE[1]:=PIECE[2];
    PIECE[2]:=RANDOM(N_TYPE-1)+1;
    IF SNP THEN
     BEGIN
      MAKEOBJ(PIECE[2]);
      SHOW_NEXT;
     END;
    MAKEOBJ(PIECE[1]);
    INC(P_COUNT);
    //controlla che sia possibile CONTINUARE
    IF NOT CAN_MOVE(0,CX,CY) THEN
     BEGIN
       RE:=2;
     END;
   END;
  MOVE_DOWN:=RE;
 END;

// SALVA LA POSIZIONE DEL PEZZO DOVE SI E' FERMATO
PROCEDURE TTETRIS.SALVA_PEZZO(KX,KY:INTEGER);
 VAR
  A,B:INTEGER;
 BEGIN
  FOR A:=0 TO 3 DO
   FOR B:=0 TO 3 DO
    IF PEZ[A,B]<>NULL_COLOR THEN
     VET[KX+A,KY+B]:=PEZ[A,B];
 END;

//RESTITUISCE TRUE SE E' POSSIBILE MUOVERE IL PEZZO NELLA
//DIREZIONE INDICATA DA DOVE (BASSO, DESTRA, SINISTRA)
FUNCTION TTETRIS.CAN_MOVE(CONST DOVE,X,Y:INTEGER):BOOLEAN;
 VAR
  DX,DY,
  A,B:INTEGER;
  R:BOOLEAN;
 BEGIN
  DX:=0;
  DY:=0;
  R:=TRUE;
  CASE DOVE OF
   0:DY:=1;  //BASSO
   1:DX:=1;  //DESTRA
   2:DX:=-1; //SINISTRA
  END;
  //CONTROLLA CHE DOPO LA TRASLAZIONE
  //IL CORRISPONDENTE DELLA MATRICE PRINCIPALE
  //SIA VUOTO
  FOR A:=0 TO 3 DO
   FOR B:=0 TO 3 DO
    R:=R AND POSI(X+DX,Y+DY,A,B);
  CAN_MOVE:=R;
 END;

FUNCTION TTETRIS.POSI(KX,KY,JX,JY:INTEGER):BOOLEAN;
 BEGIN
  IF PEZ[JX,JY]=NULL_COLOR THEN
   POSI:=TRUE //PERCHE' E' VUOTO
  ELSE
   IF (KX+JX<0) OR (KX+JX>TETRIS_COLUMNS) OR (KY+JY>TETRIS_LINES) THEN
    POSI:=FALSE // SE ESCE DALLO SCHERMO NON E' VALIDO
   ELSE
    IF KY+JY<0 THEN
     POSI:=TRUE
    ELSE
     POSI:=VET[KX+JX,KY+JY]=NULL_COLOR;
 END;

PROCEDURE TTETRIS.DISEGNA_PEZZO(CONST X,Y:INTEGER;CONST VEDI:BOOLEAN);
 VAR
  A,B:INTEGER;
 BEGIN
  FOR A:=0 TO 3 DO
   FOR B:=0 TO 3 DO
    IF (A+X<=TETRIS_COLUMNS) AND (B+Y<=TETRIS_LINES) AND (PEZ[A,B]<>NULL_COLOR) then
     BEGIN
      If VEDI then
       Quadrato(X+A,Y+B,PEZ[A,B])
      Else
       Quadrato(X+A,Y+B,NULL_COLOR);
     END;
 END;

procedure TTETRIS.MakeObj(const N:integer);
 VAR
  A,B:INTEGER;
  U:TCOLOR;
 begin
  U:=COLORI[RANDOM(14)+1]; //IMPOSTA UN COLORE QUALSIASI PER I PEZZI STRANI
  FOR A:=0 TO 3 DO
   FOR B:=0 TO 3 DO
    PEZ[A,B]:=NULL_COLOR;
  CASE N OF
   1:FOR A:=1 TO 2 DO      //  00
      FOR B:=1 TO 2 DO     //  00
       PEZ[A,B]:=CLBLUE;
   2:BEGIN
      FOR A:=0 TO 2 DO      //  0
       PEZ[1,A]:=CLFUCHSIA; //  0
      PEZ[2,2]:=CLFUCHSIA;  //  00
     END;
   3:BEGIN
      FOR A:=0 TO 2 DO     //   0
       PEZ[2,A]:=CLAQUA;   //   0
      PEZ[1,2]:=CLAQUA;    //  00
     END;
   4:FOR A:=0 TO 3 DO
      PEZ[1,A]:=CLRED;     //  0000
   5:BEGIN
      FOR A:=0 TO 1 DO     //  00
       PEZ[A,1]:=CLMAROON; //   00
      FOR A:=1 TO 2 DO
       PEZ[A,2]:=CLMAROON;
     END;
   6:BEGIN
      FOR A:=1 TO 2 DO      //   00
       PEZ[A,1]:=CLOLIVE;   //  00
      FOR A:=0 TO 1 DO
       PEZ[A,2]:=CLOLIVE;
     END;
   7:BEGIN
      FOR A:=0 TO 2 DO     //   0
       PEZ[A,2]:=CLLIME;   //  000
      PEZ[1,1]:=CLLIME;
     END;
   //PEZZI STRANI
   8:BEGIN
      FOR A:=0 TO 2 DO     //  0 0
       PEZ[A,2]:=U;        //  000
      PEZ[0,1]:=U;
      PEZ[2,1]:=U;
     END;
   9:BEGIN
      FOR A:=0 TO 2 DO     //  0 0
       PEZ[A,2]:=U;        //  000
      PEZ[0,1]:=U;         //  0 0
      PEZ[2,1]:=U;
      PEZ[0,3]:=U;
      PEZ[2,3]:=U;
     END;
   10:BEGIN
       FOR A:=0 TO 2 DO     //  0 0
        PEZ[A,2]:=U;        //  000
       PEZ[0,1]:=U;         //   0
       PEZ[2,1]:=U;
       PEZ[1,3]:=U;
      END;
   11:BEGIN
       FOR A:=0 TO 3 DO     //  0 0
        PEZ[0,A]:=U;        //  0 0
       FOR A:=0 TO 3 DO     //  0 0
        PEZ[2,A]:=U;        //  0 0
      END;
   12:BEGIN
       FOR A:=0 TO 3 DO     //  0000
        PEZ[0,A]:=U;        //  0  0
       FOR A:=0 TO 3 DO     //  0  0
        PEZ[3,A]:=U;        //  0000
       PEZ[1,0]:=U;
       PEZ[2,0]:=U;
       PEZ[1,3]:=U;
       PEZ[2,3]:=U;
      END;
   13:BEGIN
       FOR A:=0 TO 2 DO     //   0
        PEZ[A,2]:=U;        //  000
       PEZ[1,1]:=U;         //   0
       PEZ[1,3]:=U;
      END;
   14:BEGIN
       PEZ[1,2]:=U;         //  0 0
       PEZ[0,1]:=U;         //   0
       PEZ[2,1]:=U;         //  0 0
       PEZ[0,3]:=U;
       PEZ[2,3]:=U;
      END;
   else
    BEGIN
     PEZ[0,0]:=U;         //  0 0
     PEZ[2,0]:=U;         //     0
     PEZ[3,1]:=U;         //  0
     PEZ[0,2]:=U;         //   0 0
     PEZ[1,3]:=U;
     PEZ[3,3]:=U;
    END;
  END;
 end;

 //INIZIALIZZA LA NUOVA PARTITA
 PROCEDURE TTETRIS.NEW_GAME;
  begin
   CX:=TETRIS_COLUMNS DIV 2;
   CY:=-2;
   PIECE[1]:=RANDOM(N_TYPE-1)+1;
   PIECE[2]:=RANDOM(N_TYPE-1)+1;
   IF SNP THEN
     BEGIN
      MAKEOBJ(PIECE[2]);
      SHOW_NEXT;
     END;
   MAKEOBJ(PIECE[1]);
   P_COUNT:=0;
   MAKE_SCREEN;
   PAINT;
  END;

procedure TTETRIS.PAINT;
 VAR
  A,B:INTEGER;
 BEGIN
  inherited Paint;
  SIZEX:=WIDTH DIV (TETRIS_COLUMNS+1);
  SIZEY:=HEIGHT DIV (TETRIS_LINES+1);
  Canvas.Pen.Color:=NULL_COLOR;
  Canvas.BRUSH.Color:=NULL_COLOR;
  Canvas.Rectangle(0,0,WIDTH,HEIGHT);
//  If fBitmap<>nil then
//   Canvas.StretchDraw(ClientRect,fbitmap);
  FOR A:=0 TO TETRIS_COLUMNS DO
   FOR B:=0 TO TETRIS_LINES DO
    QUADRATO(A,B,VET[A,B]);
 END;

PROCEDURE TTETRIS.RUOTA_PEZZO(CONST N,X,Y:INTEGER;VAR PEZZ:PEZZO);

  FUNCTION DENT(CONST A1,B1,X1,Y1,H:INTEGER):BOOLEAN;
  BEGIN
   IF H=NULL_COLOR THEN
    DENT:=TRUE
   ELSE
    IF (A1+X1<0) OR (A1+X1>TETRIS_COLUMNS) OR (B1+Y1>TETRIS_LINES) THEN
     DENT:=FALSE
    ELSE
     DENT:=TRUE;
  END;

  PROCEDURE ROT(CONST V:PEZZO;VAR Z:PEZZO);
  VAR
   A,B:INTEGER;
  BEGIN
   FOR A:=0 TO 3 DO
    FOR B:=0 TO 3 DO
     Z[A,B]:=V[3-B,A];
  END;

 VAR
  A,B:INTEGER;
  HLP,HLP1:PEZZO;
  RES:BOOLEAN;
 //1 ORARIO
 //2 ANTIORARIO
 BEGIN
  RES:=TRUE;
  ROT(PEZZ,HLP);
  IF N=2 THEN
   BEGIN
    ROT(HLP,HLP1);
    ROT(HLP1,HLP);
   END;
  //CONTROLLA CE NON SIA SU UN PEZZO ESISTENTE
  FOR A:=0 TO 3 DO
   FOR B:=0 TO 3 DO
    RES:=RES AND DENT(A,B,X,Y,HLP[A,B]) AND
    ((HLP[A,B]=NULL_COLOR) OR (VET[X+A,Y+B]=NULL_COLOR));
  IF RES THEN
   PEZZ:=HLP;
 END;

PROCEDURE TTETRIS.P(X,Y:INTEGER;C:TCOLOR);
 BEGIN
  VET[X,Y]:=C;
  QUADRATO(X,Y,VET[X,Y]);
 END;

PROCEDURE TTETRIS.SET_SCREEN(VALUE:INTEGER);
 VAR
  A,B:INTEGER;
 BEGIN
  RANDOMIZE;
  IF VALUE IN [0..5] THEN
   BEGIN
    SCR_N:=VALUE;
   Canvas.Pen.Color:=NULL_COLOR;
   Canvas.BRUSH.Color:=NULL_COLOR;
   Canvas.Rectangle(0,0,WIDTH,HEIGHT);
    FOR A:=0 TO TETRIS_COLUMNS DO
     FOR B:=0 TO TETRIS_LINES DO
      VET[A,B]:=NULL_COLOR;
    MAKE_SCREEN;
    //PAINT;
   END
  ELSE
   SHOWMESSAGE('Value out of range...');
 END;

PROCEDURE TTETRIS.MAKE_SCREEN;
 VAR
  A,B:INTEGER;
 BEGIN
  RANDOMIZE;
  CASE SCR_N OF
   0:BEGIN
      //STANDARD SCREEN
     END;
   1:FOR A:=TETRIS_LINES-7 TO TETRIS_LINES DO
      BEGIN
       P(0,A,COLORI[RANDOM(14)+1]);
       P(TETRIS_COLUMNS,A,COLORI[RANDOM(14)+1]);
      END;
   2:BEGIN
      FOR A:=TETRIS_LINES-7 TO TETRIS_LINES DO
       BEGIN
        P(0,A,COLORI[RANDOM(14)+1]);
        P(TETRIS_COLUMNS,A,COLORI[RANDOM(14)+1]);
       END;
      FOR A:=TETRIS_LINES-5 TO TETRIS_LINES DO
       BEGIN
        P(3,A,COLORI[RANDOM(14)+1]);
        P(TETRIS_COLUMNS-3,A,COLORI[RANDOM(14)+1]);
       END;
     END;
   3:FOR A:=0 TO 20 DO
      P(RANDOM(TETRIS_COLUMNS),TETRIS_LINES-RANDOM(5),COLORI[RANDOM(14)+1]);
   4:FOR A:=TETRIS_LINES-TETRIS_COLUMNS TO TETRIS_LINES DO
     // FOR B:=0 TO COLUMNS DIV 2 DO
       BEGIN
        P(A-(TETRIS_LINES-TETRIS_COLUMNS),A,COLORI[RANDOM(14)+1]);
        P(TETRIS_COLUMNS-(A-(TETRIS_LINES-TETRIS_COLUMNS)),A,COLORI[RANDOM(14)+1]);
       END;
   5:FOR A:=0 TO TETRIS_COLUMNS DO
      FOR B:=TETRIS_LINES-5 TO TETRIS_LINES DO
       IF (A+B) MOD 2 = 0 THEN
        P(A,B,COLORI[RANDOM(14)+1]);
  END;
  PAINT;
 END;

//*********************************************
constructor TTETRIS.Create(AOwner:TComponent);
 var
  A,B:INTEGER;
 begin
  inherited Create(AOwner);
  PIECE[1]:=1;
  PIECE[2]:=1;
  N_TYPE:=8;
  SQX:=15;
  Width:=SQX*TETRIS_COLUMNS;
  Height:=SQX*TETRIS_LINES;
  NULL_COLOR:=CLBLACK;//CLAPPWORKSPACE;
  BLOCK_TYPE:=btNormal;

  FOR A:=0 TO TETRIS_COLUMNS DO
   FOR B:=0 TO TETRIS_LINES DO
    VET[A,B]:=NULL_COLOR;
  P_COUNT:=0;
  SCR_N:=0;
 // Application.CreateForm(TFRM_P,FRM_P);
  F_PREW:=TFORM.CREATE(SELF);
  F_PREW.HIDE;
  F_PREW.COLOR:=NULL_COLOR;
  SET_P_SIZE(40);
  F_PREW.CAPTION:='Next';
  F_PREW.BORDERICONS:=[biSystemMenu];
  F_PREW.BORDERSTYLE:=bsToolWindow;
//  fBitmap:=TBitmap.Create;
 end;
  {
destructor TTETRIS.Destroy;
begin
    inherited destroy;
    fBitmap.Destroy;
end;
  }
procedure Register;
begin
  RegisterComponents('Bianco', [TTETRIS]);
end;

end.