objnpc.~pas

飘飘的传奇服务端院代码 能编译的 要控件 老大就让我传上去吧

        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
          RepairWallNow(2, PlayObject);
          GotoLable(PlayObject, sMAIN, False);
        end else
          if CompareText(sLabel, sREPAIRWALLNOW3) = 0 then begin
          RepairWallNow(3, PlayObject);
          GotoLable(PlayObject, sMAIN, False);
        end else
          if CompareLStr(sLabel, sHIREGUARDNOW, Length(sHIREGUARDNOW)) then begin
          s20 := Copy(sLabel, Length(sHIREGUARDNOW) + 1, Length(sLabel));
          HireGuard(s20, PlayObject);
          PlayObject.SendMsg(Self, RM_MENU_OK, 0, Integer(Self), 0, 0, '');
          //GotoLable(PlayObject,sHIREGUARDOK,False);
        end else
          if CompareLStr(sLabel, sHIREARCHERNOW, Length(sHIREARCHERNOW)) then begin
          s20 := Copy(sLabel, Length(sHIREARCHERNOW) + 1, Length(sLabel));
          HireArcher(s20, PlayObject);
          PlayObject.SendMsg(Self, RM_MENU_OK, 0, Integer(Self), 0, 0, '');
        end else
          if CompareText(sLabel, sEXIT) = 0 then begin
          PlayObject.SendMsg(Self, RM_MERCHANTDLGCLOSE, 0, Integer(Self), 0, 0, '');
        end else
          if CompareText(sLabel, sBACK) = 0 then begin
          if PlayObject.m_sScriptGoBackLable = '' then PlayObject.m_sScriptGoBackLable := sMAIN;
          GotoLable(PlayObject, PlayObject.m_sScriptGoBackLable, False);
        end;
      end else begin
        s18 := '你没有权利使用';
        PlayObject.SendMsg(Self, RM_MENU_OK, 0, Integer(Self), 0, 0, s18);
      end;
    end;
  except
    MainOutMessage(sExceptionMsg);
  end;
  //  inherited;
end;

procedure TCastleOfficial.HireGuard(sIndex: string; PlayObject: TPlayObject);
var
  n10: Integer;
  ObjUnit: pTObjUnit;
begin
  if m_Castle = nil then begin
    PlayObject.SysMsg('NPC不属于城堡！！！', c_Red, t_Hint);
    Exit;
  end;
  if TUserCastle(m_Castle).m_nTotalGold >= g_Config.nHireGuardPrice then begin
    n10 := Str_ToInt(sIndex, 0) - 1;
    if n10 <= MAXCALSTEGUARD then begin
      if TUserCastle(m_Castle).m_Guard[n10].BaseObject = nil then begin
        if not TUserCastle(m_Castle).m_boUnderWar then begin
          ObjUnit := @TUserCastle(m_Castle).m_Guard[n10];
          ObjUnit.BaseObject := UserEngine.RegenMonsterByName(TUserCastle(m_Castle).m_sMapName,
            ObjUnit.nX,
            ObjUnit.nY,
            ObjUnit.sName);
          if ObjUnit.BaseObject <> nil then begin
            Dec(TUserCastle(m_Castle).m_nTotalGold, g_Config.nHireGuardPrice);
            ObjUnit.BaseObject.m_Castle := TUserCastle(m_Castle);
            TGuardUnit(ObjUnit.BaseObject).m_nX550 := ObjUnit.nX;
            TGuardUnit(ObjUnit.BaseObject).m_nY554 := ObjUnit.nY;
            TGuardUnit(ObjUnit.BaseObject).m_nDirection := 3;
            PlayObject.SysMsg('雇佣成功.', c_Green, t_Hint);
          end;
        end else begin
          PlayObject.SysMsg('现在无法雇佣！！！', c_Red, t_Hint);
        end;
      end
    end else begin
      PlayObject.SysMsg('指令错误！！！', c_Red, t_Hint);
    end;
  end else begin
    PlayObject.SysMsg('城内资金不足！！！', c_Red, t_Hint);
  end;
  {
  if UserCastle.m_nTotalGold >= g_Config.nHireGuardPrice then begin
    n10:=Str_ToInt(sIndex,0) - 1;
    if n10 <= MAXCALSTEGUARD then begin
      if UserCastle.m_Guard[n10].BaseObject = nil then begin
        if not UserCastle.m_boUnderWar then begin
          ObjUnit:=@UserCastle.m_Guard[n10];
          ObjUnit.BaseObject:=UserEngine.RegenMonsterByName(UserCastle.m_sMapName,
                                                          ObjUnit.nX,
                                                          ObjUnit.nY,
                                                          ObjUnit.sName);
          if ObjUnit.BaseObject <> nil then begin
            Dec(UserCastle.m_nTotalGold,g_Config.nHireGuardPrice);
            ObjUnit.BaseObject.m_Castle:=UserCastle;
            TGuardUnit(ObjUnit.BaseObject).m_nX550:=ObjUnit.nX;
            TGuardUnit(ObjUnit.BaseObject).m_nY554:=ObjUnit.nY;
            TGuardUnit(ObjUnit.BaseObject).m_n558:=3;
            PlayObject.SysMsg('雇佣成功.',c_Green,t_Hint);
          end;

        end else begin
          PlayObject.SysMsg('现在无法雇佣！！！',c_Red,t_Hint);
        end;
      end
    end else begin
      PlayObject.SysMsg('指令错误！！！',c_Red,t_Hint);
    end;
  end else begin
    PlayObject.SysMsg('城内资金不足！！！',c_Red,t_Hint);
  end;
  }
