teblock.pas

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

    else FillRect(Frame1bppMaskBmp.Canvas.Handle, UpdateRect,
           GetStockObject(WHITE_BRUSH));
  end;
end;

procedure TBlockTransition.MaskFrame(MaskBmp: TBitmap;
  CurrentFrame, Step, TotalFrames, LastExecutedFrame: Longint;
  Data: TTETransitionData; Draw, CalcDirtyRects: Boolean);
const
  ColMasks1bit: array[0..31] of DWord =
    ($FFFFFF7F, $FFFFFFBF, $FFFFFFDF, $FFFFFFEF,
     $FFFFFFF7, $FFFFFFFB, $FFFFFFFD, $FFFFFFFE,
     $FFFF7FFF, $FFFFBFFF, $FFFFDFFF, $FFFFEFFF,
     $FFFFF7FF, $FFFFFBFF, $FFFFFDFF, $FFFFFEFF,
     $FF7FFFFF, $FFBFFFFF, $FFDFFFFF, $FFEFFFFF,
     $FFF7FFFF, $FFFBFFFF, $FFFDFFFF, $FFFEFFFF,
     $7FFFFFFF, $BFFFFFFF, $DFFFFFFF, $EFFFFFFF,
     $F7FFFFFF, $FBFFFFFF, $FDFFFFFF, $FEFFFFFF);

  ColMasks2bit: array[0..30] of DWord =
    ($FFFFFF3F, $FFFFFF9F, $FFFFFFCF, $FFFFFFE7,
     $FFFFFFF3, $FFFFFFF9, $FFFFFFFC, $FFFFFFFE,
     $FFFF3FFF, $FFFF9FFF, $FFFFCFFF, $FFFFE7FF,
     $FFFFF3FF, $FFFFF9FF, $FFFFFCFF, $FFFFFE7F,
     $FF3FFFFF, $FF9FFFFF, $FFCFFFFF, $FFE7FFFF,
     $FFF3FFFF, $FFF9FFFF, $FFFCFFFF, $FFFE7FFF,
     $3FFFFFFF, $9FFFFFFF, $CFFFFFFF, $E7FFFFFF,
     $F3FFFFFF, $F9FFFFFF, $FCFFFFFF);
var
  i,
  TotFrames: Longint;
  Col,
  Row,
  Value: Integer;
  BlockBounds,
  DirtyRect: TRect;
  PuzzleMask: TBitmap;
  Mask: PDWordArray;
  aux: PDWord;
  MaskScanLineSize: Integer;
  Monochrome,
  DualToUse: Boolean;
