dxsprite.pas

传奇源代码的delphi版本

            tc1 := ddsd1.ddckCKSrcBlt.dwColorSpaceLowValue;
            tc2 := ddsd2.ddckCKSrcBlt.dwColorSpaceLowValue;

            case ddsd1.ddpfPixelFormat.dwRGBBitCount of
              8:
                begin
                  for y := 0 to h - 1 do
                  begin
                    P1 := Pointer(integer(ddsd1.lpSurface) + y * ddsd1.lPitch);
                    P2 := Pointer(integer(ddsd2.lpSurface) + y * ddsd2.lPitch);
                    for x := 0 to w - 1 do
                    begin
                      if (PByte(P1)^ <> tc1) and (PByte(P2)^ <> tc2) then
                        Exit;
                      Inc(PByte(P1));
                      Inc(PByte(P2));
                    end;
                  end;
                end;
              16:
                begin
                  for y := 0 to h - 1 do
                  begin
                    P1 := Pointer(integer(ddsd1.lpSurface) + y * ddsd1.lPitch);
                    P2 := Pointer(integer(ddsd2.lpSurface) + y * ddsd2.lPitch);
                    for x := 0 to w - 1 do
                    begin
                      if (PWord(P1)^ <> tc1) and (PWord(P2)^ <> tc2) then
                        Exit;
                      Inc(PWord(P1));
                      Inc(PWord(P2));
                    end;
                  end;
                end;
              24:
                begin
                  for y := 0 to h - 1 do
                  begin
                    P1 := Pointer(integer(ddsd1.lpSurface) + y * ddsd1.lPitch);
                    P2 := Pointer(integer(ddsd2.lpSurface) + y * ddsd2.lPitch);
                    for x := 0 to w - 1 do
                    begin
                      with PRGB(P1)^ do
                        if (R shl 16) or (G shl 8) or B <> tc1 then
                          Exit;
                      with PRGB(P2)^ do
                        if (R shl 16) or (G shl 8) or B <> tc2 then
                          Exit;
                      Inc(PRGB(P1));
                      Inc(PRGB(P2));
                    end;
                  end;
                end;
              32:
                begin
                  for y := 0 to h - 1 do
                  begin
                    P1 := Pointer(integer(ddsd1.lpSurface) + y * ddsd1.lPitch);
                    P2 := Pointer(integer(ddsd2.lpSurface) + y * ddsd2.lPitch);
                    for x := 0 to w - 1 do
                    begin
                      if (PDWORD(P1)^ <> tc1) and (PDWORD(P2)^ <> tc2) then
                        Exit;
                      Inc(PDWORD(P1));
                      Inc(PDWORD(P2));
                    end;
                  end;
                end;
            end;
          finally
            if suf1 <> suf2 then
              suf2.UnLock;
          end;
        end;
      finally
        suf1.UnLock;
      end;
    end;

    Result := False;
  end;
end;

{$HINTS ON}
{$WARNINGS ON}

function TImageSprite.TestCollision(Sprite: TSprite): boolean;
var
  img1, img2: integer;
  box1, box2: TRect;
begin
  if (Sprite is TImageSprite) and FPixelCheck then
  begin
    box1 := GetDrawRect;
    box2 := TImageSprite(Sprite).GetDrawRect;

    img1 := GetDrawImageIndex;
    img2 := TImageSprite(Sprite).GetDrawImageIndex;

    Result := ImageCollisionTest(Image.PatternSurfaces[img1],
      TImageSprite(Sprite).Image.PatternSurfaces[img2], Image.PatternRects[img1],
      TImageSprite(Sprite).Image.PatternRects[img2], box1.Left, box1.Top,
      box2.Left, box2.Top, True);
  end
  else
    Result := inherited TestCollision(Sprite);
end;

procedure TImageSprite.Assign(Source: TPersistent);
begin
  if Source is TImageSprite then begin
    FAnimCount := TImageSprite(Source).FAnimCount;
    FAnimLooped := TImageSprite(Source).FAnimLooped;
    FAnimPos := TImageSprite(Source).FAnimPos;
    FAnimSpeed := TImageSprite(Source).FAnimSpeed;
    FAnimStart := TImageSprite(Source).FAnimStart;
    FImage := TImageSprite(Source).FImage;
    FPixelCheck := TImageSprite(Source).FPixelCheck;
    FTile := TImageSprite(Source).FTile;
    FTransparent := TImageSprite(Source).FTransparent;
  end;
  inherited;
