uguildsub.pas

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

unit uGuildSub;

interface

uses
   Windows, Sysutils, Classes, aDefType, Deftype, BasicObj, SvClass,
   SubUtil, uSkills, uLevelExp, uUser, aUtil32, uGramerid, AnsUnit,
   FieldMsg, MapUnit, AnsStringCls;


type
   TGuildUserData = record
     rName: string[32];
     rGradeName : string[32];
     rLastDay : integer;
   end;
   PTGuildUserData = ^TGuildUserData;

   TGuildUserList = Class
    private
     boChanged : boolean;
     IndexClass: TAnsIndexClass;
     DataList : TList;
    public
     constructor Create;
     destructor  Destroy; override;
     procedure   LoadFromFile (aFileName: string);
     procedure   SaveToFile (aFileName: string);
     procedure   Clear;
     procedure   AddUser (aUserName: string);
     function    DelUser (aUserName: string): Boolean;
     function    GetGradeName (aUserName: string): string;
     procedure   SetGradeName (aUserName, aGradeName: string);
     function    IsGuildUser (aUserName: string): Boolean;

     property    Changed : boolean read boChanged;
   end;

   TGuildNpc = class (TLifeObject)
   private
      pGuildNpcData : PTNpcData;
      TargetPosTick : integer;
      TargetX, TargetY : integer;
      TargetId : integer;
      ParentGuildObject : TBasicObject;
      
      function IsSysopName (aname: string) : boolean;
      procedure  SetTargetId (aid: integer);
   protected
      procedure  SetNpcAttrib;
   public
      GuildNpcName : String;
      Sex : Byte;
      boMagicNpc : Boolean;
      StartX, StartY: integer;
      RestX, RestY: integer;
      GuildMagicData : TMagicData;

      constructor Create;
      destructor Destroy; override;
      procedure  StartProcess; override;
      procedure  EndProcess; override;
      function   FieldProc (hfu: Longint; Msg: word; var SenderInfo: TBasicData; var aSubData: TSubData): Integer; override;
      procedure  Initial (go : TBasicObject; aNpcName: string; ax, ay: integer; aSex : Byte);
      // procedure  SetSysop (aSysop, aSubSysop0, aSubSysop1, aSubSysop2: string);
      procedure  Update (CurTick: integer); override;

      procedure  MoveGuildNpc (aServerID, ax, ay: integer);
      procedure  MoveDieGuildNpc (aServerID, ax, ay: integer);
   end;

implementation

uses
   uGuild, uManager;

/////////////////////////////////
//      Guild User List
/////////////////////////////////
constructor TGuildUserList.Create;
begin
   boChanged := false;
   IndexClass := TAnsIndexClass.Create ('user', 20, TRUE);
   DataList := TList.Create;
end;

destructor  TGuildUserList.Destroy;
begin
   Clear;
   DataList.Free;
   IndexClass.Free;
   inherited destroy;
end;

procedure   TGuildUserList.Clear;
var i: integer;
begin
   for i := 0 to DataList.Count -1 do dispose (DataList[i]);
   DataList.Clear;
   IndexClass.Clear;
end;

procedure   TGuildUserList.LoadFromFile (aFileName: string);
var
   i: integer;
   str, rdstr: string;
   StringList : TStringList;
   p : PTGuildUserData;
begin
   Clear;
   if not FileExists (aFileName) then exit;

   StringList := TStringList.Create;
   StringList.LoadFromFile (aFileName);

   for i := 1 to StringList.Count -1 do begin    // 1何磐绰 霉临捞 鞘靛捞扁锭巩俊..
      str := StringList[i];
      new (p);
      str := GetValidStr3 (str, rdstr, ',');
      p^.rName := rdstr;
      str := GetValidStr3 (str, rdstr, ',');
      p^.rGradeName := rdstr;
      str := GetValidStr3 (str, rdstr, ',');
      p^.rLastDay := _StrToInt (rdstr);
      if p^.rLastDay = 0 then p^.rLastDay := GameCurrentDate;

      IndexClass.Insert (Integer(p), p^.rName);
      DataList.Add (p);
   end;
   StringList.Free;
end;

procedure   TGuildUserList.SaveToFile (aFileName: string);
var
   i: integer;
   str: string;
   StringList : TStringList;
   p : PTGuildUserData;
