playscn.pas

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

procedure TPlayScene.CleanObjects; //甘阑 颗辫, 磊脚 哗绊 檬扁拳
var
   i: integer;
begin
//删除所有非当前玩家角色
   for i := ActorList.Count-1 downto 0 do begin
      if TActor(ActorList[i]) <> Myself then begin
         TActor(ActorList[i]).Free;
         ActorList.Delete (i);
      end;
   end;
   MsgList.Clear;
   TargetCret := nil;
   FocusCret := nil;
   MagicTarget := nil;
   //付过档 檬扁拳 秦具窃.
     //清除魔法效果
   for i:=0 to GroundEffectList.Count-1 do
      TMagicEff (GroundEffectList[i]).Free;
   GroundEffectList.Clear;
   for i:=0 to EffectList.Count-1 do
      TMagicEff (EffectList[i]).Free;
   EffectList.Clear;
end;

{---------------------- Draw Map -----------------------}
//画地图
procedure TPlayScene.DrawTileMap;
var
   i,j, m,n, imgnum:integer;
   DSurface: TDirectDrawSurface;
begin
   with Map do
      if (ClientRect.Left = OldClientRect.Left) and (ClientRect.Top = OldClientRect.Top) then exit;
   Map.OldClientRect := Map.ClientRect;
   MapSurface.Fill(0);//.Erase(0);
   //画地面
   with Map.ClientRect do begin
      m := -UNITY*2;
      for j:=(Top - Map.BlockTop-1) to (Bottom - Map.BlockTop+1) do begin
         n := AAX + 14 -UNITX;
         for i:=(Left - Map.BlockLeft-2) to (Right - Map.BlockLeft+1) do begin
            if (i >= 0) and (i < LOGICALMAPUNIT*3) and (j >= 0) and (j < LOGICALMAPUNIT*3) then begin
               imgnum := (Map.MArr[i, j].BkImg and $7FFF);
               if imgnum > 0 then begin
                  if (i mod 2 = 0) and (j mod 2 = 0) then begin
                     imgnum := imgnum - 1;
                     DSurface := FrmMain.WTiles.Images[imgnum];
                     if Dsurface <> nil then
                        MapSurface.Draw (n, m, DSurface.ClientRect, DSurface, FALSE);
                  end;
               end;
            end;
            Inc (n, UNITX);
         end;
         Inc (m, UNITY);
      end;
   end;
  //画地面上的物体
   with Map.ClientRect do begin
      m := -UNITY;
      for j:=(Top - Map.BlockTop-1) to (Bottom - Map.BlockTop+1) do begin
         n := AAX + 14 -UNITX;
         for i:=(Left - Map.BlockLeft-2) to (Right - Map.BlockLeft+1) do begin
            if (i >= 0) and (i < LOGICALMAPUNIT*3) and (j >= 0) and (j < LOGICALMAPUNIT*3) then begin
               imgnum := Map.MArr[i, j].MidImg;
               if imgnum > 0 then begin
                  imgnum := imgnum - 1;
                  DSurface := FrmMain.WSmTiles.Images[imgnum];
                  if Dsurface <> nil then
                     MapSurface.Draw (n, m, DSurface.ClientRect, DSurface, TRUE);
               end;
            end;
            Inc (n, UNITX);
         end;
         Inc (m, UNITY);
      end;
   end;

end;

{----------------------- 器弊, 扼捞飘 贸府 -----------------------}

//从文件中装载雾
procedure TPlayScene.LoadFog;  //扼捞飘 单捞鸥 佬扁
var
   i, fhandle, w, h, prevsize: integer;
   cheat: Boolean;
