objnpc.pas

传奇源代码的delphi版本

    procedure GetVariableText(PlayObject:TPlayObject;var sMsg:String;sVariable:String);virtual; //FFE9
    function  GetLineVariableText(PlayObject:TPlayObject;sMsg:String):String;
    procedure GotoLable(PlayObject: TPlayObject;sLabel:String;boExtJmp:Boolean);
    function  sub_49ADB8(sMsg,sStr,sText:String):String;
    procedure LoadNPCScript();
    procedure ClearScript();virtual;
    procedure SendMsgToUser(PlayObject:TPlayObject;sMsg:String);
    procedure SendCustemMsg(PlayObject:TPlayObject;sMsg:String);virtual;
  end;
  TMerchant = class(TNormNpc) //0x594
    m_sScript         :String;  //0x568
    n56C              :Integer;
    m_nPriceRate      :Integer; //0x570   物品价格倍率 默认为 100%
    bo574             :Boolean;
    m_boCastle        :Boolean; //0x575
    dwRefillGoodsTick :LongWord; //0x578
    dwClearExpreUpgradeTick         :LongWord; //0x57C
    m_ItemTypeList    :TList;   //0x580  NPC买卖物品类型列表，脚本中前面的 +1 +30 之类的
    m_RefillGoodsList :TList;   //0x584
    m_GoodsList       :TList;   //0x588
    m_ItemPriceList   :TList;  //0x58C
    m_UpgradeWeaponList :TList;
    m_boCanMove :Boolean;
    m_dwMoveTime        :LongWord;
    m_dwMoveTick        :LongWord;
    m_boBuy             :Boolean;
    m_boSell            :Boolean;
    m_boMakeDrug        :Boolean;
    m_boMakeGem         :Boolean;
    m_boPrices          :Boolean;
    m_boStorage         :Boolean;
    m_boConsignment     :Boolean;
    m_boGetback         :Boolean;
    m_boUpgradenow      :Boolean;
    m_boGetBackupgnow   :Boolean;
    m_boRepair          :Boolean;
    m_boS_repair        :Boolean;
    m_boSendmsg         :Boolean;
    m_boGetMarry        :Boolean;
    m_boGetMaster       :Boolean;
    m_boUseItemName     :Boolean;
  private
    procedure ClearExpreUpgradeListData();
    function GetItemPrice(nIndex:Integer): Integer;
    function GetUserPrice(PlayObject:TPlayObject;nPrice: Integer): Integer;
    function CheckItemType(nStdMode: Integer): Boolean;
    procedure CheckItemPrice(nIndex: Integer);
    function  GetRefillList(nIndex: Integer): TList;
    procedure AddItemPrice(nIndex, nPrice: Integer);
    function GetUserItemPrice(UserItem: pTUserItem): Integer;
    function GetSellItemPrice(nPrice:integer):Integer;
    function AddItemToGoodsList(UserItem:pTUserItem):Boolean;
    procedure GetBackupgWeapon(User: TPlayObject);
    procedure UpgradeWapon(User: TPlayObject);
    procedure ChangeUseItemName(PlayObject:TPlayObject;sLabel,sItemName:String);
    procedure SaveUpgradingList;
    procedure GetMarry(PlayObject:TPlayObject;sDearName:String);
    procedure GetMaster(PlayObject:TPlayObject;sMasterName:String);
  public
    constructor Create();override;
    destructor Destroy; override;
    function  Operate(ProcessMsg:pTProcessMessage):Boolean; override;
    procedure Run;override;
    procedure UserSelect(PlayObject:TPlayObject;sData:String);override;
    procedure LoadNPCData();
    procedure SaveNPCData();
    procedure LoadUpgradeList();
    procedure RefillGoods();
    procedure LoadNPCScript();
    procedure Click(PlayObject: TPlayObject);override;
    procedure ClearScript();override;
    procedure ClearData();
    procedure GetVariableText(PlayObject:TPlayObject;var sMsg:String;sVariable:String);override; //FFE9
    procedure ClientBuyItem(PlayObject:TPlayObject;sItemName:String;nInt:Integer);
    procedure ClientGetDetailGoodsList(PlayObject:TPlayObject;sItemName:String;nInt:Integer);
    procedure ClientQuerySellPrice(PlayObject:TPlayObject;UserItem:pTUserItem;nAmount:Integer);
    function  ClientSellItem(PlayObject:TPlayObject;UserItem:pTUserItem;nAmount:Integer):Boolean;
    procedure ClientMakeDrugItem(PlayObject:TPlayObject;sItemName:String);
    procedure ClientQueryRepairCost(PlayObject:TPlayObject;UserItem:pTUserItem);
    function  ClientRepairItem(PlayObject:TPlayObject;UserItem:pTUserItem):Boolean;
    procedure ClientRequestGTList(PlayObject:TPlayObject;PageCount:byte);
    procedure ClientDeleteBBSMsg(PlayObject:TPlayObject;Index:integer);
    procedure ClientRequestDecoList(PlayObject:TPlayObject;PageCount:byte);
  //  procedure ClientRequestGameShopList(PlayObject:TPlayObject;PageCount:byte);
    procedure ClientBuyGT(PlayObject:TPlayObject;GTNumber:byte);
    procedure ClientBuyDecoItem(PlayObject:TPlayObject;Appr:integer);
    procedure ClientRequestBBSMsgList(PlayObject:TPlayObject;Pagecount:byte);
    procedure ClientRequestBBSMsg(PlayObject:TPlayObject;Index:integer);
    procedure ClientPostBBSMsg(PlayObject:TPlayObject;sMsg:String;boSticky:boolean; MasterPost:integer);
    procedure SendCustemMsg(PlayObject:TPlayObject;sMsg:String);override;
  end;
  TGuildOfficial = class(TNormNpc) //0x568
  private
    function ReQuestBuildGuild(PlayObject: TPlayObject;
      sGuildName: String): Integer;
    function ReQuestGuildWar(PlayObject: TPlayObject;
      sGuildName: String): Integer;
    procedure DoNate(PlayObject: TPlayObject);
    procedure ReQuestCastleWar(PlayObject: TPlayObject; sIndex: String);
  public
    constructor Create();override;
    destructor Destroy; override;
    procedure GetVariableText(PlayObject:TPlayObject;var sMsg:String;sVariable:String);override; //FFE9    
    procedure Run;override; //FFFB
    procedure Click(PlayObject: TPlayObject);override; //FFEB
    procedure UserSelect(PlayObject:TPlayObject;sData:String);override; //FFEA
    procedure SendCustemMsg(PlayObject:TPlayObject;sMsg:String);override;    
  end;
  TTrainer = class(TNormNpc) //0x574
    n564    :Integer;
    m_dw568    :LongWord;
    n56C    :Integer;
    n570    :Integer;
  private
  public
    constructor Create();override;
    destructor Destroy; override;
    function  Operate(ProcessMsg:pTProcessMessage):Boolean; override;//FFFC
    procedure Run;override;    
  end;