begin
  Monochrome := MaskBmp.PixelFormat = pf1bit;
  TotFrames  := TotalFrames;
  if StyleToUse = 1
  then
  begin
    DualToUse  := False;
    UpdateRect := Rect(0, 0, Data.Width, Data.Height);
  end
  else
  begin
    DualToUse  := Dual;
    UpdateRect := Rect(0, 0, 0, 0);
    if DualToUse then
    begin
      CurrentFrame := CurrentFrame * 2;
      Step         := Step * 2;
      TotFrames    := RowsToUse * ColsToUse;
    end;
  end;
  CalcDirtyRects := CalcDirtyRects and (Step <= 650);
  if IsPixel
  then
  begin
    MaskScanLineSize := GetBytesPerScanline(MaskBmp, pf1bit, 32) div 4;
    Mask := PDWordArray(MaskBmp.ScanLine[MaskBmp.Height-1]);
  end
  else
  begin
    MaskScanLineSize := 0;
    Mask := nil;
  end;

  if AllowScreenUpdate and IsPixel and Draw and Monochrome and (StyleToUse = 1)
  then
  begin
    for i := CurrentFrame-Step+1 to CurrentFrame do
    begin
      Value := BlocksOrder[i-1];
      Row   := Value shr 16;
      Col   := (Value and $0000FFFF) - 1;
      if CalcDirtyRects then
        DirtyRects.AddRect(Rect(Col, Row-1, Col+1, Row));
      aux  := @Mask[((RowsToUse - Row) * MaskScanLineSize) + (Col shr 5)];
      aux^ := aux^ and ColMasks1bit[Col and $1F];
    end;
  end
  else
  if AllowScreenUpdate and (BlockWidth = 2) and (BlockHeight = 2) and
    Draw and Monochrome and (not Puzzle)
  then
  begin
    MaskScanLineSize := GetBytesPerScanline(MaskBmp, pf1bit, 32) div 4;
    Mask := PDWordArray(MaskBmp.ScanLine[MaskBmp.Height-1]);
    for i := CurrentFrame-Step+1 to CurrentFrame do
    begin
      StyleBlockProc(i, TotFrames, Col, Row, DualToUse);
      if CalcDirtyRects
      then
      begin
        BlockBounds := GetBlockBounds(Data, False, Col, Row);
        DirtyRects.AddRect(BlockBounds);
        Row := BlockBounds.Top + 1;
        Col := BlockBounds.Left;
      end
      else
      begin
        Row := (Row * 2) - 1;
        Col := (Col - 1) * 2;
      end;
      aux := @Mask[((RowsToUse * 2 - Row) * MaskScanLineSize) + (Col shr 5)];
      Col := Col and $1F;
      if Col <> $1
      then
      begin
        aux^ := aux^ and ColMasks2bit[Col];
        Inc(aux, MaskScanLineSize);
        aux^ := aux^ and ColMasks2bit[Col];
      end
      else
      begin
        aux^ := aux^ and $FE7FFFFF;
        Inc(aux);
        aux^ := aux^ and $FFFFFF7F;
        Inc(aux, MaskScanLineSize-1);
        aux^ := aux^ and $FE7FFFFF;
        Inc(aux);
        aux^ := aux^ and $FFFFFF7F;
      end;
    end;
  end
  else
  begin
    for i := CurrentFrame-Step+1 to CurrentFrame do
    begin
      StyleBlockProc(i, TotFrames, Col, Row, DualToUse);
      if not AllowScreenUpdate
      then
      begin
        if IsPixel
        then
        begin
          Dec(Col);
          aux  := @Mask[((RowsToUse - Row) * MaskScanLineSize) + (Col shr 5)];
          aux^ := aux^ and ColMasks1bit[Col and $1F];
          if Data.IsRGB
          then SetPixelV(Data.ScreenCanvas.Handle, Col, Row-1,
                 GetPixel(Data.DstBmp.Canvas.Handle, Col, Row-1))
          else BitBlt(Data.ScreenCanvas.Handle, Col, Row-1, 1, 1,
                 Data.DstBmp.Canvas.Handle, Col, Row-1, cmSrcCopy);
        end
        else
        begin
          BlockBounds := GetBlockBounds(Data, False, Col, Row);
          MaskBmp.Canvas.FillRect(BlockBounds);
          BitBlt(Data.ScreenCanvas.Handle, BlockBounds.Left, BlockBounds.Top,
            BlockBounds.Right-BlockBounds.Left, BlockBounds.Bottom-BlockBounds.Top,
            Data.DstBmp.Canvas.Handle, BlockBounds.Left, BlockBounds.Top, cmSrcCopy);
        end;
      end
      else
      begin
        if IsPixel
        then
        begin
          if Draw then
          begin
            Dec(Col);
            if Monochrome
            then
            begin
              aux  := @Mask[((RowsToUse - Row) * MaskScanLineSize) + (Col shr 5)];
              aux^ := aux^ and ColMasks1bit[Col and $1F];
            end
            else SetPixelV(MaskBmp.Canvas.Handle, Col, Row-1, 0);
          end;
          DirtyRect := Rect(Col, Row-1, Col+1, Row);
          if StyleToUse <> 1 then
            Windows.UnionRect(UpdateRect, DirtyRect, UpdateRect);
        end
        else
        begin
          DirtyRect   := GetBlockBounds(Data, Puzzle, Col, Row);
          BlockBounds := GetBlockBounds(Data, False , Col, Row);
          if StyleToUse <> 1 then
            Windows.UnionRect(UpdateRect, DirtyRect, UpdateRect);
          if Draw then
          begin
            if Puzzle
            then
            begin
              if((Col + Row) mod 2) = 0
              then
              begin
                if BlockBounds.Right - BlockBounds.Left = PuzzleV_1.Width
                then
                begin
                  if BlockBounds.Bottom - BlockBounds.Top = PuzzleH_1.Height
                  then PuzzleMask := PuzzleV_1
                  else PuzzleMask := PuzzleV_3;
                end
                else
                begin
                  if BlockBounds.Bottom - BlockBounds.Top = PuzzleH_2.Height
                  then PuzzleMask := PuzzleV_2
                  else PuzzleMask := PuzzleV_4;
                end;

                BitBlt(MaskBmp.Canvas.Handle, BlockBounds.Left,
                  BlockBounds.Top - ExtSize, PuzzleMask.Width,
                  PuzzleMask.Height, PuzzleMask.Canvas.Handle, 0, 0, cmSrcAnd);
                if Col = 1 then
                  MaskBmp.Canvas.FillRect(Rect(BlockBounds.Left,
                    BlockBounds.Top, BlockBounds.Left + ExtSize,
                    BlockBounds.Bottom));
                if Col = ColsToUse then
                  MaskBmp.Canvas.FillRect(Rect(BlockBounds.Right - ExtSize,
                    BlockBounds.Top, BlockBounds.Right, BlockBounds.Bottom));
              end
              else
              begin
                if BlockBounds.Right - BlockBounds.Left = PuzzleV_1.Width
                then
                begin
                  if BlockBounds.Bottom - BlockBounds.Top = PuzzleH_1.Height
                  then PuzzleMask := PuzzleH_1
                  else PuzzleMask := PuzzleH_3;
                end
                else
                begin
                  if BlockBounds.Bottom - BlockBounds.Top = PuzzleH_2.Height
                  then PuzzleMask := PuzzleH_2
                  else PuzzleMask := PuzzleH_4;
                end;

                BitBlt(MaskBmp.Canvas.Handle, BlockBounds.Left - ExtSize,
                  BlockBounds.Top, PuzzleMask.Width, PuzzleMask.Height,
                  PuzzleMask.Canvas.Handle, 0, 0, cmSrcAnd);
                if Row = 1 then
                  MaskBmp.Canvas.FillRect(Rect(BlockBounds.Left,
                    BlockBounds.Top, BlockBounds.Right,
                    BlockBounds.Top + ExtSize));
                if Row = RowsToUse then
                  MaskBmp.Canvas.FillRect(Rect(BlockBounds.Left,
                    BlockBounds.Bottom - ExtSize, BlockBounds.Right,
                    BlockBounds.Bottom));
              end;
            end
            else MaskBmp.Canvas.FillRect(BlockBounds);
          end;
        end;
        if CalcDirtyRects and AllowScreenUpdate then
          DirtyRects.AddRect(DirtyRect);
      end;
    end;
  end;
