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

📄 adknpcmachine.pas

📁 N年前有个法国小组用Delphi写了一个2D网游(AD&D类型)
💻 PAS
字号:
unit ADKNpcMachine;

{
 projet ADK-ISO (c)2002-2003 Paul TOTH <tothpaul@free.fr>

 http://www.web-synergy.net/naug-land/

}

interface

uses
 Windows,Classes,ADKWalkers,ADKMaps;

type
  TAction=(aStand,aWalk,aRun);
  TDirection=(dirN,dirNE,dirE,dirSE,dirS,dirSW,dirW,dirNW);

  TPlayerStart=procedure(Sender:TObject; PlayerID:integer; const Target:TPoint; How:TAction; var Cancel:boolean) of object;
  TPlayerMove=procedure(Sender:TObject; PlayerID:integer; const Leave,Enter:TPoint) of object;
  TPlayerStop=procedure(Sender:TObject; PlayerID:integer; How:TAction; Direction:TDirection; const Target:TPoint) of object;
  TRotateEvent=procedure(Sender:TObject; PlayerID:integer; Direction:TDirection) of object;
  TCellType=ADKWalkers.TOnCellType;
  TObstacle=ADKMaps.TObstacle;

  TADKNpcMachine=class
  private
   fSprites:TStringList;
   EOnPlayerStart:TPlayerStart;
   EOnPlayerMove :TPlayerMove;
   EOnPlayerStop :TPlayerStop;
   EOnRotate     :TRotateEvent;
   LastTicks     :cardinal;
   function GetOnCellType:TCellType;
   procedure SetOnCellType(Value:TCellType);
  public
   constructor Create;
   destructor Destroy; override;
   function LoadSprites(Name:string):integer;
   procedure LoadImages(FileName:string);
   procedure LoadMap(FileName:string);
   procedure LoadDefaults;
   procedure ClearSprites;
   function AddPlayer(x,y,Sprites,PlayerID:integer):TObject;
   procedure MovePlayer(Player:TObject; Target:TPoint; How:TAction);
   procedure SetPlayerPos(Player:TObject; NewPos:TPoint; Direction:TDirection);
   procedure SetDirection(Player:TObject; Direction:TDirection);
   procedure SetSpeed(Player:TObject; Value:integer);
   property OnPlayerStart:TPlayerStart read EOnPlayerStart write EOnPlayerStart;
   property OnPlayerMove:TPlayerMove   read EOnPlayerMove  write EOnPlayerMove;
   property OnPlayerStop:TPlayerStop  read EOnPlayerStop  write EOnPlayerStop;
   property OnCellType:TCellType read GetOnCellType write SetOnCellType;
   property OnRotate:TRotateEvent read EOnRotate write EOnRotate;
   procedure Idle;
  end;

implementation

uses
 ADKData,ADKIniLoader,ADKObjects,ADKSprites;

var
 Machine:TADKNpcMachine;

procedure OnWalkerStart(Walker:TWalker; const Target:TPoint; How:ADKIniLoader.TAction; var Cancel:boolean);
begin
 if Assigned(Machine) and Assigned(Machine.EOnPlayerStart) then Machine.EOnPlayerStart(Machine,Walker.Tag,Target,TAction(How),Cancel);
end;

procedure OnWalkerMove(Walker:TWalker; Const Leave,Enter:TPoint);
begin
 if Assigned(Machine) and Assigned(Machine.EOnPlayerMove) then Machine.EOnPlayerMove(Machine,Walker.Tag,Leave,Enter);
end;

procedure OnWalkerStop(Walker:TWalker; const Target:TPoint);
begin
 if Assigned(Machine) and Assigned(Machine.EOnPlayerStop) then Machine.EOnPlayerStop(Machine,Walker.Tag,TAction(Walker.Action),TDirection(Walker.Dir),Target);
end;

procedure OnWalkerRotate(Walker:TWalker; Dir:ADKSprites.TDirection);
begin
 if Assigned(Machine) and Assigned(Machine.EOnRotate) then Machine.EOnRotate(Machine,Walker.Tag,TDirection(Dir));
end;

constructor TADKNpcMachine.Create;
begin
 fSprites:=TStringList.Create;
 Machine:=Self; // <!> global
end;

destructor TADKNpcMachine.Destroy;
begin
 Machine:=Nil;
 fSprites.Free;
 inherited;
end;

function TADKNpcMachine.GetOnCellType:TCellType;
begin
 Result:=Map.fOnCellType;
end;

procedure TADKNpcMachine.SetOnCellType(Value:TCellType);
begin
 Map.fOnCellType:=Value;
end;

function TADKNpcMachine.LoadSprites(Name:string):integer;
begin
 Result:=fSprites.IndexOf(Name);
 if Result<0 then Result:=fSprites.AddObject(Name,GetSprites(Name));
end;

procedure TADKNpcMachine.LoadImages(FileName:string);
begin
 ImageLib.LoadFromFile(FileName);
end;

procedure TADKNpcMachine.LoadMap(FileName:string);
begin
 ClearSprites;
 Map.LoadFromFile(FileName);
end;

procedure TADKNpcMachine.LoadDefaults;
begin
 LoadImages(StringProperty('Startup','Images'));
 LoadMap(StringProperty('Startup','Map'));
end;

procedure TADKNpcMachine.ClearSprites;
var
 i:integer;
begin
 for i:=ObjectList.Count-1 downto 0 do TADKObject(ObjectList[i]).Free;
end;

function TADKNpcMachine.AddPlayer(x,y,Sprites,PlayerID:integer):TObject;
begin
 Map.FixPos(x,y);
 result:=TWalker.Create(x,y,TSprites(fSprites.Objects[Sprites]),ADKSprites.DirS);
 with TWalker(Result) do begin
  OnStart:=OnWalkerStart;
  OnMove:=OnWalkerMove;
  OnStop:=OnWalkerStop;
  OnRotate:=OnWalkerRotate;
  Tag:=PlayerID;
 end;
end;

procedure TADKNpcMachine.MovePlayer(Player:TObject; Target:TPoint; How:TAction);
begin
 TWalker(Player).Go(Target,ADKIniLoader.TAction(How));
end;

procedure TADKNpcMachine.SetPlayerPos(Player:TObject; NewPos:TPoint; Direction:TDirection);
begin
 Map.FixPos(NewPos.x,NewPos.y);
 with TWalker(Player) do begin
  Action:=ADKIniLoader.aStand;
  SetPos(NewPos.x,NewPos.y);
  Dir:=ADKSprites.TDirection(Direction);
 end;
end;

procedure TADKNpcMachine.SetDirection(Player:TObject; Direction:TDirection);
begin
 TWalker(Player).Dir:=ADKSprites.TDirection(Direction);
end;

procedure TADKNpcMachine.SetSpeed(Player:TObject; Value:integer);
begin
 if Value<>0 then TWalker(Player).Speed:=100/Value;
end;

procedure TADKNpcMachine.Idle;
var
 t,ms:Cardinal;
 i:integer;
begin
 t:=GetTickCount;
 if LastTicks<>0 then begin
  ms:=t-LastTicks;
  for i:=0 to ObjectList.Count-1 do TADKObject(ObjectList[i]).Update(ms);
 end;
 LastTicks:=t;
end;

end.

⌨️ 快捷键说明

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