//  TCastleManager = class(TMerchant)
  TCastleOfficial = class(TMerchant)
  private
    procedure HireArcher(sIndex: String;PlayObject:TPlayObject);
    procedure HireGuard(sIndex: String;PlayObject:TPlayObject);
    procedure RepairDoor(PlayObject: TPlayObject);
    procedure RepairWallNow(nWallIndex:Integer;PlayObject:TPlayObject);
  public
    constructor Create();override;
    destructor Destroy; override;  
    procedure Click(PlayObject: TPlayObject);override; //FFEB
    procedure UserSelect(PlayObject:TPlayObject;sData:String);override; //FFEA
    procedure GetVariableText(PlayObject:TPlayObject;var sMsg:String;sVariable:String);override; //FFE9
    procedure SendCustemMsg(PlayObject:TPlayObject;sMsg:String);override;    
  end;
implementation

uses Castle, M2Share, HUtil32, LocalDB, Envir, Guild, EDcode, ObjMon2,
  Event, ItmUnit, GuildTerritory;

procedure TCastleOfficial.Click(PlayObject: TPlayObject); //004A4588
begin
  if m_Castle = nil then begin
    PlayObject.SysMsg('NPC error: no castle found',c_Red,t_Hint);
    exit;
  end;
  if TUserCastle(m_Castle).IsMasterGuild(TGUild(PlayObject.m_MyGuild)) or (PlayObject.m_btPermission >= 3)then
    inherited;
end;

procedure TCastleOfficial.GetVariableText(PlayObject: TPlayObject;
  var sMsg: String; sVariable: String);
var
  sText:String;
  CastleDoor:TCastleDoor;
begin
  inherited;
  if m_Castle = nil then begin
    sMsg:='????';
    exit;
  end;
  if sVariable = '$CASTLEGOLD' then begin
    sText:=IntToStr(TUserCastle(m_Castle).m_nTotalGold);
    sMsg:=sub_49ADB8(sMsg,'<$CASTLEGOLD>',sText);
  end else
  if sVariable = '$TODAYINCOME' then begin
    sText:=IntToStr(TUserCastle(m_Castle).m_nTodayIncome);
    sMsg:=sub_49ADB8(sMsg,'<$TODAYINCOME>',sText);
  end else
  if sVariable = '$CASTLEDOORSTATE' then begin
    CastleDoor:=TCastleDoor(TUserCastle(m_Castle).m_MainDoor.BaseObject);
    if CastleDoor.m_boDeath then sText:='destroyed'
    else if CastleDoor.m_boOpened then sText:='opened'
    else sText:='closed';
    sMsg:=sub_49ADB8(sMsg,'<$CASTLEDOORSTATE>',sText);
  end else
  if sVariable = '$REPAIRDOORGOLD' then begin
    sText:=IntToStr(g_Config.nRepairDoorPrice);
    sMsg:=sub_49ADB8(sMsg,'<$REPAIRDOORGOLD>',sText);
  end else
  if sVariable = '$REPAIRWALLGOLD' then begin
    sText:=IntToStr(g_Config.nRepairWallPrice);
    sMsg:=sub_49ADB8(sMsg,'<$REPAIRWALLGOLD>',sText);
  end else
  if sVariable = '$GUARDFEE' then begin
    sText:=IntToStr(g_Config.nHireGuardPrice);
    sMsg:=sub_49ADB8(sMsg,'<$GUARDFEE>',sText);
  end else
  if sVariable = '$ARCHERFEE' then begin
    sText:=IntToStr(g_Config.nHireArcherPrice);
    sMsg:=sub_49ADB8(sMsg,'<$ARCHERFEE>',sText);
  end else
  if sVariable = '$GUARDRULE' then begin
    sText:='无效';
    sMsg:=sub_49ADB8(sMsg,'<$GUARDRULE>',sText);
  end;

