delphi控制台贪吃蛇

原作者: [db:作者] 来自: [db:来源] 收藏邀请

游戏的界面

主要的功能实现

1 键盘消息

program Project1;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  windows,
  uConsoleClass in 'uConsoleClass.pas',
  uSnake in 'uSnake.pas';

// 参考
/// http://blog.csdn.net/haiou327/article/details/5695237
var
  MyMsg   : TMsg;
begin
  while windows.GetMessage(MyMsg, 0, 0, 0) do
  begin
    DispatchMessage(MyMsg);
  end;
end.

2 定时器

这里用的是API

procedure TimerProc(window : Hwnd ; message,idEvent :UInt; dwTime: dword);stdcall;
begin
  if Snake.StartSnake then
    Snake.MoveSnake();
end;


FTimer := SetTimer(0, 0, TIMERINTERVAL, @TimerProc);

3 蛇控制单元

unit uSnake;

interface

uses
  Windows, classes, uConsoleClass, ExtCtrls;

const
  GAMEROW = 16;
  GAMECOL = 54;

  TIMERINTERVAL = 300;
type

  TMoveDir   = (MD_Right, MD_Left, MD_Up, MD_Down);
  TPointType = (PT_Head, PT_Body, PT_Tail, PT_Food);


  TGamePoint = record
    Row        : byte;
    Col        : byte;
    PointType  : TPointType;
  end;
  PGamePoint = ^TGamePoint;


  TReadKeyThread = Class(TThread)
  private
    FMoveDir        : TMoveDir;
    FStartRead      : boolean;
    FPause          : boolean;

    procedure SetStartRead(const Value: boolean);
  public

    property Pause            : boolean read FPause write FPause;
    property StartRead        : boolean read FStartRead write SetStartRead;
    property MoveDir          : TMoveDir read FMoveDir write FMoveDir;
  protected
    procedure Execute; override;
  end;

  TSnake = class
  private
    //FGameMap        : array[0..GAMEROW - 1, 0..GAMECOL - 1] of byte;
    FFoodPoint      : PGamePoint;

    FSnakePointList : TList;
    FLastPoint      : PGamePoint;
    FMyConsole      : TConsoleControl;

    FStartSnake     : boolean;
    FReadKeyThread  : TReadKeyThread;

    FEatFoodCount   : integer;
//    FScores         : integer;

    procedure InitGameMap();
    procedure FreeSnakeList();
    function CheckInSnake(Row, Col: integer): boolean;

    procedure PrintSnake();



    function GetSnakeBodyType(bodyType: TPointType): PGamePoint;
    procedure GetFood();

    procedure ShowScores(add: boolean = false);

    procedure Start();
    function CheckGameOver(): boolean;
    procedure GameOver();
    function EatFood(): boolean;

    function GetMoveDir(): TMoveDir;

    property Dir: TMoveDir read GetMoveDir;
    property StartSnake: boolean read FStartSnake write FStartSnake;

  public
    constructor Create();
    destructor Destroy;override;

    procedure StartGame();
    procedure MoveSnake();
    function ThreadPause(): boolean;
  end;


implementation

uses SysUtils;

var
  Snake   : TSnake;
  FTimer  : Integer;

procedure TimerProc(window : Hwnd ; message,idEvent :UInt; dwTime: dword);stdcall;
begin
  if Snake.StartSnake then
    Snake.MoveSnake();
end;

{ TSnake }

function TSnake.CheckGameOver: boolean;
var
  Head: PGamePoint;
  I: integer;
  P: PGamePoint;
begin
  Result  := false;
  Head    := GetSnakeBodyType(PT_Head);
