unit1.pas

3d snake 游戏编程源码

unit Unit1;

interface

uses
   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
   Dialogs, Menus, IniFiles, Unit2, StdCtrls, ExtCtrls;

type
   TMainForm = class(TForm)
      MainMenu1: TMainMenu;
      MenuGame: TMenuItem;
      MenuOpenGame: TMenuItem;
      MenuPause: TMenuItem;
      N3: TMenuItem;
      MenuExit: TMenuItem;
      MenuOption: TMenuItem;
      N1: TMenuItem;
      MenuHelp: TMenuItem;
      MenuSubHelp: TMenuItem;
      MenuAbout: TMenuItem;
      MenuRestart: TMenuItem;
      N8: TMenuItem;
      N7: TMenuItem;
      MenuViewScript: TMenuItem;
      Panel1: TPanel;
      MemoMap: TMemo;
      lblSnakeHead: TLabel;
      lblSnakeLength: TLabel;
      Bevel1: TBevel;
      Bevel2: TBevel;
      lblApplePos: TLabel;
      lblShowTime: TLabel;
      Label2: TLabel;
      Label3: TLabel;
      Bevel3: TBevel;
      Image1: TImage;
      lblDown: TLabel;
      lblRight: TLabel;
      lblLeft: TLabel;
      lblUp: TLabel;
      Image2: TImage;
      Label7: TLabel;
      Label8: TLabel;
      Label9: TLabel;
      Label10: TLabel;
      lblAppleCount: TLabel;
      Bevel4: TBevel;
      MenuCloseMap: TMenuItem;
      Label1: TLabel;
      procedure FormPaint(Sender: TObject);
      procedure MenuOptionClick(Sender: TObject);
      procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
      procedure MenuViewScriptClick(Sender: TObject);
      procedure FormCreate(Sender: TObject);
      procedure FormKeyDown(Sender: TObject; var Key: Word;
         Shift: TShiftState);
      procedure MenuExitClick(Sender: TObject);
      procedure MenuRestartClick(Sender: TObject);
      procedure MenuCloseMapClick(Sender: TObject);
      procedure MenuAboutClick(Sender: TObject);
    procedure MenuSubHelpClick(Sender: TObject);
   private
    { Private declarations }
   public
      procedure LoadFiles;
      procedure SaveFiles;
      procedure MapClick(Sender: TObject);
   end;

var
   MainForm: TMainForm;
   GameCtrl: TGameCtrl;
   DrawEngine: TDrawEngine;
   MapCtrl: TMapCtrl;
   GameOption: TGameOption;

   SetIni: TIniFile;
   GameDir: string;
implementation
uses Unit3, Unit4, Unit5, unit6,Unit7;
{$R *.dfm}

procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
   SaveFiles;
   GameCtrl.Free;
   DrawEngine.Free;
   MapCtrl.Free;
   SetIni.Free;
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
   ClientWidth := 665 + Panel1.Width;
   ClientHeight := 475;
   MapCtrl := TMapCtrl.Create;
   GameCtrl := TGameCtrl.Create;

   DrawEngine := TDrawEngine.Create(Handle, 665, 430);
   GameCtrl._Engine := @DrawEngine;
   DrawEngine._GameCtrl := @GameCtrl;

   LoadFiles;
end;

procedure TMainForm.FormPaint(Sender: TObject);
begin
   SwapBuffers(DrawEngine.DrawDC);
end;

procedure TMainForm.LoadFiles;
var i: ObjNames;
begin
   GameDir := ExtractFileDir(Application.ExeName) + '\';
   SetIni := TIniFile.Create(GameDir + 'Settings.ini');
   MapCtrl.MapCount := SetIni.ReadInteger(str_Snake, str_MapCount, 0);
   MapCtrl.MapDir := GameDir + 'Maps\';
   MapCtrl.LoadMaps;

   with GameOption do begin
      for i := obj_Wall to obj_Exit do
         Colors[i] := SetIni.ReadInteger(str_Snake, str_Color + IntToStr(ord(i)), 0);
      WallAlpha := SetIni.ReadInteger(str_Snake, str_WallAlpha, 122);
      ShowGrid := SetIni.ReadBool(str_Snake, str_ShowGrid, True);
      LightOn := SetIni.ReadBool(str_Snake, str_LightOn, True);
      ShowAidLine := SetIni.ReadBool(str_Snake, str_ShowAidLine, True);
      RGBGameColors;
      LoadWallColors;
   end;
end;

procedure TMainForm.SaveFiles;
var i: ObjNames;
begin
   with GameOption do begin
      for i := obj_Wall to obj_Exit do
         SetIni.WriteInteger(str_Snake, str_Color + IntToStr(ord(i)), Colors[i]);
      SetIni.WriteInteger(str_Snake, str_Snake, WallAlpha);
      SetIni.WriteBool(str_Snake, str_ShowGrid, ShowGrid);
      SetIni.WriteBool(str_Snake, str_LightOn, LightOn);
      SetIni.WriteBool(str_Snake, str_ShowAidLine, ShowAidLine);
   end;
end;

