gm.pas

delphi俄罗斯方块delphi俄罗斯方块

unit gm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, Grids, Buttons,myData, jpeg,ExtDlgs,mmSystem;

type
  TgmForm = class(TForm)
    Timer1: TTimer;
    imgNew: TImage;
    imgPrise: TImage;
    imgBK: TImage;
    imgExit: TImage;
    imgPicture: TImage;
    OpenPictureDialog1: TOpenPictureDialog;
    imgSet: TImage;
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDblClick(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormPaint(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormDestroy(Sender: TObject);
    procedure imgPictureMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure imgNewMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure imgNewMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure imgExitMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure imgSetMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
  public
    strPrise:string;
    KeyLeft,KeyRight,KeyDown,KeyChange,KeyPause,KeySpeedUP,KeySpeedDown:Word;
    needCell,GameOver,Running:Boolean;
    speed:byte;
    score,highScore,TotalLine:Int64;
    cntLine:Word;
    picBrick:TBitmap;
    curBrick,nextBrick:TMatrixData;
    nFrameColor,nPanelColor:TColor;
    pMove,pChange:Pointer;
    fsMove,fsChange:integer;
    procedure DrawRect(X,Y:integer);
    procedure DrawCell();
    procedure DrawFrame();
    function GoNext(var aBrick:TMatrixData):boolean;
    procedure GoLeft(var aBrick:TMatrixData);
    procedure GoRight(var aBrick:TMatrixData);
    procedure NewBrick(var aBrick:TMatrixData);
    procedure ChangeBrick();
    function UpdateCell:integer;
    procedure DrawOldCell();
    procedure DrawInfo();
    procedure UpSpeed;
    procedure DownSpeed;
    procedure InitGame;
    procedure DrawGameOver;
    procedure LoadSet;
    procedure SaveSet;
    procedure mySound(flag:byte=0);
    { Public declarations }
  end;

var
  gmForm: TgmForm;
implementation

uses setFrm;

{$R *.dfm}
{$R picture.res}

//Timer  游戏的驱动
procedure TgmForm.Timer1Timer(Sender: TObject);
var
  bLine:byte;
begin
  if not Gameover then
    if not GoNext(curBrick) then
    begin
      bLine:=UpdateCell;
      cntLine:=cntLine+bLine;
      TotalLine:=TotalLine+bLine;
      if cntLine-50>0 then
      begin
        cntLine:=0;
        Canvas.Font.Name:='Courier New';
        Canvas.Font.Color:=clLime;
        Canvas.Font.Style:=[fsBold];
        Canvas.Font.Size:=16;
        Canvas.TextOut(50,170,'Mission '+inttostr(speed+1)+' Complete!');
        UpSpeed;        
      end;
      curBrick:=nextBrick;
      ChangeBrick;
      if OutBottomRange(curBrick)then
      begin
        GameOver:=true;
          if Score>highScore then
            highScore:=score;
        imgNew.Enabled:=true;
        timer1.Enabled:=false;
      end;
      NewBrick(nextBrick);
      score:=score+bLine*bLine*100;
      if bLine>2 then
        imgPrise.Visible:=true
      else
        imgPrise.Visible:=false;
      gmForm.Repaint;
    end
end;

procedure TgmForm.FormCreate(Sender: TObject);
var
  f: file;
  fs: integer;
begin
  gmForm.DoubleBuffered:=true;
  nFrameColor:=RGB(100,100,50);
  nPanelColor:=clMaroon;
  randomize;
  picBrick:=TBitmap.Create;
  picBrick.Height:=20;
  picBrick.Width:=20;
  picBrick.LoadFromResourceName(hInstance,'BRICK');
  GameOver:=true;
  Running:=false;
  LoadSet;
  //本来打算加点声音文件，结果声音文件按键时播放声音严重影响了游戏的流畅运行
  //所以干脆去掉了.
  {AssignFile(f, 'Move.wav');
  Reset(f,1);
  fsMove := FileSize(f);
  GetMem(pMove, fsMove);
  BlockRead(f, pMove^, fsMove);
  CloseFile(f);
  AssignFile(f, 'Change.wav');
  Reset(f,1);
  fsChange := FileSize(f);
  GetMem(pChange, fsChange);
  BlockRead(f, pChange^, fsChange);
  CloseFile(f);  }
end;

procedure TgmForm.FormDblClick(Sender: TObject);
begin
  gmForm.Repaint;
end;

procedure TgmForm.DrawRect(X, Y: integer);
var
  nX,nY:integer;
  aRect:TRect;
begin
  if((x<280)and(y<400))then
  begin
    nX:=(X div 20)*20;
    nY:=(Y div 20)*20;
    aRect.Left:=nX;
    aRect.Top:=nY;
    aRect.Right:=nX+20;
    aRect.Bottom:=nY+20;
    Canvas.StretchDraw(aRect,picBrick);
  end;
end;

procedure TgmForm.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  DrawRect(x,y);
end;

procedure TgmForm.DrawCell;
var
  i,j:integer;
begin
  i:=0;
  j:=0;
  gmForm.Canvas.Pen.Color:=nFrameColor;
  while(i<=400) do
  begin
    gmForm.Canvas.MoveTo(0,i);
    gmForm.Canvas.LineTo(280,i);
    i:=i+20;
  end;
  while(j<=280) do
  begin
    gmForm.Canvas.MoveTo(j,0);
    gmForm.Canvas.LineTo(j,400);
    j:=j+20;
  end; 
end;

//画边框
procedure TgmForm.DrawFrame;
var
  aRect:TRect;
begin
  aRect.Left:=0;
  aRect.Right:=280;
  aRect.Top:=0;
  aRect.Bottom:=400;
  Canvas.StretchDraw(aRect,imgBK.Picture.Graphic);
end;

//窗口更新
procedure TgmForm.FormPaint(Sender: TObject);
begin
  DrawFrame;
  if Running then
  begin
    if needCell then
      DrawCell;
    DrawMatrix(Canvas,curBrick);
    DrawOldCell;
    DrawNextMatrix(Canvas,nextBrick);
    DrawInfo;
    DrawGameOver;
  end;
end;

//控制砖块向下移动
function TgmForm.GoNext(var aBrick: TMatrixData):boolean;
begin
  gmForm.Repaint;
  result:=StepBottom(curBrick);
  gmForm.Refresh;
end;

//控制砖块向左移动
procedure TgmForm.GoLeft(var aBrick: TMatrixData);
begin
  gmForm.Repaint;
  StepLeft(curBrick);
  gmForm.Refresh;
end;

//控制砖块向右移动
procedure TgmForm.GoRight(var aBrick: TMatrixData);
begin
  gmForm.Repaint;
  StepRight(curBrick);
  gmForm.Refresh;
end;

//本函数完成游戏的按键控制
procedure TgmForm.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if key=KeyLeft then
  begin
    GoLeft(curBrick);
    repaint;
//    mySound;
  end;
  if Key=Keyright then
  begin
     GoRight(curBrick);
     repaint;
//     mySound;
  end;
  if Key=KeyDown then
  begin
     GoNext(curBrick);
     repaint;
//     mySound;
  end;
  if Key=KeyChange then
  begin
     ChangeBrick();
//     mySound(1);
     repaint;
  end;
  if Key=KeyPause then
     timer1.Enabled:=Not Timer1.Enabled;
  if key=KeySpeedUP then
     upSpeed;
  if key=KeySpeedDown then
     downSpeed;
  case key of
    {37:GoLeft(curBrick);
    39:GoRight(curBrick);
    40:GoNext(curBrick);
    38:ChangeBrick();
    85:upSpeed;
    68:downSpeed;
    80:timer1.Enabled:=Not Timer1.Enabled; }
    vk_escape:begin
      timer1.Enabled:=false;
      Application.Minimize;
    end;
  end;
  Repaint;
  //showmessage(inttostr(key));
end;

//用随机数新生成一个砖块
procedure TgmForm.NewBrick(var aBrick: TMatrixData);
var
  BrickMode:integer;
begin
  BrickMode:=random(7);
  case BrickMode of
    0:SetMatrix(aBrick,0);
    1:SetMatrix(aBrick,1);
    2:SetMatrix(aBrick,3);
    3:SetMatrix(aBrick,5);
    4:SetMatrix(aBrick,7);
    5:SetMatrix(aBrick,11);
    6:SetMatrix(aBrick,15);
  end;