urunning.pas

一个dos游戏的源代码

    gsPause:
      begin
        Sprite.Active := false;
        Map.Active := false;

      end;

    gsSuccess:
      begin
        fn := ExtractFilePath(Paramstr(0)) + 'SUCCESS.AVI';
        if FileExists(fn) then
        begin
          pbxView.Canvas.Brush.Color := clBlack;
          pbxView.Canvas.FillRect(FBackBitmap.Canvas.ClipRect);
          MediaPlayer2.FileName := fn;
          MediaPlayer2.Open;
          MediaPlayer2.Play;
        end;
      end;
  end;

  if (FGameStatus <> gsTerminate) then
  begin
    if (FGameStatus <> gsSuccess) then
    begin
      UpdateControlStatus;
      UpdateView;
    end;
  end
  else
  begin
    Close //关闭窗口
  end
end;

procedure TForm_Run.UpdateControlStatus;
const
  StatusStr: array[TGameStatus] of string = (
    'Welcome  请按回车键正式开始游戏',
    'Playing',
    'Pause',
    'Success', 'Game Over', 'Terminating...');
begin
  Caption := Format('%s - %s', [Application.Title, StatusStr[FGameStatus]]);

end;

//游戏初始化

procedure TForm_Run.InitGame;
var
  i, k: integer;
begin
  Map.Active := true;
  Map.CurrentPoint := 0;
  Map.CurrentMetre := 0;

  Sprite.Visible := True;
  Sprite.Active := False;
  Sprite.X := WORLD_WIDTH div 2;
  Sprite.Direction := drRight;
  Sprite.HP := Sprite.MaxHP;

  Randomize;

  for i := 1 to MaxArrowNumber do
  begin
    Arrows[i].Active := True;
    Arrows[i].ReSet;
  end;

  Arrows[1].X := 400;

  for i := 2 to MaxArrowNumber do
  begin
    Arrows[i].X := Arrows[i - 1].X + Arrows[i].Width * 4 + Random(Dynameter);
  end;

  for i := 1 to MaxFireNumber do
  begin
    Fires[i].Active := True;
    Fires[i].ReSet;
  end;

  Fires[1].X := WORLD_WIDTH div 2;
  for i := 2 to MaxArrowNumber do
  begin
    Fires[i].X := Fires[i - 1].X + Fires[1].Width * 4 + Random(Dynameter);
  end;

  Timer1.Enabled := True;

  if sound then
    MediaPlayer1.Play;

end;

procedure TForm_Run.GameLoop;
var
  Msg: TMsg;
  i: integer;
begin

  // 游戏主循环
  while (FGameStatus = gsPlaying) or (FGameStatus = gsPause) do
  begin
    if PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then //取得消息
    begin
      case Msg.message of
        WM_QUIT: //程序结束，离开游戏循环
          begin
            Timer1.Enabled := False;
            FGameStatus := gsTerminate;
            UpdateControlStatus;
            UpdateView;
            Break;
          end;

        WM_PAUSE: //游戏暂停
          begin
            SetGameStatus(gsPause);
          end;

        WM_CONTINUE: //结束暂停状态，继续进行游戏
          begin
            FGameStatus := gsPlaying;
            Sprite.Active := False;
            Map.Active := True;
            Timer1.Enabled := True;
            UpdateControlStatus;
            UpdateView;
          end;

        WM_GAMEOVER: // 主角挂掉了，游戏结束
          begin
            Timer1.Enabled := False;
            FGameStatus := gsOver;
            UpdateControlStatus;
            UpdateView;
            Break;
          end;

        WM_SUCCESS:
          begin
            SetGameStatus(gsSuccess);
            Break;
          end;

        WM_INIT_LEVEL:
          begin
            InitGame; //游戏重新开始
          end;
      end;

      //正常的消息处理程序
      TranslateMessage(Msg);
      DispatchMessage(Msg);
    end
    else if Focused then //当窗口扔有输入焦点时才动作
    begin

      if Map.Active then
      begin
        Map.Roll;
        for i := 1 to MaxArrowNumber do
        begin
          Arrows[i].X := Arrows[1].X - MapRollSpeed;
          Arrows[i].Roll;
        end;
        for i := 1 to MaxFireNumber do
        begin
          Fires[i].X := Fires[i].X - MapRollSpeed;
          Fires[i].Drop;
        end;
        Cut.Cut;
        if Sprite.Active then
          Sprite.Move
        else
          Sprite.RollBack;

      end;

      CheckCollisions;

      //更新画面
      UpdateView;

    end
    else
    begin
      //若窗口没有取得输入焦点，则将控制权交给其他线程
      //直到有消息进来
      WaitMessage;
    end;
  end;
end;

