uusersub.pas

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

                           NewItemArr[i].rColor := 0;
                           NewItemArr[i].rCount := 0;
                           break;
                        end else begin
                           NewItemArr[i].rCount := NewItemArr[i].rCount - OldItemArr[j].rCount;
                           OldItemArr[j].rName[0] := 0;
                           OldItemArr[j].rColor := 0;
                           OldItemArr[j].rCount := 0;
                        end;
                     end;
                  end;
               end;
            end;
         end;
      end;

      for i := 0 to HAVEITEMSIZE - 1 do begin
         if OldItemArr[i].rName [0] <> 0 then begin
            // if (aItemData^.rPrice * aItemData^.rCount >= 100) or (aItemData^.rcolor <> 1) then begin
            FSendClass.SendItemMoveInfo (FUserName + ',' + '@接瘤' + ',' + StrPas(@OldItemArr[i].rName) + ',' + IntToStr(OldItemArr[i].rCount)
            + ',' + IntToStr(0) + ',' + IntToStr(0) + ',' + IntToStr(0) + ',,');
            // end;
         end;
      end;
      for i := 0 to HAVEITEMSIZE - 1 do begin
         if NewItemArr[i].rName [0] <> 0 then begin
            // if (aItemData^.rPrice * aItemData^.rCount >= 100) or (aItemData^.rcolor <> 1) then begin
            FSendClass.SendItemMoveInfo ('@接瘤' + ',' + FUserName + ',' + StrPas(@NewItemArr[i].rName) + ',' + IntToStr(NewItemArr[i].rCount)
            + ',' + IntToStr(0) + ',' + IntToStr(0) + ',' + IntToStr(0) + ',,');
            // end;
         end;
      end;
   end;

   FillChar (HaveItemArr, SizeOf (TItemData) * HAVEITEMSIZE, 0);
   for i := 0 to HAVEITEMSIZE - 1 do begin
      if aHaveItemClass.ViewItem (i, @ItemData) = true then begin
         if ItemData.rName [0] <> 0 then begin
            HaveItemArr[i] := ItemData;
         end;
      end;
   end;
end;

procedure THaveItemClass.CopyFromHaveItem (aItemArr : PTItemData);
begin
   Move (HaveItemArr, aItemArr^, SizeOf (HaveItemArr));
end;

procedure THaveItemClass.SaveToSdb (aCharData : PTDBRecord);
var
   i : integer;
   str, rdstr : String;
begin
   for i := 0 to HAVEITEMSIZE-1 do begin
      str := ItemClass.GetWearItemString (HaveItemArr[i]);
      str := GetValidStr3 (str, rdstr, ':');
      StrPCopy (@aCharData^.HaveItemArr[i].Name, rdstr);
      str := GetValidStr3 (str, rdstr, ':');
      aCharData^.HaveItemArr[i].Color := _StrToInt (rdstr);
      str := GetValidStr3 (str, rdstr, ':');
      aCharData^.HaveItemArr[i].Count := _StrToInt (rdstr);
   end;
end;

function  THaveItemClass.FreeSpace: integer;
var i: integer;
begin
   Result := 0;
   for i := 0 to HAVEITEMSIZE-1 do begin
      if HaveItemArr[i].rName[0] = 0 then Result := Result + 1;
   end;
end;

function  THaveItemClass.ViewItem (akey: integer; aItemData: PTItemData): Boolean;
begin
   FillChar (aItemData^, sizeof(TItemData), 0);
   Result := FALSE;

   if boLocked = true then exit;
   
   if (akey < 0) or (akey > HAVEITEMSIZE-1) then exit;
   if HaveItemArr[akey].rName[0] = 0 then exit;
   Move (HaveItemArr[akey], aItemData^, SizeOf (TItemData));
   Result := TRUE;
end;

function  THaveItemClass.FindItem (aItemData : PTItemData): Boolean;
var
   i : integer;
begin
   Result := false;
   for i := 0 to HAVEITEMSIZE-1 do begin
      if StrPas (@HaveItemArr[i].rName) = StrPas (@aItemData^.rName) then begin
         if HaveItemArr[i].rCount >= aItemData^.rCount then begin
            Result := true;
            exit;
         end;
      end;
   end;
end;

function  THaveItemClass.FindKindItem (akind: integer): integer;
var
   i : integer;
begin
   Result := -1;
   for i := 0 to HAVEITEMSIZE-1 do begin
      if HaveItemArr[i].rkind = akind then begin
         Result := i;
         exit;
      end;
   end;
end;

function  THaveItemClass.FindItemByMagicKind (aKind: integer): integer;
var
   i : integer;
begin
   Result := -1;
   for i := 0 to HAVEITEMSIZE - 1 do begin
      if aKind = MAGICTYPE_WRESTLING then begin
         if HaveItemArr[i].rName[0] = 0 then begin
            Result := i;
            exit;
         end;
      end;
      if (HaveItemArr[i].rName[0] <> 0) and
         (HaveItemArr[i].rWearArr = ARR_WEAPON) and
         (HaveItemArr[i].rHitType = aKind) and
         (HaveItemArr[i].rKind = ITEM_KIND_WEARITEM) then begin
         Result := i;
         exit;
      end;
   end;
