⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 udoorgen.pas

📁 千年源代码,只缺少控件,可以做二次开发用,好不容易得来的
💻 PAS
📖 第 1 页 / 共 2 页
字号:
   BasicData.x := aX;
   BasicData.y := aY;
   BasicData.nx := aX;
   BasicData.ny := aY;
   BasicData.ClassKind := CLASS_SERVEROBJ;
   BasicData.Feature.rRace := RACE_ITEM;
   BasicData.Feature.rImageNumber := 0;
   BasicData.Feature.rImageColorIndex := 0;

   RegenData;

   UpdatedTick := 0;
   boMonsterDie := false;
   boDynamicObjectDie := false;
   MonsterDieTick := 0;
   DynamicObjectDieTick := 0;
end;

procedure TObjectChecker.RegenData;
begin
   DataList.Clear;
   TDynamicObjectList (Manager.DynamicObjectList).GetDynamicObjects ('咯快阂', DataList);
end;

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

   inherited EndProcess;
end;

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

procedure TObjectChecker.Update (CurTick: integer);
var
   i, iCount : Integer;
   xx, yy : Word;
   DynamicObject : TDynamicObject;
   SubData : TSubData;
   cdod : TCreateDynamicObjectData;
begin
   {
   if boMonsterDie = true then begin
      if HaveMonster <> nil then begin
         HaveMonster.EndProcess;
         HaveMonster.Free;
         HaveMonster := nil;
      end;
      boMonsterDie := false;
   end;
   if boDynamicObjectDie = true then begin
      if HaveDynamicObject <> nil then begin
         HaveDynamicObject.EndProcess;
         HaveDynamicObject.Free;
         HaveDynamicObject := nil;
      end;
      boDynamicObjectDie := false;
   end;
   }

   if HaveMonster <> nil then begin
      if HaveMonster.boRegisted = true then begin
         if HaveMonster.boAllowDelete = true then begin
            HaveMonster.EndProcess;
            HaveMonster := nil;
         end else begin
            HaveMonster.Update (CurTick);
         end;
      end;
   end;
   if HaveDynamicObject <> nil then begin
      if HaveDynamicObject.boRegisted = true then begin
         if HaveDynamicObject.boAllowDelete = true then begin
            HaveDynamicObject.EndProcess;
            HaveDynamicObject.Free;
            HaveDynamicObject := nil;
         end else begin
            HaveDynamicObject.Update (CurTick);
         end;
      end;
   end;

   if CurTick < UpdatedTick + 100 then exit;

   UpdatedTick := CurTick;

   iCount := 0;
   for i := 0 to DataList.Count - 1 do begin
      DynamicObject := DataList.Items [i];
      if DynamicObject.Status = dos_Openned then begin
         Inc (iCount);
      end;
   end;

   if iCount < 2 then begin
      if HaveMonster <> nil then begin
         if HaveMonster.boRegisted = true then begin
            HaveMonster.EndProcess;
         end;
      end;
   end else if iCount < 4 then begin
      if HaveMonster = nil then begin
         HaveMonster := TMonster.Create;
         HaveMonster.SetManagerClass (Manager);
         HaveMonster.Initial ('荤尔赤角眉', BasicData.X, BasicData.Y, 5);
      end;
      if HaveMonster.boRegisted = false then begin
         HaveMonster.StartProcess;
         HaveMonster.SetHideState (hs_0);
      end;
      if HaveDynamicObject <> nil then begin
         if HaveDynamicObject.boRegisted = true then begin
            if HaveDynamicObject.ObjectStatus = dos_Closed then begin
               HaveDynamicObject.EndProcess;
            end;
         end;
      end;
   end else begin
      if HaveDynamicObject = nil then begin
         FillChar (cdod, SizeOf (TCreateDynamicObjectData), 0);

         DynamicObjectClass.GetDynamicObjectData ('夸拳', cdod.rBasicData);
         cdod.rServerId := Manager.ServerID;
         cdod.rX[0] := 37;
         cdod.rY[0] := 50;

         HaveDynamicObject := TDynamicObject.Create;
         HaveDynamicObject.SetManagerClass (Manager);
         HaveDynamicObject.Initial (@cdod);
      end;
      if HaveDynamicObject.boRegisted = false then begin
         HaveDynamicObject.StartProcess;
      end;
   end;
end;