begin
   prevsize := 0; //炼累 眉农
   cheat := FALSE;
   for i:=0 to MAXLIGHT do begin
      if FileExists (LightFiles[i]) then begin
         fhandle := FileOpen (LightFiles[i], fmOpenRead or fmShareDenyNone);
         FileRead (fhandle, w, sizeof(integer));
         FileRead (fhandle, h, sizeof(integer));
         Lights[i].Width := w;
         Lights[i].Height := h;
         Lights[i].PFog := AllocMem  (w * h + 8);
         if prevsize < w * h then begin
            FileRead (fhandle, Lights[i].PFog^, w*h);
         end else
            cheat := TRUE;
         prevsize := w * h;
         FileClose (fhandle);
      end;
   end;
   if cheat then
      for i:=0 to MAXLIGHT do begin
         if Lights[i].PFog <> nil then
            FillChar (Lights[i].PFog^, Lights[i].Width*Lights[i].Height+8, #0);
      end;
end;
procedure TPlayScene.ClearLightMap;
var
   i, j: integer;
begin
   FillChar (LightMap, (LMX+1)*(LMY+1)*sizeof(TLightMapInfo), 0);
   for i:=0 to LMX do
      for j:=0 to LMY do
         LightMap[i, j].Light := -1;
end;

procedure TPlayScene.UpdateBright (x, y, light: integer);
var
   i, j, r, lx, ly: integer;
   pmask: ^ShortInt;
begin
   r := -1;
   case light of
      0: begin r := 2; pmask := @LightMask0; end;
      1: begin r := 4; pmask := @LightMask1; end;
      2: begin r := 8; pmask := @LightMask2; end;
      3: begin r := 10; pmask := @LightMask3; end;
      4: begin r := 14; pmask := @LightMask4; end;
      5: begin r := 16; pmask := @LightMask5; end;
   end;
   for i:=0 to r do
      for j:=0 to r do begin
         lx := x-(r div 2)+i;
         ly := y-(r div 2)+j;
         if (lx in [0..LMX]) and (ly in [0..LMY]) then
            LightMap[lx, ly].bright := LightMap[lx, ly].bright + PShoftInt(integer(pmask) + (i*(r+1) + j) * sizeof(shortint))^;
      end;
end;

function  TPlayScene.CheckOverLight (x, y, light: integer): Boolean;
var
   i, j, r, mlight, lx, ly, count, check: integer;
   pmask: ^ShortInt;
begin
   r := -1;
   case light of
      0: begin r := 2; pmask := @LightMask0; check := 0; end;
      1: begin r := 4; pmask := @LightMask1; check := 4; end;
      2: begin r := 8; pmask := @LightMask2; check := 8; end;
      3: begin r := 10; pmask := @LightMask3; check := 18; end;
      4: begin r := 14; pmask := @LightMask4; check := 30; end;
      5: begin r := 16; pmask := @LightMask5; check := 40; end;
   end;
   count := 0;
   for i:=0 to r do
      for j:=0 to r do begin
         lx := x-(r div 2)+i;
         ly := y-(r div 2)+j;
         if (lx in [0..LMX]) and (ly in [0..LMY]) then begin
            mlight := PShoftInt(integer(pmask) + (i*(r+1) + j) * sizeof(shortint))^;
            if LightMap[lx, ly].bright < mlight then begin
               inc (count, mlight - LightMap[lx, ly].bright);
               if count >= check then begin
                  Result := FALSE;
                  exit;
               end;
            end;
         end;
      end;
   Result := TRUE;
end;

procedure TPlayScene.AddLight (x, y, shiftx, shifty, light: integer; nocheck: Boolean);
var
   lx, ly: integer;
begin
   lx := x - Myself.Rx + LMX div 2;
   ly := y - Myself.Ry + LMY div 2;
   if (lx >= 1) and (lx < LMX) and (ly >= 1) and (ly < LMY) then begin
      if LightMap[lx, ly].light < light then begin
         if not CheckOverLight(lx, ly, light) or nocheck then begin // > LightMap[lx, ly].light then begin
            UpdateBright (lx, ly, light);
            LightMap[lx, ly].light := light;
            LightMap[lx, ly].Shiftx := shiftx;
            LightMap[lx, ly].Shifty := shifty;
         end;
      end;
   end;
end;

procedure TPlayScene.ApplyLightMap;
var
   i, j, light, defx, defy, lx, ly, lxx, lyy, lcount: integer;
begin


   defx := -UNITX*2 + AAX + 14 - Myself.ShiftX;
   defy := -UNITY*3 - Myself.ShiftY;
   lcount := 0;
   for i:=1 to LMX-1 do
      for j:=1 to LMY-1 do begin
         light := LightMap[i, j].light;
         if light >= 0 then begin
            lx := (i + Myself.Rx - LMX div 2);
            ly := (j + Myself.Ry - LMY div 2);
            lxx := (lx-Map.ClientRect.Left)*UNITX + defx + LightMap[i, j].ShiftX;
            lyy := (ly-Map.ClientRect.Top)*UNITY + defy + LightMap[i, j].ShiftY;

            FogCopy (Lights[light].PFog,
                     0,
                     0,
                     Lights[light].Width,
                     Lights[light].Height,
                     PFogScreen,
                     lxx - (Lights[light].Width-UNITX) div 2,
                     lyy - (Lights[light].Height-UNITY) div 2 - 5,
                     FogWidth,
                     FogHeight,
                     20);
            inc (lcount);
         end;
      end;
end;

procedure TPlayScene.DrawLightEffect (lx, ly, bright: integer);
begin

   if (bright > 0) and (bright <= MAXLIGHT) then
      FogCopy (Lights[bright].PFog,
               0,
               0,
               Lights[bright].Width,
               Lights[bright].Height,
               PFogScreen,
               lx - (Lights[bright].Width-UNITX) div 2,
               ly - (Lights[bright].Height-UNITY) div 2,
               FogWidth,
               FogHeight,
               15);
end;

{-----------------------------------------------------------------------}

procedure TPlayScene.DrawMiniMap (surface: TDirectDrawSurface);
var
   d: TDirectDrawSurface;
   v: Boolean;
   mx, my: integer;
   rc: TRect;
begin
   if GetTickCount > BlinkTime + 300 then begin
   //当前玩家在小地图上的位置，每300毫秒闪一次
      BlinkTime := GetTickCount;
      ViewBlink := not ViewBlink;
   end;

   d := FrmMain.WMMap.Images[MiniMapIndex];
   if d <> nil then begin
      mx := (Myself.XX*48) div 32;
      my := (Myself.YY*32) div 32;
      rc.Left := _MAX(0, mx-60);
      rc.Top := _MAX(0, my-60);
      rc.Right := _MIN(d.ClientRect.Right, rc.Left + 120);
      rc.Bottom := _MIN(d.ClientRect.Bottom, rc.Top + 120);
      //surface.Draw (0, 0, rc, d, FALSE);
      DrawBlendEx (surface, (SCREENWIDTH-120), 0, d, rc.Left, rc.Top, 120, 120, 0);
      if ViewBlink then begin
      //显示当前角色所在的位置
         mx := (SCREENWIDTH-120) + (Myself.XX*48) div 32 - rc.Left;
         my := (Myself.YY*32) div 32 - rc.Top;
         surface.Pixels[mx, my] := 255;
      end;
   end;
end;


{-----------------------------------------------------------------------}

//画游戏正式场景
procedure TPlayScene.PlayScene (MSurface: TDirectDrawSurface);
  //检查myrc区域是否完全在obrc区域内
   function  CheckOverlappedObject (myrc, obrc: TRect): Boolean;
   begin
      if (obrc.Right > myrc.Left) and (obrc.Left < myrc.Right) and
         (obrc.Bottom > myrc.Top) and (obrc.Top < myrc.Bottom) then
         Result := TRUE
      else Result := FALSE;
   end;

var
   i, j, k, n, m, mmm, ix, iy, line, defx, defy, wunit, fridx, ani, anitick, ax, ay, idx, drawingbottomline: integer;
   DSurface, d: TDirectDrawSurface;
   blend, movetick: Boolean;
   //myrc, obrc: TRect;
   pd: PTDropItem;
   evn: TClEvent;
   actor: TActor;
   meff: TMagicEff;
   msgstr: string;
begin
  //当点了LogOut后，注销角色，返回选择角色画面
   if (Myself = nil) then begin
      msgstr := '正在注销，请梢后......';
      with MSurface.Canvas do begin
         SetBkMode (Handle, TRANSPARENT);
         BoldTextOut (MSurface, (SCREENWIDTH-TextWidth(msgstr)) div 2, 200,
                      clWhite, clBlack, msgstr);
         Release;
      end;
      exit;
   end;
   //关闭快速淡出模式
   DoFastFadeOut := FALSE;

   //200毫秒MoveStepCount归零
   movetick := FALSE;
   if GetTickCount - MoveTime >= 100 then begin
      MoveTime := GetTickCount;   //捞悼狼 悼扁拳
      movetick := TRUE;          //捞悼 平
      Inc (MoveStepCount);
      if MoveStepCount > 1 then MoveStepCount := 0;
   end;
   //50X100000毫秒AniCount归零
   if GetTickCount - AniTime >= 50 then begin
      AniTime := GetTickCount;
      Inc (AniCount);
      if AniCount > 100000 then AniCount := 0;
   end;
   //运动物体的移动计算
   try
   i := 0;                          //角色编号
   while TRUE do begin              //Frame 贸府绰 咯扁辑 救窃.
      if i >= ActorList.Count then break;
      actor := ActorList[i];
      if movetick then actor.LockEndFrame := FALSE;
      if not actor.LockEndFrame then begin
         actor.ProcMsg;   //处理角色的消息.actor啊 瘤况龙 荐 乐澜.
         if movetick then
            if actor.Move(MoveStepCount) then begin  //悼扁拳秦辑 框流烙
               Inc (i);
               continue;
            end;
         actor.Run;    //某腐磐甸阑 框流捞霸 窃.
         if actor <> Myself then actor.ProcHurryMsg;
      end;
      if actor = Myself then actor.ProcHurryMsg;
      //函脚牢 版快
      if actor.WaitForRecogId <> 0 then begin
         if actor.IsIdle then begin
            DelChangeFace (actor.WaitForRecogId);
            NewActor (actor.WaitForRecogId, actor.XX, actor.YY, actor.Dir, actor.WaitForFeature, actor.WaitForStatus);
            actor.WaitForRecogId := 0;
            actor.BoDelActor := TRUE;
         end;
      end;
      if actor.BoDelActor then begin
         //actor.Free;
         FreeActorList.Add (actor);
         ActorList.Delete (i);
         if TargetCret = actor then TargetCret := nil;
         if FocusCret = actor then FocusCret := nil;
         if MagicTarget = actor then MagicTarget := nil;
      end else
         Inc (i);
   end;
   except
      DebugOutStr ('101');
   end;