basicobj.pas

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

      if GateObject.boRegisted then begin
         GateObject.EndProcess;
      end;
      GateObject.Free;
   end;
   DataList.Clear;
end;

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

procedure TGateList.LoadFromFile (aFileName : String);
var
   i, j, xx, yy : integer;
   iName, srcstr, tokenstr : String;
   ItemData : TItemData;
   GateObject : TGateObject;
   pd : PTCreateGateData;
   DB : TUserStringDB;
   Manager : TManager;
begin
   if not FileExists (aFileName) then exit;

   DB := TUserStringDb.Create;
   DB.LoadFromFile (aFileName);

   for i := 0 to DB.Count - 1 do begin
      iName := DB.GetIndexName (i);

      GateObject := TGateObject.Create;
      pd := GateObject.GetSelfData;

      pd^.Name := DB.GetFieldValueString (iName, 'GateName');
      pd^.ViewName := DB.GetFieldValueString (iName, 'ViewName');
      pd^.Kind := DB.GetFieldValueInteger (iname, 'Kind');
      pd^.MapID := DB.GetFieldValueInteger (iname, 'MapID');
      pd^.x := DB.GetFieldValueInteger (iName, 'X');
      pd^.y := DB.GetFieldValueInteger (iName, 'Y');
      pd^.targetx := DB.GetFieldValueInteger (iName, 'TX');
      pd^.targety := DB.GetFieldValueInteger (iName, 'TY');
      pd^.ejectx := DB.GetFieldValueInteger (iName, 'EX');
      pd^.ejecty := DB.GetFieldValueInteger (iName, 'EY');
      pd^.targetserverid := DB.GetFieldValueInteger (iName, 'ServerId');
      pd^.shape := DB.GetFieldValueInteger (iName, 'Shape');
      pd^.Width := DB.GetFieldValueInteger (iName, 'Width');

      pd^.NeedAge := DB.GetFieldValueInteger (iName, 'NeedAge');
      pd^.AgeNeedItem := DB.GetFieldValueInteger (iName, 'AgeNeedItem');

      srcstr := DB.GetFieldValueString (iName, 'NeedItem');
      if srcstr <> '' then begin
         for j := 0 to 5 - 1 do begin
            srcstr := GetValidStr3 (srcstr, tokenstr, ':');
            if tokenstr = '' then break;
            ItemClass.GetItemData (tokenstr, ItemData);
            if ItemData.rName[0] <> 0 then begin
               srcstr := GetValidStr3 (srcstr, tokenstr, ':');
               ItemData.rCount := _StrToInt (tokenstr);
               pd^.NeedItem[j].rName := StrPas (@ItemData.rName);
               pd^.NeedItem[j].rCount := ItemData.rCount;
            end;
         end;
      end;
      pd^.Quest := DB.GetFieldValueInteger (iname, 'Quest');
      pd^.QuestNotice := DB.GetFieldValueString (iname, 'QuestNotice');
      pd^.RegenInterval := DB.GetFieldValueInteger (iName, 'RegenInterval');
      pd^.ActiveInterval := DB.GetFieldValueInteger (iName, 'ActiveInterval');
      pd^.EjectNotice := DB.GetFieldValueString (iname, 'EjectNotice');

      if (pd^.X = 0) and (pd^.Y = 0) then begin
         pd^.RandomPosCount := 0;
         srcstr := DB.GetFieldValueString (iName, 'RandomPos');
         for j := 0 to 10 - 1 do begin
            srcstr := GetValidStr3 (srcstr, tokenstr, ':');
            xx := _StrToInt (tokenstr);
            srcstr := GetValidStr3 (srcstr, tokenstr, ':');
            yy := _StrToInt (tokenstr);
            if (xx = 0) or (yy = 0) then break;
            pd^.RandomX[j] := xx;
            pd^.RandomY[j] := yy;
            Inc (pd^.RandomPosCount);
         end;
      end;

      Manager := ManagerList.GetManagerByServerID (pd^.MapID);
      if Manager <> nil then begin
         GateObject.SetManagerClass (Manager);
         GateObject.Initial;
         GateObject.StartProcess;
         DataList.Add (GateObject);
      end else begin
         GateObject.Free;
      end;
   end;
   DB.Free;
