Chip: Shareware for Win 95/Chip-Shareware-Win95.bin/ostatni/delphi/delphi2/wowsrc.exe/SSSPRITE.PAS

Pascal/Delphi Source File | 1995-11-07 | 11.6 KB | 414 lines

{               //SleepingSheep Sprite Engine//
This unit is desined to work under normal windows3.1(non-WinG).
Ver. 0.2.0 11/5/95
1995 All Copy Rights Reserved by Koji Yamashita, Sleeping Sheep Ltd. Co.}
unit Sssprite;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs;

const
  MaxSegment = 7;
  MaxOffset = 7;
  VirtualWorkSpaceWidth = 64;
  VirtualWorkSpaceHeight = 64;

type
  SegmentIndexRange = 0..MaxSegment;
  OffsetIndexRange = 0..MaxOffset;
  AnimationFileArray = array [0..MaxSegment, 0..MaxOffset] of TBitmap;

{TSprite is a new object, which has TBitmap as its direct parent.}
  TSprite = class(TBitmap)
    {users are not allowed to access this part}
    private
      SpriteFiles: AnimationFileArray;
      MaskedFiles: AnimationFileArray;
      SaveSpace: TBitmap;
      {refer to the procedure TSprite.Create}
      SegmentIndex: SegmentIndexRange;
      OffsetIndex: OffsetIndexRange;
      XPosition: integer;
      YPosition: integer;
      DisplayOn: boolean;

      function SpriteToWorkSpace(var Sprite: TSprite): boolean;
      function SaveSpaceToWorkSpace(var Sprite: TSprite): boolean;
      function FindEmptyOffset(Sprite: TSprite; Segment: integer;
        var Offset: integer): boolean;
    {users are free to use these procedures}
    public
      procedure CreateSprite(var Sprite: TSprite; SpriteFileName: string;
        MaskedFileName: string);
      {!!DELETE EACH SPRITES, WHEN THEY ARE NO MORE INUSE!!}
      procedure DeleteSprite(var Sprite: TSprite);
      procedure SetPosition(var Sprite: TSprite; X: integer; Y: integer);
      procedure CheckPosition(Sprite: TSprite; var X: integer; var Y: integer);
      procedure MoveSprite(var Sprite: TSprite;
        XMove: integer; YMove: integer);
      procedure AddAnimation(Sprite: TSprite; SpriteFileName: string;
        MaskedFileName: string; Segment: integer);
      Procedure AnimateForwardSprite(var Sprite: TSprite;
        WithinSegment: boolean);
      procedure TurnOnOffSprite(var Sprite: TSprite; Switch: boolean);
      procedure SetSegment(var Sprite: TSprite; DesiredSegment: integer);
      procedure IncOffset(var Sprite: TSprite);
      procedure IncSegment(var Sprite: TSprite);
    end;


