⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 unit1.pas

📁 用delphi 7写的贪食蛇游戏的源代码
💻 PAS
📖 第 1 页 / 共 2 页
字号:
  else
  begin
    gamerepaint;
    move(glassworksheet,oldglassworksheet,sizeof(glassworksheet));
  end;
end;

procedure TSnake.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
  direction: Tdirect;
begin
  case key of
    vk_up: direction := mbup;
    vk_down: direction := mbdown;
    vk_left: direction := mbleft;
    vk_right: direction := mbright;
    vk_space:
    begin
      btpauseClick(self);
      exit;
    end;
    vk_return:
    begin
      btcontrolclick(self);
      exit;
    end;
  end;
  if (originaldirect = mbup) and (direction = mbdown) then exit;
  if (originaldirect = mbdown) and (direction = mbup) then exit;
  if (originaldirect = mbright) and (direction = mbleft) then exit;
  if (originaldirect = mbleft) and (direction = mbright) then exit;
  glassworksheet[headofsnake.x][headofsnake.y].direct := direction;
  oldglassworksheet[headofsnake.x][headofsnake.y].direct := direction;
end;

procedure TSnake.generatefood;
var
  i,j:byte;
begin
  repeat
    i := random(glasswidth) + 1;
    j := random(glassheight) + 1;
  until (oldglassworksheet[i][j].value = 0) and (glassworksheet[i][j].value =0);
  glassworksheet[i][j].value := 26;
end;

procedure TSnake.drawfood(x,y: byte);
var
  glassrect: TRect;
begin
  canvas.Brush.Color := clblack;
  glassrect := rect(glassleft+(x-1)*unitwidth,glasstop+(y-1)*unitheight,glassleft+x*unitwidth,glasstop+y*unitheight);
  canvas.CopyRect(glassrect,gameimage.Canvas,rect(0,84,13,97));
end;

procedure TSnake.initailizegame;
var
  i,j: Integer;
begin
  for i := 1 to glasswidth do
    for j := 1 to glassheight do
    begin
      if glassworksheet[i][j].value > 0 then
      begin
        case glassworksheet[i][j].value of
          0: drawblank(i,j);
          1,2,3,4: drawhead(i,j,glassworksheet[i][j].value);
          5,6,7,8: drawmouth(i,j,glassworksheet[i][j].value - 4);
          9,10,11,12: drawtail(i,j,glassworksheet[i][j].value - 8);
          13,14,15,16: drawcorner(i,j,glassworksheet[i][j].value - 12);
          17,18,19,20: drawbody(i,j,glassworksheet[i][j].value - 16);
          21,22,23,24,25: drawspecial(i,j,glassworksheet[i][j].value - 20);
          26:
          begin
            drawfood(i,j);
            label3.Caption := inttostr(totalscore);
          end;
          27: drawwall(i,j);
        end;
      end;
    end;
end;

procedure TSnake.drawbody(x, y , value: byte);
var
  glassrect: TRect;
begin
  glassrect := rect(glassleft+(x-1)*unitwidth,glasstop+(y-1)*unitheight,glassleft+x*unitwidth,glasstop+y*unitheight);
  Canvas.CopyRect(glassrect,gameimage.Canvas,rect((value-1)*14,56,value*14-1,69));
end;

procedure TSnake.drawwall(x, y: byte);
var
  glassrect: TRect;
begin
  canvas.Brush.Color := clblack;
  glassrect := rect(glassleft+(x-1)*unitwidth,glasstop+(y-1)*unitheight,glassleft+x*unitwidth,glasstop+y*unitheight);
  Canvas.FillRect(glassrect);
end;

procedure TSnake.generatespecial;
var
  i,j,k:byte;
begin
  repeat
    i := random(glasswidth) + 1;
    j := random(glassheight) + 1;
  until (oldglassworksheet[i][j].value = 0) and (glassworksheet[i][j].value =0);
  k := random(5)+21;
  glassworksheet[i][j].value := k;
  special.x := i;
  special.y := j;
  specialtype := k-20;