begin
   if boChanged = true then begin
      StringList := TStringList.Create;
      str := 'Name,GradeName,LastDay,';
      StringList.add (str);
      for i := 0 to DataList.Count -1 do begin
         p := DataList[i];
         str := p^.rName + ',' + p^.rGradeName + ',' + IntToStr (p^.rLastDay);
         StringList.Add (str);
      end;
      StringList.SaveToFile (aFileName);
      StringList.Free;
      boChanged := false;
   end;
end;

function    TGuildUserList.GetGradeName (aUserName: string): string;
var
   n : integer;
begin
   Result := '';
   n := IndexClass.Select (aUserName);
   if (n <> 0) and (n <> -1) then begin
      PTGuildUserData(n)^.rLastDay := GameCurrentDate;
      Result := PTGuildUserData (n)^.rGradeName;
   end;
end;

procedure   TGuildUserList.SetGradeName (aUserName, aGradeName: string);
var
   n : integer;
begin
   n := IndexClass.Select (aUserName);
   if (n <> 0) and (n <> -1) then begin
      PTGuildUserData (n)^.rGradeName := aGradeName;
      boChanged := true;
   end;
end;

procedure   TGuildUserList.AddUser (aUserName: string);
var
   n : integer;
   p : PTGuildUserData;
begin
   n := IndexClass.Select (aUserName);
   if (n <> 0) and (n <> -1) then exit
   else begin
      new (p);
      p^.rName := aUserName;
      p^.rGradeName := '';
      p^.rLastDay := GameCurrentDate;

      DataList.Add (p);
      IndexClass.Insert (Integer(p), aUserName);

      boChanged := true;
   end;
end;

function    TGuildUserList.IsGuildUser (aUserName: string): Boolean;
var
   n : integer;
begin
   n := IndexClass.Select (aUserName);
   if (n <> 0) and (n <> -1) then Result := TRUE
   else Result := FALSE;
end;

function    TGuildUserList.DelUser (aUserName: string): Boolean;
var i, n : integer;
begin
   n := IndexClass.Select (aUserName);
   if (n <> 0) and (n <> -1) then begin
      for i := 0 to DataList.Count -1 do begin
         if aUserName = PTGuildUserData (DataList[i])^.rname then begin
            dispose (DataList[i]);
            DataList.Delete (i);
            IndexClass.Delete (aUserName);
            boChanged := true;
            break;
         end;
      end;
      Result := TRUE;
   end else Result := FALSE;
end;

///////////////////////////////////////////


/////////////////////////////////////
//       Npc
////////////////////////////////////
constructor TGuildNpc.Create;
begin
   inherited Create;
   pGuildNpcData := nil;
   Sex := 1;
end;

destructor TGuildNpc.Destroy;
begin
   pGuildNpcData := nil;
   inherited destroy;
end;

procedure TGuildNpc.SetTargetId (aid: integer);
begin
   if aid = BasicData.id then exit;
   TargetId := aid;

   if TargetID <> 0 then LifeObjectState := los_attack
   else LifeObjectState := los_none;
end;

procedure TGuildNpc.SetNpcAttrib;
begin
   if pGuildNpcData = nil then exit;

   LifeData.damagebody      := LifeData.damagebody      + pGuildNpcData^.rDamage;
   LifeData.damagehead      := LifeData.damagehead      + 0;
   LifeData.damagearm       := LifeData.damagearm       + 0;
   LifeData.damageleg       := LifeData.damageleg       + 0;
   LifeData.AttackSpeed     := LifeData.AttackSpeed     + pGuildNpcData^.rAttackSpeed;
   LifeData.avoid           := LifeData.avoid           + pGuildNpcData^.ravoid;
   LifeData.recovery        := LifeData.recovery        + pGuildNpcData^.rrecovery;
   LifeData.armorbody       := LifeData.armorbody       + pGuildNpcData^.rarmor;
   LifeData.armorhead       := LifeData.armorhead       + pGuildNpcData^.rarmor;
   LifeData.armorarm        := LifeData.armorarm        + pGuildNpcData^.rarmor;
   LifeData.armorleg        := LifeData.armorleg        + pGuildNpcData^.rarmor;

   BasicData.Feature.raninumber := pGuildNpcData^.rAnimate;
   BasicData.Feature.rImageNumber := pGuildNpcData^.rShape;

   MaxLife := pGuildNpcData^.rLife;

   SoundNormal := pGuildNpcData^.rSoundNormal;
   SoundAttack := pGuildNpcData^.rSoundAttack;
   SoundDie := pGuildNpcData^.rSoundDie;
   SoundStructed := pGuildNpcData^.rSoundStructed;