end;

procedure TImageSprite.ReAnimate(MoveCount: integer);
begin
  FAnimPos := FAnimPos + FAnimSpeed * MoveCount;

  if FAnimLooped then
  begin
    if FAnimCount > 0 then
      FAnimPos := Mod2f(FAnimPos, FAnimCount)
    else
      FAnimPos := 0;
  end
  else
  begin
    if Round(FAnimPos) >= FAnimCount then
    begin
      FAnimPos := FAnimCount - 1;
      FAnimSpeed := 0;
    end;
    if FAnimPos < 0 then
    begin
      FAnimPos := 0;
      FAnimSpeed := 0;
    end;
  end;
end;

{  TImageSpriteEx  }

procedure TImageSpriteEx.Assign(Source: TPersistent);
begin
  if Source is TImageSpriteEx then begin
    FAngle := TImageSpriteEx(Source).FAngle;
    FAlpha := TImageSpriteEx(Source).FAlpha;
    FBlendMode := TImageSpriteEx(Source).FBlendMode;
  end;
  inherited;
end;

constructor TImageSpriteEx.Create(AParent: TSprite);
begin
  inherited Create(AParent);
  FAlpha := 255;
  FAngle := 0;
  FBlendMode := bmDraw;
end;

procedure TImageSpriteEx.DoDraw;
var
  r: TRect;
  vImage: TPictureCollectionItem;
begin
  {init image when object come from form}
  if Image = nil then
    if AsSigned(FOnGetImage) then begin
      vImage := nil;
      FOnGetImage(Self, vImage);
      if vImage <> FImage then
        Image := vImage;
    end;
  {owner draw called here}
  if AsSigned(FOnDraw) then
    FOnDraw(Self)
  else
  {when is not owner draw then go here}
  begin
    r := Bounds(Round(WorldX), Round(WorldY), Width, Height);
    Case FBlendMode of
     bmDraw: Begin  // FAlpha is ignored there
       if FAngle = 0 then
         Image.StretchDraw(FEngine.FSurface, r, GetDrawImageIndex)
       Else
         Image.DrawRotate(FEngine.FSurface, (r.Left + r.Right) div 2,
          (r.Top + r.Bottom) div 2,
          Width, Height, GetDrawImageIndex, 0.5, 0.5, FAngle);
      End;
     bmBlend: Begin
       if FAngle = 0 then
         Image.DrawAlpha(FEngine.FSurface, r, GetDrawImageIndex, FAlpha)
       Else
         Image.DrawRotateAlpha(FEngine.FSurface, (r.Left + r.Right) div 2,
          (r.Top + r.Bottom) div 2,
          Width, Height, GetDrawImageIndex, 0.5, 0.5, FAngle, FAlpha);
      End;
     bmAdd: Begin
       if FAngle = 0 then
         Image.DrawAdd(FEngine.FSurface, r, GetDrawImageIndex, FAlpha)
       Else
         Image.DrawRotateAdd(FEngine.FSurface, (r.Left + r.Right) div 2,
          (r.Top + r.Bottom) div 2,
          Width, Height, GetDrawImageIndex, 0.5, 0.5, FAngle, FAlpha);
      End;
     bmSub: Begin
       if FAngle = 0 then
         Image.DrawSub(FEngine.FSurface, r, GetDrawImageIndex, FAlpha)
       Else
         Image.DrawRotateSub(FEngine.FSurface, (r.Left + r.Right) div 2,
          (r.Top + r.Bottom) div 2,
          Width, Height, GetDrawImageIndex, 0.5, 0.5, FAngle, FAlpha);
      End;
    End;{case}
  end;
end;

function TImageSpriteEx.GetBoundsRect: TRect;
begin
  Result := FEngine.SurfaceRect;
end;

function TImageSpriteEx.TestCollision(Sprite: TSprite): boolean;
begin
  if Sprite is TImageSpriteEx then
  begin
    Result := OverlapRect(Bounds(Round(Sprite.WorldX), Round(Sprite.WorldY),
      Sprite.Width, Sprite.Height), Bounds(Round(WorldX), Round(WorldY), Width, Height));
  end
  else
  begin
    Result := OverlapRect(Sprite.BoundsRect, Bounds(Round(WorldX),
      Round(WorldY), Width, Height));
  end;