end;

procedure TSnake.drawspecial(x, y ,value: byte);
var
  glassrect: TRect;
begin
  glassrect := rect(glassleft+(x-1)*unitwidth,glasstop+(y-1)*unitheight,glassleft+x*unitwidth,glasstop+y*unitheight);
  Canvas.CopyRect(glassrect,gameimage.Canvas,rect((value-1)*14,70,value*14-1,83));
end;

procedure TSnake.btcontrolClick(Sender: TObject);
begin
  if not gamestart then
  begin
    totalscore := 0;
    label3.Caption := '0';
    btcontrol.Caption := '停止游戏';
    move(selectedmap,glassworksheet,sizeof(selectedmap));
    move(selectedmap,oldglassworksheet,sizeof(selectedmap));
    generatesnake;
    generatefood;
    initailizegame;
    movementtimer.interval := currentlevel;
    movementtimer.Enabled := true;
    specialfoodtimer.Enabled := true;
    gamestart := true;
    pause := false;
  end
  else
  begin
    fillchar(glassworksheet,sizeof(glassworksheet),0);
    fillchar(oldglassworksheet,sizeof(oldglassworksheet),0);
    formpaint(self);
    btcontrol.Caption := '新游戏';
    movementtimer.Enabled := false;
    specialfoodtimer.Enabled := false;
    gamestart := false;
  end;
end;

procedure TSnake.SpecialfoodtimerTimer(Sender: TObject);
begin
  if specialfoodtimer.Interval = 10000 then
  begin
    generatespecial;
    cout := 20;
    specialfoodtimer.Interval := 200;
  end else
  begin
    dec(cout);
    case glassworksheet[special.x][special.y].value of
      21,22,23,24,25:
        if cout < 0 then
        begin
          glassworksheet[special.x][special.y].value := 0;
          specialfoodtimer.Interval := 10000;
        end
        else
        begin
          time.Caption := inttostr(cout);
          specialinbox;
        end;
    else
    begin
      specialfoodtimer.Interval := 10000;
      inc(totalscore,specialscore);
      label3.Caption := inttostr(totalscore);
    end;
    end;
  end;
end;

procedure TSnake.drawhead(x, y, value: byte);
var
  glassrect: TRect;
begin
  glassrect := rect(glassleft+(x-1)*unitwidth,glasstop+(y-1)*unitheight,glassleft+x*unitwidth,glasstop+y*unitheight);
  Canvas.CopyRect(glassrect,gameimage.Canvas,rect((value-1)*14,0,value*14-1,13));
end;

procedure TSnake.drawblank(x, y: byte);
var
  glassrect: TRect;
begin
  canvas.Brush.Color := clwhite;
  glassrect := rect(glassleft+(x-1)*unitwidth,glasstop+(y-1)*unitheight,glassleft+x*unitwidth,glasstop+y*unitheight);
  Canvas.FillRect(glassrect);
end;

procedure TSnake.drawcorner(x, y, value: byte);
var
  glassrect: TRect;
begin
  glassrect := rect(glassleft+(x-1)*unitwidth,glasstop+(y-1)*unitheight,glassleft+x*unitwidth,glasstop+y*unitheight);
  Canvas.CopyRect(glassrect,gameimage.Canvas,rect((value-1)*14,42,value*14-1,57));
end;

procedure TSnake.drawtail(x, y, value: byte);
var
  glassrect: TRect;
begin
  glassrect := rect(glassleft+(x-1)*unitwidth,glasstop+(y-1)*unitheight,glassleft+x*unitwidth,glasstop+y*unitheight);
  Canvas.CopyRect(glassrect,gameimage.Canvas,rect((value-1)*14,28,value*14-1,41));
end;

procedure TSnake.drawmouth(x, y, value: byte);
var
  glassrect: TRect;
begin
  glassrect := rect(glassleft+(x-1)*unitwidth,glasstop+(y-1)*unitheight,glassleft+x*unitwidth,glasstop+y*unitheight);
  Canvas.CopyRect(glassrect,gameimage.Canvas,rect((value-1)*14,14,value*14-1,27));