end;

procedure TCastleOfficial.HireArcher(sIndex: string; PlayObject: TPlayObject);
var
  n10: Integer;
  ObjUnit: pTObjUnit;
begin
  if m_Castle = nil then begin
    PlayObject.SysMsg('NPC不属于城堡！！！', c_Red, t_Hint);
    Exit;
  end;
  if TUserCastle(m_Castle).m_nTotalGold >= g_Config.nHireArcherPrice then begin
    n10 := Str_ToInt(sIndex, 0) - 1;
    if n10 <= MAXCASTLEARCHER then begin
      if TUserCastle(m_Castle).m_Archer[n10].BaseObject = nil then begin
        if not TUserCastle(m_Castle).m_boUnderWar then begin
          ObjUnit := @TUserCastle(m_Castle).m_Archer[n10];
          ObjUnit.BaseObject := UserEngine.RegenMonsterByName(TUserCastle(m_Castle).m_sMapName,
            ObjUnit.nX,
            ObjUnit.nY,
            ObjUnit.sName);
          if ObjUnit.BaseObject <> nil then begin
            Dec(TUserCastle(m_Castle).m_nTotalGold, g_Config.nHireArcherPrice);
            ObjUnit.BaseObject.m_Castle := TUserCastle(m_Castle);
            TGuardUnit(ObjUnit.BaseObject).m_nX550 := ObjUnit.nX;
            TGuardUnit(ObjUnit.BaseObject).m_nY554 := ObjUnit.nY;
            TGuardUnit(ObjUnit.BaseObject).m_nDirection := 3;
            PlayObject.SysMsg('雇佣成功.', c_Green, t_Hint);
          end;
        end else begin
          PlayObject.SysMsg('现在无法雇佣！！！', c_Red, t_Hint);
        end;
      end else begin
        PlayObject.SysMsg('早已雇佣！！！', c_Red, t_Hint);
      end;
    end else begin
      PlayObject.SysMsg('指令错误！！！', c_Red, t_Hint);
    end;
  end else begin
    PlayObject.SysMsg('城内资金不足！！！', c_Red, t_Hint);
  end;
  {
  if UserCastle.m_nTotalGold >= g_Config.nHireArcherPrice then begin
    n10:=Str_ToInt(sIndex,0) - 1;
    if n10 <= MAXCASTLEARCHER then begin
      if UserCastle.m_Archer[n10].BaseObject = nil then begin
        if not UserCastle.m_boUnderWar then begin
          ObjUnit:=@UserCastle.m_Archer[n10];
          ObjUnit.BaseObject:=UserEngine.RegenMonsterByName(UserCastle.m_sMapName,
                                                          ObjUnit.nX,
                                                          ObjUnit.nY,
                                                          ObjUnit.sName);
          if ObjUnit.BaseObject <> nil then begin
            Dec(UserCastle.m_nTotalGold,g_Config.nHireArcherPrice);
            ObjUnit.BaseObject.m_Castle:=UserCastle;
            TGuardUnit(ObjUnit.BaseObject).m_nX550:=ObjUnit.nX;
            TGuardUnit(ObjUnit.BaseObject).m_nY554:=ObjUnit.nY;
            TGuardUnit(ObjUnit.BaseObject).m_n558:=3;
            PlayObject.SysMsg('雇佣成功.',c_Green,t_Hint);
          end;

        end else begin
          PlayObject.SysMsg('现在无法雇佣！！！',c_Red,t_Hint);
        end;
      end else begin
        PlayObject.SysMsg('早已雇佣！！！',c_Red,t_Hint);
      end;
    end else begin
      PlayObject.SysMsg('指令错误！！！',c_Red,t_Hint);
    end;
  end else begin
    PlayObject.SysMsg('城内资金不足！！！',c_Red,t_Hint);
  end;
  }
