unit TextEffectUnit;

interface
uses
  SysUtils,
  Classes,
  Windows,
  DXDraws;

type

  PDirectDraw = ^TDirectDraw;
  PDirectDrawSurface = ^TDirectDrawSurface;

  TextEffectExc = class(Exception);

  TLetterEffect = record
    Visible: Boolean;
    CurTime, Delay: Integer;
    Scale: Integer;
  end;
  TLetterEffectArray = array of TLetterEffect;
  PLetterEffectArray = ^TLetterEffectArray;

  TTextEffect = class
  private
    FontSurface: TDirectDrawSurface;
    TextSurface: TDirectDrawSurface;
    FText: String;
    FFontSize: Integer;
    FState: Integer;
    FFileName: String;
    LetterEffect: TLetterEffectArray;
    procedure SetText(const Value: String);
    procedure Error(ErrorType: Integer);
    procedure SetFontSize(const Value: Integer);
    procedure SetFileName(const Value: String);
  public
    property Text: String read FText write SetText;
    property FontSize: Integer read FFontSize write SetFontSize;
    property FileName: String read FFileName write SetFileName;
    procedure Draw(Surface: PDirectDrawSurface);
    constructor Create(DD: PDirectDraw);
    destructor Destroy;
  end;

implementation


procedure ResetLetterEffectArray(L: PLetterEffectArray);
var
  i: Integer;
begin
  for i:=0 to High(L^) do
  begin
    L^[i].Visible := False;
    L^[i].Delay := 30;
    L^[i].CurTime := 0;
    L^[i].Scale := 32;
  end;
end;

{ Procedures for update effect }

procedure ScaleDown(L: PLetterEffectArray);
var
  i: Integer;
begin
  for i:=0 to High(L^) do
  begin
    if L^[i].Scale > 0 then
    begin
      inc(L^[i].CurTime);
      if L^[i].CurTime >= L^[i].Delay then
        dec(L^[i].Scale, 1);
      exit;
    end;
  end;
end;

{ TTextEffect }

constructor TTextEffect.Create(DD: PDirectDraw);
begin
  FText := '';
  FFontSize := 16;
  SetLength(LetterEffect, 0);
  FontSurface := TDirectDrawSurface.Create(DD^);
  if FontSurface = nil then
    Error(1);
  TextSurface := TDirectDrawSurface.Create(DD^);
  if TextSurface = nil then
    Error(1);
end;

destructor TTextEffect.Destroy;
begin
  LetterEffect := nil;
  if FontSurface <> nil then
  begin
    FontSurface.Free;
    FontSurface := nil;
  end;
  if TextSurface <> nil then
  begin
    TextSurface.Free;
    TextSurface := nil;
  end;
end;

procedure TTextEffect.Draw(Surface: PDirectDrawSurface);
var
  i: Integer;
  rc: TRect;
  s: Integer;
begin
  if FontSurface = nil then
    Error(9);
  if FText = '' then
    exit;
  Surface^.Draw(32, 32, TextSurface.ClientRect, TextSurface, True);
  ScaleDown(@LetterEffect);
  for i:=0 to High(LetterEffect) do
  begin
    s := LetterEffect[i].Scale;
    if s = 32 then
      exit;
    if s > 0 then
    begin
      rc := Rect(i*16+32-s, 64-s, ((i+1)*16)+32+s, 80+s);
      Surface^.StretchDraw(rc, Rect(i*16,0,(i+1)*16,16), TextSurface, True);
    end
    else
      Surface^.Draw(i*16+32, 64, Rect(i*16,0,(i+1)*16,16), TextSurface, True)
  end;
end;

procedure TTextEffect.Error(ErrorType: Integer);
begin
  raise TextEffectExc.Create('Error!');
end;

procedure TTextEffect.SetFileName(const Value: String);
begin
  if FileExists(Value) = False then
    Error(2);
  FontSurface.LoadFromFile(Value);
  FFileName := Value;
end;

procedure TTextEffect.SetFontSize(const Value: Integer);
begin
  FFontSize := Value;
end;

procedure TTextEffect.SetText(const Value: String);
var
  i, j: Integer;
begin
  if FontSurface = nil then
    Error(3);
  FText := Value;
  FState := 0;
  TextSurface.Fill(0);
  TextSurface.SetSize(Length(Value)*FFontSize, FFontSize);
  for i:=1 to Length(Value) do
  begin
    j := Ord(Value[i])-2;
    TextSurface.Draw((i-1)*FFontSize, 0, Rect(j*FFontSize, 0, (j+1)*FFontSize, FFontSize), FontSurface, False);
  end;
  SetLength(LetterEffect, Length(Value));
  ResetLetterEffectArray(@LetterEffect);
  for i:=0 to High(LetterEffect) do
    LetterEffect[i].Delay := 30;
end;

end.