basicobj.pas

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

            if boAllowPickup = false then begin
               if (SenderInfo.x <> BasicData.x) or (SenderInfo.y <> BasicData.y) then begin
                  exit;
               end;
            end;
            }

            SubData.ItemData := SelfItemData;
            SubData.ServerId := ServerId;
            if Phone.SendMessage (SenderInfo.id, FM_ADDITEM, BasicData, SubData) = PROC_TRUE then begin
               FboAllowDelete := TRUE;
            end;
         end;
      FM_SAY :
         begin
         end;
   end;
end;

procedure TItemObject.Initial (aItemData: TItemData; aOwnerId, ax, ay: integer);
var
   iName, iViewName : String;
begin
   iName := StrPas (@aItemData.rName);
   if aItemData.rCount > 1 then iName := iName + ':' + IntToStr (aItemData.rCount);
   iViewName := StrPas (@aItemData.rViewName);
   if aItemData.rCount > 1 then iViewName := iViewName + ':' + IntToStr (aItemData.rCount);

   inherited Initial (iName, iViewName);
   
   OwnerId := aOwnerId;
   SelfItemdata := aItemData;
   BasicData.id := GetNewItemId;
   BasicData.x := ax;
   BasicData.y := ay;
   BasicData.ClassKind := CLASS_ITEM;
   BasicData.Feature.rrace := RACE_ITEM;
   BasicData.Feature.rImageNumber := aItemData.rShape;
   BasicData.Feature.rImageColorIndex := aItemData.rcolor;

   {
   boAllowPickup := true;
   if not Maper.isMoveable (ax, ay) then begin
      boAllowPickup := false;
   end;
   }
end;

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

   Phone.RegisterUser (BasicData.id, FieldProc, BasicData.X, BasicData.Y);
   Phone.SendMessage (0, FM_CREATE, BasicData, SubData);

   if SelfItemData.rSoundDrop.rWavNumber <> 0 then begin
      SetWordString (SubData.SayString, IntToStr (SelfItemData.rSoundDrop.rWavNumber) + '.wav');
      SendLocalMessage (NOTARGETPHONE, FM_SOUND, BasicData, SubData);
   end;
end;

procedure TItemObject.EndProcess;
var SubData : TSubData;
begin
   if FboRegisted = FALSE then exit;

   Phone.SendMessage (0, FM_DESTROY, BasicData, SubData);
   Phone.UnRegisterUser (BasicData.id, BasicData.x, BasicData.y);
   inherited EndProcess;
end;

procedure   TItemObject.Update (CurTick: integer);
var
   SubData : TSubData;
begin
   if CreateTick + 3 * 60 * 100 < CurTick then FboAllowDelete := TRUE;
   if CurTick >= FAlarmTick + 300 then begin
      SendLocalMessage (NOTARGETPHONE, FM_IAMHERE, BasicData, SubData);
   end;

   {
   if boAllowPickup = false then begin
      if CreateTick + 5*100 < CurTick then begin
         boAllowPickup := true;
      end;
   end;
   }
end;


////////////////////////////////////////////////////
//
//             ===  ItemList  ===
//
////////////////////////////////////////////////////

constructor TItemList.Create (cnt: integer; aManager: TManager);
begin
   Manager := aManager;
   DataList := TList.Create;
end;

destructor TItemList.Destroy;
begin
   AllClear;
   DataList.Free;
   inherited destroy;
end;

procedure TItemList.AllClear;
var
   i : Integer;
   ItemObject : TItemObject;
begin
   for i := 0 to DataList.Count - 1 do begin
      ItemObject := DataList.Items [i];
      ItemObject.EndProcess;
      ItemObject.Free;
   end;
   DataList.Clear;
end;

function  TItemList.GetCount: integer;
begin
   Result := DataList.Count;
end;

procedure TItemList.AddItemObject (aItemData: TItemData; aOwnerId, ax, ay: integer);
var
   ItemObject : TItemObject;
begin
   if DataList.Count > 3000 then exit;

   ItemObject := TItemObject.Create;
   
   ItemObject.SetManagerClass (Manager);
   ItemObject.Initial (aItemData, aOwnerId, ax, ay);
   ItemObject.StartProcess;

   DataList.Add (ItemObject);
end;

procedure TItemList.Update (CurTick: integer);
var
   i : integer;
   ItemObject : TItemObject;
