udoorgen.pas

千年源代码,只缺少控件,可以做二次开发用,好不容易得来的

unit uDoorGen;

interface

uses
   Classes, SysUtils, BasicObj, DefType, UserSDB, AUtil32, uManager,
   uMonster, AnsStringCls;

type
   TDoorObject = class (TBasicObject)
   private
      DoorName : String;

   protected
      procedure Initial (aName : String; aX, aY: Integer);
      procedure StartProcess; override;
      procedure EndProcess; override;
      function FieldProc (hfu: Longint; Msg: word; var SenderInfo: TBasicData; var aSubData: TSubData): Integer; override;
   public
      constructor Create;
      destructor Destroy; override;

      procedure Update (CurTick: integer); override;
   end;

   TDoorGen = class
   private
      DataList : TList;
   public
      constructor Create;
      destructor Destroy; override;
   end;

   TItemGen = class (TBasicObject)
   private
      SelfData : TItemGenData;

      UpdatedTick : Integer;
      RegenedTick : Integer;
      CreatedTick : Integer;
   protected
      function FieldProc (hfu: Longint; Msg: word; var SenderInfo: TBasicData; var aSubData: TSubData): Integer; override;
   public
      constructor Create;
      destructor Destroy; override;

      function GetSelfData : PTItemGenData;

      procedure Initial (aName : String; aX, aY: Integer);
      procedure StartProcess; override;
      procedure EndProcess; override;

      procedure Update (CurTick: integer); override;
   end;

   TObjectChecker = class (TBasicObject)
   private
      UpdatedTick : Integer;

      DataList : TList;

      boMonsterDie : Boolean;
      boDynamicObjectDie : Boolean;
      MonsterDieTick : Integer;
      DynamicObjectDieTick : Integer;

      HaveMonster : TMonster;
      HaveDynamicObject : TDynamicObject;
   protected
      function FieldProc (hfu: Longint; Msg: word; var SenderInfo: TBasicData; var aSubData: TSubData): Integer; override;
   public
      constructor Create;
      destructor Destroy; override;

      procedure Initial (aName : String; aX, aY: Integer);
      procedure StartProcess; override;
      procedure EndProcess; override;

      procedure RegenData;

      procedure Update (CurTick: integer); override;

      function GetCurInfo : String;
   end;

   TSoundObj = class (TBasicObject)
   private
      SoundName : String;

      UpdatedTick : Integer;
      PlayedTick : Integer;
      PlayInterval : Integer;
   protected
      function FieldProc (hfu: Longint; Msg: word; var SenderInfo: TBasicData; var aSubData: TSubData): Integer; override;
   public
      constructor Create;
      destructor Destroy; override;

      procedure Initial (pd : PTCreateSoundObjData);
      procedure StartProcess; override;
      procedure EndProcess; override;

      procedure Update (CurTick: integer); override;
   end;

   TSoundObjList = class
   private
      DataList : TList;
   public
      constructor Create;
      destructor Destroy; override;

      procedure Clear;
      function LoadFromFile (aFileName : String) : Boolean;
      
      procedure Update (CurTick : Integer);
   end;



var
   ItemGen : TItemGen;
   ObjectChecker : TObjectChecker;
   SoundObjList : TSoundObjList;

implementation

uses
   svClass, SubUtil;

// TDoorObject
constructor TDoorObject.Create;
begin

end;

destructor TDoorObject.Destroy;
begin
   inherited Destroy;
end;

procedure TDoorObject.Initial (aName : String; aX, aY: Integer);
begin
   inherited Initial (aName, '');
end;

procedure TDoorObject.StartProcess;
begin

end;

procedure TDoorObject.EndProcess;
begin

end;

function TDoorObject.FieldProc (hfu: Longint; Msg: word; var SenderInfo: TBasicData; var aSubData: TSubData): Integer;
begin

end;

procedure TDoorObject.Update (CurTick: integer);
begin

end;

// TDoorGen
constructor TDoorGen.Create;
begin

end;

destructor TDoorGen.Destroy;
begin
   inherited Destroy;
end;

// TItemGen
constructor TItemGen.Create;
begin
   inherited Create;
   
   UpdatedTick := 0;
   CreatedTick := 0;
   RegenedTick := 0;

   FillChar (SelfData, SizeOf (TItemGenData), 0);
end;

destructor TItemGen.Destroy;
begin
   inherited Destroy;
end;

function TItemGen.GetSelfData : PTItemGenData;
begin
   Result := @SelfData;
end;