//  FMyConsole.SetCursorTo(0, 16);
//  FMyConsole.WriteText('Row: ' + inttostr(Head^.Row) + ' Col: ' + inttostr(Head^.Col));

  if Dir = MD_Up then
  begin
    if Head^.Row = 1 then
      Result := true;
  end;

  // 判断撞到上下的墙
  if (Head^.Row < 1) or (Head^.Row > GAMEROW - 3) then
    Result := true;

  // 判断撞到左右的墙
  if (Head^.Col < 3) or (Head^.Col > GAMECOL - 6) then
    Result := true;

  // 判断是否撞到自己

  for I := 2 to FSnakePointList.Count - 1 do
  begin
    P := FSnakePointList.Items[I];
    case Dir of
    MD_Right:
      begin
        if (Head^.Col + 1 = P^.Col) and (Head^.Row = P^.Row) then
          Result := true;
      end;
    MD_Left:
      begin
        if (Head^.Col - 1 = P^.Col) and (Head^.Row = P^.Row) then
          Result := true;
      end;
    MD_Up:
      begin
        if (Head^.Row - 1 = P^.Row) and (Head^.Col = P^.Col) then
          Result := true;
      end;
    MD_Down:
      begin
        if (Head^.Row + 1 = P^.Row) and (Head^.Col = P^.Col) then
          Result := true;
      end;
    end;
  end;
end;

function TSnake.CheckInSnake(Row, Col: integer): boolean;
var
  P: PGamePoint;
  I: integer;
begin
  Result := false;
  for I := 0 to FSnakePointList.Count - 1 do
  begin
    P := FSnakePointList.Items[I];
    if (P^.Row = Row) and (P^.Col= Col) then
    begin
      Result := true;
      break;
    end;
  end;
end;

constructor TSnake.Create();
begin
  FReadKeyThread  := TReadKeyThread.Create(true);
  FSnakePointList := TList.Create();
  New(FFoodPoint);
  New(FLastPoint);
  FMyConsole:= TConsoleControl.Create;
  FMyConsole.SetWindowTitle('【贪吃蛇】 V1.0');
  InitGameMap();
end;

destructor TSnake.Destroy;
begin
  Dispose(FFoodPoint);
  Dispose(FLastPoint);
  FreeAndNil(FSnakePointList);
  FMyConsole.Free;
  FReadKeyThread.Free();
  inherited;
end;

function TSnake.EatFood: boolean;
var
  Head : PGamePoint;
begin
  Result := false;
  Head := GetSnakeBodyType(PT_Head);
  if (Head^.Row = FFoodPoint^.Row) and (Head^.Col = FFoodPoint^.Col) then
  begin
    ShowScores(true);
    Result := true;
  end;
  ShowScores();
end;

procedure TSnake.FreeSnakeList;
var
  P: PGamePoint;
  Index: integer;
begin
  if FSnakePointList.Count > 0 then
  begin
    repeat
      Index := FSnakePointList.Count - 1;
      P     := FSnakePointList.Items[Index];
      FSnakePointList.Delete(Index);
      Dispose(P);
    until FSnakePointList.Count = 0;
  end;
end;

procedure TSnake.GameOver;
var
  S: string;
begin
  StartSnake               := false;
  FReadKeyThread.StartRead := false;
//
  FMyConsole.SetCursorTo(0, 16);
  FMyConsole.WriteText('                                                      ');
  FMyConsole.SetCursorTo(0, 16);
  FMyConsole.WriteText('游戏结束重新开始吗? (y/n):');
  Readln(S);
  if LowerCase(S) = 'y' then
  begin
    //FMyConsole.SetCursorTo(0, 16);
    //FMyConsole.WriteText('游戏开始                      ');
    InitGameMap();
    Start();
  end;
end;

procedure TSnake.GetFood;
begin
  Randomize;
  repeat
    FFoodPoint^.Row := Random(GAMEROW - 7) + 5;
    FFoodPoint^.Col := Random(GAMECOL - 10) + 5;
  until not CheckInSnake(FFoodPoint^.Row, FFoodPoint^.Col);
  FMyConsole.SetForegroundColor(true, false, true, false);
  FMyConsole.SetCursorTo(FFoodPoint^.Col, FFoodPoint^.Row);
  FMyConsole.WriteText('O');
end;

function TSnake.GetMoveDir: TMoveDir;
begin
  Result := FReadKeyThread.MoveDir;
end;

function TSnake.GetSnakeBodyType(bodyType: TPointType): PGamePoint;
var
  I: integer;
begin
  Result := nil;
  for I := 0 to FSnakePointList.Count - 1 do
  begin
    Result := FSnakePointList.Items[I];
    if Result.PointType = bodyType then break;
  end;