procedure TForm_Run.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (Key = VK_ESCAPE) then
    if (FGameStatus = gsTitle) or (FGameStatus = gsOver)
      or (FGameStatus = gsSuccess) then
      Close
    else
    begin
      FGameStatus := gsTerminate;
      exit;
    end;

  if (Key = VK_RETURN) then //回车键  暂停/继续
  begin
    case FGameStatus of
      gsSuccess:
        begin
          InitGame;
          Timer1.Enabled := true;
          SetGameStatus(gsPlaying);
        end;
      gsOver:
        begin
          InitGame;
          Timer1.Enabled := true;
          SetGameStatus(gsPlaying);
        end;
      gsTitle:
        begin
          InitGame;
          Timer1.Enabled := true;
          SetGameStatus(gsPlaying);
        end;
      gsPause:
        begin
          Timer1.Enabled := true;
          PostMessage(0, WM_CONTINUE, 0, 0);
          /////          SetGameStatus(gsPlaying);
        end;
      gsPlaying:
        begin
          Timer1.Enabled := false;
          PostMessage(0, WM_PAUSE, 0, 0);
          /////          SetGameStatus(gsPause);
        end;
    end;
    exit;
  end;

  // 只有在游戏状态中，键盘控制才有效
  if FGameStatus = gsPlaying then
  begin
    case Key of
      VK_RIGHT, VK_LEFT: //// , VK_UP, VK_DOWN :
        begin
          case Key of
            VK_RIGHT: Sprite.Direction := drRight;

            VK_LEFT: Sprite.Direction := drLeft;

            //          VK_UP:   Sprite.Direction := drUp;

            //          VK_DOWN:  Sprite.Direction := drDown;

          end;

          Sprite.Active := True;
        end;

      {      VK_SPACE:
              begin
                //  跳
              end;
            VK_ESCAPE:
              begin
                //  游戏暂停
              end;
      }
    end;
  end;
end;

procedure TForm_Run.FormKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  // 只有在游戏状态中，键盘控制才有效
  if FGameStatus = gsPlaying then
  begin
    case Key of
      VK_UP, VK_DOWN, VK_LEFT, VK_RIGHT: Sprite.Active := False;
    end;
  end;

end;

function TForm_Run.CheckCollisions: Boolean;
var
  R: TRect;
  i: integer;
  function Tile(Rec: TRect): Integer;
    //角色中心点所在位置
  begin
    Result := (Rec.Left + Rec.Right) div 2;
  end;

begin
  result := false;

  // 终于千辛万苦地跑完一千米，胜利喽！！
  if (Map.CurrentMetre >= 1000) then
  begin
    PostMessage(0, WM_SUCCESS, 0, 0);
    exit;
  end;

  // 跑过一定距离，加血
  if Map.CurrentPoint mod (Map.PointPerMetre * Map.RunMetre) = 0 then
  begin
    Sprite.HP := Sprite.HP + Map.AddHP;
    if Sprite.HP > Sprite.MaxHP then
      Sprite.HP := Sprite.MaxHP;
  end;

  if IntersectRect(R, Sprite.Rect, Cut.Rect) then
  begin
    Sprite.HP := Sprite.HP - Cut.HurtPoint;
    //如果碰撞到，则人物前进一段距离，以避免连续碰撞
    Sprite.X := Cut.ObjectWidth + MapRollSpeed;
    Result := True;
  end;

  for i := 1 to MaxArrowNumber do
    if IntersectRect(R, Sprite.Rect, Arrows[i].Rect) then
    begin
      Sprite.HP := Sprite.HP - Arrows[i].HurtPoint;
      //如果碰撞时人物中心点在箭中心点左边，则后退，否则前进
      if Tile(Arrows[i].Rect) < Tile(Sprite.Rect) then
        Sprite.X := Arrows[i].X + Arrows[i].Width
      else
        Sprite.X := Arrows[i].X - Sprite.ObjectWidth - MapRollSpeed;

      Result := True;
    end;

  for i := 1 to MaxFireNumber do
    if IntersectRect(R, Sprite.Rect, Fires[i].Rect) then
    begin
      Sprite.HP := Sprite.HP - Fires[i].HurtPoint;
      //如果碰撞时人物中心点在火球中心点左边，则后退，否则前进
      if Tile(Fires[i].Rect) < Tile(Sprite.Rect) then
        Sprite.X := Fires[i].X + Fires[i].Width
      else
        Sprite.X := Fires[i].X - Sprite.ObjectWidth - MapRollSpeed;

      Result := True;
    end;

  //人物死亡，游戏结束
  if (Sprite.HP < 0) then
  begin
    Sprite.HP := 0;
    PostMessage(0, WM_GAMEOVER, 0, 0);
  end;
end;

end.