end;

{  TBackgroundSprite  }

constructor TBackgroundSprite.Create(AParent: TSprite);
begin
  inherited Create(AParent);
  Collisioned := False;
end;

destructor TBackgroundSprite.Destroy;
begin
  SetMapSize(0, 0);
  inherited Destroy;
end;

procedure TBackgroundSprite.ChipsDraw(Image: TPictureCollectionItem; X, Y: Integer; PatternIndex: Integer);
Begin
  If AsSigned(FOnDraw) Then
    FOnDraw(Self)
  Else
    Image.Draw(FEngine.Surface, X, Y, PatternIndex);
End;

procedure TBackgroundSprite.DoDraw;
var
  TmpX, TmpY, cx, cy, cx2, cy2, PatternIndex, ChipWidth, ChipHeight: integer;
  StartX, StartY, EndX, EndY, StartX_, StartY_, OfsX, OfsY, dWidth, dHeight: 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 Image = nil then
    Exit;

  if (FMapWidth <= 0) or (FMapHeight <= 0) then
    Exit;

  r := Image.PatternRects[0];
  ChipWidth := r.Right - r.Left;
  ChipHeight := r.Bottom - r.Top;

  dWidth := (FEngine.SurfaceRect.Right + ChipWidth) div ChipWidth + 1;
  dHeight := (FEngine.SurfaceRect.Bottom + ChipHeight) div ChipHeight + 1;

  TmpX := Round(WorldX);
  TmpY := Round(WorldY);

  OfsX := TmpX mod ChipWidth;
  OfsY := TmpY mod ChipHeight;

  StartX := TmpX div ChipWidth;
  StartX_ := 0;

  if StartX < 0 then
  begin
    StartX_ := -StartX;
    StartX := 0;
  end;

  StartY := TmpY div ChipHeight;
  StartY_ := 0;

  if StartY < 0 then
  begin
    StartY_ := -StartY;
    StartY := 0;
  end;

  EndX := Min(StartX + FMapWidth - StartX_, dWidth);
  EndY := Min(StartY + FMapHeight - StartY_, dHeight);

  if FTile then
  begin
    for cy := -1 to dHeight do
    begin
      cy2 := Mod2((cy - StartY + StartY_), FMapHeight);
      for cx := -1 to dWidth do
      begin
        cx2 := Mod2((cx - StartX + StartX_), FMapWidth);
        PatternIndex := Chips[cx2, cy2];
        ChipsPatternIndex := PatternIndex;
        ChipsRect := Bounds(cx * ChipWidth + OfsX,cy * ChipHeight + OfsY,ChipWidth,ChipHeight);
        if PatternIndex >= 0 then
          ChipsDraw(Image,cx * ChipWidth + OfsX, cy * ChipHeight + OfsY, PatternIndex);
          //Image.Draw(FEngine.Surface, cx * ChipWidth + OfsX, cy * ChipHeight + OfsY, PatternIndex);
      end;
    end;
  end
  else
  begin
    for cy := StartY to EndY - 1 do
      for cx := StartX to EndX - 1 do
      begin
        PatternIndex := Chips[cx - StartX + StartX_, cy - StartY + StartY_];
        ChipsPatternIndex := PatternIndex;
        ChipsRect := Bounds(cx * ChipWidth + OfsX,cy * ChipHeight + OfsY,ChipWidth,ChipHeight);
        if PatternIndex >= 0 then
          ChipsDraw(Image,cx * ChipWidth + OfsX, cy * ChipHeight + OfsY, PatternIndex);
          //Image.Draw(FEngine.Surface, cx * ChipWidth + OfsX, cy * ChipHeight + OfsY, PatternIndex);
      end;
  end;
end;

function TBackgroundSprite.TestCollision(Sprite: TSprite): boolean;
var
  box0, box1, box2: TRect;
  cx, cy, ChipWidth, ChipHeight: integer;
  r: TRect;