end;

procedure TGateList.Update (CurTick: integer);
var
   i: integer;
   GateObject : TGateObject;
begin
   for i := DataList.Count - 1 downto 0 do begin
      GateObject := DataList.Items [i];
      if GateObject.boAllowDelete then begin
         GateObject.EndProcess;
         GateObject.Free;
         DataList.Delete (i);
      end;
   end;
   
   for i := 0 to DataList.Count - 1 do begin
      GateObject := DataList.Items [i];
      GateObject.Update (CurTick);
   end;
end;

procedure TGateList.SetBSGateActive (boFlag : Boolean);
var
   i: integer;
   GateObject : TGateObject;
begin
   for i := 0 to DataList.Count - 1 do begin
      GateObject := DataList.Items [i];
      if GateObject.SelfData.Kind = GATE_KIND_BS then begin
         GateObject.boActive := boFlag;
      end;
   end;
end;

////////////////////////////////////////////////////
//
//             ===  MirrorObject  ===
//
////////////////////////////////////////////////////

constructor TMirrorObject.Create;
begin
   inherited Create;

   ViewerList := TList.Create;
   
   FillChar (SelfData, SizeOf (TCreateMirrorData), 0);
   boActive := false;
end;

destructor TMirrorObject.Destroy;
begin
   ViewerList.Free;
   
   inherited Destroy;
end;

procedure TMirrorObject.AddViewer (aUser : Pointer);
var
   i : Integer;
begin
   if ViewerList.IndexOf (aUser) >= 0 then exit;
   ViewerList.Add (aUser);

   TUser (aUser).SendClass.SendMap (BasicData, Manager.MapName, Manager.ObjName, Manager.RofName, Manager.TilName, Manager.SoundBase);
   for i := 0 to ViewObjectList.Count - 1 do begin
      TUser (aUser).SendClass.SendShow (TBasicObject (ViewObjectList[i]).BasicData);
   end;
end;

function TMirrorObject.DelViewer (aUser : Pointer) : Boolean;
var
   i, iNo : Integer;
   tmpManager : TManager;
   tmpViewObjectList : TList;
begin
   Result := false;

   iNo := ViewerList.IndexOf (aUser);
   if iNo < 0 then exit;

   tmpManager := TUser (aUser).Manager;
   tmpViewObjectList := TUser (aUser).ViewObjectList;

   TUser (aUser).SendClass.SendMap (TUser (aUser).BasicData, tmpManager.MapName, tmpManager.ObjName, tmpManager.RofName, tmpManager.TilName, tmpManager.SoundBase);
   for i := 0 to tmpViewObjectList.Count - 1 do begin
      TUser (aUser).SendClass.SendShow (TBasicObject (tmpViewObjectList[i]).BasicData);
   end;

   ViewerList.Delete (iNo);

   Result := true;
end;

procedure TMirrorObject.Initial;
begin
   inherited Initial (SelfData.Name, SelfData.Name);

   BasicData.id := GetNewItemId;
   BasicData.x := SelfData.X;
   BasicData.y := SelfData.Y;
   BasicData.ClassKind := CLASS_SERVEROBJ;
   BasicData.Feature.rrace := RACE_ITEM;
   BasicData.Feature.rImageNumber := 0;
   BasicData.Feature.rImageColorIndex := 0;

   boActive := SelfData.boActive;
end;

procedure TMirrorObject.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 TMirrorObject.EndProcess;
var
   SubData : TSubData;
begin
   Phone.SendMessage (0, FM_DESTROY, BasicData, SubData);
   Phone.UnRegisterUser (BasicData.id, BasicData.x, BasicData.y);

   inherited EndProcess;
end;

function TMirrorObject.FieldProc (hfu: Longint; Msg: word; var SenderInfo: TBasicData; var aSubData: TSubData): Integer;
var
   i : Integer;
   User : TUser;
