dxsprite.pas

传奇源代码的delphi版本

constructor TSpriteEngine.Create(AParent: TSprite);
begin
  inherited Create(AParent);
  FDeadList := TList.Create;
  // group handling
{$IFDEF Ver4Up}
  fCurrentSelected := Tlist.create;
  GroupCount := 10;
{$ENDIF}
end;

destructor TSpriteEngine.Destroy;
begin
  // cleanup Group handling
{$IFDEF Ver4Up}
  ClearCurrent;
  GroupCount := 0;
{$ENDIF}
  FDeadList.Free;
  inherited Destroy;
{$IFDEF Ver4Up}
  fCurrentSelected.free;
{$ENDIF}
end;

procedure TSpriteEngine.Collisions;
var
  index: integer;
begin
  for index := 0 to Count - 1 do
    Items[index].Collision;
end;
{Collisions}
{$IFDEF Ver4Up}

procedure TSpriteEngine.GroupSelect(const Area: TRect; Add: Boolean = false);
begin
  GroupSelect(Area, [Tsprite], Add);
end; {GroupSelect}

procedure TSpriteEngine.GroupSelect(const Area: TRect; Filter: array of TSpriteClass; Add: Boolean = false);
var
  index, index2: integer;
  sprite: TSprite;
begin
  Assert(length(Filter) <> 0, 'Filter = []');
  if not Add then
    ClearCurrent;
  if length(Filter) = 1 then
  begin
    for Index := 0 to Count - 1 do
    begin
      sprite := Items[Index];
      if (sprite is Filter[0]) and
        OverlapRect(sprite.GetBoundsRect, Area) then
        sprite.Selected := true;
    end
  end
  else
  begin
    for Index := 0 to Count - 1 do
    begin
      sprite := Items[index];
      for index2 := 0 to high(Filter) do
        if (sprite is Filter[index2]) and
          OverlapRect(sprite.GetBoundsRect, Area) then
        begin
          sprite.Selected := true;
          break;
        end;
    end
  end;
  fObjectsSelected := CurrentSelected.count <> 0;
end; {GroupSelect}

function TSpriteEngine.Select(Point: TPoint; Filter: array of TSpriteClass; Add: Boolean = false): Tsprite;
var
  index, index2: integer;
begin
  Assert(length(Filter) <> 0, 'Filter = []');
  if not Add then
    ClearCurrent;
  // By searching the Drawlist in reverse
  // we select the highest sprite if the sprit is under the point
  assert(FDrawList <> nil, 'FDrawList = nil');
  if length(Filter) = 1 then
  begin
    for Index := FDrawList.Count - 1 downto 0 do
    begin
      result := FDrawList[Index];
      if (result is Filter[0]) and PointInRect(Point, result.GetBoundsRect) then
      begin
        result.Selected := true;
        fObjectsSelected := CurrentSelected.count <> 0;
        exit;
      end;
    end
  end
  else
  begin
    for Index := FDrawList.Count - 1 downto 0 do
    begin
      result := FDrawList[index];
      for index2 := 0 to high(Filter) do
        if (result is Filter[index2]) and PointInRect(Point, result.GetBoundsRect) then
        begin
          result.Selected := true;
          fObjectsSelected := CurrentSelected.count <> 0;
          exit;
        end;
    end
  end;
  result := nil;
end; {Select}

function TSpriteEngine.Select(Point: TPoint; Add: Boolean = false): TSprite;
begin
  result := Select(Point, [Tsprite], Add);
end; {Select}

procedure TSpriteEngine.ClearCurrent;
begin
  while CurrentSelected.count <> 0 do
    TSprite(CurrentSelected[CurrentSelected.count - 1]).Selected := false;
  fObjectsSelected := false;
end; {ClearCurrent}

procedure TSpriteEngine.ClearGroup(GroupNumber: integer);
var
  index: integer;
  Group: Tlist;
begin
  Group := Groups[GroupNumber];
  if Group <> nil then
    for index := 0 to Group.count - 1 do
      TSprite(Group[index]).Selected := false;
end; {ClearGroup}

procedure TSpriteEngine.CurrentToGroup(GroupNumber: integer; Add: Boolean = false);
var
  Group: Tlist;
  index: integer;
begin
  Group := Groups[GroupNumber];
  if Group = nil then
    exit;
  if not Add then
    ClearGroup(GroupNumber);
  for index := 0 to Group.count - 1 do
    TSprite(Group[index]).GroupNumber := GroupNumber;
end; {CurrentToGroup}

procedure TSpriteEngine.GroupToCurrent(GroupNumber: integer; Add: Boolean = false);
var
  Group: Tlist;
  index: integer;