end;

function  THaveItemClass.AddKeyItem (aKey, aCount : Integer; var aItemData: TItemData): Boolean;
var
   i : Integer;
   nPos : Integer;
begin
   Result := FALSE;

   if boLocked = true then exit;
   if (aKey < 0) or (aKey > HAVEITEMSIZE - 1) then exit;
   if aItemData.rName[0] = 0 then exit;

   nPos := aKey;
   for i := 0 to HAVEITEMSIZE - 1 do begin
      if StrPas (@HaveItemArr[i].rName) = StrPas (@aItemData.rName) then begin
         if HaveItemArr[i].rColor = aItemData.rColor then begin
            if HaveItemArr[i].rboDouble = true then begin
               nPos := i;
               break;
            end;
         end;
      end;
   end;

   if HaveItemArr[nPos].rName[0] <> 0 then begin
      if StrPas (@HaveItemArr[nPos].rName) <> StrPas (@aItemData.rName) then exit;
      if aItemData.rboDouble = false then exit;
      HaveItemArr[nPos].rCount := HaveItemArr[nPos].rCount + aItemData.rCount;
   end else begin
      HaveItemArr[nPos] := aItemData;
   end;

   FSendClass.SendHaveItem (nPos, HaveItemArr[nPos]);
   ReQuestPlaySoundNumber := HaveItemArr[nPos].rSoundEvent.rWavNumber;

   Result := true;
end;

function  THaveItemClass.AddItem  (aItemData: PTItemData): Boolean;
var i : integer;
begin
   Result := FALSE;

   if boLocked = true then exit;
   if aItemData^.rboDouble then begin
      for i := 0 to HAVEITEMSIZE-1 do begin
         if StrPas (@HaveItemArr[i].rName) <> StrPas (@aItemData^.rName) then continue;
         if HaveItemArr[i].rColor <> aItemData^.rcolor then continue;

         HaveItemArr[i].rCount := HaveItemArr[i].rCount + aItemData^.rCount;
         FSendClass.SendHaveItem (i, HaveItemArr[i]);
         ReQuestPlaySoundNumber := HaveItemArr[i].rSoundEvent.rWavNumber;
         Result := TRUE;
         if (aItemData^.rPrice * aItemData^.rCount >= 100) or (aItemData^.rcolor <> 1) then begin
            if aItemData^.rOwnerName[0] <> 0 then begin
               FSendClass.SendItemMoveInfo (StrPas(@aItemData^.rOwnerName) + ',' + FUserName + ',' + StrPas(@aItemData^.rName) + ',' + IntToStr(aItemData^.rCount)
               + ',' + IntToStr(aItemData^.rOwnerServerID) + ',' + IntToStr(aItemData^.rOwnerX) + ',' + IntToStr(aItemData^.rOwnerY) + ',' + StrPas (@aItemData^.rOwnerIP) + ',');
            end;
         end;
         exit;
      end;
   end;

   for i := 0 to HAVEITEMSIZE-1 do begin
      if HaveItemArr[i].rName[0] = 0 then begin
         Move (aItemData^, HaveItemArr[i], SizeOf (TItemData));
         FSendClass.SendHaveItem (i, HaveItemArr[i]);
         ReQuestPlaySoundNumber := HaveItemArr[i].rSoundEvent.rWavNumber;

         Result := TRUE;

         if (aItemData.rPrice * aItemData.rCount >= 100) or (aItemData.rcolor <> 1) then begin
            if aItemData.rOwnerName[0] <> 0 then begin
               FSendClass.SendItemMoveInfo (StrPas(@aItemData.rOwnerName) + ',' + FUserName + ',' + StrPas(@aItemData.rName) + ',' + IntToStr(aItemData.rCount)
               + ',' + IntToStr(aItemData.rOwnerServerID) + ',' + IntToStr(aItemData.rOwnerX) + ',' + IntToStr(aItemData.rOwnerY) + ',' + StrPas (@aItemData.rOwnerIP) + ',');
            end;
         end;
         exit;
      end;
   end;
end;