procedure TMainForm.MapClick(Sender: TObject);
begin
   if GameCtrl.AskIfGameEnd then begin
      GameCtrl.Game_End;
      GameCtrl.NewGame(MapCtrl.MapFileName((Sender as TComponent).Tag));
      GameCtrl.NowLevelIdx := (Sender as TComponent).Tag;
   end;
end;

procedure TMainForm.MenuOptionClick(Sender: TObject);
var OptionForm: TFormOption;
begin
   GameCtrl.Game_Pause;
   OptionForm := TFormOption.Create(nil);
   OptionForm.ShowModal;
   OptionForm.Free;
   if GameCtrl.AMapLoaded then
      DrawEngine.DrawScene;
end;

procedure TMainForm.MenuViewScriptClick(Sender: TObject);
var frm: TfrmScriptView;
begin
   if GameCtrl.AMapLoaded = False then begin
      MessageDlg(msg_NoFileToShowScript, mtInformation, [mbOK], 0);
      Exit;
   end;
   GameCtrl.Game_Pause;
   frm := TfrmScriptView.Create(nil);
   frm.Edit1.Text := DrawEngine.MapFileName;
   frm.Memo1.Lines.AddStrings(DrawEngine.MapScript);
   frm.ShowModal;
   frm.Free;
end;

procedure TMainForm.FormKeyDown(Sender: TObject; var Key: Word;
   Shift: TShiftState);
begin
   if GameCtrl.AMapLoaded = False then Exit;
   case Key of
      kb_ViewAngleV: begin
            DrawEngine.NextViewAngelV;
            Exit;
         end;
      kb_ViewAngleH: begin
            DrawEngine.NextViewAngelH;
            Exit;
         end;
      kb_FarNear: begin
            DrawEngine.ChangeFarNear;
            Exit;
         end;
   end;

   if GameCtrl.GameEnd then Exit; //实现游戏结束玩家仍可以改变视角，但不可再操纵
   if GameCtrl.GameStarted = False then begin //蛇没有开始动，那么按方向键和加速键蛇开始动
      case Key of
         kb_Up: GameCtrl.Game_Start(td_Up);
         kb_Down: GameCtrl.Game_Start(td_Down);
         kb_Left: GameCtrl.Game_Start(td_Left);
         kb_Right: GameCtrl.Game_Start(td_Right);
         kb_Accelerate: GameCtrl.Game_Start(td_Accelerate);
      end;
      Exit;
   end;

   if Key = kb_PauseOrResume then begin
      if GameCtrl.GamePaused = False then
         GameCtrl.Game_Pause
      else
         GameCtrl.Game_Resume;
      Exit;
   end;

   if GameCtrl.GamePaused = True then
      GameCtrl.Game_Resume;

   case Key of
      kb_Up: DrawEngine.SnakeTurn(td_Up);
      kb_Down: DrawEngine.SnakeTurn(td_Down);
      kb_Left: DrawEngine.SnakeTurn(td_Left);
      kb_Right: DrawEngine.SnakeTurn(td_Right);
      kb_Accelerate: DrawEngine.SnakeTurn(td_Accelerate);
   end;

end;

procedure TMainForm.MenuExitClick(Sender: TObject);
begin
   if (GameCtrl.AMapLoaded) and (GameCtrl.GameEnd = False) then begin
      GameCtrl.Game_Pause;
      if MessageDlg(msg_GameOnIfExit, mtConfirmation, [mbYes, mbNo], 0) = mrYes then
         Close
      else
         GameCtrl.Game_Resume;
   end else
      Close;
end;

procedure TMainForm.MenuRestartClick(Sender: TObject);
begin
   if GameCtrl.AMapLoaded = False then begin
      MessageDlg(msg_NoFileToRestart, mtInformation, [mbOK], 0);
      Exit;
   end;
   if GameCtrl.GameEnd = True then
      GameCtrl.Game_Restart
   else
      if MessageDlg(msg_WantToRestart, mtConfirmation, [mbYes, mbNo], 0) = mrYes then begin
         GameCtrl.Game_End;
         GameCtrl.Game_Restart;
      end;
end;

procedure TMainForm.MenuCloseMapClick(Sender: TObject);
begin
   if GameCtrl.AMapLoaded = False then begin
      MessageDlg(msg_NoFileToClose, mtInformation, [mbOK], 0);
      Exit;
   end;
   if MessageDlg(msg_WantToClose, mtConfirmation, [mbYes, mbNo], 0) = mrYes then
      GameCtrl.CloseMap;
end;

procedure TMainForm.MenuAboutClick(Sender: TObject);
var frm: TFrmAbout;
begin
   frm := TFrmAbout.Create(nil);
   if (GameCtrl.AMapLoaded) and (GameCtrl.GameEnd = False) then begin
      GameCtrl.Game_Pause;
      frm.ShowModal;
   end else
      frm.ShowModal;
   frm.Free;
end;

procedure TMainForm.MenuSubHelpClick(Sender: TObject);
var frmHelp:TFrmHelp;
begin
   frmHelp:=TfrmHelp.Create(nil);
   if (GameCtrl.AMapLoaded) and (GameCtrl.GameEnd = False) then begin
      GameCtrl.Game_Pause;
      frmHelp.showModal;
   end else
      frmHelp.showModal;
   frmHelp.Free;
end;

end.