end;

procedure GetDualData(var Frame: Longint; TotalFrames: Longint);
begin
  if Frame and $1 = $1
  then Frame := (Frame shr 1) + 1
  else Frame := TotalFrames - (Frame shr 1) + 1;
end;

procedure TBlockTransition.StyleBlockByArray(CurrentFrame, TotFrames: Longint;
  var Col, Row: Integer; Dual: Boolean);
var
  Value: Longint;
begin
  if Dual then
    GetDualData(CurrentFrame, TotFrames);
  Value := BlocksOrder[CurrentFrame];
  Row   := Value shr 16;
  Col   := Value and $0000FFFF;
end;

procedure TBlockTransition.StyleBlockByArrayReversed(
  CurrentFrame, TotFrames: Longint; var Col, Row: Integer; Dual: Boolean);
var
  Value: Longint;
begin
  if Dual then
    GetDualData(CurrentFrame, TotFrames);
  Value := BlocksOrder[TotFrames - CurrentFrame + 1];
  Row   := Value shr 16;
  Col   := Value and $0000FFFF;
end;

procedure TBlockTransition.Style2_1Block(CurrentFrame, TotFrames: Longint;
  var Col, Row: Integer; Dual: Boolean);
begin
  if Dual then
    GetDualData(CurrentFrame, TotFrames);

  Col := ((CurrentFrame - 1) mod ColsToUse) + 1;
  Row := ((CurrentFrame - 1) div ColsToUse) + 1;
