playscn.pas

在网上有很多传奇源程序DELPHI

function  TPlayScene.GetDropItems (x, y: integer; var inames: string): PTDropItem; //拳搁谅钎肺 酒捞袍
var
   k, i, ccx, ccy, ssx, ssy, dx, dy: integer;
   d: PTDropItem;
   s: TDirectDrawSurface;
   c: byte;
begin
   Result := nil;
   CXYfromMouseXY (x, y, ccx, ccy);
   ScreenXYfromMCXY (ccx, ccy, ssx, ssy);
   dx := x - ssx;
   dy := y - ssy;
   inames := '';
   for i:=0 to DropedItemList.Count-1 do begin
      d := PTDropItem(DropedItemList[i]);
      if (d.X = ccx) and (d.Y = ccy) then begin
         s := FrmMain.WDnItem.Images[d.Looks];
         if s = nil then continue;
         dx := (x - ssx) + (s.Width div 2) - 3;
         dy := (y - ssy) + (s.Height div 2);
         c := s.Pixels[dx, dy];
         if c <> 0 then begin
            if Result = nil then Result := d;
            inames := inames + d.Name + '\';   
            //break;
         end;
      end;
   end;
end;

function  TPlayScene.CanRun (sx, sy, ex, ey: integer): Boolean;
var
   ndir, rx, ry: integer;
begin
   ndir := GetNextDirection (sx, sy, ex, ey);
   rx := sx;
   ry := sy;
   GetNextPosXY (ndir, rx, ry);
   if CanWalk (rx, ry) and CanWalk (ex, ey) then
      Result := TRUE
   else Result := FALSE;
end;

function  TPlayScene.CanWalk (mx, my: integer): Boolean;
begin
   Result := FALSE;
   if Map.CanMove(mx,my) then
      Result := not CrashMan (mx, my);
end;

function  TPlayScene.CrashMan (mx, my: integer): Boolean;
var
   i: integer;
   a: TActor;
begin
   Result := FALSE;
   for i:=0 to ActorList.Count-1 do begin
      a := TActor(ActorList[i]);
      if (a.Visible) and (a.BoHoldPlace) and (not a.Death) and (a.XX = mx) and (a.YY = my) then begin
         Result := TRUE;
         break;
      end;
   end;
end;

function  TPlayScene.CanFly (mx, my: integer): Boolean;
begin
   Result := Map.CanFly (mx, my);
end;


{------------------------ Actor ------------------------}

function  TPlayScene.FindActor (id: integer): TActor;
var
   i: integer;
begin
   Result := nil;
   for i:=0 to ActorList.Count-1 do begin
      if TActor(ActorList[i]).RecogId = id then begin
         Result := TActor(ActorList[i]);
         break;
      end;
   end;
end;

function  TPlayScene.FindActorXY (x, y: integer): TActor;  //甘 谅钎肺 actor 掘澜
var
   i: integer;
begin
   Result := nil;
   for i:=0 to ActorList.Count-1 do begin
      if (TActor(ActorList[i]).XX = x) and (TActor(ActorList[i]).YY = y) then begin
         Result := TActor(ActorList[i]);
         if not Result.Death and Result.Visible and Result.BoHoldPlace then
            break;
      end;
   end;
end;

function  TPlayScene.IsValidActor (actor: TActor): Boolean;
var
   i: integer;
begin
   Result := FALSE;
   for i:=0 to ActorList.Count-1 do begin
      if TActor(ActorList[i]) = actor then begin
         Result := TRUE;
         break;
      end;
   end;
end;

function  TPlayScene.NewActor (chrid:     integer;
                               cx:        word; //x
                               cy:        word; //y
                               cdir:      word;
                               cfeature:  integer; //race, hair, dress, weapon
                               cstate:    integer): TActor;
var
   i: integer;
   actor: TActor;