end;

procedure TSnake.N8Click(Sender: TObject);
begin
  currentlevel := gamelevel[1];
  eatscore := gamescore[1];
  label1.Caption := '等级1';
end;

procedure TSnake.N21Click(Sender: TObject);
begin
  currentlevel := gamelevel[2];
  eatscore := gamescore[2];
  label1.Caption := '等级2';
end;

procedure TSnake.N31Click(Sender: TObject);
begin
  currentlevel := gamelevel[3];
  eatscore := gamescore[3];
  label1.Caption := '等级3';
end;

procedure TSnake.N41Click(Sender: TObject);
begin
  currentlevel := gamelevel[4];
  eatscore := gamescore[4];
  label1.Caption := '等级4';
end;

procedure TSnake.N51Click(Sender: TObject);
begin
  currentlevel := gamelevel[5];
  eatscore := gamescore[5];
  label1.Caption := '等级5';
end;

procedure TSnake.N61Click(Sender: TObject);
begin
  currentlevel := gamelevel[6];
  eatscore := gamescore[6];
  label1.Caption := '等级6';
end;

procedure TSnake.specialinbox;
var
  drawrect: TRect;
begin
  drawrect := rect(420,160,433,173);
  if specialexit then
  begin
    canvas.Brush.Color := clbtnface;
    Canvas.FillRect(drawrect);
    specialexit := false;
  end else
  begin
    Canvas.CopyRect(drawrect,gameimage.Canvas,rect((specialtype-1)*14,70,specialtype*14-1,83));
    specialexit := true;
  end;
end;

procedure TSnake.generatesnake;
begin
  glassworksheet[10][5].value := 3;
  glassworksheet[10][5].direct := mbright;
  glassworksheet[9][5].value := 18;
  glassworksheet[9][5].direct := mbright;
  glassworksheet[8][5].value := 18;
  glassworksheet[8][5].direct := mbright;
  glassworksheet[7][5].value := 11;
  glassworksheet[7][5].direct := mbright;
  headofsnake.x := 10;
  headofsnake.y := 5;
  tailofsnake.x := 7;
  tailofsnake.y := 5;
  originaldirect := mbright;
  move(glassworksheet,oldglassworksheet,sizeof(glassworksheet));
end;

procedure TSnake.N11Click(Sender: TObject);
begin
  move(gamemap[1],selectedmap,sizeof(selectedmap));
  label2.Caption := '地图1';
end;

procedure TSnake.N22Click(Sender: TObject);
begin
  move(gamemap[2],selectedmap,sizeof(selectedmap));
  label2.Caption := '地图2';
end;

procedure TSnake.btupClick(Sender: TObject);
begin
  fackkey := vk_up;
  formkeydown(self,fackkey,fackShiftState);
end;

procedure TSnake.btleftClick(Sender: TObject);
begin
  fackkey := vk_left;
  formkeydown(self,fackkey,fackShiftState);
end;

procedure TSnake.btdownClick(Sender: TObject);
begin
  fackkey := vk_down;
  formkeydown(self,fackkey,fackShiftState);
end;

procedure TSnake.btrightClick(Sender: TObject);
begin
  fackkey := vk_right;
  formkeydown(self,fackkey,fackShiftState);
end;

procedure TSnake.btpauseClick(Sender: TObject);
begin
  if not gamestart then exit;
  if pause then
  begin
    pause := false;
    movementtimer.Enabled := true;
    specialfoodtimer.Enabled := true;
  end else
  begin
    pause := true;
    movementtimer.Enabled := false;
    specialfoodtimer.Enabled := false;
  end;
end;

procedure TSnake.N2Click(Sender: TObject);
begin
  btcontrolClick(self);
end;

procedure TSnake.N4Click(Sender: TObject);
begin
  btcontrolClick(self);
end;

procedure TSnake.N3Click(Sender: TObject);
begin
  btpauseClick(self);
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -