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

📄 main.pas

📁 Delphi Engine for games.
💻 PAS
📖 第 1 页 / 共 2 页
字号:
//UnTitledRTS for UnDelphiX
unit Main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  DXClass, DXSprite, DXInput, DXDraws, DXSounds, DIB,
  DXWStatObj, DXWPath, DXWNavigator,DXWSceneUnit,
  Wave, MMSystem, IniFiles, DXPlay
  //,Z_prof
  ;


const
 //FullScreen=true;
 FullScreen=false;

type
  TGameScene = (
                 gsNone,
                 gsTitle,
                 gsMainMenu,
                 gsMultiPlayerMenu1,
                 gsMultiPlayerMenu2,
                 gsMultiPlayerMenu3,
                 gsMultiPlayerMenu4,
                 gsMain,
                 gsGameOver
                );

  TGameSubScene = (
                   gssNone,
                   gssMenu
                  );


  //TSceneClass = class of TScene;


  TMainForm = class(TDXForm)

    DXTimer        : TDXTimer;
    DXDraw         : TDXDraw;
    SpriteEngine   : TDXSpriteEngine;
    DXInput        : TDXInput;
    ImageList      : TDXImageList;
    DXWaveList     : TDXWaveList;
    DXSound        : TDXSound;
    TmpImageList1  : TDXImageList;
    TmpImageList2  : TDXImageList;
    CursorImageList: TDXImageList;
    DXPlay: TDXPlay;

    procedure DXDrawFinalize(Sender: TObject);
    procedure DXDrawInitialize(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure DXTimerTimer(Sender: TObject; LagCount: Integer);
    procedure DXDrawInitializing(Sender: TObject);
    procedure FormDestroy(Sender: TObject);

    procedure DXDrawMouseMove(Sender:TObject;Shift:TShiftState;X,Y:Integer);
    procedure DXDrawMouseDown(Sender:TObject;Button:TMouseButton;Shift:TShiftState;X,Y:Integer);
    procedure DXDrawMouseUp(Sender:TObject;Button:TMouseButton;Shift:TShiftState;X,Y:Integer);

    procedure FormClose(Sender: TObject; var Action: TCloseAction);

    procedure DXSoundInitialize(Sender: TObject);

    procedure DXDrawKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure DXDrawKeyPress(Sender: TObject; var Key: Char);
    procedure DXDrawKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure FormMouseWheel(Sender: TObject; Shift: TShiftState;
      WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
  private

    FBlink     : Integer;
    FBlinkTime : Integer;

    procedure BlinkStart;
    procedure BlinkUpdate;

    procedure StartSceneTitle;
    procedure SceneTitle;
    procedure EndSceneTitle;


    procedure StartSceneGameOver;
    procedure SceneGameOver;
    procedure EndSceneGameOver;

    procedure EndScene;

    //MainMenu
    procedure StartSceneMainMenu;
    procedure SceneMainMenu;
    procedure EndSceneMainMenu;

    procedure SceneMainMenuMouseMove(Shift: TShiftState; X, Y: Integer);
    procedure SceneMainMenuMouseDown(Shift: TShiftState; X, Y: Integer);
    procedure SceneMainMenuMouseUp(Shift: TShiftState; X, Y: Integer);

  Public
    FScene     : TGameScene;
    FNextScene : TGameScene;

    procedure PrintScreen;

    procedure PlaySound(const Name: string; Wait: Boolean);
    procedure StartScene(Scene: TGameScene);
    procedure LoadWaves;
    procedure SavePicData(var DXImageList: TDXImageList; FileName: string);
    procedure LoadPicData(var DXImageList: TDXImageList; FileName: string);

  end;


var
  MainForm                 : TMainForm;
  FBtnList                 : TList;
  SubSceneMainMenuEnabled  : Boolean;

  MapDownPointX       : Double;
  MapDownPointY       : Double;

  MouseXY             : TPoint;
  DimW,DimH           : Integer;
  MapW,MapH           : Integer;
  ChipW,ChipH         : Integer;
  PathInf             : TDXPath;
  Navigator           : TDXWNavigator;

  JobList             : TStringList;

  DXRed,DXBlue,DXYellow,DXGreen,DXLime : Integer;

  PlayerName          : String;
  SessionName         : String;

  function  FindPath(StartPos,EndPos : TPoint) : Boolean;
  Function  Sign(x : double): integer ;
  function GetFirstToken(S: string; Token: Char): string;

implementation
{$R *.DFM}
Uses  Menu,Pathes, GameSpritesUnit,SceneMainUnit,JPEG,SceneMultiPlayerMenuUnit;


Const
 DXInputButton = [isButton1, isButton2, isButton3,
 isButton4, isButton5, isButton6, isButton7, isButton8, isButton9, isButton10, isButton11,
 isButton12, isButton13, isButton14, isButton15, isButton16, isButton17, isButton18,
 isButton19, isButton20, isButton21, isButton22, isButton23, isButton24, isButton25,
 isButton26, isButton27, isButton28, isButton29, isButton30, isButton31, isButton32];


Var
 PlayerDirection : integer;
 SceneMultiPlayerMenu1 : TSceneMultiPlayerMenu1;
 SceneMultiPlayerMenu2 : TSceneMultiPlayerMenu2;
 SceneMultiPlayerMenu3 : TSceneMultiPlayerMenu3;

 //PX,PY           : Double;
 //WPX,WPY         : Double;


Function Sign(x : double): integer ;
begin
 if X>0 then Result:=1  else Result:=-1;
end;

{
Function GradToRad( A : Double):Double;
begin
  Result:=A*Pi/180;
end;

Function RadToGrad( A : Double):Double;
begin
 Result:=A*180/Pi;
end;
}

function FindPath(StartPos,EndPos : TPoint) : Boolean;
begin
 PathInf.FStartPos:=StartPos;
 PathInf.FEndPos:=EndPos;
 Result:=PathInf.FindPath;
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  JobList:=TStringList.Create;

  Cursor:=crNone;

  SubSceneMainMenuEnabled:=False;
  FBtnList:=TList.Create;

  //RandSeed:=GetTickCount;

  FScene:=gsNone;
  FNextScene:=gsNone;

  if FullScreen then
   begin
    BorderStyle := bsNone;
    DXDraw.Options := DXDraw.Options + [doFullScreen];
   end
  else
   begin
    ClientWidth:=640;
    ClientHeight:=480;
   end;

  DXDraw.Initialize;
  DXSound.Initialize;

  LoadWaves;

  StartScene(gsTitle);
  //StartScene(gsMainMenu);
  //StartScene(gsMain);

end;

procedure TMainForm.FormDestroy(Sender: TObject);
Var
i: integer;
begin
JobList.Free;
DXTimer.Enabled := False;

PathInf.Free;

For i:=0 to FBtnList.Count-1
 do TDXImageButton(FBtnList[i]).free;
FBtnList.Clear;
FBtnList.Free;
end;

procedure TMainForm.DXDrawInitializing(Sender: TObject);
begin
 DXDraw.Cursor := crNone;
end;

procedure TMainForm.DXDrawInitialize(Sender: TObject);
begin
 DXTimer.Enabled := True;

 DXRed:=DXDraw.Surface.ColorMatch(clRed);
 DXBlue:=DXDraw.Surface.ColorMatch(clBlue);
 DXYellow:=DXDraw.Surface.ColorMatch(clYellow);
 DXGreen:=DXDraw.Surface.ColorMatch(clGreen);
 DXLime:=DXDraw.Surface.ColorMatch(clLime);

end;

procedure TMainForm.DXDrawFinalize(Sender: TObject);
begin
  DXTimer.Enabled := False;
end;

procedure TMainForm.DXTimerTimer(Sender: TObject; LagCount: Integer);
 Const
  Counter : LongInt=0;
  CursorPatternIndex : Integer=0;
begin
  if not DXDraw.CanDraw then exit;

  DXInput.Update;

  case FScene of
    gsTitle    : SceneTitle;
    gsMainMenu : SceneMainMenu;
    gsMultiPlayerMenu1 : SceneMultiPlayerMenu1.DoDraw;
    gsMultiPlayerMenu2 : SceneMultiPlayerMenu2.DoDraw;
    gsMultiPlayerMenu3 : SceneMultiPlayerMenu3.DoDraw;
    gsMain     : SceneMain;
    gsGameOver : SceneGameOver;
  end;


  with DXDraw.Surface.Canvas do
  begin
    Brush.Style := bsClear;
    Font.Color := clRed;
    Font.Name := 'MS Sans Serif';
    Font.Size := 8;
    Textout(20, 20, 'FPS: '+inttostr(DXTimer.FrameRate));
    Release;
  end;


  If Counter=10 then
  begin
   Inc(CursorPatternIndex);
   Counter:=0;
   if CursorPatternIndex>4  then CursorPatternIndex:=0;
  end
   else Inc(Counter);

  if (FScene<>gsTitle)
   then CursorImageList.Items.Find('CursorNormal').Draw(DXDraw.Surface,mouseXY.x,mouseXY.y, CursorPatternIndex);
   //then CursorImageList.Items.Find('CursorAttack').Draw(DXDraw.Surface,mouseXY.x,mouseXY.y, CursorPatternIndex);

  if FNextScene<>gsNone then
  begin
    StartScene(FNextScene);
    FNextScene := gsNone;
  end;

  DXDraw.Flip;

end;

procedure TMainForm.BlinkStart;
begin
  FBlink := 0;
  FBlinkTime := GetTickCount;
end;

procedure TMainForm.BlinkUpdate;
begin
  if GetTickCount<>FBlinkTime then
  begin
    FBlink := FBlink + (GetTickCount-FBlinkTime);
    FBlinkTime := GetTickCount;
  end;
end;

procedure TMainForm.PlaySound(const Name: string; Wait: Boolean);
begin
 DXWaveList.Items.Find(Name).Play(Wait);
end;

procedure TMainForm.StartScene(Scene: TGameScene);
begin
  EndScene;
  DXInput.States := DXInput.States - DXInputButton;
  FScene := Scene;
  case FScene of
    gsTitle   : StartSceneTitle;
    gsMainMenu: StartSceneMainMenu;
    gsMultiPlayerMenu1 : SceneMultiPlayerMenu1:=TSceneMultiPlayerMenu1.Create;
    gsMultiPlayerMenu2 : SceneMultiPlayerMenu2:=TSceneMultiPlayerMenu2.Create;
    gsMultiPlayerMenu3 : SceneMultiPlayerMenu3:=TSceneMultiPlayerMenu3.Create;
    gsMain    : StartSceneMain;
    gsGameOver: StartSceneGameOver;
  end;
end;

//.....................................................................

procedure TMainForm.StartSceneTitle;
Var
FileName    : string;
begin
 FileName:='GameTitl.dxg';
 LoadPicData(TmpImageList1,FileName);
 SavePicData(TmpImageList1,FileName);
end;


procedure TMainForm.StartSceneMainMenu;
Var
FileName : string;
begin
 FileName:='MainMenu.dxg';
 LoadPicData(TmpImageList1,FileName);
 SavePicData(TmpImageList1,FileName);

FBtnList.Add(TDXImageButton.Create);
  With TDXImageButton(FBtnList[FBtnList.Count-1]) do
   begin
   Image := MainForm.TmpImageList1.Items.Find('BtnMainMenu');
   Width := Image.Width;
   Height := Image.Height;
   X := 200;
   Y := 240;
   Surface:=DXDraw.Surface;
   Caption:='Single Player Game';
   end;

FBtnList.Add(TDXImageButton.Create);
  With TDXImageButton(FBtnList[FBtnList.Count-1]) do
   begin
   Image := MainForm.TmpImageList1.Items.Find('BtnMainMenu');
   Width := Image.Width;
   Height := Image.Height;
   X := 200;
   Y := 276;
   Surface:=DXDraw.Surface;
   Caption:='Multi Player Game';
   end;

FBtnList.Add(TDXImageButton.Create);
  With TDXImageButton(FBtnList[FBtnList.Count-1]) do
   begin
   Image := MainForm.TmpImageList1.Items.Find('BtnMainMenu');
   Width := Image.Width;
   Height := Image.Height;
   X := 200;
   Y := 312;
   Surface:=DXDraw.Surface;
   Caption:='Replay Introduction';
   end;

FBtnList.Add(TDXImageButton.Create);
  With TDXImageButton(FBtnList[FBtnList.Count-1]) do
   begin
   Image := MainForm.TmpImageList1.Items.Find('BtnMainMenu');
   Width := Image.Width;
   Height := Image.Height;
   X := 200;
   Y := 348;
   Surface:=DXDraw.Surface;
   Caption:='Show Credits';
   end;

FBtnList.Add(TDXImageButton.Create);
  With TDXImageButton(FBtnList[FBtnList.Count-1]) do
   begin
   Image := MainForm.TmpImageList1.Items.Find('BtnMainMenu');
   Width := Image.Width;
   Height := Image.Height;
   X := 200;
   Y := 384;
   Surface:=DXDraw.Surface;
   Caption:='Exit Program';
   end;

end;


//........................................................................
procedure TMainForm.StartSceneGameOver;
Var
FileName : string;
begin
 FileName:='GameOver.dxg';
 LoadPicData(TmpImageList1,FileName);
 SavePicData(TmpImageList1,FileName);
end;
//..........................................................................

//>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
procedure TMainForm.EndScene;
begin
  case FScene of
    gsTitle   : EndSceneTitle;
    gsMainMenu: EndSceneMainMenu;
    gsMultiPlayerMenu1 : SceneMultiPlayerMenu1.free;
    gsMultiPlayerMenu2 : SceneMultiPlayerMenu2.free;
    gsMultiPlayerMenu3 : SceneMultiPlayerMenu3.free;
    //gsMultiPlayerMenu4 : SceneMultiPlayerMenu1.free;
    gsMain    : EndSceneMain;
    gsGameOver: EndSceneGameOver;
  end;
end;
//>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

procedure TMainForm.EndSceneTitle;
begin
 TmpImageList1.Items.Clear;
end;
//>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

procedure TMainForm.EndSceneMainMenu;
Var
i : integer;
begin
TmpImageList1.Items.Clear;

For i:=0 to FBtnList.Count-1
 do TDXImageButton(FBtnList[i]).free;
FBtnList.Clear;

end;

procedure TMainForm.EndSceneGameOver;
begin

⌨️ 快捷键说明

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