begin
  if not Add then
    ClearCurrent;
  Group := Groups[GroupNumber];
  if Group <> nil then
    for index := 0 to Group.count - 1 do
      TSprite(Group[index]).Selected := true;
end; {GroupToCurrent}

function TSpriteEngine.GetGroup(Index: integer): Tlist;
begin
  if (index >= 0) or (index < fGroupCount) then
    result := fGroups[index]
  else
    result := nil;
end; {GetGroup}

procedure TSpriteEngine.SetGroupCount(AGroupCount: integer);
var
  index: integer;
begin
  if (AGroupCount <> FGroupCount) and (AGroupCount >= 0) then
  begin
    if FGroupCount > AGroupCount then
    begin // remove groups
      for index := AGroupCount to FGroupCount - 1 do
      begin
        ClearGroup(index);
        FGroups[index].Free;
      end;
      SetLength(FGroups, AGroupCount);
    end
    else
    begin // add groups
      SetLength(FGroups, AGroupCount);
      for index := FGroupCount to AGroupCount - 1 do
        FGroups[index] := Tlist.Create;
    end;
    FGroupCount := Length(FGroups);
  end;
end; {SetGroupCount}
{$ENDIF}

procedure TSpriteEngine.Dead;
begin
  while FDeadList.Count > 0 do
    TSprite(FDeadList[FDeadList.Count - 1]).Free;
end;

procedure TSpriteEngine.Draw;
begin
  FDrawCount := 0;
  inherited Draw;
end;

procedure TSpriteEngine.SetSurface(Value: TDirectDrawSurface);
begin
  FSurface := Value;
  if FSurface <> nil then
  begin
    FSurfaceRect := Surface.ClientRect;
    Width := FSurfaceRect.Right - FSurfaceRect.Left;
    Height := FSurfaceRect.Bottom - FSurfaceRect.Top;
  end;
end;

{  TCustomDXSpriteEngine  }

constructor TCustomDXSpriteEngine.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FEngine := TSpriteEngine.Create(nil);
  FItems := TSpriteCollection.Create(Self);
  FItems.FOwner := Self;
  FItems.FOwnerItem := FEngine;
  FItems.Initialize(FEngine);
end;

destructor TCustomDXSpriteEngine.Destroy;
begin
  FEngine.Free;
  inherited Destroy;
end;

procedure TCustomDXSpriteEngine.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (DXDraw = AComponent) then
    DXDraw := nil;
end;

procedure TCustomDXSpriteEngine.Dead;
begin
  FEngine.Dead;
end;

procedure TCustomDXSpriteEngine.Draw;
begin
  if (FDXDraw <> nil) and (FDXDraw.Initialized) then
    FEngine.Draw;
end;

procedure TCustomDXSpriteEngine.Move(MoveCount: integer);
begin
  FEngine.Move(MoveCount);
end;

procedure TCustomDXSpriteEngine.DXDrawNotifyEvent(Sender: TCustomDXDraw;
  NotifyType: TDXDrawNotifyType);
begin
  case NotifyType of
    dxntDestroying: DXDraw := nil;
    dxntInitialize: FEngine.Surface := Sender.Surface;
    dxntFinalize: FEngine.Surface := nil;
  end;
end;

procedure TCustomDXSpriteEngine.SetDXDraw(Value: TCustomDXDraw);
begin
  if FDXDraw <> nil then
    FDXDraw.UnRegisterNotifyEvent(DXDrawNotifyEvent);

  FDXDraw := Value;

  if FDXDraw <> nil then
    FDXDraw.RegisterNotifyEvent(DXDrawNotifyEvent);
end;

procedure TCustomDXSpriteEngine.SetItems(const Value: TSpriteCollection);
begin
  FItems.Assign(Value);
end;

{ TSpriteCollectionItem }

function TSpriteCollectionItem.GetSpriteCollection: TSpriteCollection;
begin
  Result := Collection as TSpriteCollection;
end;

procedure TSpriteCollectionItem.SetSprite(const Value: TSprite);
begin
  FSprite.Assign(Value);
end;

constructor TSpriteCollectionItem.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  FOwner := Collection;
  FOwnerItem := (Collection as TSpriteCollection).FOwnerItem;
  FSpriteType := stSprite;
  FSprite := TSprite.Create(FOwnerItem);
end;

procedure TSpriteCollectionItem.Assign(Source: TPersistent);
begin
  if Source is TSpriteCollectionItem then begin
    Finalize;
    FSprite.Assign(TSpriteCollectionItem(Source).FSprite);
    inherited Assign(Source);
    Initialize;
  end
  else
    inherited;

end;

procedure TSpriteCollectionItem.Initialize;
begin