begin
   for i := DataList.Count - 1 downto 0 do begin
      ItemObject := DataList.Items [i];
      if ItemObject.boAllowDelete then begin
         ItemObject.EndProcess;
         ItemObject.Free;
         DataList.delete (i);
      end;
   end;
   
   for i := 0 to DataList.Count - 1 do begin
      ItemObject := DataList.Items [i];
      ItemObject.Update (CurTick);
   end;
end;

////////////////////////////////////////////////////
//
//             ===  GateObject  ===
//
////////////////////////////////////////////////////

constructor TGateObject.Create;
begin
   inherited Create;

   boActive := false;
   RegenedTick := mmAnsTick;

   FillChar (SelfData, SizeOf (TCreateGateData), 0);
end;

destructor TGateObject.Destroy;
begin
   inherited destroy;
end;

function TGateObject.GetSelfData : PTCreateGateData;
begin
   Result := @SelfData;
end;

function TGateObject.FieldProc (hfu: Longint; Msg: word; var SenderInfo: TBasicData; var aSubData: TSubData): Integer;
var
   i : Integer;
   SubData : TSubData;
   ItemData : TItemData;
   pUser : TUser;
   boFlag : Boolean;
   BO : TBasicObject;
   RetStr : String;
begin
   Result := PROC_FALSE;
   if isRangeMessage ( hfu, Msg, SenderInfo) = FALSE then exit;
   Result := inherited FieldProc (hfu, Msg, Senderinfo, aSubData);
   if Result = PROC_TRUE then exit;

   case Msg of
      FM_MOVE :
         begin
            if (SelfData.Kind = GATE_KIND_NORMAL) and (BasicData.nx = 0) and (BasicData.ny = 0) then exit;

            if CheckInArea (SenderInfo.nx, SenderInfo.ny, BasicData.x, BasicData.y, SelfData.Width) then begin
               BO := TBasicObject (SenderInfo.P);
               if BO = nil then exit;
               if not (BO is TUser) then exit;
               pUser := TUser (BO);

               if pUser.MovingStatus = true then begin
                  exit;
               end;

               if boActive = false then begin
                  pUser.SetPosition (SelfData.EjectX, SelfData.EjectY);
                  Case SelfData.Kind of
                     GATE_KIND_NORMAL : pUser.SendClass.SendChatMessage (format ('瘤陛篮 甸绢哎 荐 绝嚼聪促. %d盒%d檬饶俊 凯赋聪促', [RemainHour * 60 + RemainMin, RemainSec]), SAY_COLOR_SYSTEM);
                     GATe_KIND_BS : pUser.SendClass.SendChatMessage (format ('瘤陛篮 甸绢哎 荐 绝嚼聪促.', [RemainHour * 60 + RemainMin, RemainSec]), SAY_COLOR_SYSTEM);
                  end;
                  exit;
               end;

               boFlag := true;
               if SelfData.NeedAge > 0 then begin
                  if SelfData.NeedAge <= pUser.GetAge then begin
                  end else begin
                     if SelfData.AgeNeedItem > 0 then begin
                        if SelfData.AgeNeedItem <= pUser.GetAge then begin
                           for i := 0 to 5 - 1 do begin
                              if SelfData.NeedItem[i].rName = '' then break;
                              ItemClass.GetItemData (SelfData.NeedItem[i].rName, ItemData);
                              if ItemData.rName[0] <> 0 then begin
                                 ItemData.rCount := SelfData.NeedItem[i].rCount;
                                 boFlag := TUser (BO).FindItem (@ItemData);
                                 if boFlag = false then break;
                              end;
                           end;
                           if boFlag = true then begin
                              for i := 0 to 5 - 1 do begin
                                 if SelfData.NeedItem[i].rName = '' then break;
                                 ItemClass.GetItemData (SelfData.NeedItem[i].rName, ItemData);
                                 if ItemData.rName[0] <> 0 then begin
                                    ItemData.rCount := SelfData.NeedItem[i].rCount;
                                    TUser (BO).DeleteItem (@ItemData);
                                 end;
                              end;
                           end;
                        end else begin
                           boFlag := false;
                        end;
                     end else begin
                        boFlag := false;
                     end;
                  end;
               end;
               
               if boFlag = true then begin
                  if SelfData.Quest <> 0 then begin
                     if QuestClass.CheckQuestComplete (SelfData.Quest, ServerID, RetStr) = false then begin
                        pUser.SetPosition (SelfData.EjectX, SelfData.EjectY);
                        pUser.SendClass.SendChatMessage (SelfData.QuestNotice, SAY_COLOR_SYSTEM);
                        pUser.SendClass.SendChatMessage (RetStr, SAY_COLOR_SYSTEM);
                        exit;
                     end;
                  end;
               end;
               
               if boFlag = true then begin
                  Case SelfData.Kind of
                     GATE_KIND_NORMAL :
                        begin
                           SubData.ServerId := SelfData.TargetServerId;
                           Phone.SendMessage (SenderInfo.id, FM_GATE, BasicData, SubData);
                        end;
                     GATE_KIND_BS :
                        begin
                           pUser.SetPositionBS (SelfData.EjectX, SelfData.EjectY);
                        end;
                  end;
               end else begin
                  if (SelfData.EjectX > 0) and (SelfData.EjectY > 0) then begin
                     pUser.SetPosition (SelfData.EjectX, SelfData.EjectY);
                  end;
                  if SelfData.EjectNotice = '' then begin
                     pUser.SendClass.SendChatMessage ('甸绢哎 荐 绝嚼聪促. 免涝捞 力茄等 镑涝聪促', SAY_COLOR_SYSTEM);
                  end else begin
                     pUser.SendClass.SendChatMessage (SelfData.EjectNotice, SAY_COLOR_SYSTEM);
                  end;
               end;
            end;
         end;
   end;
