teroll.pas

Do your applications look a little boring? Would you like to get spectacular yet easy to use visual

          BitBlt(Data.Canvas.Handle, RRoll.Left, RRoll.Top, Data.Width,
            RollPixels, ReversedBmp.Canvas.Handle, 0,
            Data.Height - RRoll.Bottom - RollPixels, cmSrcCopy);
        end;
      tedUp:
        begin
          RRoll   .Top    := RRoll.Top - Step;
          RRoll   .Bottom := RRoll.Top + RollPixels;
          RVisible.Bottom := RVisible.Top;
          RVisible.Top    := RRoll.Bottom;

          BitBlt(Data.Canvas.Handle, RRoll.Left, RRoll.Top, Data.Width,
            RollPixels, ReversedBmp.Canvas.Handle, 0,
            Data.Height - RRoll.Bottom + RollPixels - 1, cmSrcCopy);
        end;
    end;
  end
  else
  begin
    if CurrentFrame >= FSize
    then RollPixels := FSize
    else RollPixels := CurrentFrame;

    case DirectionToUse of
      tedRight:
        begin
          RVisible.Left  := RVisible.Right;
          RVisible.Right := RVisible.Right + Step;
          RRoll   .Left  := RVisible.Right;
          RRoll   .Right := RRoll.Left + RollPixels;

          BitBlt(Data.Canvas.Handle, RRoll.Left, RRoll.Top, RollPixels,
            Data.Height, ReversedBmp.Canvas.Handle,
            ReversedBmp.Width - RRoll.Left - 1, 0, cmSrcCopy);
        end;
      tedLeft:
        begin
          RVisible.Right := RVisible.Left;
          RVisible.Left  := RVisible.Left - Step;
          RRoll   .Right := RVisible.Left;
          RRoll   .Left  := RRoll.Right - RollPixels;

          BitBlt(Data.Canvas.Handle, RRoll.Left, RRoll.Top, RollPixels,
            Data.Height, ReversedBmp.Canvas.Handle,
            ReversedBmp.Width - RRoll.Right - RollPixels, 0, cmSrcCopy);
        end;
      tedDown:
        begin
          RVisible.Top    := RVisible.Bottom;
          RVisible.Bottom := RVisible.Bottom + Step;
          RRoll   .Top    := RVisible.Bottom;
          RRoll   .Bottom := RRoll.Top + RollPixels;

          BitBlt(Data.Canvas.Handle, RRoll.Left, RRoll.Top, Data.Width,
            RollPixels, ReversedBmp.Canvas.Handle, 0,
            Data.Height - RRoll.Top - 1, cmSrcCopy);
        end;
      tedUp:
        begin
          RVisible.Bottom := RVisible.Top;
          RVisible.Top    := RVisible.Top - Step;
          RRoll   .Bottom := RVisible.Top;
          RRoll   .Top    := RRoll.Bottom - RollPixels;

          BitBlt(Data.Canvas.Handle, RRoll.Left, RRoll.Top, Data.Width,
            RollPixels, ReversedBmp.Canvas.Handle, 0,
            Data.Height - RRoll.Bottom - RollPixels, cmSrcCopy);
        end;
    end;
  end;

  Windows.UnionRect(UpdateRect, RRoll, UpdateRect);
  BitBlt(Data.Canvas.Handle, RVisible.Left, RVisible.Top,
    RVisible.Right-RVisible.Left, RVisible.Bottom-RVisible.Top,
    Data.DstBmp.Canvas.Handle, RVisible.Left, RVisible.Top, cmSrcCopy);
  Windows.UnionRect(UpdateRect, RVisible, UpdateRect);
  IntersectRect(UpdateRect, UpdateRect, Rect(0, 0, Data.Width, Data.Height));

  if Is3D then
  begin
    CreateLightMap(RollPixels);

    ScanLineSize := GetBytesPerScanline(Data.Bitmap, pf32bit, 32);
    Work         := PChar(Data.Bitmap.ScanLine[0]) + ScanlineSize;

    FirstLightIndex := 0;
    if(     UnRollToUse  and (DirectionToUse = tedRight)) or
      ((not UnRollToUse) and (DirectionToUse = tedLeft ))
    then FirstLightIndex := RRoll.Left - 1
    else
    if(     UnRollToUse  and (DirectionToUse = tedUp   )) or
      ((not UnRollToUse) and (DirectionToUse = tedDown ))
    then FirstLightIndex := Data.Bitmap.Height - RRoll.Bottom - 1;

    if FirstLightIndex < 0
    then FirstLightIndex := -(FirstLightIndex * 4)
    else
    begin
      if RRoll.Left mod 2 = 0
      then FirstLightIndex := 4
      else FirstLightIndex := 0;
    end;

    ApplyLightMap(Work, Data.Bitmap.Width, ScanLineSize, FirstLightIndex, RRoll,
      Rect(0, 0, 0, 0));
  end;
end;

procedure TRollTransition.CreateLightMap(RollPixels: Integer);
{$ifdef TrialLimited}
begin
end;
{$else}

  procedure SetLightMap(Index, Value: Integer);
  begin
    LightMap[(Index * 4) + 0] := Value;
    LightMap[(Index * 4) + 1] := Value;
    LightMap[(Index * 4) + 2] := Value;
    LightMap[(Index * 4) + 3] := Value;
  end;

const
  BaseLight = 110;
var
  Even: Boolean;
  Dif: Double;
  aux,
  Half,
  i,
  Values: Integer;