end;

procedure TSnake.InitGameMap;
var
//  I, J: integer;
  P: PGamePoint;
begin
  FMyConsole.ClearScreen;
//  for I := 0 to GAMEROW - 1 do
//  begin
//    for J := 0 to GAMECOL - 1 do
//    begin
//      if (I = 0) or (I = GAMEROW - 1) then
//        FGameMap[I][J] := 1
//      else
//        FGameMap[I][J] := 0;
//
//      if (J = 0) or (J = 1) or (J = GAMECOL - 1 ) or (J = GAMECOL - 2 ) then
//        FGameMap[I][J] := 1
//      else
//        FGameMap[I][J] := 0;
//    end;
//  end;

  FreeSnakeList();

  // 头 先添加
  New(P);
  P^.Row := 2;
  P^.Col := 7;
  P^.PointType := PT_Head;
  FSnakePointList.Add(P);

  // 身体
  New(P);
  P^.Row := 2;
  P^.Col := 6;
  P^.PointType := PT_Body;
  FSnakePointList.Add(P);
  New(P);
  P^.Row := 2;
  P^.Col := 5;
  P^.PointType := PT_Body;
  FSnakePointList.Add(P);
  New(P);
  P^.Row := 2;
  P^.Col := 4;
  P^.PointType := PT_Body;
  FSnakePointList.Add(P);
  New(P);
  P^.Row := 2;
  P^.Col := 3;
  P^.PointType := PT_Tail;
  FSnakePointList.Add(P);

//  // 蛇的初始位置
//  for J := 1 to 5 do
//    FGameMap[1][J] := 1;

  // 食物初始位置
//  FFoodPoint^.Row := 10;
//  FFoodPoint^.Col := 30;
//  FFoodPoint^.PointType := PT_Food;

//  FGameMap[10][30] := 1; 
  FMyConsole.SetCursorTo(0, 0);
  FMyConsole.SetForegroundColor(true, false, false, false);
  FMyConsole.WriteTextLine('┏━━━━━━━━━━━━━━━━━━━━━━━━┓');
  FMyConsole.WriteTextLine('┃                                                ┃');
  FMyConsole.WriteTextLine('┃                                                ┃');
  FMyConsole.WriteTextLine('┃                                                ┃');
  FMyConsole.WriteTextLine('┃                                                ┃');
  FMyConsole.WriteTextLine('┃                                                ┃');
  FMyConsole.WriteTextLine('┃                                                ┃');
  FMyConsole.WriteTextLine('┃                                                ┃');
  FMyConsole.WriteTextLine('┃                                                ┃');
  FMyConsole.WriteTextLine('┃                                                ┃');
  FMyConsole.WriteTextLine('┃                                                ┃');
  FMyConsole.WriteTextLine('┃                                                ┃');
  FMyConsole.WriteTextLine('┃                                                ┃');
  FMyConsole.WriteTextLine('┃                                                ┃');
  FMyConsole.WriteTextLine('┃                                                ┃');
  FMyConsole.WriteTextLine('┗━━━━━━━━━━━━━━━━━━━━━━━━┛');

  GetFood();
end;

procedure TSnake.MoveSnake;
var
  Head  : PGamePoint;
  Tail  : PGamePoint;
  P1, P2: PGamePoint;
  I     : integer;
  NewBody: PGamePoint;
  eat: boolean;