function TObjectChecker.GetCurInfo : String;
var
   i, iCount : Integer;
   DynamicObject : TDynamicObject;
   Str : String;
begin
   Result := '';

   iCount := 0;
   for i := 0 to DataList.Count - 1 do begin
      DynamicObject := DataList.Items [i];
      if DynamicObject.Status = dos_Openned then begin
         Inc (iCount);
      end;
   end;

   Str := format ('咯快阂(%d) ', [iCount]);
   if HaveMonster = nil then begin
      Str := Str + '荤尔赤(nil) ';
   end else begin
      if HaveMonster.boRegisted = true then begin
         Str := Str + '荤尔赤(Registed) ';
      end else begin
         Str := Str + '荤尔赤(UnRegisted) ';
      end;
   end;
   if HaveDynamicObject = nil then begin
      Str := Str + '夸拳(nil) ';
   end else begin
      if HaveMonster.boRegisted = true then begin
         Str := Str + '夸拳(Registed) ';
      end else begin
         Str := Str + '夸拳(UnRegisted) ';
      end;
   end;

   Result := Str;
end;

// TSoundObj
constructor TSoundObj.Create;
begin
   inherited Create;

   SoundName := '';

   UpdatedTick := 0;
   PlayedTick := 0;
   PlayInterval := 0;
end;

destructor TSoundObj.Destroy;
begin
   inherited Destroy;
end;

procedure TSoundObj.Initial (pd : PTCreateSoundObjData);
begin
   inherited Initial (pd^.Name, '');

   BasicData.id := GetNewItemId;

   BasicData.x := pd^.X;
   BasicData.y := pd^.Y;
   BasicData.nx := pd^.X;
   BasicData.ny := pd^.Y;
   BasicData.ClassKind := CLASS_SERVEROBJ;
   BasicData.Feature.rRace := RACE_ITEM;
   BasicData.Feature.rImageNumber := 0;
   BasicData.Feature.rImageColorIndex := 0;

   SoundName := pd^.SoundName;

   UpdatedTick := 0;
   PlayedTick := 0;
   PlayInterval := pd^.PlayInterval;
end;

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

   inherited EndProcess;
end;

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

procedure TSoundObj.Update (CurTick: integer);
var
   i, iCount : Integer;
   xx, yy : Word;
   BasicObject : TBasicObject;
   SubData : TSubData;
begin
   if CurTick < UpdatedTick + 100 then exit;
   UpdatedTick := CurTick;

   if CurTick >= PlayedTick + PlayInterval then begin
      SetWordString (SubData.SayString, SoundName + '.wav'); 
      SendLocalMessage (NOTARGETPHONE, FM_SOUND, BasicData, SubData);
      PlayedTick := CurTick;
   end;
end;

// TSoundObjList
constructor TSoundObjList.Create;
begin
   DataList := TList.Create;
   LoadFromFile ('.\Setting\CreateSoundObject.SDB');
end;

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

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

   DataList.Clear;
end;

function TSoundObjList.LoadFromFile (aFileName : String) : Boolean;
var
   i : Integer;
   iName : String;
   DB : TUserStringDB;
   SoundObj : TSoundObj;
   csod : TCreateSoundObjData;
   Manager : TManager;
begin
   Result := false;

   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;

      csod.Name := iName;
      csod.SoundName := DB.GetFieldValueString (iName, 'SoundName');
      csod.MapID := DB.GetFieldValueInteger (iName, 'MapID');
      csod.X := DB.GetFieldValueInteger (iName, 'X');
      csod.Y := DB.GetFieldValueInteger (iName, 'Y');
      csod.PlayInterval := DB.GetFieldValueInteger (iName, 'PlayInterval');

      Manager := ManagerList.GetManagerByServerID (csod.MapID);
      if Manager <> nil then begin
         SoundObj := TSoundObj.Create;
         SoundObj.SetManagerClass (Manager);
         SoundObj.Initial (@csod);
         SoundObj.StartProcess;

         DataList.Add (SoundObj);
      end;
   end;
   DB.Free;

   Result := true;
end;

procedure TSoundObjList.Update (CurTick : Integer);
var
   i : Integer;
   SoundObj : TSoundObj;
begin
   for i := 0 to DataList.Count - 1 do begin
      SoundObj := DataList.Items [i];
      SoundObj.Update (CurTick);
   end;
end;


end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -