dxsprite.pas

传奇源代码的delphi版本

{$IFDEF Ver4Up}

procedure TSprite.SetGroupNumber(AGroupNumber: integer);
begin
  if (AGroupNumber <> GroupNumber) and
    (Engine <> nil) then
  begin
    if Groupnumber >= 0 then
      Engine.Groups[GroupNumber].Remove(self);
    if AGroupNumber >= 0 then
      Engine.Groups[AGroupNumber].Add(self);
  end;
end; {SetGroupNumber}

procedure TSprite.SetSelected(ASelected: Boolean);
begin
  if (ASelected <> fSelected) and
    (Engine <> nil) then
  begin
    fSelected := ASelected;
    if Selected then
      Engine.CurrentSelected.Add(self)
    else
      Engine.CurrentSelected.Remove(self);
    Engine.fObjectsSelected := Engine.CurrentSelected.count <> 0;
  end;
end;
{$ENDIF}

procedure TSprite.Add(Sprite: TSprite);
begin
  if FList = nil then
  begin
    FList := TList.Create;
    FDrawList := TList.Create;
  end;
  FList.Add(Sprite);
  AddDrawList(Sprite);
end;

procedure TSprite.Remove(Sprite: TSprite);
begin
  FList.Remove(Sprite);
  FDrawList.Remove(Sprite);
  if FList.Count = 0 then
  begin
    FList.Free;
    FList := nil;
    FDrawList.Free;
    FDrawList := nil;
  end;
end;

procedure TSprite.AddDrawList(Sprite: TSprite);
var
  L, H, I, C: integer;
begin
  L := 0;
  H := FDrawList.Count - 1;
  while L <= H do
  begin
    I := (L + H) div 2;
    C := TSprite(FDrawList[I]).Z - Sprite.Z;
    if C < 0 then
      L := I + 1
    else
      H := I - 1;
  end;
  FDrawList.Insert(L, Sprite);
end;

procedure TSprite.Clear;
begin
  while Count > 0 do
    Items[Count - 1].Free;
end;

function TSprite.Collision: integer;
var
  i: integer;
begin
  Result := 0;
  if (FEngine <> nil) and (not FDeaded) and (Collisioned) then
  begin
    with FEngine do
    begin
      FCollisionCount := 0;
      FCollisionDone := False;
      FCollisionRect := Self.BoundsRect;
      FCollisionSprite := Self;

      for i := 0 to Count - 1 do
        Items[i].Collision2;

      Result := FCollisionCount;
    end;
  end;
end;

procedure TSprite.Collision2;
var
  i: integer;
begin
  if Collisioned then
  begin
    if (Self <> FEngine.FCollisionSprite) and OverlapRect(BoundsRect,
      FEngine.FCollisionRect) and FEngine.FCollisionSprite.TestCollision(Self) and
      TestCollision(FEngine.FCollisionSprite) then
    begin
      Inc(FEngine.FCollisionCount);
      FEngine.FCollisionSprite.DoCollision(Self, FEngine.FCollisionDone);
      if (not FEngine.FCollisionSprite.Collisioned) or
        (FEngine.FCollisionSprite.FDeaded) then
      begin
        FEngine.FCollisionDone := True;
      end;
    end;
    if FEngine.FCollisionDone then
      Exit;
    for i := 0 to Count - 1 do
      Items[i].Collision2;
  end;
end;

procedure TSprite.Dead;
begin
  if (FEngine <> nil) and (not FDeaded) then
  begin
    FDeaded := True;
    FEngine.FDeadList.Add(Self);
  end;
end;

procedure TSprite.DoMove(MoveCount: integer);
begin
  if AsSigned(FOnMove) then
    FOnMove(Self, MoveCount);
end;

procedure TSprite.DoDraw;
begin
  if AsSigned(FOnDraw) then
    FOnDraw(Self);
end;

procedure TSprite.DoCollision(Sprite: TSprite; var Done: boolean);
begin
  if AsSigned(FOnCollision) then
    FOnCollision(Sprite, Done);
end;

function TSprite.TestCollision(Sprite: TSprite): boolean;
begin
  Result := True;
end;

procedure TSprite.Move(MoveCount: integer);
var
  i: integer;
begin
  if FMoved then
  begin
    DoMove(MoveCount);
    for i := 0 to Count - 1 do
      Items[i].Move(MoveCount);
  end;
end;

procedure TSprite.Draw;
var
  i: integer;