begin
  if RollPixels <> LightMapSize then
  begin
    SetLightMap(0, 0);
    if RollPixels > 2
    then
    begin
      Even   := (RollPixels mod 2) = 0;
      Values := (RollPixels - 1) div 4;
      Dif    := (BaseLight * 2) / ((RollPixels - 1) div 2);
      Half   := (RollPixels + 1) div 2;

      SetLightMap(1         , -BaseLight);
      SetLightMap(RollPixels, -BaseLight);
      SetLightMap(Half      ,  BaseLight);
      if Even then
        SetLightMap(Half+1  ,  BaseLight);

      for i:= 1 to Values do
      begin
        aux := Round(BaseLight - (Dif * i));
        SetLightMap(i+1          , -aux);
        SetLightMap(RollPixels-i , -aux);
        if RollPixels > 6 then
        begin
          SetLightMap(Half-i       ,  aux);
          if Even
          then SetLightMap(Half+i+1, aux)
          else SetLightMap(Half+i  , aux);
        end;
      end;
    end
    else
    begin
      if RollPixels = 1
      then SetLightMap(1, BaseLight)
      else
      begin
        SetLightMap(1, -BaseLight);
        SetLightMap(2,  BaseLight);
      end;
    end;
    LightMapSize := RollPixels;
  end;
  SetLightMap(RollPixels + 1, 0);
end; //EROC itnA
{$endif TrialLimited}

{$ifndef TrialLimited}
procedure ApplyLightMapHrz(LightMap: PLightMap; Work: PByteArray;
  k, UpdateRowLenght, UpdateGap: Longint);
var
  i: Longint;
  Light: Shortint;
  Limit: Longint;
begin
  i := 0;
  while k < 0 do
  begin
    Light := LightMap[i*4];
    Limit := k + UpdateRowLenght;
    while k < Limit do
    begin
      if(Light < 0) and (Work[k+0] <= -Light)
      then Work[k+0] := 0
      else if Work[k+0] >= 255-Light
      then Work[k+0] := 255
      else Inc(Work[k+0], Light);
      if(Light < 0) and (Work[k+1] <= -Light)
      then Work[k+1] := 0
      else if Work[k+1] >= 255-Light
      then Work[k+1] := 255
      else Inc(Work[k+1], Light);
      if(Light < 0) and (Work[k+2] <= -Light)
      then Work[k+2] := 0
      else if Work[k+2] >= 255-Light
      then Work[k+2] := 255
      else Inc(Work[k+2], Light);
      if(Light < 0) and (Work[k+3] <= -Light)
      then Work[k+3] := 0
      else if Work[k+3] >= 255-Light
      then Work[k+3] := 255
      else Inc(Work[k+3], Light);
      Inc(k, 4);
    end;
    Inc(i);
    Inc(k, UpdateGap);
  end;
end;

procedure ApplyLightMapVrt(LightMap: PLightMap; Work: PByteArray;
  k, UpdateRowLenght, UpdateGap: Longint);
var
  i: Longint;
  Light: Shortint;
  Limit: Longint;
begin
  while k < 0 do
  begin
    i     := 0;
    Limit := k + UpdateRowLenght;
    while k < Limit do
    begin
      Light := LightMap[i];
      if(Light < 0) and (Work[k+0] <= -Light)
      then Work[k+0] := 0
      else if Work[k+0] >= 255-Light
      then Work[k+0] := 255
      else Inc(Work[k+0], Light);
      if(Light < 0) and (Work[k+1] <= -Light)
      then Work[k+1] := 0
      else if Work[k+1] >= 255-Light
      then Work[k+1] := 255
      else Inc(Work[k+1], Light);
      if(Light < 0) and (Work[k+2] <= -Light)
      then Work[k+2] := 0
      else if Work[k+2] >= 255-Light
      then Work[k+2] := 255
      else Inc(Work[k+2], Light);
      if(Light < 0) and (Work[k+3] <= -Light)
      then Work[k+3] := 0
      else if Work[k+3] >= 255-Light
      then Work[k+3] := 255
      else Inc(Work[k+3], Light);
      Inc(k, 4);
      Inc(i, 4);
    end;
    Inc(k, UpdateGap);
  end;
end;
{$endif TrialLimited}

procedure TRollTransition.ApplyLightMap(Work2: PChar;
  Width, ScanLineSize, FirstLightIndex: Longint; RollRect, UnUpdateRect: TRect);
{$ifdef TrialLimited}begin end;{$else}
var
  UpdParams: TTEUpdParams;
  LM: PLightMap;
begin
  IntersectRect(RollRect, RollRect, UpdateRect);
  GiveMeTheUpdMode(Width, 0, 2, RollRect, UnUpdateRect, pf32bit);
  GiveMeTheUpdParams(2, UpdParams, ScanLineSize, RollRect, UnUpdateRect,
    pf32bit);

  LM := PLightMap(PChar(LightMap) + FirstLightIndex);
  if DirectionToUse in [tedDown, tedUp]
  then ApplyLightMapHrz(LM, PByteArray(Work2 - UpdParams.Start1),
         -UpdParams.Lenght1 * 4, UpdParams.RowLenght1 * 4, UpdParams.Gap1 * 4)
  else ApplyLightMapVrt(LM, PByteArray(Work2 - UpdParams.Start1),
         -UpdParams.Lenght1 * 4, UpdParams.RowLenght1 * 4, UpdParams.Gap1 * 4);
end;
{$endif TrialLimited}

initialization

  TERegisterTransition(TRollTransition);

end.