begin
  Result := True;
  if Image = nil then
    Exit;
  if (FMapWidth <= 0) or (FMapHeight <= 0) then
    Exit;

  r := Image.PatternRects[0];
  ChipWidth := r.Right - r.Left;
  ChipHeight := r.Bottom - r.Top;

  box1 := Sprite.BoundsRect;
  box2 := BoundsRect;

  IntersectRect(box0, box1, box2);

  OffsetRect(box0, -Round(WorldX), -Round(WorldY));
  OffsetRect(box1, -Round(WorldX), -Round(WorldY));

  for cy := (box0.Top - ChipHeight + 1) div ChipHeight to box0.Bottom div ChipHeight do
    for cx := (box0.Left - ChipWidth + 1) div ChipWidth to box0.Right div ChipWidth do
      if CollisionMap[Mod2(cx, MapWidth), Mod2(cy, MapHeight)] then
      begin
        if OverlapRect(Bounds(cx * ChipWidth, cy * ChipHeight, ChipWidth,
          ChipHeight), box1) then
          Exit;
      end;

  Result := False;
end;

function TBackgroundSprite.GetChip(X, Y: integer): integer;
begin
  if (X >= 0) and (X < FMapWidth) and (Y >= 0) and (Y < FMapHeight) then
    Result := PInteger(integer(FMap) + (Y * FMapWidth + X) * SizeOf(integer))^
  else
    Result := -1;
end;

type
  PBoolean = ^boolean;

function TBackgroundSprite.GetCollisionMapItem(X, Y: integer): boolean;
begin
  if (X >= 0) and (X < FMapWidth) and (Y >= 0) and (Y < FMapHeight) then
    Result := PBoolean(integer(FCollisionMap) + (Y * FMapWidth + X) * SizeOf(boolean))^
  else
    Result := False;
end;

function TBackgroundSprite.GetBoundsRect: TRect;
begin
  if FTile then
    Result := FEngine.SurfaceRect
  else
  begin
    if Image <> nil then
      Result := Bounds(Round(WorldX), Round(WorldY), Image.Width * FMapWidth,
        Image.Height * FMapHeight)
    else
      Result := Rect(0, 0, 0, 0);
  end;
end;

procedure TBackgroundSprite.SetChip(X, Y: integer; Value: integer);
begin
  if (X >= 0) and (X < FMapWidth) and (Y >= 0) and (Y < FMapHeight) then
    PInteger(integer(FMap) + (Y * FMapWidth + X) * SizeOf(integer))^ := Value;
end;

procedure TBackgroundSprite.SetCollisionMapItem(X, Y: integer; Value: boolean);
begin
  if (X >= 0) and (X < FMapWidth) and (Y >= 0) and (Y < FMapHeight) then
    PBoolean(integer(FCollisionMap) + (Y * FMapWidth + X) * SizeOf(boolean))^ := Value;
end;

procedure TBackgroundSprite.SetMapHeight(Value: integer);
begin
  SetMapSize(FMapWidth, Value);
end;

procedure TBackgroundSprite.SetMapWidth(Value: integer);
begin
  SetMapSize(Value, FMapHeight);
end;

procedure TBackgroundSprite.SetImage(Img: TPictureCollectionItem);
begin
  FImage := Img;
  FWidth := FMapWidth * Img.Width;
  FHeight := FMapHeight * Img.Height;
end;

procedure TBackgroundSprite.SetMapSize(AMapWidth, AMapHeight: integer);
begin
  if (FMapWidth <> AMapWidth) or (FMapHeight <> AMapHeight) then
  begin
    if (AMapWidth <= 0) or (AMapHeight <= 0) then
    begin
      AMapWidth := 0;
      AMapHeight := 0;
    end;
    FMapWidth := AMapWidth;
    FMapHeight := AMapHeight;
    ReAllocMem(FMap, FMapWidth * FMapHeight * SizeOf(integer));
    FillChar(FMap^, FMapWidth * FMapHeight * SizeOf(integer), 0);

    ReAllocMem(FCollisionMap, FMapWidth * FMapHeight * SizeOf(boolean));
    FillChar(FCollisionMap^, FMapWidth * FMapHeight * SizeOf(boolean), 1);
  end;
end;

procedure TBackgroundSprite.Assign(Source: TPersistent);
begin
  if Source is TBackgroundSprite then begin
    FImage := TBackgroundSprite(Source).FImage;
    FMapWidth := TBackgroundSprite(Source).FMapWidth;
    FMapHeight := TBackgroundSprite(Source).FMapHeight;
    FTile := TBackgroundSprite(Source).FTile;
  end;
  inherited;
end;

{  TSpriteEngine  }