begin

  if ThreadPause then
  begin
    FMyConsole.SetCursorTo(0, 16);
    FMyConsole.WriteText('游戏已暂停请按空格键继续...                    ');
  end
  else
  begin
    if CheckGameOver() then
    begin
      GameOver();
    end
    else
    begin
      eat := EatFood();

      //保存最后一个要擦除的点
      Tail := GetSnakeBodyType(PT_Tail);
      FLastPoint^.Row := Tail^.Row;
      FLastPoint^.Col := Tail^.Col;

      if eat then
      begin
        New(NewBody);
        NewBody^.Row := Tail^.Row;
        NewBody^.Col := Tail^.Col;
        NewBody^.PointType := PT_Tail;
        FSnakePointList.add(NewBody);

        Tail^.PointType := PT_Body;

        GetFood();
      end;

      // 移动蛇的位置
      for I := FSnakePointList.Count - 1 downto 1 do
      begin
        P1 := FSnakePointList.Items[I];
        P2 := FSnakePointList.Items[I - 1];

        P1^.Row := P2^.Row;
        P1^.Col := P2^.Col;
      end;

      Head := GetSnakeBodyType(PT_Head);
      case Dir of
        MD_Right: Inc(Head^.Col);
        MD_Left : Dec(Head^.Col);
        MD_Up   : Dec(Head^.Row);
        MD_Down : Inc(Head^.Row);
      end;

      PrintSnake();

        // 清空蛇尾
      if FStartSnake and not eat then
      begin
        FMyConsole.SetCursorTo(FLastPoint^.Col, FLastPoint^.Row);
        FMyConsole.WriteText(' ');
      end;
    end;
  end;

end;

procedure TSnake.PrintSnake;
var
  P: PGamePoint;
  I: integer;
begin
  FMyConsole.SetForegroundColor(false, true, false, false);
  for I := 0 to FSnakePointList.Count - 1 do
  begin
    P := FSnakePointList.Items[I];
    FMyConsole.SetCursorTo(P^.Col, P^.Row);
    case P^.PointType of
      PT_Head: FMyConsole.WriteText('#');
      PT_Body: FMyConsole.WriteText('*');
      PT_Tail: FMyConsole.WriteText('*');
    end;
  end;

//  FMyConsole.WriteTextLine('┏━━━━━━━━━━━━━━━━━━━━━━━━┓');
//  FMyConsole.WriteTextLine('┃****#                                           ┃');
//  FMyConsole.WriteTextLine('┃                                                ┃');
//  FMyConsole.WriteTextLine('┃                                                ┃');
//  FMyConsole.WriteTextLine('┃                                                ┃');
//  FMyConsole.WriteTextLine('┃                                                ┃');
//  FMyConsole.WriteTextLine('┃                                                ┃');
//  FMyConsole.WriteTextLine('┃                                                ┃');
//  FMyConsole.WriteTextLine('┃                                                ┃');
//  FMyConsole.WriteTextLine('┃                                                ┃');
//  FMyConsole.WriteTextLine('┃                                         O      ┃');
//  FMyConsole.WriteTextLine('┃                                                ┃');
//  FMyConsole.WriteTextLine('┃                                                ┃');
//  FMyConsole.WriteTextLine('┃                                                ┃');
//  FMyConsole.WriteTextLine('┃                                                ┃');
//  FMyConsole.WriteTextLine('┗━━━━━━━━━━━━━━━━━━━━━━━━┛');
  // 14 行 48 列
end;

procedure TSnake.ShowScores(add: boolean = false);
var
  S: string;
begin
//    FEatFoodCount   : integer;
//    FScores         : integer;
  if add then
  begin
    Inc(FEatFoodCount);
  end;
  S := Format('完成食物个数: %d     得分数: %d    ', [FEatFoodCount, 10 * FEatFoodCount]);
  FMyConsole.SetCursorTo(0, 16);
  FMyConsole.WriteText(S);
end;

procedure TSnake.Start;
begin
  FEatFoodCount   := 0;
  //FScores         := 0;
  StartSnake := true;
  FReadKeyThread.StartRead := true;
end;

procedure TSnake.StartGame;
var
  S: string;
begin
  PrintSnake();

  FMyConsole.SetCursorTo(0, 16);
  FMyConsole.WriteText('现在开始游戏吗? (y/n):');
  Readln(S);
  if LowerCase(S) = 'y' then
  begin
//    FMyConsole.SetCursorTo(0, 16);
//    FMyConsole.WriteText('开始游戏                          ');
    Start();
  end;
end;

function TSnake.ThreadPause: boolean;
begin
  Result := FReadKeyThread.Pause;
end;

{ TReadKeyThread }

procedure TReadKeyThread.Execute;
var
  arrInputRecs   : array[0..9] of TInputRecord;
  dwCur, dwCount : DWORD;
  hInput         : THandle;
