MadCortez

Untitled

May 21st, 2021
314
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 8.28 KB | None | 0 0
  1. unit UnitGame;
  2.  
  3. interface
  4.  
  5. uses
  6.   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  7.   Vcl.Controls, Vcl.Forms, Vcl.Dialogs, UnitMain, Vcl.ExtCtrls, Vcl.Menus,
  8.   Vcl.StdCtrls, UnitBot;
  9.  
  10. type
  11.    TArr = array of Integer;
  12.   TForm1 = class(TForm)
  13.     TimerPlayer: TTimer;
  14.     MainMenu1: TMainMenu;
  15.     Game1: TMenuItem;
  16.     Respawn: TMenuItem;
  17.     Level: TMenuItem;
  18.     Level1: TMenuItem;
  19.     Level2: TMenuItem;
  20.     Level3: TMenuItem;
  21.     Level4: TMenuItem;
  22.     Info: TMenuItem;
  23.     LabelScore: TLabel;
  24.     LabelPoint: TLabel;
  25.     TimerBot: TTimer;
  26.     LabelScoreBot: TLabel;
  27.     LabelPointBot: TLabel;
  28.     procedure FormCreate(Sender: TObject);
  29.     procedure TimerPlayerTimer(Sender: TObject);
  30.     procedure NewGame;
  31.     procedure FormPaint(Sender: TObject);
  32.     procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
  33.     procedure ReadMap(Path: String);
  34.     procedure RespawnClick(Sender: TObject);
  35.     procedure Level2Click(Sender: TObject);
  36.     procedure Level3Click(Sender: TObject);
  37.     procedure Level4Click(Sender: TObject);
  38.     procedure Level1Click(Sender: TObject);
  39.     procedure InfoClick(Sender: TObject);
  40.     procedure TimerBotTimer(Sender: TObject);
  41.     procedure GamePause;
  42.     procedure GameStart;
  43.   private
  44.     { Private declarations }
  45.   public
  46.     { Public declarations }
  47.   end;
  48.  
  49.   procedure SpawnApple;
  50.  
  51. var
  52.   Form1: TForm1;
  53.   SnakeLen, BoxNum, Score, Min, SnakeLenBot, ScoreBot: Integer;
  54.   AHeadBot, AHead: THead;
  55.   ATailsBot, ATails: array [1..500] of TTail;
  56.   DirBot, Map, Dir, NextDirCol: String;
  57.   AApple: TApple;
  58.   ABoxs: array[1..100] of TBox;
  59.   HeadPic, ApplePic, TailPic, BoxPic, HeadBotPic, TailBotPic: TBitmap;
  60.   WayX, WayY: TArr;
  61.   Flag, LoseFlag, CheckFlag, NextFlag: Boolean;
  62.   MyFile: File of String[30];
  63.   S: String[30];
  64.   Field: TMatrix;
  65.  
  66. implementation
  67.  
  68. Uses
  69.    UnitPlayer;
  70.  
  71. {$R *.dfm}
  72.  
  73. procedure TForm1.FormCreate(Sender: TObject);
  74. begin
  75.    DoubleBuffered := True;
  76.    Color := ClWhite;
  77.    Width := 20 * 24 + 18;
  78.    Height := 23 * 24;
  79.    Map := 'lvl-1.txt';
  80.  
  81.    HeadPic := TBitmap.Create;
  82.    HeadPic.LoadFromFile('yellow.bmp');
  83.    ApplePic := TBitmap.Create;
  84.    ApplePic.LoadFromFile('red.bmp');
  85.    TailPic := TBitmap.Create;
  86.    TailPic.LoadFromFile('green.bmp');
  87.    BoxPic := TBitmap.Create;
  88.    BoxPic.LoadFromFile('box.bmp');
  89.  
  90.    HeadBotPic := TBitmap.Create;
  91.    HeadBotPic.LoadFromFile('green.bmp');
  92.    TailBotPic := TBitmap.Create;
  93.    TailBotPic.LoadFromFile('yellow.bmp');
  94.  
  95.    NewGame;
  96. end;
  97.  
  98. procedure TForm1.GamePause;
  99. begin
  100.    TimerPlayer.Enabled := False;
  101.    TimerBot.Enabled := False;
  102.    MessageDlg('Game paused, click "OK" to continue', mtCustom, [mbOK], 0);
  103.    TimerPlayer.Enabled := True;
  104.    if not LoseFlag then
  105.       TimerBot.Enabled := True;
  106. end;
  107.  
  108. procedure TForm1.GameStart;
  109. begin
  110.    Dir := 'Down';
  111.    DirBot := 'Down';
  112.    TimerPlayer.Enabled := True;
  113.    TimerPlayer.Interval := 0;
  114.    TimerBot.Enabled := True;
  115.    TimerBot.Interval := 5;
  116. end;
  117.  
  118. procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  119.   Shift: TShiftState);
  120. begin
  121.    if (Key = VK_LEFT) and (Dir <> 'Right') then
  122.       Dir := 'Left';
  123.    if (Key = VK_RIGHT) and (Dir <> 'Left') then
  124.       Dir := 'Right';
  125.    if (Key = VK_UP) and (Dir <> 'Down') then
  126.       Dir := 'Up';
  127.    if (Key = VK_DOWN) and (Dir <> 'Up') then
  128.       Dir := 'Down';
  129.  
  130.    if Key = VK_ESCAPE then
  131.       GamePause;
  132.    if (Key = VK_RETURN) and (Dir = '') then
  133.       GameStart;
  134. end;
  135.  
  136. procedure TForm1.FormPaint(Sender: TObject);
  137. var
  138.    i: Integer;
  139. begin
  140.    for i := 1 to SnakeLen do
  141.       Canvas.Draw(ATails[i].GetX, ATails[i].GetY, ATails[i].GetBitmap);
  142.  
  143.    for i := 1 to SnakeLenBot do
  144.       Canvas.Draw(ATailsBot[i].GetX, ATailsBot[i].GetY, ATailsBot[i].GetBitmap);
  145.  
  146.    Canvas.Draw(AHeadBot.GetX, AHeadBot.GetY, AHeadBot.GetBitmap);
  147.  
  148.    Canvas.Draw(AHead.GetX, AHead.GetY, AHead.GetBitmap);
  149.    Canvas.Draw(AApple.GetX, AApple.GetY, AApple.GetBitmap);
  150.    for i := 1 to BoxNum do
  151.       Canvas.Draw(ABoxs[i].GetX, ABoxs[i].GetY, ABoxs[i].GetBitmap);
  152. end;
  153.  
  154. procedure SpawnApple;
  155. var
  156.    i: Integer;
  157.    Valid: Boolean;
  158. begin
  159.    randomize;
  160.       repeat
  161.          Valid := True;
  162.          AApple.SetX(random(18) * 24 + 24);
  163.          AApple.SetY(random(18) * 24 + 24);
  164.          for i := 1 to BoxNum do
  165.             if (AApple.GetX = ABoxs[i].GetX) and (AApple.GetY = ABoxs[i].GetY) then
  166.                Valid := False;
  167.          for i := 1 to SnakeLen do
  168.             if (AApple.GetX = ATails[i].GetX) and (AApple.GetY = ATails[i].GetY) then
  169.                Valid := False;
  170.          for i := 1 to SnakeLenBot do
  171.             if (AApple.GetX = ATailsBot[i].GetX) and (AApple.GetY = ATailsBot[i].GetY) then
  172.                Valid := False;
  173.          if (AApple.GetX = AHead.GetX) and (AApple.GetY = AHead.GetY) then
  174.             Valid := False;
  175.          if (AApple.GetX = AHeadBot.GetX) and (AApple.GetY = AHeadBot.GetY) then
  176.             Valid := False;
  177.       until Valid;
  178.    for i := 1 to 30 do
  179.       s[i] := ' ';
  180.    S := 'Apple spawned in ' + IntToStr(AApple.GetX) + ' ' + IntToStr(AApple.GetY) + #10#13;
  181.    Write(MyFile, S);
  182. end;
  183.  
  184. procedure TForm1.InfoClick(Sender: TObject);
  185. var
  186.    InfoText: String;
  187.    Flag: Boolean;
  188. begin
  189.    InfoText := 'Press ENTER to START game' + #10#13 + 'Press ESC to PAUSE' + #10#13;
  190.    InfoText := InfoText + 'Разработал Пестунов Илья, гр. 051007, в рамках курсового проекта';
  191.    if TimerPlayer.Enabled = False then
  192.       Flag := True;
  193.    TimerPlayer.Enabled := False;
  194.    TimerBot.Enabled := False;
  195.    MessageDlg(InfoText, mtInformation, [mbOK], 0);
  196.    if not(Flag) then
  197.       TimerPlayer.Enabled := True;
  198.    if not(LoseFlag) then
  199.       TimerBot.Enabled := True;
  200. end;
  201.  
  202. procedure TForm1.Level1Click(Sender: TObject);
  203. begin
  204.    TimerPlayer.Enabled := False;
  205.    ClearPlayer;
  206.    ClearBot;
  207.    Map := 'lvl-1.txt';
  208.    NewGame;
  209. end;
  210.  
  211. procedure TForm1.Level2Click(Sender: TObject);
  212. begin
  213.    TimerPlayer.Enabled := False;
  214.    ClearPlayer;
  215.    ClearBot;
  216.    Map := 'lvl-2.txt';
  217.    NewGame;
  218. end;
  219.  
  220. procedure TForm1.Level3Click(Sender: TObject);
  221. begin
  222.    TimerPlayer.Enabled := False;
  223.    ClearPlayer;
  224.    ClearBot;
  225.    Map := 'lvl-3.txt';
  226.    NewGame;
  227. end;
  228.  
  229. procedure TForm1.Level4Click(Sender: TObject);
  230. begin
  231.    TimerPlayer.Enabled := False;
  232.    ClearPlayer;
  233.    ClearBot;
  234.    Map := 'lvl-4.txt';
  235.    NewGame;
  236. end;
  237.  
  238. procedure TForm1.NewGame;
  239. var
  240.    i: Integer;
  241.    Valid: Boolean;
  242. begin
  243.    AssignFile(MyFile, 'log.txt');
  244.    Rewrite(MyFile);
  245.    Reset(MyFile);
  246.    TimerPlayer.Enabled := False;
  247.    TimerBot.Enabled := False;
  248.    LoseFlag := False;
  249.    Flag := False;
  250.    Score := 0;
  251.    ScoreBot := 0;
  252.    LabelPoint.Caption := IntToStr(Score);
  253.    LabelPointBot.Caption := IntToStr(Score);
  254.    ReadMap(Map);
  255.    AApple := TApple.Create(random(18) * 24 + 24, random(18) * 24 + 24, ApplePic);
  256.    AHead := THead.Create(random(20) * 24, random(20) * 24, HeadPic);
  257.    SpawnHeadPlayer;
  258.    SpawnHeadBot;
  259.  
  260.    SnakeLen := 2;
  261.    SnakeLenBot := 2;
  262.    ATails[1] := TTail.Create(AHead.GetX, AHead.GetY - 24, TailPic);
  263.    ATails[2] := TTail.Create(AHead.GetX, AHead.GetY - 48, TailPic);
  264.  
  265.    ATailsBot[1] := TTail.Create(AHeadBot.GetX, AHeadBot.GetY - 24, TailBotPic);
  266.    ATailsBot[2] := TTail.Create(AHeadBot.GetX, AHeadBot.GetY - 48, TailBotPic);
  267.  
  268.    SpawnApple;
  269.  
  270.    DirBot := '';
  271.    Dir := '';
  272.    Repaint;
  273. end;
  274.  
  275. procedure TForm1.RespawnClick(Sender: TObject);
  276. begin
  277.    TimerPlayer.Enabled := False;
  278.    TimerBot.Enabled := False;
  279.    ClearPlayer;
  280.    ClearBot;
  281.    NewGame;
  282. end;
  283.  
  284. procedure TForm1.ReadMap(Path: String);
  285. var
  286.    i, j: Integer;
  287.    MyFile: TextFile;
  288.    Cell: Char;
  289. begin
  290.    AssignFile(MyFile, Path);
  291.    Reset(MyFile);
  292.    BoxNum := 0;
  293.    for i := 1 to 20 do
  294.    begin
  295.       for j := 1 to 20 do
  296.       begin
  297.          Read(MyFile, Cell);
  298.          if Cell = '#' then
  299.          begin
  300.             Inc(BoxNum);
  301.             ABoxs[BoxNum] := TBox.Create((j - 1) * 24, (i - 1) * 24, BoxPic);
  302.          end;
  303.       end;
  304.       Readln(MyFile);
  305.    end;
  306.    CloseFile(MyFile);
  307. end;
  308.  
  309. procedure TForm1.TimerBotTimer(Sender: TObject);
  310. begin
  311.    MoveSnakeBot;
  312.    GamePlayBot;
  313.    Repaint;
  314. end;
  315.  
  316. procedure TForm1.TimerPlayerTimer(Sender: TObject);
  317. begin
  318.    MoveSnakePlayer;
  319.    GamePlayPlayer;
  320.    Repaint;
  321. end;
  322.  
  323. end.
Add Comment
Please, Sign In to add comment