basicobj.pas

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

unit BasicObj;

interface

uses
  Windows, Classes, SysUtils, svClass, SubUtil, uAnsTick, AnsUnit,
  FieldMsg, MapUnit, DefType, Autil32, uManager, AnsStringCls,
  uObjectEvent;

type
   TBasicObject = class
   private
      FCreateTick : integer;
      FCreateX, FCreateY : integer;
      function  GetPosx: integer;
      function  GetPosy: integer;
      function  GetFeatureState: TFeatureState;
   protected
      FboRegisted : Boolean;
      FboAllowDelete : Boolean;
      FboHaveGuardPos : Boolean;

      FAlarmTick : Integer;      
      
      function  isRange (xx, yy: word) : Boolean;
      function  isRangeMessage (hfu: Longint; Msg: word; var SenderInfo: TBasicData): Boolean;
      function  FieldProc (hfu: Longint; Msg: word; var SenderInfo: TBasicData; var aSubData: TSubData): Integer; dynamic;
      function  GetViewObjectById (aid: integer): TBasicObject;

      function  isHitedArea (adir, ax, ay: integer; afunc: byte; var apercent: integer) : Boolean;
      function  GetViewObjectByName (aName: string; aRace: integer): TBasicObject;
      procedure Initial (aName, aViewName : string);
      procedure StartProcess; dynamic;
      procedure EndProcess; dynamic;

      procedure BocChangeFeature;

      procedure BoSysopMessage (astr: string; aSysopScope: integer);
   public
      procedure SetManagerClass (aManager : TManager);
      function  SendLocalMessage (hfu: Longint; Msg: word; var SenderInfo: TBasicData; var aSubData: TSubData): Integer;
      procedure BocSay (astr: string);      
   public
      Manager : TManager;
      Maper : TMaper;
      Phone : TFieldPhone;
      ServerID : Integer;

      BasicData : TBasicData;                         // 傍侩函荐
      ViewObjectList : TList;

      constructor Create;
      destructor  Destroy; override;
      procedure   Update (CurTick: integer); dynamic;
      procedure   BocChangeProperty;

      function    FindViewObject (aBasicObject : TBasicObject) : Boolean;

      property    PosX : integer read GetPosX;
      property    PosY : integer read GetPosY;
      property    CreateX : integer read FCreateX;
      property    CreateY : integer read FCreateY;
      property    CreateTick : integer read FCreateTick;
      property    boAllowDelete: Boolean read FboAllowDelete write FboAllowDelete;
      property    boRegisted : Boolean read FboRegisted;
      property    State : TFeatureState read GetFeatureState;
   end;

   TItemObject = class (TBasicObject)
    private
     SelfItemData : TItemData;
     OwnerId : Integer;
     boAllowPickup : Boolean;
    protected
     procedure   Initial (aItemData: TItemData; aOwnerId, 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;

     property    AllowPickUp : Boolean read boAllowPickup;
   end;

   TItemList = class
   private
      Manager : TManager;

      DataList : TList;
      // function  AllocFunction: pointer;
      // procedure FreeFunction (item: pointer);
      function  GetCount: integer;
   public
      constructor Create (cnt: integer; aManager : TManager);
      destructor  Destroy; override;

      procedure   AllClear;
      procedure   AddItemObject (aItemData: TItemData; aOwnerId, ax, ay: integer);
      procedure   Update (CurTick: integer);
      property    Count : integer read GetCount;
   end;

   TGateObject = class (TBasicObject)
   private
      SelfData : TCreateGateData;

      boActive : Boolean;
      RegenedTick : Integer;
      RemainHour, RemainMin, RemainSec : Word;
   protected
      procedure   Initial;
      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;

      function    GetSelfData : PTCreateGateData;
   end;

   TGateList = class
   private
      DataList : TList;
      
      function  GetCount: integer;
   public
      constructor Create;
      destructor  Destroy; override;

      procedure   Clear;
      procedure   LoadFromFile (aFileName : String);

      procedure   Update (CurTick: integer);

      procedure   SetBSGateActive (boFlag : Boolean);

      property    Count : integer read GetCount;
   end;

   TMirrorObject = class (TBasicObject)
   private
      SelfData : TCreateMirrorData;

      ViewerList : TList;

      boActive : Boolean;
   protected
      procedure   Initial;
      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   AddViewer (aUser : Pointer);
      function    DelViewer (aUser : Pointer) : Boolean;

      procedure   Update (CurTick : Integer); override;

      function    GetSelfData : PTCreateMirrorData;
   end;

   TMirrorList = class
   private
      DataList : TList;

      function  GetCount: integer;
   public
      constructor Create;
      destructor  Destroy; override;

      function    AddViewer (aStr : String; aUser : Pointer) : Boolean;
      function    DelViewer (aUser : Pointer) : Boolean;

      procedure   Clear;
      procedure   LoadFromFile (aFileName : String);

      procedure   Update (CurTick: integer);

      property    Count : integer read GetCount;
   end;

   TStaticItem = class (TBasicObject)
    private
      CurDurability : integer;
      SelfItemData : TItemData;
      OwnerId : Integer;
    protected
      procedure   Initial (aItemData: TItemData; aOwnerId, 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;

   TStaticItemList = class
   private
      Manager : TManager;
      DataList : TList;
      // function  AllocFunction: pointer;
      // procedure FreeFunction (item: pointer);
      function  GetCount: integer;
   public
      constructor Create (cnt: integer; aManager: TManager);
      destructor  Destroy; override;

      procedure   Clear;

      function    AddStaticItemObject (aItemData: TItemData; aOwnerId, ax, ay: integer): integer;
      procedure   Update (CurTick: integer);
      property    Count : integer read GetCount;
   end;

   TDynamicObject = class (TBasicObject)
    private
     SelfData : TCreateDynamicObjectData;

     CurLife : Integer;
     EventItemCount : Integer;
     DragDropEvent : TDragDropEvent;

     MemberList : TList;
    protected
     function    FieldProc (hfu: Longint; Msg: word; var SenderInfo: TBasicData; var aSubData: TSubData): Integer; override;
    public
     OpenedTick : Integer;
     OpenedPosX, OpenedPosY : Word;
     ObjectStatus : TDynamicObjectState;
    public
     constructor Create;
     destructor  Destroy; override;

     procedure   Initial (pObjectData: PTCreateDynamicObjectData);
     procedure   StartProcess; override;
     procedure   EndProcess; override;

     procedure   Update (CurTick: integer); override;
     procedure   MemberDie (aBasicObject : TBasicObject);

     property    Status : TDynamicObjectState read ObjectStatus;
   end;

   TDynamicObjectList = class
   private
      Manager : TManager;

      DataList : TList;

      function  GetCount: integer;
   public
      constructor Create (cnt: integer; aManager: TManager);
      destructor  Destroy; override;

      procedure   Clear;
      procedure   ReLoadFromFile;

      function    AddDynamicObject (pObjectData: PTCreateDynamicObjectData): integer;
      function    DeleteDynamicObject (aName : String) : Boolean;
      function    FindDynamicObject (aName : STring) : Integer;

      function    GetDynamicObjects (aName : String; aList : TList) : Integer;
      
      procedure   Update (CurTick: integer);

      property    Count : integer read GetCount;
   end;

   procedure SignToItem (var aItemData : TItemData;aServerID : Integer; var aBasicData : TBasicData; aIP : String);

var
   boShowHitedValue : Boolean = FALSE;
   boShowGuildDuraValue : Boolean = FALSE;

   GateList : TGateList = nil;
   MirrorList : TMirrorList = nil;

implementation

uses
   SvMain, uUser, uNpc, uMonster, uSkills, uLevelExp, UserSDB;

///////////////////////////////
//        TBasicObject
///////////////////////////////

constructor TBasicObject.Create;
begin
   FillChar (BasicData, sizeof(BasicData), 0);
   BasicData.P := Self;
   ViewObjectList := TList.Create;
   // ViewObjectNameList := TStringList.Create;
end;

destructor TBasicObject.Destroy;
var
   i : Integer;
begin
   ViewObjectList.Free;
   // ViewObjectNameList.Free;
   inherited Destroy;
end;

function TBasicObject.FindViewObject (aBasicObject : TBasicObject) : Boolean;
var
   i : Integer;
   BasicObject : TBasicObject;
begin
   Result := false;
   for i := 0 to ViewObjectList.Count - 1 do begin
      BasicObject := ViewObjectList.Items [i];
      if BasicObject = aBasicObject then begin
         Result := true;
         exit;
      end;
   end;
end;

function Check5Hit (adir, ax, ay, myx, myy: integer): integer;
var
   tempdir : byte;
   xx, yy: word;
begin
   Result := 0;

   tempdir := adir;
   xx := ax; yy := ay;
   GetNextPosition (tempdir, xx, yy);
   if (myx = xx) and (myy = yy) then begin Result := 100; exit; end;   //99

   tempdir := adir;
   tempdir := GetRightDirection (tempdir);
   xx := ax; yy := ay;
   GetNextPosition (tempdir, xx, yy);
   if (myx = xx) and (myy = yy) then begin Result := 99; exit; end;    //90

   tempdir := adir;
   tempdir := GetLeftDirection (tempdir);
   xx := ax; yy := ay;
   GetNextPosition (tempdir, xx, yy);
   if (myx = xx) and (myy = yy) then begin Result := 99; exit; end;    //90


   tempdir := adir;
   tempdir := GetRightDirection (tempdir);
   tempdir := GetRightDirection (tempdir);
   xx := ax; yy := ay;
   GetNextPosition (tempdir, xx, yy);
   if (myx = xx) and (myy = yy) then begin Result := 99; exit; end;     //80

   tempdir := adir;
   tempdir := GetLeftDirection (tempdir);
   tempdir := GetLeftDirection (tempdir);
   xx := ax; yy := ay;
   GetNextPosition (tempdir, xx, yy);
   if (myx = xx) and (myy = yy) then begin Result := 99; exit; end;     //80
end;

function Check8Hit (adir, ax, ay, myx, myy: integer): integer;
var
   tempdir : byte;
   xx, yy: word;
begin
   Result := 0;

   tempdir := adir;
   xx := ax; yy := ay;
   GetNextPosition (tempdir, xx, yy);
   if (myx = xx) and (myy = yy) then begin Result := 100; exit; end;      //100

   tempdir := GetRightDirection (tempdir);
   xx := ax; yy := ay;
   GetNextPosition (tempdir, xx, yy);
   if (myx = xx) and (myy = yy) then begin Result := 99; exit; end;       //70

   tempdir := GetRightDirection (tempdir);
   xx := ax; yy := ay;
   GetNextPosition (tempdir, xx, yy);
   if (myx = xx) and (myy = yy) then begin Result := 99; exit; end;       //70

   tempdir := GetRightDirection (tempdir);
   xx := ax; yy := ay;
   GetNextPosition (tempdir, xx, yy);
   if (myx = xx) and (myy = yy) then begin Result := 99; exit; end;       //85

   tempdir := GetRightDirection (tempdir);
   xx := ax; yy := ay;
   GetNextPosition (tempdir, xx, yy);
   if (myx = xx) and (myy = yy) then begin Result := 99; exit; end;       //85

   tempdir := GetRightDirection (tempdir);
   xx := ax; yy := ay;
   GetNextPosition (tempdir, xx, yy);