uguild.pas

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

unit uGuild;

interface

uses
  Windows, Classes, SysUtils, svClass, subutil, uAnsTick, AnsUnit,
  BasicObj, FieldMsg, MapUnit, DefType, Autil32, uMonster, uGramerid, UUser,
  IniFiles, uLevelexp, uManager, AnsStringCls, UserSDB;

const
   // DEC_GUILD_DURA_TICK = 200;
   DEC_GUILD_DURA_TICK = 500;

   // 2000.09.16 巩颇檬籍狼 郴备己 刘啊摹 5000栏肺 荐沥 by Lee.S.G
   // ADD_GUILD_DURA_BY_SYSOP = 4000;
   ADD_GUILD_DURA_BY_SYSOP = 5000;
   ADD_GUILD_DURA_BY_SUBSYSOP = 1000;
   DEC_GUILD_DURA_BY_HIT = 20;

   MAX_GUILD_DURA = 1100000;

   GUILDSTONE_IMAGE_NUMBER = 67;

   MAX_SUBSYSOP_COUNT = 3;
   MAX_AGREESUBSYSOP_COUNT = 1;
   MAX_AGREECHAR_COUNT = 1;
   MAX_GUILDNPC_COUNT = 5;
   MaX_GUILDWEAR_COUNT = 2;

type
   TGuildObject = class (TBasicObject)
   private
      FGuildName : String;
      SelfData : TCreateGuildData;
      MakeGuildData : PTMakeGuildData;

      GuildNpcList : TList;
      DieGuildNpcList : TList;
      GuildUserList : TGuildUserList;
      DuraTick : integer;

      boAddGuildMagic : Boolean;

      AgreeList : TStringList;

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

      procedure   Clear;
      procedure   LoadFromFile (aGuildName: String);
      procedure   SaveToFile;

      procedure   GetGuildInfo (aUser: TUser);
      function    MoveStone (aServerID, ax, ay: integer) : Boolean;
      function    CreateStone (aSysopName : String; aServerID, ax, ay: integer) : Boolean;

      function    MakeGuild (aMakeGuildData : PTCMakeGuildData; aUser : TUser) : Boolean;
      procedure   AgreeMakeGuild (aName : String; aFlag : Boolean);
      procedure   ShowGuildInfo (aUser : TUser);

      procedure   Update (CurTick: integer); override;

      function    IsGuildUser (aName : String) : Boolean;
      function    IsGuildNpc (aName : String) : Boolean;

      function    GetSelfData : PTCreateGuildData;

      property    GuildName : String read FGuildName;
   end;

   TGuildList = class
   private
      CurProcessPos : Integer;
      DataList : TList;
      
      function    GetCount: Integer;
   public
      constructor Create;
      destructor  Destroy; override;

      procedure   Clear;

      procedure   LoadFromFile (aFileName : String);
      procedure   SaveToFile (aFileName : String);

      function    GetGuildBySysop (aSysopName : String) : TGuildObject;
      function    GetGuildByName (aGuildName : String) : TGuildObject;
      
      procedure   AllowGuildName (gid: integer; aboAllow: Boolean; aGuildName, aSysopName: string);
      function    AllowGuildCondition (gname, uname: String; var aRetStr : String) : Boolean; 
      function    AddGuildObject (aGuildName, aOwnerName : String; aServerID, aX, aY: integer): TGuildObject;
      function    GetUserGrade (aGuildName, uname: string): string;
      function    GetGuildServerID (aGuildName : String): Integer;
      procedure   GetGuildInfo (aGuildName: string; aUser: TUser);
      function    CheckGuildUser(aGuildName, aName : String) : Boolean;
      function    MoveStone (aGuildName : string; aServerID, ax, ay: integer) : Boolean;
      function    CreateStone (aGuildName, aSysopName : string; aServerID, ax, ay: integer) : Boolean;
      procedure   DeleteStone (aGuildName : String);
      procedure   CompactGuild;

      procedure   Update (CurTick: integer);
      property    Count : integer read GetCount;
   end;