end;

procedure TGateObject.Initial;
var
   iNo : Integer;
begin
   inherited Initial (SelfData.Name, SelfData.ViewName);

   BasicData.id := GetNewItemId;

   if (SelfData.X <> 0) or (SelfData.Y <> 0) then begin
      BasicData.x := SelfData.x;
      BasicData.y := SelfData.y;
   end else begin
      iNo := Random (SelfData.RandomPosCount);
      BasicData.X := SelfData.RandomX [iNo];
      BasicData.Y := SelfData.RandomY [iNo];
   end;

   BasicData.nx := SelfData.targetx;
   BasicData.ny := SelfData.targety;
   BasicData.ClassKind := CLASS_GATE;
   BasicData.Feature.rrace := RACE_ITEM;
   BasicData.Feature.rImageNumber := SelfData.Shape;
   BasicData.Feature.rImageColorIndex := 0;

   boActive := true;
   RegenedTick := mmAnsTick;
end;

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

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

procedure TGateObject.EndProcess;
var
   SubData : TSubData;
begin
   Phone.SendMessage (0, FM_DESTROY, BasicData, SubData);
   Phone.UnRegisterUser (BasicData.id, BasicData.x, BasicData.y);

   inherited EndProcess;
end;

procedure TGateObject.Update (CurTick : Integer);
begin
   if (SelfData.RegenInterval > 0) and (RegenedTick + 100 <= CurTick) then begin
      Manager.CalcTime (RegenedTick + SelfData.RegenInterval - CurTick, RemainHour, RemainMin, RemainSec);
   end;
   if (SelfData.RegenInterval > 0) and (RegenedTick + SelfData.RegenInterval <= CurTick) then begin
      RegenedTick := CurTick;
      boActive := true;
   end else begin
      if (SelfData.X = 0) and (SelfData.Y = 0) then begin
         if CurTick >= RegenedTick + SelfData.ActiveInterval then begin
            EndProcess;
            Initial;
            StartProcess;
         end;
         exit;
      end;
      if boActive = true then begin
         if (SelfData.RegenInterval > 0) and (RegenedTick + SelfData.ActiveInterval <= CurTick) then begin
            boActive := false;
         end;
      end;
   end;
end;

////////////////////////////////////////////////////
//
//             ===  GateList  ===
//
////////////////////////////////////////////////////

constructor TGateList.Create;
begin
   DataList := TList.Create;

   LoadFromFile ('.\Setting\CreateGate.SDB');
end;

destructor TGateList.Destroy;
begin
   Clear;
   DataList.Free;
   
   inherited Destroy;
end;

procedure TGateList.Clear;
var
   i : Integer;
   GateObject : TGateObject;
begin
   for i := 0 to DataList.Count - 1 do begin
      GateObject := DataList.Items [i];