📄 main.pas
字号:
//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 + -