procedure TItemGen.Initial (aName : String; aX, aY: Integer);
begin
   inherited Initial (aName, '');

   BasicData.id := GetNewItemId;

   BasicData.x := aX;
   BasicData.y := aY;
   BasicData.nx := aX;
   BasicData.ny := aY;
   BasicData.ClassKind := CLASS_SERVEROBJ;
   BasicData.Feature.rRace := RACE_ITEM;
   BasicData.Feature.rImageNumber := 0;
   BasicData.Feature.rImageColorIndex := 0;

   UpdatedTick := 0;
   CreatedTick := -30000;
   RegenedTick := 0;

   SelfData.Name := aName;
   SelfData.ItemName := '积绊扁';
   SelfData.ItemCount := 60;
   SelfData.CreateInterval := 30000;
   SelfData.RegenInterval := 1000;
   SelfData.ItemCreateX := 100;
   SelfData.ItemCreateY := 84;
   SelfData.ItemCreateW := 10;
   SelfData.ItemRegenX := 134;
   SelfData.ItemRegenY := 39;
   SelfData.ItemRegenW := 12; 
end;

procedure TItemGen.StartProcess;
var
   SubData : TSubData;
begin
   inherited StartProcess;

   Phone.RegisterUser (BasicData.id, FieldProc, BasicData.X, BasicData.Y);
   Phone.SendMessage (0, FM_CREATE, BasicData, SubData);
end;

procedure TItemGen.EndProcess;
var
   SubData : TSubData;
begin
   Phone.SendMessage (0, FM_DESTROY, BasicData, SubData);
   Phone.UnRegisterUser (BasicData.id, BasicData.x, BasicData.y);

   inherited EndProcess;
end;

function TItemGen.FieldProc (hfu: Longint; Msg: word; var SenderInfo: TBasicData; var aSubData: TSubData): Integer;
begin
   Result := PROC_FALSE;

   if isRangeMessage (hfu, Msg, SenderInfo) = FALSE then exit;
   Result := inherited FieldProc (hfu, Msg, Senderinfo, aSubData);
   if Result = PROC_TRUE then exit;
end;

procedure TItemGen.Update (CurTick: integer);
var
   i, iCount : Integer;
   xx, yy : Word;
   BasicObject : TBasicObject;
   SubData : TSubData;
begin
   if CurTick < UpdatedTick + 100 then exit;
   UpdatedTick := CurTick;

   iCount := 0;
   for i := 0 to ViewObjectList.Count - 1 do begin
      BasicObject := ViewObjectList.Items [i];
      if BasicObject.BasicData.ClassKind = CLASS_ITEM then begin
         if StrPas (@BasicObject.BasicData.Name) = SelfData.ItemName then begin
            Inc (iCount);
         end;
      end;
   end;

   if CurTick >= CreatedTick + SelfData.CreateInterval then begin
      ItemClass.GetItemData (SelfData.ItemName, SubData.ItemData);

      SignToItem (SubData.ItemData, ServerID, BasicData, '');
      SubData.ItemData.rCount := 1;
      SubData.ServerId := ServerID;

      if SubData.ItemData.rName [0] <> 0 then begin
         for i := 0 to SelfData.ItemCount - iCount - 1 do begin
            xx := SelfData.ItemCreateX - SelfData.ItemCreateW + Random(SelfData.ItemCreateW * 2);
            yy := SelfData.ItemCreateY - SelfData.ItemCreateW + Random(SelfData.ItemCreateW * 2);

            if not Maper.isMoveable (xx, yy) then continue;

            BasicData.nX := xx;
            BasicData.nY := yy;

            Phone.SendMessage (MANAGERPHONE, FM_ADDITEM, BasicData, SubData);
         end;
      end;
      CreatedTick := CurTick;
   end;
   if CurTick >= RegenedTick + SelfData.RegenInterval then begin
      ItemClass.GetItemData (SelfData.ItemName, SubData.ItemData);

      SignToItem (SubData.ItemData, ServerID, BasicData, '');
      SubData.ItemData.rCount := 1;
      SubData.ServerId := ServerID;

      if SubData.ItemData.rName [0] <> 0 then begin
         if iCount > 0 then begin
            xx := SelfData.ItemRegenX - SelfData.ItemRegenW + Random(SelfData.ItemRegenW * 2);
            yy := SelfData.ItemRegenY - SelfData.ItemRegenW + Random(SelfData.ItemRegenW * 2);

            if Maper.isMoveable (xx, yy) then begin
               BasicData.nX := xx;
               BasicData.nY := yy;

               Phone.SendMessage (MANAGERPHONE, FM_ADDITEM, BasicData, SubData);
            end;
         end;
      end;

      RegenedTick := CurTick;
   end;
end;

// TObjectChecker
constructor TObjectChecker.Create;
begin
   inherited Create;

   UpdatedTick := 0;

   HaveMonster := nil;
   HaveDynamicObject := nil;

   DataList := TList.Create;
end;

destructor TObjectChecker.Destroy;
begin
   if HaveMonster <> nil then begin
      HaveMonster.EndProcess;
      HaveMonster.Free;
      HaveMonster := nil;
   end;
   if HaveDynamicObject <> nil then begin
      HaveDynamicObject.EndProcess;
      HaveMonster.Free;
      HaveMonster := nil;
   end;

   DataList.Clear;
   DataList.Free;
   
   inherited Destroy;
end;

procedure TObjectChecker.Initial (aName : String; aX, aY: Integer);
begin
   inherited Initial (aName, '');

   BasicData.id := GetNewItemId;