end;
procedure TCastleOfficial.UserSelect(PlayObject: TPlayObject; sData: String);
var
  s18,s20,sMsg,sLabel:String;
  boCanJmp:Boolean;
ResourceString
  sExceptionMsg = '[Exception] TCastleManager::UserSelect... ';
begin
  inherited;
  try
//    PlayObject.m_nScriptGotoCount:=0;
    if m_Castle = nil then begin
      PlayObject.SysMsg('This Npc is not standing inside any Castle',c_Red,t_Hint);
      exit;
    end;
    if (sData <> '') and (sData[1] = '@') then begin
      sMsg:=GetValidStr3(sData,sLabel,[#13]);
      s18:='';
      PlayObject.m_sScriptLable:=sData;
      if TUserCastle(m_Castle).IsMasterGuild(TGUild(PlayObject.m_MyGuild)) and (PlayObject.IsGuildMaster) then begin
        boCanJmp:= PlayObject.LableIsCanJmp(sLabel);
        if CompareText(sLabel,sSL_SENDMSG) = 0 then begin
          if sMsg = '' then exit;
        end;
        GotoLable(PlayObject,sLabel,not boCanJmp);
        //GotoLable(PlayObject,sLabel,not PlayObject.LableIsCanJmp(sLabel));
        if not boCanJmp then exit;
        if CompareText(sLabel,sSL_SENDMSG) = 0 then begin
          SendCustemMsg(PlayObject,sMsg);
          PlayObject.SendMsg(Self,RM_MENU_OK,0,Integer(Self),0,0,s18);
        end else        
        if CompareText(sLabel,sCASTLENAME) = 0 then begin
          sMsg:=Trim(sMsg);
          if sMsg <> '' then begin
            TUserCastle(m_Castle).m_sName:=sMsg;
            TUserCastle(m_Castle).Save;
            TUserCastle(m_Castle).m_MasterGuild.RefMemberName;
            s18:='CastleName changed...';
          end else begin
            s18:='You did not enter a new castle name';
          end;
          PlayObject.SendMsg(Self,RM_MENU_OK,0,Integer(Self),0,0,s18);
        end else
        if CompareText(sLabel,sWITHDRAWAL) = 0 then begin
          case TUserCastle(m_Castle).WithDrawalGolds(PlayObject,Str_ToInt(sMsg,0)) of
            -4: s18:='You have entered an invalid amount, please check and re-enter.';
            -3: s18:='This will exceed the maximum gold you are allowed to carry.\Please enter a lower amount';
            -2: s18:='There is not enough gold in the castle bank.';
            -1: s18:='Only Guildchief of ' + TUserCastle(m_Castle).m_sOwnGuild + ' can use that service.';
            1: GotoLable(PlayObject,sMAIN,False);
          end;
          PlayObject.SendMsg(Self,RM_MENU_OK,0,Integer(Self),0,0,s18);
        end else
        if CompareText(sLabel,sRECEIPTS) = 0 then begin
          case TUserCastle(m_Castle).ReceiptGolds(PlayObject,Str_ToInt(sMsg,0)) of
            -4: s18:='You have entered an invalid amount, please check and re-enter.';
            -3: s18:='This will exceed the maximum gold allowed to be held in the bank.\Please enter a lower amount.';
            -2: s18:='You do not have enough gold.';
            -1: s18:='Only Guildchief of ' + TUserCastle(m_Castle).m_sOwnGuild + ' can use that service.';
            1: GotoLable(PlayObject,sMAIN,False);
          end;
          PlayObject.SendMsg(Self,RM_MENU_OK,0,Integer(Self),0,0,s18);
        end else
        if CompareText(sLabel,sOPENMAINDOOR) = 0 then begin
          TUserCastle(m_Castle).MainDoorControl(False);
        end else
        if CompareText(sLabel,sCLOSEMAINDOOR) = 0 then begin
          TUserCastle(m_Castle).MainDoorControl(True);
        end else
        if CompareText(sLabel,sREPAIRDOORNOW) = 0 then begin
          RepairDoor(PlayObject);
          GotoLable(PlayObject,sMAIN,False);
        end else
        if CompareText(sLabel,sREPAIRWALLNOW1) = 0 then begin
          RepairWallNow(1,PlayObject);
          GotoLable(PlayObject,sMAIN,False);
        end else
        if CompareText(sLabel,sREPAIRWALLNOW2) = 0 then begin