begin
  if FVisible then
  begin
    if FEngine <> nil then
    begin
      if OverlapRect(FEngine.FSurfaceRect, BoundsRect) then
      begin
        DoDraw;
        Inc(FEngine.FDrawCount);
      end;
    end;

    if FDrawList <> nil then
    begin
      for i := 0 to FDrawList.Count - 1 do
        TSprite(FDrawList[i]).Draw;
    end;
  end;
end;

function TSprite.GetSpriteAt(X, Y: integer): TSprite;

  procedure Collision_GetSpriteAt(X, Y: double; Sprite: TSprite);
  var
    i: integer;
    X2, Y2: double;
  begin
    if Sprite.Visible and PointInRect(Point(Round(X), Round(Y)),
      Bounds(Round(Sprite.X), Round(Sprite.Y), Sprite.Width, Sprite.Width)) then
    begin
      if (Result = nil) or (Sprite.Z > Result.Z) then
        Result := Sprite;
    end;

    X2 := X - Sprite.X;
    Y2 := Y - Sprite.Y;
    for i := 0 to Sprite.Count - 1 do
      Collision_GetSpriteAt(X2, Y2, Sprite.Items[i]);
  end;

var
  i: integer;
  X2, Y2: double;
begin
  Result := nil;

  X2 := X - Self.X;
  Y2 := Y - Self.Y;
  for i := 0 to Count - 1 do
    Collision_GetSpriteAt(X2, Y2, Items[i]);
end;

function TSprite.GetBoundsRect: TRect;
begin
  Result := Bounds(Round(WorldX), Round(WorldY), Width, Height);
end;

function TSprite.GetClientRect: TRect;
begin
  Result := Bounds(0, 0, Width, Height);
end;

function TSprite.GetCount: integer;
begin
  if FList <> nil then
    Result := FList.Count
  else
    Result := 0;
end;

function TSprite.GetItem(Index: integer): TSprite;
begin
  if FList <> nil then
    Result := FList[Index]
  else
    raise ESpriteError.CreateFmt(SListIndexError, [Index]);
end;

function TSprite.GetWorldX: double;
begin
  if Parent <> nil then
    Result := Parent.WorldX + FX
  else
    Result := FX;
end;

function TSprite.GetWorldY: double;
begin
  if Parent <> nil then
    Result := Parent.WorldY + FY
  else
    Result := FY;
end;

procedure TSprite.SetZ(Value: integer);
begin
  if FZ <> Value then
  begin
    FZ := Value;
    if Parent <> nil then
    begin
      Parent.FDrawList.Remove(Self);
      Parent.AddDrawList(Self);
    end;
  end;
end;

procedure TSprite.Assign(Source: TPersistent);
begin
  if Source is TSprite then begin
    FCollisioned := TSprite(Source).FCollisioned;
    FMoved := TSprite(Source).FMoved;
    FVisible := TSprite(Source).FVisible;
    FHeight := TSprite(Source).FHeight;
    FWidth := TSprite(Source).FWidth;
    FX := TSprite(Source).FX;
    FY := TSprite(Source).FY;
    FZ := TSprite(Source).FZ;
{$IFDEF Ver4Up}
    FSelected := TSprite(Source).FSelected;
    FGroupNumber := TSprite(Source).FGroupNumber;
{$ENDIF}
    FOnDraw := TSprite(Source).FOnDraw;
    FOnMove := TSprite(Source).FOnMove;
    FOnCollision := TSprite(Source).FOnCollision;
    FOnGetImage := TSprite(Source).FOnGetImage;
  end
  else
    inherited;
end;

{  TImageSprite  }

constructor TImageSprite.Create(AParent: TSprite);
begin
  inherited Create(AParent);
  FTransparent := True;
end;

procedure TImageSprite.SetImage(AImage: TPictureCollectionItem);
begin
  fImage := AImage;
  if AImage <> nil then
  begin
    Width := AImage.Width;
    Height := AImage.Height;
  end
  else
  begin
    Width := 0;
    Height := 0;
  end;
end; {SetImage}

function TImageSprite.GetBoundsRect: TRect;
var
  dx, dy: integer;
begin
  dx := Round(WorldX);
  dy := Round(WorldY);
  if FTile then
  begin
    dx := Mod2(dx, FEngine.SurfaceRect.Right + Width);
    dy := Mod2(dy, FEngine.SurfaceRect.Bottom + Height);

    if dx > FEngine.SurfaceRect.Right then
      dx := (dx - FEngine.SurfaceRect.Right) - Width;

    if dy > FEngine.SurfaceRect.Bottom then
      dy := (dy - FEngine.SurfaceRect.Bottom) - Height;
  end;

  Result := Bounds(dx, dy, Width, Height);