end;

destructor TSpriteCollectionItem.Destroy;
begin
  FSprite.Destroy;
  inherited;
end;

procedure TSpriteCollectionItem.Finalize;
begin

end;

procedure TSpriteCollectionItem.SetOnCollision(
  const Value: TCollisionEvent);
begin
  FSprite.FOnCollision := Value;
end;

procedure TSpriteCollectionItem.SetOnDraw(const Value: TDrawEvent);
begin
  FSprite.FOnDraw := Value;
end;

procedure TSpriteCollectionItem.SetOnMove(const Value: TMoveEvent);
begin
  FSprite.FOnMove := Value
end;

function TSpriteCollectionItem.GetDisplayName: string;
begin
  Result := inherited GetDisplayName
end;

procedure TSpriteCollectionItem.SetDisplayName(const Value: string);
begin
  if (Value <> '') and (AnsiCompareText(Value, GetDisplayName) <> 0) and
    (Collection is TSpriteCollection) and (TSpriteCollection(Collection).IndexOf(Value) >= 0) then
    raise Exception.Create(Format(SSpriteDuplicateName, [Value]));
  inherited SetDisplayName(Value);
end;

function TSpriteCollectionItem.GetSpriteType: TSpriteType;
begin
  Result := FSpriteType;
end;

procedure TSpriteCollectionItem.SetSpriteType(const Value: TSpriteType);
var
  tmpSprite: TSprite;
begin
  if Value <> FSpriteType then begin
    case Value of
      stSprite: tmpSprite := TSprite.Create(TSpriteEngine(FOwnerItem));
      stImageSprite: TImageSprite(tmpSprite) := TImageSprite.Create(TSpriteEngine(FOwnerItem));
      stImageSpriteEx: TImageSpriteEx(tmpSprite) := TImageSpriteEx.Create(TSpriteEngine(FOwnerItem));
      stBackgroundSprite: TBackgroundSprite(tmpSprite) := TBackgroundSprite.Create(TSpriteEngine(FOwnerItem));
    else
      tmpSprite := nil
    end;
    if Assigned(FSprite) then begin
      tmpSprite.Assign(FSprite);
      tmpSprite.FOnDraw := FSprite.FOnDraw;
      tmpSprite.FOnMove := FSprite.FOnMove;
      tmpSprite.FOnCollision := FSprite.FOnCollision;
      FSprite.Free;
    end;
    FSprite := tmpSprite;
    FSpriteType := Value;
  end;
end;

function TSpriteCollectionItem.GetOnCollision: TCollisionEvent;
begin
  Result := FSprite.FOnCollision
end;

function TSpriteCollectionItem.GetOnDraw: TDrawEvent;
begin
  Result := FSprite.FOnDraw
end;

function TSpriteCollectionItem.GetOnMove: TMoveEvent;
begin
  Result := FSprite.FOnMove
end;

function TSpriteCollectionItem.GetOnGetImage: TGetImage;
begin
  Result := FSprite.FOnGetImage;
end;

procedure TSpriteCollectionItem.SetOnGetImage(const Value: TGetImage);
begin
  FSprite.FOnGetImage := Value;
end;

{ TSpriteCollection }

function TSpriteCollection.Initialized: Boolean;
begin
  Result := True
end;

constructor TSpriteCollection.Create(AOwner: TPersistent);
begin
  inherited Create(TSpriteCollectionItem);
  FOwner := AOwner;
end;

function TSpriteCollection.GetItem(Index: Integer): TSpriteCollectionItem;
begin
  Result := TSpriteCollectionItem(inherited Items[Index]);
end;

function TSpriteCollection.Initialize(DXSpriteEngine: TSpriteEngine): Boolean;
begin
  Result := True;
  try
    if AsSigned(FOnInitialize) then
      FOnInitialize(DXSpriteEngine);
  except
    Result := False;
  end
end;

function TSpriteCollection.Find(const Name: string): TSpriteCollectionItem;
var
  i: Integer;
begin
  i := IndexOf(Name);
  if i = -1 then
    raise ESpriteCollectionError.CreateFmt(SSpriteNotFound, [Name]);
  Result := Items[i];
end;

procedure TSpriteCollection.Finalize;
begin
  if AsSigned(FOnFinalize) then
    FOnFinalize(FOwnerItem);
end;

function TSpriteCollection.GetOwner: TPersistent;
begin
  Result := FOwner;
end;

function TSpriteCollection.Add: TSpriteCollectionItem;
begin
  Result := TSpriteCollectionItem(inherited Add);
  Result.FOwner := FOwner;
  Result.FOwnerItem := FOwnerItem;
end;

end.