end;

procedure TBlockTransition.Style2_2Block(
  CurrentFrame, TotFrames: Longint; var Col, Row: Integer; Dual: Boolean);
begin
  Style2_1Block(TotFrames - CurrentFrame + 1, TotFrames, Col, Row, False);
end;

procedure TBlockTransition.Style2_3Block(CurrentFrame, TotFrames: Longint;
  var Col, Row: Integer; Dual: Boolean);
begin
  if Dual then
    GetDualData(CurrentFrame, TotFrames);

  Col := ((CurrentFrame - 1) mod ColsToUse) + 1;
  Row := RowsToUse - (((CurrentFrame - 1) div ColsToUse));
end;

procedure TBlockTransition.Style2_4Block(
  CurrentFrame, TotFrames: Longint; var Col, Row: Integer; Dual: Boolean);
begin
  Style2_3Block(TotFrames - CurrentFrame + 1, TotFrames, Col, Row, False);
end;

procedure TBlockTransition.Style2_5Block(CurrentFrame, TotFrames: Longint;
  var Col, Row: Integer; Dual: Boolean);
begin
  if Dual then
    GetDualData(CurrentFrame, TotFrames);

  Col := ((CurrentFrame - 1) div RowsToUse) + 1;
  Row := ((CurrentFrame - 1) mod RowsToUse) + 1;
end;

procedure TBlockTransition.Style2_6Block(
  CurrentFrame, TotFrames: Longint; var Col, Row: Integer; Dual: Boolean);
begin
  Style2_5Block(TotFrames - CurrentFrame + 1, TotFrames, Col, Row, False);
end;

procedure TBlockTransition.Style2_7Block(CurrentFrame, TotFrames: Longint;
  var Col, Row: Integer; Dual: Boolean);
begin
  if Dual then
    GetDualData(CurrentFrame, TotFrames);

  Col := ColsToUse - (((CurrentFrame - 1) div RowsToUse));
  Row := ((CurrentFrame - 1) mod RowsToUse) + 1;
end;

procedure TBlockTransition.Style2_8Block(
  CurrentFrame, TotFrames: Longint; var Col, Row: Integer; Dual: Boolean);
begin
  Style2_7Block(TotFrames - CurrentFrame + 1, TotFrames, Col, Row, False);
end;

procedure TBlockTransition.Style3_1Block(CurrentFrame, TotFrames: Longint;
  var Col, Row: Integer; Dual: Boolean);
begin
  if Dual then
    GetDualData(CurrentFrame, TotFrames);

  Row := ((CurrentFrame - 1) div ColsToUse) + 1;
  if(Row mod 2) = 1
  then Col := ((CurrentFrame - 1) mod ColsToUse) + 1
  else Col := ColsToUse - ((CurrentFrame - 1) mod ColsToUse)
end;

procedure TBlockTransition.Style3_2Block(CurrentFrame, TotFrames: Longint;
  var Col, Row: Integer; Dual: Boolean);
begin
  Style3_1Block(TotFrames - CurrentFrame + 1, TotFrames, Col, Row, False);
end;

procedure TBlockTransition.Style3_3Block(CurrentFrame, TotFrames: Longint;
  var Col, Row: Integer; Dual: Boolean);
begin
  if Dual then
    GetDualData(CurrentFrame, TotFrames);

  Col := ((CurrentFrame - 1) div RowsToUse) + 1;
  if(Col mod 2) = 1
  then Row := ((CurrentFrame - 1) mod RowsToUse) + 1
  else Row := RowsToUse - ((CurrentFrame - 1) mod RowsToUse);
end;

procedure TBlockTransition.Style3_4Block(CurrentFrame, TotFrames: Longint;
  var Col, Row: Integer; Dual: Boolean);
begin
  Style3_3Block(TotFrames - CurrentFrame + 1, TotFrames, Col, Row, False);
end;

initialization

  TERegisterTransition(TBlockTransition);

end.