function  THaveItemClass.DeleteKeyItem (akey, aCount: integer; aItemData : PTItemData): Boolean;
begin
   Result := FALSE;
   if boLocked = true then exit;
   if (akey < 0) or (akey > HAVEITEMSIZE - 1) then exit;

   if (aItemData^.rPrice * aItemData^.rCount >= 100) or (aItemData^.rcolor <> 1) then begin
      if aItemData^.rOwnerName[0] <> 0 then begin
         FSendClass.SendItemMoveInfo (FUserName + ',' + StrPas(@aItemData^.rOwnerName) + ',' + StrPas(@aItemData^.rName) + ',' + IntToStr(aItemData^.rCount)
         + ',' + IntToStr(aItemData^.rOwnerServerID) + ',' + IntToStr(aItemData^.rOwnerX) + ',' + IntToStr(aItemData^.rOwnerY) + ',' + StrPas (@aItemData^.rOwnerIP) + ',');
      end;
   end;
   
   HaveItemArr[akey].rCount := HaveItemArr[akey].rCount - aCount;
   if HaveItemArr [aKey].rCount <= 0 then begin
      FillChar (HaveItemArr [aKey], SizeOf (TItemData), 0);
   end;

   FSendClass.SendHaveItem (aKey, HaveItemArr[akey]);

   Result := TRUE;
end;

procedure THaveItemClass.DeleteAllItem;
var
   i : Integer;
begin
   for i := 0 to HAVEITEMSIZE - 1 do begin
      FillChar (HaveItemArr [i], SizeOf (TItemData), 0);
      FSendClass.SendHaveItem (i, HaveItemArr[i]);
   end;
end;

function  THaveItemClass.DeleteItem (aItemData: PTItemData): Boolean;
var
   i : integer;
begin
   Result := FALSE;

   if boLocked = true then exit;
   for i := 0 to HAVEITEMSIZE-1 do begin
      if StrPas (@HaveItemArr[i].rName) = StrPas (@aItemData^.rName) then begin
         if HaveItemArr[i].rCount < aItemData^.rCount then exit;

         if (aItemData^.rPrice * aItemData^.rCount >= 100) or (aItemData^.rcolor <> 1) then begin
            if aItemData^.rOwnerName[0] <> 0 then begin
               FSendClass.SendItemMoveInfo (FUserName + ',' + StrPas(@aItemData.rOwnerName) + ',' + StrPas(@aItemData^.rName) + ',' + IntToStr(aItemData^.rCount)
               + ',' + IntToStr(aItemData^.rOwnerServerID) + ',' + IntToStr(aItemData.rOwnerX) + ',' + IntToStr(aItemData^.rOwnerY) + ',' + StrPas (@aItemData^.rOwnerIP) + ',');
            end;
         end;

         HaveItemArr[i].rCount := HaveItemArr[i].rCount - aItemData.rCount;
         if HaveItemArr[i].rCount = 0 then FillChar (HaveItemArr[i], sizeof(TItemData), 0);
         FSendClass.SendHaveItem (i, HaveItemArr[i]);
         Result := TRUE;
         exit;
      end;
   end;
end;

function  THaveItemClass.ChangeItem (asour, adest: integer): Boolean;
var
   ItemData : TItemData;
begin
   Result := FALSE;
   if boLocked = true then exit;
   if (asour < 0) or (asour > HAVEITEMSIZE-1) then exit;
   if (adest < 0) or (adest > HAVEITEMSIZE-1) then exit;

   ItemData := HaveItemArr[asour];
   HaveItemArr[asour] := HaveItemArr[adest];
   HaveItemArr[adest] := ItemData;

   FSendClass.SendHaveItem (asour, HaveItemArr[asour]);
   FSendClass.SendHaveItem (adest, HaveItemArr[adest]);
   Result := TRUE;
end;

procedure THaveItemClass.Refresh;
var
   i : Integer;
begin
   for i := 0 to HAVEITEMSIZE-1 do begin
      FSendClass.SendHaveItem (i, HaveItemArr[i]);
   end;
end;


///////////////////////////////////
//         TWearItemClass
///////////////////////////////////

constructor TWearItemClass.Create (aBasicObject : TBasicObject; aSendClass: TSendClass; aAttribClass: TAttribClass);
begin
   boLocked := false;
   FBasicObject := aBasicObject;
   ReQuestPlaySoundNumber := 0;
   FSendClass := aSendClass;
   FAttribClass := aAttribClass;
end;

destructor TWearItemClass.Destroy;
begin
   inherited destroy;
end;

procedure TWearItemClass.SetLifeData;
var
   i: integer;
begin
   FillChar (WearItemLifeData, sizeof(TLifeData), 0);
   for i := ARR_GLOVES to ARR_WEAPON do begin
      GatherLifeData (WearItemLifeData, WearItemArr[i].rLifeData);
   end;
   TUserObject (FBasicObject).SetLifeData;
end;

procedure TWearItemClass.Update (CurTick : integer);
begin
end;

procedure TWearItemClass.LoadFromSdb (aCharData : PTDBRecord);
var
   i : integer;
   str : String;
begin
   boLocked := false;
   ReQuestPlaySoundNumber := 0;
   FillChar (WearItemArr, sizeof(WearItemArr), 0);
   Fillchar (WearFeature, sizeof(WearFeature), 0);

   if StrPas (@aCharData^.Sex) = INI_SEX_FIELD_MAN then WearFeature.rboMan := TRUE
   else WearFeature.rboMan := FALSE;

   WearFeature.rArr[ARR_BODY*2] := 0;