tetris1.pas

Delphi编程┃Delphi游戏编程

  RedrawSheet := True;
end;

procedure TTetro1.ScanFillLines;
var
  I,J,K,L: byte;
begin
  ClearFigureIntoGlass;
  for I := 1 to GlassHeight do begin
    K := 0;
    for J := 1 to GlassWidth do
      if GlassWorkSheet[I,J]>0 then Inc(K);
    if K=GlassWidth then begin
      for L := I downto 1 do
        for J := 1 to GlassWidth do
          if L>1 then GlassWorkSheet[L,J] := GlassWorkSheet[L-1,J];
    end;
  end;
  PutFigureIntoGlass(FigureMove);
end;

procedure TTetro1.Timer1Timer(Sender: TObject);
var
  I,J: Byte;
begin
  if ReentTimer then Exit
    else ReentTimer := True;
  if StrToInt(Label3.Caption)<>Level then Label3.Caption := IntToStr(Level);
  if StrToInt(Label4.Caption)<>Score then Label4.Caption := IntToStr(Score);
  if not FigureActive then begin
    GenerateNewFigure;
    if not PutFigureIntoGlass(FigureMove) then begin
      MessageDlg('Glass is full... Game over!',mtInformation,[mbOk],0);
      FillChar(OldGlassWorkSheet,SizeOf(OldGlassWorkSheet),#255);
      Timer1.Enabled := False;
      SpeedButton1.Enabled := False;
      SpeedButton2.Enabled := False;
      SpeedButton3.Enabled := False;
      SpeedButton4.Enabled := False;
      SpeedButton5.Enabled := True;
      SpeedButton6.Enabled := False;
      SpeedButton7.Enabled := False;
      ClearFigureIntoGlass;
      FigureActive := False;
      Level := 1;
      Score := 0;
      for I := 1 to GlassHeight do
        for J := 1 to GlassWidth do GlassWorkSheet[I,J] := 0;
      RedrawSheet := False;
      FormPaint(Self);
      RedrawSheet := True;
    end;
    FigureActive := True;
  end
  else begin
    ClearFigureIntoGlass;
    Inc(FigureY);
    if not PutFigureIntoGlass(FigureMove) then begin
      case FigureType of
        0: Score := Score+10;
        1: Score := Score+30;
        2: Score := Score+30;
        3: Score := Score+25;
        4: Score := Score+25;
        5: Score := Score+15;
        6: Score := Score+20;
      end;
      if Score>300 then Level := 2;
      if Score>700 then Level := 3;
      if Score>1300 then Level := 4;
      if Score>2000 then Level := 5;
      if Score>3000 then Level := 6;
      if Score>5000 then Level := 7;
      Timer1.Interval := Round((7.1-Level)*100);
      FigureActive := False;
    end;
  end;
  ScanFillLines;
  ReentTimer := False;
end;

procedure TTetro1.FormCreate(Sender: TObject);
begin
  FillChar(OldGlassWorkSheet,SizeOf(OldGlassWorkSheet),#255);
  RedrawSheet := True;
  with Bevel3 do begin
    Top := TopOfs-FieldWidth;
    Left := LeftOfs-FieldWidth;
    Width := GlassWidth*BarWidth+FieldWidth*2;
    Height := GlassHeight*BarHeight+FieldWidth*2;
  end;
  ClientWidth := Bevel3.Width+FieldWidth*3+SpeedButton5.Width;
  ClientHeight := Bevel3.Height+FieldWidth*2;
  SpeedButton1.Left := Bevel3.Width+FieldWidth*2-2;
  SpeedButton2.Left := SpeedButton1.Left+SpeedButton1.Width+1;
  SpeedButton3.Left := SpeedButton2.Left+SpeedButton2.Width+1;
  SpeedButton4.Left := SpeedButton2.Left;
  SpeedButton5.Left := Bevel3.Width+FieldWidth*2;
  SpeedButton6.Left := SpeedButton5.Left;
  SpeedButton7.Left := SpeedButton5.Left;
  SpeedButton8.Left := SpeedButton5.Left;
  SpeedButton9.Left := SpeedButton5.Left;
  Label1.Left := Bevel3.Width+FieldWidth*2;
  Label2.Left := Label1.Left;
  Bevel1.Left := Label1.Left;
  Bevel1.Width := SpeedButton5.Width;
  Bevel2.Left := Label1.Left;
  Bevel2.Width := SpeedButton5.Width;
  Label3.Left := Bevel1.Left+FieldWidth;
  Label4.Left := Bevel1.Left+FieldWidth;
  Bevel4.Top := SpeedButton9.Top+SpeedButton9.Height+4;
  Bevel4.Left := SpeedButton9.Left+SpeedButton9.Width div 4-4;
  Bevel4.Height := NextBarHeight*(MaxFigureSize-1)+4;
  Bevel4.Width :=NextBarWidth*MaxFigureSize+8;
  NextTopOfs := SpeedButton9.Top+SpeedButton9.Height+8;
  NextLeftOfs := SpeedButton9.Left+SpeedButton9.Width div 4;
  Level := 1;
  Timer1.Interval := Round((6.5-Level)*100);
  Score := 0;
  ReentTimer := False;
  ReentKeys := False;
  FigureActive := False;
  Label3.Caption := '1';
  Label4.Caption := '0';
  Randomize;
  FirstFigure := Random(MaxFigureNumber);
  FirstColor := Random(MaxFigureColor)+1;
end;

procedure TTetro1.RotateFigure;
var
  OldFigureCornet: TFigureCorner;
  CurSheet:        TFigureWorksheet;
  OldFigureCorner: TFigureCorner;
procedure RotateFigureWorksheet;
var
  VertFlag:  Byte;
  HorizFlag: Byte;
  K,I,J:     Byte;
begin
  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;
  FillChar(CurSheet,SizeOf(CurSheet),0);
  for K := 0 to Byte(FigureCorner) do begin
    for I := 1 to MaxFigureSize do
      for J := 1 to MaxFigureSize do
        CurSheet[J,I] := FigureWorkSheet[MaxFigureSize-I+1,J];
    Move(CurSheet,FigureWorkSheet,SizeOf(FigureWorkSheet));
  end;
  SetFigureColor;
  HorizFlag := 0;
  while HorizFlag=0 do begin
    for I := 1 to MaxFigureSize do
      if FigureWorkSheet[1,I]>0 then HorizFlag := 1;
    if HorizFlag=0 then begin
      for J := 1 to MaxFigureSize-1 do
        for I := 1 to MaxFigureSize do
          FigureWorkSheet[J,I] := FigureWorkSheet[J+1,I];
      for J := 1 to MaxFigureSize do
        FigureWorkSheet[MaxFigureSize,J] := 0;
    end;
  end;
  VertFlag := 0;
  while VertFlag=0 do begin
    for J := 1 to MaxFigureSize do
      if FigureWorkSheet[J,1]>0 then VertFlag := 1;
    if VertFlag=0 then begin
      for J := 1 to MaxFigureSize do
        for I := 1 to MaxFigureSize-1 do
          FigureWorkSheet[J,I] := FigureWorkSheet[J,I+1];
      for J := 1 to MaxFigureSize do
        FigureWorkSheet[J,MaxFigureSize] := 0;
    end;
  end;
end;
begin
  ClearFigureIntoGlass;
  OldFigureCorner := FigureCorner;
  if FigureCorner>fc00 then Dec(FigureCorner)
    else FigureCorner := fc270;
  RotateFigureWorksheet;
  if not PutFigureIntoGlass(mdDown) then begin
    FigureCorner := OldFigureCorner;
    RotateFigureWorksheet;
    PutFigureIntoGlass(mdDown);
  end;
end;

procedure TTetro1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if ReentKeys then Exit
    else ReentKeys := True;
  if not FigureActive then begin
    ReentKeys := False;
    Exit;
  end;
  case Key of
    VK_UP:    RotateFigure;
    VK_DOWN,
    VK_SPACE: begin
                repeat
                  ClearFigureIntoGlass;
                  Inc(FigureY);
                until not PutFigureIntoGlass(mdDown);
                Inc(Score,5);
              end;
    VK_LEFT:  if FigureX>0 then begin
                ClearFigureIntoGlass;
                Dec(FigureX);
                PutFigureIntoGlass(mdLeft);
              end;
    VK_RIGHT: if FigureX+FigureXSize<GlassWidth then begin
                ClearFigureIntoGlass;
                Inc(FigureX);
                PutFigureIntoGlass(mdRight);
              end;
  end;
  ReentKeys := False;
end;

procedure TTetro1.SetFigureColor;
var
  I,J: Byte;
begin
  for I := 1 to MaxFigureSize do
    for J := 1 to MaxFigureSize do
      if FigureWorkSheet[I,J]>0 then FigureWorkSheet[I,J] := SecondColor;
end;

procedure TTetro1.SpeedButton8Click(Sender: TObject);
begin
  if MessageDlg('Exit programm?',mtConfirmation,[mbYes,mbNo],0)=mrYes then
    Application.Terminate;
end;

procedure TTetro1.SpeedButton5Click(Sender: TObject);
begin
  Timer1.Enabled := True;
  SpeedButton5.Enabled := False;
  SpeedButton1.Enabled := True;
  SpeedButton2.Enabled := True;
  SpeedButton3.Enabled := True;
  SpeedButton4.Enabled := True;
  SpeedButton6.Enabled := True;
  SpeedButton7.Enabled := True;
end;

procedure TTetro1.SpeedButton6Click(Sender: TObject);
begin
  if Timer1.Enabled then begin
    Timer1.Enabled := False;
    SpeedButton1.Enabled := False;
    SpeedButton2.Enabled := False;
    SpeedButton3.Enabled := False;
    SpeedButton4.Enabled := False;
    SpeedButton7.Enabled := False;
  end
  else begin
    Timer1.Enabled := True;
    SpeedButton1.Enabled := True;
    SpeedButton2.Enabled := True;
    SpeedButton3.Enabled := True;
    SpeedButton4.Enabled := True;
    SpeedButton7.Enabled := True;
  end;
end;

procedure TTetro1.SpeedButton7Click(Sender: TObject);
var
  I,J: Byte;
begin
  Timer1.Enabled := False;
  ClearFigureIntoGlass;
  FigureActive := False;
  Level := 1;
  Score := 0;
  for I := 1 to GlassHeight do
    for J := 1 to GlassWidth do GlassWorkSheet[I,J] := 0;
  RedrawSheet := False;
  FormPaint(Self);
  RedrawSheet := True;
  Timer1.Enabled := True;
end;

procedure TTetro1.SpeedButton2Click(Sender: TObject);
begin
  Timer1.Enabled := False;
  RotateFigure;
  Timer1.Enabled := True;
end;

procedure TTetro1.SpeedButton1Click(Sender: TObject);
begin
  Timer1.Enabled := False;
  if FigureX>0 then begin
    ClearFigureIntoGlass;
    Dec(FigureX);
    PutFigureIntoGlass(mdLeft);
  end;
  Timer1.Enabled := True;
end;

procedure TTetro1.SpeedButton3Click(Sender: TObject);
begin
  Timer1.Enabled := False;
  if FigureX+FigureXSize<GlassWidth then begin
    ClearFigureIntoGlass;
    Inc(FigureX);
    PutFigureIntoGlass(mdRight);
  end;
  Timer1.Enabled := True;
end;

procedure TTetro1.SpeedButton4Click(Sender: TObject);
begin
  Timer1.Enabled := False;
  repeat
    ClearFigureIntoGlass;
    Inc(FigureY);
  until not PutFigureIntoGlass(mdDown);
  Inc(Score,5);
  Timer1.Enabled := True;
end;

procedure TTetro1.SpeedButton9Click(Sender: TObject);
var
  OldState: Boolean;
begin
  OldState := Timer1.Enabled;
  Timer1.Enabled := False;
  Tetro2.ShowModal;
  Timer1.Enabled := OldState;
end;

end.