var
   GuildList : TGuildList;

implementation

uses
   SVMain;

////////////////////////////////////////////////////
//
//             ===  GuildObject  ===
//
////////////////////////////////////////////////////

constructor TGuildObject.Create;
begin
   inherited Create;

   FGuildName := '';

   FillChar (SelfData, SizeOf (TCreateGuildData), 0);
   MakeGuildData := nil;

   GuildNpcList := TList.Create;
   DieGuildNpcList := TList.Create;
   GuildUserList := TGuildUserList.Create;

   AgreeList := TStringList.Create;
end;

destructor  TGuildObject.Destroy;
begin
   if MakeGuildData <> nil then begin
      Dispose (MakeGuildData);
      MakeGuildData := nil;
   end;

   Clear;
   GuildUserList.Free;
   GuildNpcList.Free;
   DieGuildNpcList.Free;
   
   AgreeList.Free;

   inherited Destroy;
end;

procedure TGuildObject.Clear;
var
   i : Integer;
   GuildNpc : TGuildNpc;
begin
   for i := 0 to DieGuildNpcList.Count - 1 do begin
      GuildNpc := DieGuildNpcList.Items [i];
      GuildNpc.Free;
   end;
   DieGuildNpcList.Clear;
   
   for i := 0 to GuildNpcList.Count - 1 do begin
      GuildNpc := GuildNpcList.Items [i];
      GuildNpc.EndProcess;
      GuildNpc.Free;
   end;
   GuildNpcList.Clear;
   GuildUserList.Clear;
end;

function TGuildObject.GetSelfData : PTCreateGuildData;
begin
   Result := @SelfData;
end;

function TGuildObject.IsGuildUser (aName : String) : boolean;
begin
   Result := GuildUserList.IsGuildUser(aName);
end;

function TGuildObject.IsGuildNpc (aName : String) : Boolean;
var
   i : Integer;
   GuildNpc : TGuildNpc;
begin
   Result := false;

   if aName = '' then exit;
   
   for i := 0 to GuildNpcList.Count - 1 do begin
      GuildNpc := GuildNpcList.Items [i];
      if GuildNpc.GuildNpcName = aName then begin
         Result := true;
         exit;
      end;
   end;
   for i := 0 to DieGuildNpcList.Count - 1 do begin
      GuildNpc := DieGuildNpcList.Items [i];
      if GuildNpc.GuildNpcName = aName then begin
         Result := true;
         exit;
      end;
   end;
end;

procedure TGuildObject.SaveToFile;
var
   i, j, nIndex : Integer;
   GuildNpc : TGuildNpc;