begin
   Result := PROC_FALSE;

   if isRangeMessage (hfu, Msg, SenderInfo) = FALSE then exit;
   Result := inherited FieldProc (hfu, Msg, Senderinfo, aSubData);

   for i := 0 to ViewerList.Count - 1 do begin
      User := ViewerList.Items [i];
      User.FieldProc2 (hfu, Msg, SenderInfo, aSubData);
   end;
end;

procedure TMirrorObject.Update (CurTick : Integer);
begin

end;

function TMirrorObject.GetSelfData : PTCreateMirrorData;
begin
   Result := @SelfData;
end;


////////////////////////////////////////////////////
//
//             ===  MirrorList  ===
//
////////////////////////////////////////////////////

constructor TMirrorList.Create;
begin
   DataList := TList.Create;
   LoadFromFile ('.\Setting\CreateMirror.SDB');
end;

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

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

procedure TMirrorList.Clear;
var
   i : Integer;
   MirrorObj : TMirrorObject;
begin
   for i := 0 to DataList.Count - 1 do begin
      MirrorObj := DataList.Items [i];
      MirrorObj.EndProcess;
      MirrorObj.Free;
   end;
   DataList.Clear;
end;

function TMirrorList.AddViewer (aStr : String; aUser : Pointer) : Boolean;
var
   i : Integer;
   MirrorObj : TMirrorObject;
begin
   Result := false;

   for i := 0 to DataList.Count - 1 do begin
      MirrorObj := DataList.Items [i];
      if StrPas (@MirrorObj.BasicData.Name) = aStr then begin
         MirrorObj.AddViewer (aUser);
         Result := true;
         exit;
      end;
   end;
end;

function TMirrorList.DelViewer (aUser : Pointer) : Boolean;
var
   i : Integer;
   MirrorObj : TMirrorObject;
begin
   Result := false;

   for i := 0 to DataList.Count - 1 do begin
      MirrorObj := DataList.Items [i];
      if MirrorObj.DelViewer (aUser) = true then begin
         Result := true;
         exit;
      end;
   end;
end;

procedure TMirrorList.LoadFromFile (aFileName : String);
var
   i : Integer;
   iName : String;
   DB : TUserStringDB;
   MirrorObj : TMirrorObject;
   pd : PTCreateMirrorData;
   Manager : TManager;
begin
   if not FileExists (aFileName) then exit;

   DB := TUserStringDB.Create;
   DB.LoadFromFile (aFileName);

   for i := 0 to DB.Count - 1 do begin
      iName := DB.GetIndexName (i);
      if iName = '' then continue;

      MirrorObj := TMirrorObject.Create;
      pd := MirrorObj.GetSelfData;

      pd^.Name := DB.GetFieldValueString (iName, 'Name');
      pd^.X := DB.GetFieldValueInteger (iName, 'X');
      pd^.Y := DB.GetFieldValueInteger (iName, 'Y');
      pd^.MapID := DB.GetFieldValueInteger (iName, 'MapID');
      pd^.boActive := DB.GetFieldValueBoolean (iName, 'boActive');

      Manager := ManagerList.GetManagerByServerID (pd^.MapID);
      if Manager <> nil then begin
         MirrorObj.SetManagerClass (Manager);
         MirrorObj.Initial;
         MirrorObj.StartProcess;
         DataList.Add (MirrorObj);
      end else begin
         MirrorObj.Free;
      end;
   end;

   DB.Free;
end;

procedure TMirrorList.Update (CurTick: integer);
var
   i : Integer;
   MirrorObj : TMirrorObject;
begin
   for i := 0 to DataList.Count - 1 do begin
      MirrorObj := DataList.Items [i];
      MirrorObj.Update (CurTick);
   end;
end;

////////////////////////////////////////////////////
//
//             ===  StaticItemObject  ===
//
////////////////////////////////////////////////////

constructor TStaticItem.Create;
begin
   inherited Create;
end;

destructor  TStaticItem.Destroy;
begin
   inherited destroy;
end;

function  TStaticItem.FieldProc (hfu: Longint; Msg: word; var SenderInfo: TBasicData; var aSubData: TSubData): Integer;
var
   percent : integer;
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;