procedure InitializeScreen (SpriteScreen: TCanvas; CanvasWidth: integer;
  CanvasHeight: integer; BackGroundFile: string);
{!!DON'T FORGET TO TERMINATE SPRITE AT THE END OF YOUR APPLICATIONS!!}
procedure TerminateScreen;
procedure DisplaySprite(Sprite: TSprite; X: integer; Y: integer);
procedure RefreshScreen;

implementation

var
   BackGroundBitmap: TBitmap;
   WorkSpace: TBitmap;
   OutputSpace: TCanvas;
   OutputWidth: integer;
   OutputHeight: integer;
   OutputSpaceActive: boolean;

procedure InitializeScreen(SpriteScreen: TCanvas;
  CanvasWidth: integer;CanvasHeight: integer; BackGroundFile: string);
begin
  OutputSpaceActive := True;
  OutputSpace := SpriteScreen;
  OutputWidth := CanvasWidth;
  OutputHeight := CanvasHeight;

  BackGroundBitmap := TBitmap.Create;
  BackGroundBitmap.LoadFromFile(BackGroundFile);

  WorkSpace := TBitmap.Create;
  WorkSpace.Canvas.CopyMode := cmSrcCopy;
  WorkSpace.Width := CanvasWidth + 128;
  WorkSpace.Height := CanvasHeight + 128;
  WorkSpace.Canvas.StretchDraw(rect(-VirtualWorkSpaceWidth,
    -VirtualWorkSpaceHeight, CanvasWidth + VirtualWorkSpaceWidth,
    CanvasHeight + VirtualWorkSpaceHeight), BackGroundBitmap);

  OutputSpace.CopyMode := cmSrcCopy;
  OutputSpace.CopyRect(rect(0, 0, WorkSpace.Width, WorkSpace.Height),
    WorkSpace.Canvas, rect(0, 0, WorkSpace.Width, WorkSpace.Height));
end;

procedure RefreshScreen;
begin
  if OutputSpaceActive then
  begin
    OutputSpace.CopyMode := cmSrcCopy;
    OutputSpace.Draw(0, 0,
      WorkSpace);
  end;
end;

procedure TSprite.CreateSprite(var Sprite: TSprite; SpriteFileName: string;
  MaskedFileName: string);
var
  Test: boolean;
  Index1, Index2: integer;
begin
  Sprite := TSprite.Create;
  Sprite.SaveSpace := TBitmap.Create;
  for Index1 := 0 to 7 do
  begin
    for Index2 := 0 to 7 do
    begin
      Sprite.SpriteFiles[Index1, Index2] := TBitmap.Create;
      Sprite.MaskedFiles[Index1, Index2] := TBitmap.Create;
    end;
  end;
  Sprite.SpriteFiles[0,0].LoadFromFile(SpriteFileName);
  Sprite.MaskedFiles[0,0].LoadFromFile(MaskedFileName);
  {animation Segment/Offset Index: [<Segment>, <Offset>]}
  Sprite.SegmentIndex := 0;
  Sprite.OffsetIndex := 0;
  Sprite.DisplayOn := False;
end;

procedure TerminateScreen;
begin
  BackGroundBitmap.Free;
  WorkSpace.Free;
  OutputSpaceActive := False;
end;

procedure Tsprite.DeleteSprite(var Sprite: TSprite);
var
Index1, Index2: integer;
begin
  Sprite.Free;
  Sprite.SaveSpace.Free;
  for Index1 := 0 to 7 do
  begin
    for Index2 := 0 to 7 do
    begin
      Sprite.SpriteFiles[Index1, Index2].Free;
      Sprite.MaskedFiles[Index1, Index2].Free;
    end;
  end;
end;

procedure TSprite.SetPosition(var Sprite: TSprite; X: integer; Y: integer);
var
  Test: boolean;
begin
  MoveSprite(Sprite, X - Sprite.XPosition, Y - Sprite.YPosition);
end;

procedure TSprite.TurnOnOffSprite(var Sprite: TSprite; Switch: boolean);
begin
  Sprite.DisplayOn := Switch;
end;

function TSprite.SaveSpaceToWorkSpace(var Sprite: TSprite): boolean;
begin
  {add a programmer-protect function here-- Empty(SaveSpace)-> Cancel}
  with Sprite do
  begin
    if DisplayOn then
    begin
      WorkSpace.Canvas.CopyMode := cmSrcCopy;
      WorkSpace.Canvas.CopyRect(
        rect(XPosition, YPosition, XPosition + Width, YPosition + Height),
        SaveSpace.Canvas,
        rect(0, 0, Width, Height));
    end;
  end;
end;

function TSprite.SpriteToWorkSpace(var Sprite: TSprite): boolean;
begin
  {if Sprite is out from WorkSpace then Cancel it}
  with Sprite do
  begin
    if DisplayOn then
    begin
      if (XPosition < -VirtualWorkSpaceWidth) or
        (XPosition > WorkSpace.Width - Width) or
        (YPosition < -VirtualWorkSpaceHeight) or
        (YPosition > WorkSpace.Height - Height) then
      begin
        SpriteToWorkSpace := False;
      end
      else
      begin
        Width := SpriteFiles[SegmentIndex, OffsetIndex].Width;
        Height := SpriteFiles[SegmentIndex, OffsetIndex].Height;
        {save WorkSpace, which will be modified, to SaveSpace}
        SaveSpace.Width := Width;
        SaveSpace.Height := Height;
        SaveSpace.Canvas.CopyMode := cmSrcCopy;
        SaveSpace.Canvas.CopyRect(rect(0, 0, Width, Height),
          WorkSpace.Canvas,
          rect(XPosition, YPosition, XPosition + Width, YPosition + Height));
        {modify the WorkPlace by MaskedFile}
        WorkSpace.Canvas.CopyMode := cmSrcAnd;
        WorkSpace.Canvas.CopyRect(
          rect(XPosition, YPosition, XPosition + Width, YPosition + Height),
          MaskedFiles[SegmentIndex, OffsetIndex].Canvas,
          rect(0,0, Width, Height));
        {modify the WorkSpace by SpriteFile}
        WorkSpace.Canvas.CopyMode := cmSrcInvert;
        WorkSpace.Canvas.CopyRect(
          rect(XPosition, YPosition, XPosition + Width, YPosition + Height),
          SpriteFiles[SegmentIndex, OffsetIndex].Canvas,
          rect(0,0, Width, Height));
      end;
    end;
  end;
end;

procedure DisplaySprite(Sprite: TSprite; X: Integer; Y: Integer);
var
LTX, LTY, RBX, RBY: integer;
begin
  with Sprite do
  begin
    if DisplayOn then
    begin
      OutputSpace.CopyMode := cmSrcCopy;
      if (Width > abs(X)) and (Height > abs(Y)) then
      begin
        if X >= 0 then
        begin
          LTX := XPosition - abs(X);
          RBX := XPosition + Width;
        end;
        if Y >= 0 then
        begin
          LTY := YPosition - abs(Y);
          RBY := YPosition + Height;
        end;
        if X < 0 then
        begin
          LTX := XPosition;
          RBX := XPosition + Width + abs(X);
        end;
        if Y < 0 then
        begin
          LTY := YPosition;
          RBY := YPosition + Height +abs(Y);
        end;
        OutputSpace.CopyRect(
          rect(LTX, LTY, RBX, RBY),
          WorkSpace.Canvas,
          rect(LTX, LTY, RBX, RBY));
      end
      else
      begin
        OutputSpace.CopyRect(
          rect(XPosition - X, YPosition - Y,
          XPosition + Width, YPosition + Height),
          WorkSpace.Canvas,
          rect(XPosition - X, YPosition - Y,
          XPosition + Width, YPosition + Height));
        OutputSpace.CopyRect(
          rect(XPosition, YPosition, XPosition + Width, YPosition + Height),
          WorkSpace.Canvas,
          rect(XPosition, YPosition, XPosition + Width, YPosition + Height));
      end;
    end;
  end;
end;

procedure TSprite.MoveSprite(var Sprite: TSprite;
  XMove: integer; YMove: integer);
var
  Test: boolean;
begin
  Test := SaveSpaceToWorkSpace(Sprite);
  Sprite.XPosition := Sprite.XPosition + XMove;
  SPrite.YPosition := Sprite.YPosition + YMove;
  Test := SpriteToWorkSpace(Sprite);
  DisplaySprite(Sprite, XMove, YMove);
end;

procedure TSprite.CheckPosition(Sprite: TSprite; var X:
  integer; var Y: integer);
begin
  X := Sprite.XPosition;
  Y := SPrite.YPosition;
end;

procedure TSprite.AddAnimation(Sprite: TSprite; SpriteFileName: string;
  MaskedFileName: string; Segment: integer);
var
  Test: boolean;
  Offset: integer;
begin
  Test := FindEmptyOffset(Sprite, Segment, Offset);
  if test then
  begin
    Sprite.SpriteFiles[Segment, Offset].LoadFromFile(SpriteFileName);
    Sprite.MaskedFiles[Segment, Offset].LoadFromFile(MaskedFileName);
  end;
end;

{this function is to find the youngest available Offset with in a segment}
function TSprite.FindEmptyOffset(Sprite: TSprite; Segment: integer;
  var Offset: integer): boolean;
begin
  FindEmptyOffset := False;
  Offset := MaxOffset;
  if Sprite.SpriteFiles[Segment, 0].Empty then
  begin
    Offset := 0;
    FindEmptyOffset := True;
  end
  else
  begin
    while Sprite.SpriteFiles[Segment, Offset].Empty and (Offset > 0) do
      begin
        Offset := Offset - 1;
        FindEmptyOffset := True;
      end;
    Offset := Offset + 1;
  end;
end;

{this function is to animate the sprite}
procedure TSprite.AnimateForwardSprite(var Sprite: TSprite;
  WithinSegment: boolean);
begin
  if WithinSegment then
  begin
    IncOffset(Sprite);
  end
  else
  begin
    IncOffset(Sprite);
    if Sprite.OffsetIndex = 0 then
    begin
      IncSegment(Sprite);
    end;
  end;
end;

{this function is to increment offset No. within segment}
procedure TSprite.IncOffset(var Sprite: TSprite);
begin
  with Sprite do
  begin
    if OffsetIndex = MaxOffset then
    begin
      OffsetIndex := 0;
    end
    else
    begin
      OffsetIndex := OffsetIndex + 1;
      if SpriteFiles[SegmentIndex, OffsetIndex].Empty then
      begin
        OffsetIndex := 0;
      end;
    end;
  end;
end;

{this function is to increment segment No.}
procedure TSprite.IncSegment(var Sprite: TSprite);
begin
  with Sprite do
  begin
    if SegmentIndex = MaxSegment then
    begin
      SegmentIndex := 0;
    end
    else
    begin
      SegmentIndex := SegmentIndex + 1;
      if SpriteFiles[SegmentIndex, OffsetIndex].Empty then
      begin
        SegmentIndex := 0;
      end;
    end;
  end;
end;

procedure TSprite.SetSegment(var Sprite: TSprite; DesiredSegment: integer);
begin
  with Sprite do
  begin
    if DesiredSegment > MaxSegment then
    begin
    end
    else
    begin
      if not(SpriteFiles[DesiredSegment, OffsetIndex].Empty) then
      begin
        SegmentIndex := DesiredSegment;
      end;
    end;
  end;
end;
end.