begin
   for i:=0 to ActorList.Count-1 do
      if TActor(ActorList[i]).RecogId = chrid then begin
         Result := TActor(ActorList[i]);
         exit; //捞固 乐澜
      end;
   if IsChangingFace (chrid) then exit;  //函脚吝...

   case RACEfeature (cfeature) of
      0:  actor := THumActor.Create;
      13: actor := TKillingHerb.Create;
      14: actor := TSkeletonOma.Create;
      15: actor := TDualAxeOma.Create;

      16: actor := TGasKuDeGi.Create;  //啊胶筋绰 备单扁

      17: actor := TCatMon.Create;   //豹捞, 快搁蓖(快搁蓖,芒电快搁蓖,枚硼快搁蓖)
      18: actor := THuSuABi.Create;
      19: actor := TCatMon.Create;   //快搁蓖(快搁蓖,芒电快搁蓖,枚硼电快搁蓖)

      20: actor := TFireCowFaceMon.Create;
      21: actor := TCowFaceKing.Create;
      22: actor := TDualAxeOma.Create;  //魔筋绰 促农
      23: actor := TWhiteSkeleton.Create;  //家券归榜

      30: actor := TCatMon.Create; //朝俺窿
      31: actor := TCatMon.Create; //朝俺窿
      32: actor := TScorpionMon.Create; //傍拜捞 2悼累

      33: actor := TCentipedeKingMon.Create;  //瘤匙空

      40: actor := TZombiLighting.Create;  //粱厚 1 (傈扁 付过 粱厚)
      41: actor := TZombiDigOut.Create;  //顶颇绊 唱坷绰 粱厚
      42: actor := TZombiZilkin.Create;

      43: actor := TBeeQueen.Create;

      45: actor := TArcherMon.Create;
      47: actor := TSculptureMon.Create;  //堪家厘焙, 堪家措厘
      48: actor := TSculptureMon.Create;  //
      49: actor := TSculptureKingMon.Create;  //林付空

      50: actor := TNpcActor.Create;

      52, 53: actor := TGasKuDeGi.Create;  //啊胶筋绰 禁扁唱规, 嫡
      54: actor := TSmallElfMonster.Create;
      55: actor := TWarriorElfMonster.Create;

      98: actor := TWallStructure.Create;
      99: actor := TCastleDoor.Create;  //己巩...


      else actor := TActor.Create;
   end;

   with actor do begin
      RecogId := chrid;
      XX     := cx;
      YY     := cy;
      Rx := XX;
      Ry := YY;
      Dir    := cdir;
      Feature := cfeature;
      Race   := RACEfeature (cfeature);         //changefeature啊 乐阑锭父
      hair   := HAIRfeature (cfeature);         //函版等促.
      dress  := DRESSfeature (cfeature);
      weapon := WEAPONfeature (cfeature);
      Appearance := APPRfeature (cfeature);
      if Race = 0 then begin
         Sex := dress mod 2;   //0:巢磊 1:咯磊
      end else
         Sex := 0;
      state  := cstate;
      Saying[0] := '';
   end;
   ActorList.Add (actor);
   Result := actor;
end;

procedure TPlayScene.ActorDied (actor: TObject);
var
   i: integer;
   flag: Boolean;
begin
   for i:=0 to ActorList.Count-1 do
      if ActorList[i] = actor then begin
         ActorList.Delete (i);
         break;
      end;
   flag := FALSE;
   for i:=0 to ActorList.Count-1 do
      if not TActor(ActorList[i]).Death then begin
         ActorList.Insert (i, actor);
         flag := TRUE;
         break;
      end;
   if not flag then ActorList.Add (actor);
end;

procedure TPlayScene.SetActorDrawLevel (actor: TObject; level: integer);
var
   i: integer;
begin
   if level = 0 then begin  //盖 贸澜俊 弊府档废 窃
      for i:=0 to ActorList.Count-1 do
         if ActorList[i] = actor then begin
            ActorList.Delete (i);
            ActorList.Insert (0, actor);
            break;
         end;
   end;
end;

procedure TPlayScene.ClearActors;  //肺弊酒眶父 荤侩
var
   i: integer;
begin
   for i:=0 to ActorList.Count-1 do
      TActor(ActorList[i]).Free;
   ActorList.Clear;
   Myself := nil;
   TargetCret := nil;
   FocusCret := nil;
   MagicTarget := nil;

   //付过档 檬扁拳 秦具窃.
   for i:=0 to EffectList.Count-1 do
      TMagicEff (EffectList[i]).Free;
   EffectList.Clear;
end;

function  TPlayScene.DeleteActor (id: integer): TActor;
var
   i: integer;