begin
  hInput   := GetStdHandle(STD_INPUT_HANDLE);
  while TRUE do
  begin
    ReadConsoleInput(hInput, arrInputRecs[0], 10, dwCount);

    for dwCur := 0 to 10 - 1 do
    begin
      if self.Terminated then break;
      case arrInputRecs[dwCur].EventType of
        KEY_EVENT:
          begin
            with arrInputRecs[dwCur].Event.KeyEvent do
            begin
              if bKeyDown = true then
              begin
                case wVirtualKeyCode of
                  VK_Space:
                    begin
                      Pause := not Pause;
                    end;
                  VK_Left:
                    begin
                      if (MoveDir <> MD_Left) and (MoveDir <> MD_Right) then
                      begin
                        if not FPause then
                          MoveDir := MD_Left;
                      end;
                    end;
                  VK_Right:
                    begin
                      if (MoveDir <> MD_Right) and (MoveDir <> MD_Left) then
                      begin
                        if not  FPause then
                          MoveDir := MD_Right;
                      end;
                    end;
                  VK_Up:
                    begin
                      if (MoveDir <> MD_Up) and (MoveDir <> MD_Down) then
                      begin
                        if not  FPause then
                          MoveDir := MD_Up;
                      end;
                    end;
                  VK_Down:
                    begin
                      if (MoveDir <> MD_Up) and (MoveDir <> MD_Down) then
                      begin
                        if not  FPause then
                          MoveDir := MD_Down;
                      end;
                    end;
                end;
              end;
            end;
          end;
      end;
    end;
  end;
end;

procedure TReadKeyThread.SetStartRead(const Value: boolean);
begin
  FStartRead := Value;
  if FStartRead then
  begin
    MoveDir := MD_Right;
    FPause  := false;
    Resume;
  end
  else
    Suspend;
end;

initialization
  Snake := TSnake.Create;
  Snake.StartGame();
  FTimer := SetTimer(0, 0, TIMERINTERVAL, @TimerProc);
  
finalization
  KillTimer(0, FTimer);
  Snake.Free();

end.

4 控制台单元这个单元是网上的

unit uConsoleClass;

interface

uses Windows;