end;

procedure TImageSprite.DoMove(MoveCount: integer);
begin
  if AsSigned(FOnMove) then
    FOnMove(Self, MoveCount)
  else begin

    ReAnimate(MoveCount);
  end;
end;

function TImageSprite.GetDrawImageIndex: integer;
begin
  Result := FAnimStart + Round(FAnimPos);
end;

function TImageSprite.GetDrawRect: TRect;
begin
  Result := BoundsRect;
  OffsetRect(Result, (Width - Image.Width) div 2, (Height - Image.Height) div 2);
end;

procedure TImageSprite.DoDraw;
var
  ImageIndex: integer;
  r: TRect;
  vImage: TPictureCollectionItem;
begin
  if Image = nil then
    if AsSigned(FOnGetImage) then begin
      vImage := nil;
      FOnGetImage(Self, vImage);
      if vImage <> FImage then
        Image := vImage;
    end;
  if AsSigned(FOnDraw) then
    FOnDraw(Self)
  else
  begin
    ImageIndex := GetDrawImageIndex;
    r := GetDrawRect;
    Image.Draw(FEngine.Surface, r.Left, r.Top, ImageIndex);
  end;
end;

{$WARNINGS OFF}
{$HINTS OFF}

function TImageSprite.ImageCollisionTest(suf1, suf2: TDirectDrawSurface;
  const rect1, rect2: TRect; x1, y1, x2, y2: integer; DoPixelCheck: boolean): boolean;

  function ClipRect(var DestRect: TRect; const DestRect2: TRect): boolean;
  begin
    with DestRect do
    begin
      Left := Max(Left, DestRect2.Left);
      Right := Min(Right, DestRect2.Right);
      Top := Max(Top, DestRect2.Top);
      Bottom := Min(Bottom, DestRect2.Bottom);

      Result := (Left < Right) and (Top < Bottom);
    end;
  end;

type
  PRGB = ^TRGB;

  TRGB = packed record
    R, G, B: byte;
  end;
var
  ddsd1, ddsd2: TDDSURFACEDESC;
  r1, r2, r1a, r2a: TRect;
  tc1, tc2: DWORD;
  x, y, w, h: integer;
  P1, P2: Pointer;
begin
  with rect1 do
    r1 := Bounds(0, 0, Right - Left, Bottom - Top);
  r1a := r1;
  with rect2 do
    r2 := Bounds(0, 0, Right - Left, Bottom - Top);
  r2a := r2;

  with rect2 do
    r2 := Bounds(x2 - x1, y2 - y1, Right - Left, Bottom - Top);

  Result := OverlapRect(r1, r2);

  if (suf1 = nil) or (suf2 = nil) then
    Exit;

  if DoPixelCheck and Result then
  begin
    {  Get Overlapping rectangle  }
    with r1 do
      r1 := Bounds(Max(x2 - x1, 0), Max(y2 - y1, 0), Right - Left, Bottom - Top);
    with r2 do
      r2 := Bounds(Max(x1 - x2, 0), Max(y1 - y2, 0), Right - Left, Bottom - Top);

    ClipRect(r1, r1a);
    ClipRect(r2, r2a);

    w := Min(r1.Right - r1.Left, r2.Right - r2.Left);
    h := Min(r1.Bottom - r1.Top, r2.Bottom - r2.Top);

    ClipRect(r1, bounds(r1.Left, r1.Top, w, h));
    ClipRect(r2, bounds(r2.Left, r2.Top, w, h));

    {  Pixel check !!!  }
    ddsd1.dwSize := SizeOf(ddsd1);

    with rect1 do
      r1 := Bounds(r1.Left + left, r1.Top + top, w, h);
    with rect2 do
      r2 := Bounds(r2.Left + left, r2.Top + top, w, h);

    if suf1 = suf2 then
    begin
      suf2.Lock(r2, ddsd2);
      suf2.unlock;
    end;

    if suf1.Lock(r1, ddsd1) then
    begin
      try
        ddsd2.dwSize := SizeOf(ddsd2);
        if (suf1 = suf2) or suf2.Lock(r2, ddsd2) then
        begin
          try
            {this line out: don't test pixel but rect only, its wrong}
            {if suf1=suf2 then ddsd2 := ddsd1;}
            if ddsd1.ddpfPixelFormat.dwRGBBitCount <> ddsd2.ddpfPixelFormat.dwRGBBitCount
              then
              Exit;

            {  Get transparent color  }