begin
   Result := nil;
   i := 0;
   while TRUE do begin
      if i >= ActorList.Count then break;
      if TActor(ActorList[i]).RecogId = id then begin
         if TargetCret = TActor(ActorList[i]) then TargetCret := nil;
         if FocusCret = TActor(ActorList[i]) then FocusCret := nil;
         if MagicTarget = TActor(ActorList[i]) then MagicTarget := nil;
         TActor(ActorList[i]).DeleteTime := GetTickCount;
         FreeActorList.Add (ActorList[i]);
         //TActor(ActorList[i]).Free;
         ActorList.Delete (i);
      end else
         Inc (i);
   end;
end;

procedure TPlayScene.DelActor (actor: TObject);
var
   i: integer;
begin
   for i:=0 to ActorList.Count-1 do
      if ActorList[i] = actor then begin
         TActor(ActorList[i]).DeleteTime := GetTickCount;
         FreeActorList.Add (ActorList[i]);
         ActorList.Delete (i);
         break;
      end;
end;

function  TPlayScene.ButchAnimal (x, y: integer): TActor;
var
   i: integer;
   a: TActor;
begin
   Result := nil;
   for i:=0 to ActorList.Count-1 do begin
      a := TActor(ActorList[i]);
      if a.Death and (a.Race <> 0) then begin //悼拱 矫眉
         if (abs(a.XX - x) <= 1) and (abs(a.YY - y) <= 1) then begin
            Result := a;
            break;
         end;
      end;
   end;
end;


{------------------------- Msg -------------------------}


//皋技瘤甫 滚欺傅窍绰 捞蜡绰 ?
//某腐磐狼 皋技瘤 滚欺俊 皋技瘤啊 巢酒 乐绰 惑怕俊辑
//促澜 皋技瘤啊 贸府登搁 救登扁 锭巩烙.
procedure TPlayScene.SendMsg (ident, chrid, x, y, cdir, feature, state: integer; str: string);
var
   actor: TActor;
begin
   case ident of
      SM_TEST:
         begin
            actor := NewActor (111, 254{x}, 214{y}, 0, 0, 0);
            Myself := THumActor (actor);
            Map.LoadMap ('0', Myself.XX, Myself.YY);
         end;
      SM_CHANGEMAP,      //634
      SM_NEWMAP:         //51
         begin
            Map.LoadMap (str, x, y);
            DarkLevel := cdir;
            if DarkLevel = 0 then ViewFog := FALSE
            else ViewFog := TRUE;
            BoViewMiniMap := FALSE;
            if (ident = SM_NEWMAP) and (Myself <> nil) then begin  //辑滚捞悼 且锭 何靛反霸 甘捞悼阑 窍霸 父甸妨绊
               Myself.XX := x;
               Myself.YY := y;
               Myself.RX := x;
               Myself.RY := y;
               DelActor (Myself);
            end;
         end;
      SM_LOGON:        //50
         begin
            actor := FindActor (chrid);
            if actor = nil then begin
               actor := NewActor (chrid, x, y, Lobyte(cdir), feature, state);
               actor.ChrLight := Hibyte(cdir);
               cdir := Lobyte(cdir);
               actor.SendMsg (SM_TURN, x, y, cdir, feature, state, '', 0);
            end;
            if Myself <> nil then begin
               Myself := nil;
            end;
            Myself := THumActor (actor);
         end;
      SM_HIDE:
         begin
            actor := FindActor (chrid);
            if actor <> nil then begin
               if actor.BoDelActionAfterFinished then begin //顶栏肺 荤扼瘤绰 局聪皋捞记捞 场唱搁 磊悼栏肺 荤扼咙.
                  exit;
               end;
               if actor.WaitForRecogId <> 0 then begin  //函脚吝.. 函脚捞 场唱搁 磊悼栏肺 荤扼咙
                  exit;
               end;
            end;
            DeleteActor (chrid);
         end;
      else
         begin
            actor := FindActor (chrid);
            if (ident=SM_TURN) or (ident=SM_RUN) or (ident=SM_WALK) or
               (ident=SM_BACKSTEP) or
               (ident = SM_DEATH) or (ident = SM_SKELETON) or
               (ident = SM_DIGUP) or (ident = SM_ALIVE) then
            begin
               if actor = nil then
                  actor := NewActor (chrid, x, y, Lobyte(cdir), feature, state);
               if actor <> ni