type
  TConsoleControl = Class
  private
    FhStdIn            : THandle;  // Handle to the standard input
    FhStdOut           : THandle;  // Handle to the standard output
    FhStdErr           : THandle;  // Handle to the standard error (Output)
    FbConsoleAllocated : Boolean;  // Creation Flag
    FBgAttrib          : Cardinal; // Currently set BackGround Attribs.
    FFgAttrib          : Cardinal; // Currently set ForeGround Attribs.

  public
    (* Creates a new consolewindow, or connects the current window *)
    constructor Create;
    destructor Destroy;override;

    (* Cleanup of the class structures  
                       
                    
                     
                      



鲜花




握手




雷人




路过




鸡蛋

该文章已有0人参与评论

请发表评论

全部评论

专题导读

More+

10-27 六六分期app的软件客服如何联系？(六六分期

11-06 可心卡盟:win10系统火狐flash插件崩溃怎么

11-06 亲亲特价:怎么删除回收站图标

11-06 济南大学虚拟社区:鲁大师节能降温的具体办

11-06 xlueops.exe:无线网络安装向导

11-06 女斗合众国:win7系统cf与主机连接不稳定怎

11-06 0xc000022-[cf烟雾头]cf怎么调烟雾头

11-06 qizideyouhuo:应用程序无法正常启动0xc0000

11-06 ipz-185:win7系统vcf文件怎么打开

11-06 傻哥蹦迪:win10系统s4怎么打开usb调试

11-06 八神浩树gtaste:回收站清空了怎么恢复

11-06 妖尾之黑色守护:win10系统电脑没有1440x900

11-06 校园至尊魔王小说:win7系统浏览网页时字体

11-06 女斗合众国:win10系统访问共享文件夹提示请

11-06 tokyo hot n0654:恢复win7系统默认字体一招

11-06 雨酷仙境:设置win7系统转移临时文件夹腾出

11-06 阿穆纳伊之杖:win7系统开始菜单在右边还原

11-06 tunespotting:win10系统火狐flash插件总是

11-06 甘尔葛分析师：计谋网站seo关键词暴涨有什

11-06 蔡贵霖: 计谋网站seo关键词暴涨有什么秘密

11-06 博益网首页:ao3网页版进入不了解决方法

11-06 漏斗子专栏: 网站数据分析小白易懂精华篇

11-06 见证双虹怎么做:win7系统开启telnet命令的

11-06 颾狐蝶蜋:系统资源不足无法完成请求的服务

11-06 国光中学校歌:提交网站到alexa查询详细步骤

11-06 西安有情天:静态网页和动态网页的区别

11-06 红木雅尚斋:外部链接构造对网站的好处

11-06 前官礼遇：防止域名劫持–增强域安全性的10

11-06 密传二转答案: 中文分词算法有哪些

11-06 金泉家园邮编:百度快照劫持的表现及应对方

理解 Delphi 的类(十) - 深入方法[14] - 在TForm1 类内声明的方法发布时间：2022-07-18

DelphiRichEdit读取剪切板发布时间：2022-07-18

剪的笔顺,诠释剪的笔画,认识剪的部首

六六分期app的软件客服如何联系？(六六分期

2023-10-27

florent37/ViewAnimator: A fluent Android

2022-08-15

florent37/Shrine-MaterialDesign2: implem

2022-08-17

CVE-2020-36276

2022-09-23

SimpleSoftwareIO/simple-sms: Send and re

2022-08-13

阅读排行榜

1 六六分期app的软件客服如何联系？(六六分期

六六分期app的软件客服如何联系？不知道吗？加qq群【895510560】即可！标题：六六分期

阅读：18029|2023-10-27

2 可心卡盟:win10系统火狐flash插件崩溃怎么

今天小编告诉大家如何处理win10系统火狐flash插件总是崩溃的问题，可能很多用户都不知

阅读：9595|2022-11-06

3 亲亲特价:怎么删除回收站图标

今天小编告诉大家如何对win10系统删除桌面回收站图标进行设置，可能很多用户都不知道

阅读：8141|2022-11-06

4 济南大学虚拟社区:鲁大师节能降温的具体办

今天小编告诉大家如何对win10系统电脑设置节能降温的设置方法，想必大家都遇到过需要

阅读：8522|2022-11-06

5 xlueops.exe:无线网络安装向导

我们在使用xp系统的过程中,经常需要对xp系统无线网络安装向导设置进行设置，可能很多

阅读：8425|2022-11-06

6 女斗合众国:win7系统cf与主机连接不稳定怎

今天小编告诉大家如何处理win7系统玩cf老是与主机连接不稳定的问题，可能很多用户都不

阅读：9330|2022-11-06

7 0xc000022-[cf烟雾头]cf怎么调烟雾头

电脑对日常生活的重要性小编就不多说了，可是一旦碰到win7系统设置cf烟雾头的问题，很

阅读：8389|2022-11-06

8 qizideyouhuo:应用程序无法正常启动0xc0000

我们在日常使用电脑的时候，有的小伙伴们可能在打开应用的时候会遇见提示应用程序无法

阅读：7825|2022-11-06

9 ipz-185:win7系统vcf文件怎么打开

今天小编告诉大家如何对win7系统打开vcf文件进行设置，可能很多用户都不知道怎么对win

阅读：8379|2022-11-06

10 傻哥蹦迪:win10系统s4怎么打开usb调试

今天小编告诉大家如何对win10系统s4开启USB调试模式进行设置，可能很多用户都不知道怎

阅读：7372|2022-11-06

扫描微信二维码

查看手机版网站

随时了解更新最新资讯

139-2527-9053

在线客服（服务时间 9:00～18:00）

在线QQ客服

地址：深圳市南山区西丽大学城创智工业园

电邮：jeky_zhao#qq.com

移动电话：139-2527-9053

客服电话

电子邮件

delphi控制台贪吃蛇

请发表评论

全部评论

上一篇：

下一篇：

librespeed/speedtest: Self-hosted Speedt

avehtari/BDA_m_demos: Bayesian Data Anal

四维彩超怎么看性别？四维看男孩女孩诀窍

medfreeman/markdown-it-toc-and-anchor: m

Delphi操作XML(八)