main.pas

是一个非常好的游戏

unit main;
{
  本程序由北京邮电大学计算机科学与技术学院  邹佳 开发
   开发时间：2004－07－20
   版权所有 翻版有过
   献给我至爱无敌的宝贝爱豆可可}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, Menus, CustObj, About, WinSkinData, Buttons, jpeg,
  SUIImagePanel, SUISideChannel, OleCtrls, ShockwaveFlashObjects_TLB,
  ComCtrls, SUIStatusBar,registry,mmsystem;

type

  TfrmMain = class(TForm)
    Timer1: TTimer;
    SkinData1: TSkinData;
    Panel1: TPanel;
    Panel3: TPanel;
    PaintBox1: TPaintBox;
    Label1: TLabel;
    suiPanel1: TsuiPanel;
    Label2: TLabel;
    Image1: TImage;
    suiPanel2: TsuiPanel;
    Image2: TImage;
    suiSideChannel1: TsuiSideChannel;
    Image3: TImage;
    mnustart: TBitBtn;
    mnucancel: TBitBtn;
    mnupause: TBitBtn;
    mnuexit: TBitBtn;
    mnuabout: TBitBtn;
    Image4: TImage;
    Panel2: TPanel;
    ScrNext: TPaintBox;
    GroupBox1: TGroupBox;
    stlines: TEdit;
    GroupBox2: TGroupBox;
    stspeed: TEdit;
    GroupBox3: TGroupBox;
    stscore: TEdit;
    GroupBox4: TGroupBox;
    stduring: TEdit;
    Image5: TImage;
    Image6: TImage;
    Image7: TImage;
    Image8: TImage;
    Image9: TImage;
    Image10: TImage;
    shezhi1: TBitBtn;
    zhuce1: TBitBtn;
    Image11: TImage;
    GroupBox5: TGroupBox;
    GroupBox6: TGroupBox;
    GroupBox7: TGroupBox;
    GroupBox8: TGroupBox;
    GroupBox9: TGroupBox;
    GroupBox10: TGroupBox;
    zhuce2: TBitBtn;
    Bevel1: TBevel;
    lblStatus: TEdit;
    Timer2: TTimer;
    sb1: TsuiStatusBar;
    Timer3: TTimer;
    Image12: TImage;
    Label3: TLabel;
    l1: TEdit;
    l2: TEdit;
    l3: TEdit;
    l4: TEdit;
    l5: TEdit;
    l6: TEdit;
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure FormCreate(Sender: TObject);
    procedure ScrDraw;
    procedure NextDraw;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Timer1Timer(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure mnuStartClick(Sender: TObject);
    procedure mnuPauseClick(Sender: TObject);
    procedure mnuExitClick(Sender: TObject);
    procedure mnuCancelClick(Sender: TObject);
    procedure Init;
    procedure AboutTeris1Click(Sender: TObject);
    procedure shezhi1Click(Sender: TObject);
    procedure zhuce2Click(Sender: TObject);
    procedure mnuaboutClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    procedure Image11Click(Sender: TObject);
    procedure zhuce1Click(Sender: TObject);
    procedure Timer3Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;
  BG: array[0..9, 0..19] of Byte;
  FG: array[0..9, 0..19] of Byte;
  mCanvas: Tbitmap;
  BOX: array[0..7] of TBitmap;
  Obj: TCustObj;
  sNext: Byte;
  STime: TDateTime;
  Score, Lines, Speed: Integer;
implementation
uses unit1,unit3,unit4;
{$R *.DFM}

procedure TfrmMain.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Timer1.Enabled then //按键配置
  begin
    case Key of
      37:
      begin
      Obj.Move(-1);
      PlaySound('put.wav',0,Snd_ASync) ;
      end;
      39:
      begin
      Obj.Move(1);
      PlaySound('put.wav',0,Snd_ASync) ;
      end;
      38:
      begin
         Obj.Rotate;
         PlaySound('change.wav',0,Snd_ASync) ;
         end;
      40:
      begin
      Obj.Drop;
      PlaySound('drop.wav',0,Snd_ASync) ;
      end;
      32: while Obj.Drop do
          ScrDraw;
      27: if mnuCancel.Enabled then mnuCancelClick(Self);
    end;
    ScrDraw;
  end;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
var
  i: integer;
begin
  Randomize;
  for i := 0 to 7 do
    BOX[i] := TBitmap.Create;
  BOX[0].LoadFromResourceName(HInstance, 'BLACK');
  BOX[1].LoadFromResourceName(HInstance, 'GREEN');
  BOX[2].LoadFromResourceName(HInstance, 'PURPLE');
  BOX[3].LoadFromResourceName(HInstance, 'RED');
  BOX[4].LoadFromResourceName(HInstance, 'AQUA');
  BOX[5].LoadFromResourceName(HInstance, 'BLUE');
  BOX[6].LoadFromResourceName(HInstance, 'ORANGE');
  BOX[7].LoadFromResourceName(HInstance, 'YELLOW');
  mCanvas := TBitmap.Create;
  mCanvas.Width := 200;
  mCanvas.Height := 400;
  FillChar(BG, 200, #0);
  FillChar(FG, 200, #0);
  sNext := Random(7);
  Obj := TCustObj.Create(Random(7));
  Init;
end;

procedure TfrmMain.NextDraw; //绘制下一个图形
  procedure DrawBox(x, y: Integer); overload;
  begin
    scrNext.Canvas.CopyRect(Rect((x - 1) * 17 + 10, (y - 1) * 17 + 10, x * 17 + 10, y * 17 + 10), BOX[sNext + 1].Canvas, Rect(0, 0, 16, 16));
  end;
  procedure DrawBox(sx, sy, x, y: Integer); overload;
  begin
    scrNext.Canvas.CopyRect(Rect((x - 1) * 17 + sx, (y - 1) * 17 + sy, x * 17 + sx, y * 17 + sy), BOX[sNext + 1].Canvas, Rect(0, 0, 16, 16));
  end;
begin
  scrNext.Canvas.Brush.Bitmap := BOX[0];
  scrNext.Canvas.FillRect(Rect(0, 0, 170, 340));
  if not Timer1.Enabled then exit;
  case sNext of
    0: begin
        DrawBox(1, 18, 1, 1);
        DrawBox(1, 18, 2, 1);
        DrawBox(1, 18, 3, 1);
        DrawBox(1, 18, 4, 1);
      end;
    1: begin
        DrawBox(18, 10, 1, 1);
        DrawBox(18, 10, 2, 1);
        DrawBox(18, 10, 1, 2);
        DrawBox(18, 10, 2, 2);
      end;
    2: begin
        DrawBox(2, 1);
        DrawBox(1, 2);
        DrawBox(2, 2);
        DrawBox(3, 2);
      end;
    3: begin
        DrawBox(1, 1);
        DrawBox(1, 2);
        DrawBox(2, 1);
        DrawBox(3, 1);
      end;
    4: begin
        DrawBox(1, 1);
        DrawBox(2, 1);
        DrawBox(3, 1);
        DrawBox(3, 2);
      end;
    5: begin
        DrawBox(1, 1);
        DrawBox(2, 1);
        DrawBox(2, 2);
        DrawBox(3, 2);
      end;
    6: begin
        DrawBox(1, 2);
        DrawBox(2, 2);
        DrawBox(2, 1);
        DrawBox(3, 1);
      end;
  end;
end;

procedure TfrmMain.ScrDraw;
var
  i, j: Integer;
begin
  with mCanvas.Canvas do
  begin
    Brush.Bitmap := BOX[0];
    FillRect(Rect(0, 0, 170, 340));
    for i := 0 to 9 do
    begin
      for j := 0 to 19 do
      begin
        if (FG[i, j] <> 0) then
          CopyRect(Rect(i * 17, j * 17, (i + 1) * 17, (j + 1) * 17), BOX[FG[i, j]].Canvas, Rect(0, 0, 16, 16));
        if (BG[i, j] <> 0) then
          CopyRect(Rect(i * 17, j * 17, (i + 1) * 17, (j + 1) * 17), BOX[BG[i, j]].Canvas, Rect(0, 0, 16, 16));
      end;
    end;
  end;
  PaintBox1.Canvas.CopyRect(Rect(0, 0, 170, 340), mCanvas.Canvas, Rect(0, 0, 170, 340));
end;

procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
var
  i: integer;
begin
  for i := 0 to 7 do
    BOX[i].Free;
  mCanvas.Free;
  Obj.Free;
end;

procedure TfrmMain.Timer1Timer(Sender: TObject);
var
  i: integer;
begin
  if not Obj.Drop then
  begin
    Score := Score + 4;
    i := Obj.ClearLine;
    if i > 0 then
    begin
      Score := Score + (i - 1) * 20 + i * 40;
      PlaySound('tada.wav',0,Snd_ASync) ;
    end;
    Lines := Lines + i;
    Speed := Lines div 30;
    Timer1.Interval := 1000 div (Speed + 1);//变换速度
    stScore.text := IntToStr(Score);//积分
    stLines.text := IntToStr(Lines);//行数
    stSpeed.text := IntToStr(Speed);//速度
    l5.text:='您的级别：'+inttostr((score div 500)+speed*10)+'级';
    l6.text:='您的经验值：'+inttostr((score div 50)+speed*50);
    Obj.Free;
    FillChar(FG, 200, #0);
    Obj := TCustObj.Create(sNext);
    sNext := Random(7);
    NextDraw;
    if Obj.IsOver then //结束时候的操作
    begin
      Timer1.Enabled := False;
      mnuStart.Enabled := True;
      mnuPause.Enabled := False;
      mnuCancel.Enabled := False;
      PlaySound('bell.wav',0,Snd_ASync) ;
     IF messagedlg('你输了!GAME OVER!!!',mtinformation,[mbok],0)=IDOK THEN
        BEGIN
          Init;
    mnuStart.Enabled := True;
    mnuPause.Enabled := False;
    mnuCancel.Enabled := False;
    END;
    end;
  end;
  ScrDraw;
  stDuring.text := TimeToStr(Now - sTime); //时间
end;

procedure TfrmMain.FormPaint(Sender: TObject);
begin
  ScrDraw;
  NextDraw;
end;

procedure TfrmMain.mnuStartClick(Sender: TObject); //start按钮
begin
if (l1.text<>'')and(l2.text<>'')and(l3.text<>'')and(l4.text<>'')then
begin
  Timer1.Enabled := True;
  mnuPause.Enabled := True;
  mnuCancel.Enabled := True;
  STime := Now;
  mnuStart.Enabled := False;
  Init;
  lblStatus.TEXT:= 'RUNNING!!';
  sb1.Panels[2].Text:='欢迎您'+l1.text+'!!祝您玩的愉快!爱豆可可欢迎你!';
end else
  messagedlg('请将您的信息设置完整',mtinformation,[mbok],0);
end;

procedure TfrmMain.mnuPauseClick(Sender: TObject);//停止按钮
begin
  Timer1.Enabled := not Timer1.Enabled;
  if not Timer1.Enabled then
    lblStatus.TEXT := 'Paused....'
  else
    lblStatus.TEXT:= 'RUNNING!!';
end;

procedure TfrmMain.mnuExitClick(Sender: TObject);//退出按钮
begin
 if messagedlg('您确定了要退出游戏了',mtconfirmation,[mbyes]+[mbno],0)=idyes then
  Close;
end;

procedure TfrmMain.mnuCancelClick(Sender: TObject);//cancel按钮
begin


  Timer1.Enabled := False;
  if Application.MessageBox('您真要取消当前正在进行的游戏吗?', 'Question', MB_ICONQUESTION + MB_YESNO) = IDYES then
  begin
    Init;
    mnuStart.Enabled := True;
    mnuPause.Enabled := False;
    mnuCancel.Enabled := False;
  end
  else
    Timer1.Enabled := True;
 end;

procedure TfrmMain.Init;//窗体初始化
begin
  FillChar(BG, 200, #0);
  FillChar(FG, 200, #0);
  ScrDraw;
  NextDraw;
  Score := 0;
  Lines := 0;
  Speed := 0;
  lblStatus.TEXT := 'READY....';
  stScore.text := '0';
  stLines.text := '0';
  stSpeed.text:= '0';
  stDuring.text:= '0:00:00';
  l5.text:='级别：0';
  l6.text:='经验值：0';
end;

procedure TfrmMain.AboutTeris1Click(Sender: TObject);//关于窗体
begin
  frmAbout.Show;
end;

procedure TfrmMain.shezhi1Click(Sender: TObject);
begin
  shezhi.ShowModal;
end;

procedure TfrmMain.zhuce2Click(Sender: TObject);
var
  re_id: integer;
  registertemp: tregistry;
  inputstr, sunyixin: string;
  dy, clickedok: boolean;
begin
  dy := false;
  registertemp := tregistry.create;
  with registertemp do
    begin
      rootkey := hkey_local_machine; 
      if openkey('software\microsoft\windows\currentversion\mark', true) then
        begin
          if valueexists('sunyixin') then begin
              re_id := readinteger('sunyixin');
              if (re_id <> 0) and (re_id <> 150) then begin
                  re_id := re_id + 5;
                  writeinteger('sunyixin', re_id);
                end;
              if re_id = 150 then dy := true;
            end
          else writeinteger('sunyixin', 5);
        end;
      if dy then begin
          clickedok := inputquery('请您输入注册码获取正版使用权：', ' ', inputstr);
          if clickedok then begin
              sunyixin := inttostr(1984040519820817);
              if sunyixin = inputstr then begin
                  writeinteger('sunyixin', 0);
                  closekey;
                  free;
                end
              else begin
                  application.messagebox('注册码错误!请与孙意欣联系!', '系统提示', mb_ok);
                  closekey;
                  free;
                  application.terminate;
                end;
            end
          else begin
              application.messagebox('请与孙意欣联系，使用注册软件!', '警告框', mb_ok);
              closekey;
              free;
              application.terminate;
            end;
        end;
    end;
end;

procedure TfrmMain.mnuaboutClick(Sender: TObject);
begin
    frmabout.ShowModal;
end;

procedure TfrmMain.FormShow(Sender: TObject);
begin
 mnupause.Enabled:=false;
 mnucancel.Enabled:=false;
 PlaySound('3.wav',0,Snd_ASync) ;

end;

procedure TfrmMain.Timer2Timer(Sender: TObject);
begin
   PlaySound('3.wav',0,Snd_ASync) ;
end;

procedure TfrmMain.Image11Click(Sender: TObject);
begin
  //infor.ShowModal;
end;

procedure TfrmMain.zhuce1Click(Sender: TObject);
begin
  reg1.ShowModal;
end;

procedure TfrmMain.Timer3Timer(Sender: TObject);
begin
 sb1.Panels[1].Text:=datetimetostr(now);
end;

end.