end;
{ TMerchant }

procedure TMerchant.AddItemPrice(nIndex: Integer; nPrice: Integer);
var
  ItemPrice: pTItemPrice;
begin
  New(ItemPrice);
  ItemPrice.wIndex := nIndex;
  ItemPrice.nPrice := nPrice;
  m_ItemPriceList.Add(ItemPrice);
  FrmDB.SaveGoodPriceRecord(Self, m_sScript + '-' + m_sMapName);
end;

procedure TMerchant.CheckItemPrice(nIndex: Integer);
var
  i: Integer;
  ItemPrice: pTItemPrice;
  n10: Integer;
  StdItem: pTStdItem;
begin
  for i := 0 to m_ItemPriceList.Count - 1 do begin
    ItemPrice := m_ItemPriceList.Items[i];
    if ItemPrice = nil then Continue;
    if ItemPrice.wIndex = nIndex then begin
      n10 := ItemPrice.nPrice;
      if ROUND(n10 * 1.1) > n10 then begin
        n10 := ROUND(n10 * 1.1);
      end else Inc(n10);
      Exit;
    end;
  end;
  StdItem := UserEngine.GetStdItem(nIndex);
  if StdItem <> nil then begin
    AddItemPrice(nIndex, ROUND(StdItem.Price * 1.1));
  end;
end;

function TMerchant.GetRefillList(nIndex: Integer): TList;
var
  i: Integer;
  List: TList;
begin
  Result := nil;
  if nIndex <= 0 then Exit;
  for i := 0 to m_GoodsList.Count - 1 do begin
    List := TList(m_GoodsList.Items[i]);
    if List = nil then Continue;
    if List.Count > 0 then begin
      if pTUserItem(List.Items[0]).wIndex = nIndex then begin
        Result := List;
        break;
      end;
    end;
  end;
end;

procedure TMerchant.RefillGoods;
  procedure RefillItems(var List: TList; sItemName: string; nInt: Integer);
  var
    i: Integer;
    UserItem: pTUserItem;
  begin
    if List = nil then begin
      List := TList.Create;
      m_GoodsList.Add(List);
    end;
    for i := 0 to nInt - 1 do begin
      New(UserItem);
      if UserEngine.CopyToUserItemFromName(sItemName, UserItem) then begin
        List.Insert(0, UserItem);
      end else DisPose(UserItem);
    end;
  end;
  procedure DelReFillItem(var List: TList; nInt: Integer);
  var
    i: Integer;
  begin
    for i := List.Count - 1 downto 0 do begin
      if nInt <= 0 then break;
      if pTUserItem(List.Items[i]) <> nil then begin
        DisPose(pTUserItem(List.Items[i]));
      end;
      List.Delete(i);
      Dec(nInt);
    end;
  end;
var