begin
   if SelfData.Name = '' then exit;

   FillChar (SelfData.GuildNpc, SizeOf (SelfData.GuildNpc), 0);
   nIndex := 0;
   for i := 0 to GuildNpcList.Count - 1 do begin
      GuildNpc := GuildNpcList.Items [i];
      if GuildNpc.boMagicNpc = true then begin
         SelfData.MagicExp := GuildNpc.GuildMagicData.rSkillExp;
      end;
      SelfData.GuildNpc[nIndex].rName := GuildNpc.GuildNpcName;
      SelfData.GuildNpc[nIndex].rX := GuildNpc.StartX;
      SelfData.GuildNpc[nIndex].rY := GuildNpc.StartY;
      Inc (nIndex);
   end;
   for i := 0 to DieGuildNpcList.Count - 1 do begin
      GuildNpc := DieGuildNpcList.Items [i];
      if GuildNpc.boMagicNpc = true then begin
         SelfData.MagicExp := GuildNpc.GuildMagicData.rSkillExp;
      end;
      SelfData.GuildNpc[nIndex].rName := GuildNpc.GuildNpcName;
      SelfData.GuildNpc[nIndex].rX := GuildNpc.StartX;
      SelfData.GuildNpc[nIndex].rY := GuildNpc.StartY;
      Inc (nIndex);
   end;

   GuildUserList.SaveToFile ('.\Guild\' + SelfData.Name + 'GUser.sdb');
end;

procedure TGuildObject.LoadFromFile;
begin
   if not FileExists ('.\Guild\' + SelfData.Name + 'GUser.SDB') then exit;

   GuildUserList.LoadFromFile ('.\Guild\' + SelfData.Name + 'GUser.sdb');
end;

function TGuildObject.GetUserGrade (uName: String) : String;
var
   i : Integer;
begin
   if uName = SelfData.Sysop then
      inc (SelfData.Durability, ADD_GUILD_DURA_BY_SYSOP);
   for i := 0 to MAX_SUBSYSOP_COUNT - 1 do begin
      if uName = SelfData.SubSysop[i] then
         inc (SelfData.Durability, ADD_GUILD_DURA_BY_SUBSYSOP);
   end;
   if SelfData.Durability > SelfData.MaxDurability then
      SelfData.Durability := SelfData.MaxDurability;

   Result := GuildUserList.GetGradeName (uName);
end;

procedure TGuildObject.GetGuildInfo (aUser: TUser);
var
   i : Integer;
   tmpStr, Sep : String;
begin
   tmpStr := SelfData.Name + ' (' + IntToStr (BasicData.X) + ',' + IntToStr (BasicData.Y) + ')';
   aUser.SendClass.SendChatMessage ('巩颇捞抚 : ' + tmpStr, SAY_COLOR_NORMAL);
   aUser.SendClass.SendChatMessage ('巩林 : ' + SelfData.Sysop, SAY_COLOR_NORMAL);

   tmpStr := '何巩林 : ';
   Sep := '';
   for i := 0 to MAX_SUBSYSOP_COUNT - 1 do begin
      if SelfData.SubSysop[i] <> '' then begin
         tmpStr := tmpStr + Sep + SelfData.SubSysop[i] + Sep;
         Sep := ', ';
      end;
   end;
   aUser.SendClass.SendChatMessage (tmpStr, SAY_COLOR_NORMAL);
end;

function TGuildObject.AddGuildNpc (aName: string; ax, ay: integer): Boolean;
var
   i : integer;
   GuildNpc : TGuildNpc;
begin
   Result := FALSE;

   if GetGuildNpcByName (aName) <> -1 then exit;

   for i := 0 to MAX_GUILDNPC_COUNT - 1 do begin
      if SelfData.GuildNpc[i].rName = '' then begin
         SelfData.GuildNpc[i].rName := aName;
         SelfData.GuildNpc[i].rX := aX;
         SelfData.GuildNpc[i].rY := aY;

         GuildNpc := TGuildNpc.Create;
         GuildNpc.SetManagerClass (Manager);

         GuildNpc.Initial (Self, SelfData.GuildNpc[i].rName, SelfData.GuildNpc[i].rX, SelfData.GuildNpc[i].rY);

         if (SelfData.GuildMagic <> '') and (boAddGuildMagic = false) then begin
            GuildNpc.boMagicNpc := true;
            StrPCopy (@GuildNpc.BasicData.Guild, SelfData.GuildMagic);
            MagicClass.GetMagicData (SelfData.GuildMagic, GuildNpc.GuildMagicData, SelfData.MagicExp);
            boAddGuildMagic := true;
         end;
         DieGuildNpcList.Add (GuildNpc);
         
         Result := TRUE;
         exit;
      end;
   end;
end;

function  TGuildObject.FieldProc (hfu: Longint; Msg: word; var SenderInfo: TBasicData; var aSubData: TSubData): Integer;
var
   i, n, percent : integer;
//   xx, yy: word;
   str1, str2, str3: string;
   str, gname : string;
   sayer, objectname, gradename: string;
   SubData: TSubData;