end;

{
procedure  TGuildNpc.SetSysop (aSysop, aSubSysop0, aSubSysop1, aSubSysop2: string);
begin
   SysopName := aSysop;
   SubSysopName0 := aSubSysop0;
   SubSysopName1 := aSubSysop1;
   SubSysopName2 := aSubSysop2;
end;
}
function TGuildNpc.IsSysopName (aname : String) : boolean;
var
   i : Integer;
   pd : PTCreateGuildData;
begin
   Result := TRUE;
   if ParentGuildObject <> nil then begin
      pd := TGuildObject (ParentGuildObject).GetSelfData;
      if pd^.Sysop = aname then exit;
      for i := 0 to MAX_SUBSYSOP_COUNT - 1 do begin
         if pd^.SubSysop[i] = aname then exit;
      end;
   end;

   Result := FALSE;
end;

procedure  TGuildNpc.Initial (go : TBasicObject; aNpcName: string; ax, ay: integer; aSex : Byte);
begin
   inherited Initial (aNpcName, aNpcName);

   GuildNpcName := aNpcName;
   Sex := aSex;

   boMagicNpc := FALSE;
   FillChar (GuildMagicData, sizeof(TMagicData), 0);

   ParentGuildObject := go;

   if Sex = 2 then begin
      NpcClass.GetNpcData (INI_GUILD_NPCWOMAN_NAME, pGuildNpcData);
   end else begin
      NpcClass.GetNpcData (INI_GUILD_NPCMAN_NAME, pGuildNpcData);
   end;

   Basicdata.id := GetNewMonsterId;
   BasicData.x := ax;
   BasicData.y := ay;
   BasicData.dir := DR_4;
   BasicData.ClassKind := CLASS_GUILDNPC;
   BasicData.Feature.rrace := RACE_NPC;
   StrPCopy (@BasicData.Name, aNpcName);
   StrPCopy (@BasicData.ViewName, aNpcName);

   SetNpcAttrib;

   TargetId := 0;
   TargetPosTick := 0;

   // 2000.09.16 TargetX, TargetY 啊 瘤沥登瘤 臼酒 辑滚啊 矫累等 饶 NPC甸狼
   // 悼累捞 裙老利栏肺 合辑率阑 氢茄促. 檬扁 困摹甫 持绢霖促 by Lee.S.G
   TargetX := aX; TargetY := aY;
   RestX := aX; RestY := aY;
   StartX := aX; StartY := aY;
end;

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

   CurLife := MaxLife;

   BasicData.Feature.rhitmotion := AM_HIT1;
   TFieldPhone(Manager.Phone).RegisterUser (BasicData.id, FieldProc, BasicData.X, BasicData.Y);
   TFieldPhone(Manager.Phone).SendMessage (0, FM_CREATE, BasicData, SubData);
end;

procedure TGuildNpc.EndProcess;
var SubData : TSubData;
begin
   if FboRegisted = FALSE then exit;
   
   TFieldPhone (Manager.Phone).SendMessage (0, FM_DESTROY, BasicData, SubData);
   TFieldPhone (Manager.Phone).UnRegisterUser (BasicData.id, BasicData.x, BasicData.y);
   inherited EndProcess;
end;

procedure TGuildNpc.MoveGuildNpc (aServerID, ax, ay: integer);
var
   tmpManager : TManager;
   SubData : TSubData;
   nX, nY : Integer;
begin
   tmpManager := ManagerList.GetManagerByServerID (aServerID);

   TFieldPhone (Manager.Phone).SendMessage (NOTARGETPHONE, FM_DESTROY, BasicData, SubData);
   TFieldPhone (Manager.Phone).UnRegisterUser (BasicData.id, BasicData.x, BasicData.y);

   nX := aX; nY := aY;
   TMaper(tmpManager.Maper).GetNearXY (nX, nY);
   StartX := nX; StartY := nY;
   TargetX := nX; TargetY := nY;
   RestX := nX; RestY := nY;
   BasicData.x := nX; BasicData.y := nY;

   SetManagerClass (tmpManager);

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

procedure TGuildNpc.MoveDieGuildNpc (aServerID, ax, ay: integer);
var
   tmpManager : TManager;
   nX, nY : Integer;
begin