teblock.pas

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

        if IncCol > 0 then
        begin
          if PrevCol + 1 = R.Right then
          begin
            IncCol := 0;
            IncRow := 1;
            Dec(R.Right);
          end;
        end
        else
        begin
          if PrevCol - 1 = R.Left then
          begin
            IncCol :=  0;
            IncRow := -1;
            Inc(R.Left);
          end;
        end;
      end
      else
      begin
        if IncRow > 0 then
        begin
          if PrevRow + 1 = R.Bottom then
          begin
            IncCol := -1;
            IncRow :=  0;
            Dec(R.Bottom);
          end;
        end
        else
        begin
          if PrevRow - 1 = R.Top then
          begin
            IncCol := 1;
            IncRow := 0;
            Inc(R.Top);
          end;
        end;
      end;

      Col            := PrevCol + IncCol;
      Row            := PrevRow + IncRow;
      PrevCol        := Col;
      PrevRow        := Row;
      BlocksOrder[i] := (Row shl 16) + Col;
    end;
  end;

  procedure Style4_3BlocksOrder;
  var
    TotalBlocks,
    Col,
    Row,
    PrevCol,
    PrevRow,
    IncCol,
    IncRow: Longint;
    i: Longint;
    R : TRect;
  begin
    TotalBlocks    := ColsToUse * RowsToUse;
    Col            := ColsToUse;
    Row            := 1;
    PrevCol        := Col;
    PrevRow        := Row;
    IncCol         := -1;
    IncRow         :=  0;
    R              := Rect(0, 1, ColsToUse + 1, RowsToUse + 1);
    GetMem(BlocksOrder, (TotalBlocks+1) * 4);
    BlocksOrder[1] := (Row shl 16) + Col;
    for i := 2 to TotalBlocks do
    begin
      if IncCol <> 0 then
      begin
        if IncCol > 0 then
        begin
          if PrevCol + 1 = R.Right then
          begin
            IncCol  :=  0;
            IncRow  := -1;
            R.Right := PrevCol;
          end;
        end
        else
        begin
          if PrevCol - 1 = R.Left then
          begin
            IncCol := 0;
            IncRow := 1;
            R.Left := PrevCol;
          end;
        end;
      end
      else
      begin
        if IncRow > 0 then
        begin
          if PrevRow + 1 = R.Bottom then
          begin
            IncCol   := 1;
            IncRow   := 0;
            R.Bottom := PrevRow;
          end;
        end
        else
        begin
          if PrevRow - 1 = R.Top then
          begin
            IncCol := -1;
            IncRow :=  0;
            R.Top  := PrevRow;
          end;
        end;
      end;

      Col            := PrevCol + IncCol;
      Row            := PrevRow + IncRow;
      PrevCol        := Col;
      PrevRow        := Row;
      BlocksOrder[i] := (Row shl 16) + Col;
    end;
  end;

var
  BlockBounds: TRect;
begin
  case StyleToUse of
    1: StyleBlockProc := StyleBlockByArray;
    2: case SubStyleToUse of
         1: StyleBlockProc := Style2_1Block;
         2: if Dual
            then StyleBlockProc := Style2_1Block
            else StyleBlockProc := Style2_2Block;
         3: StyleBlockProc := Style2_3Block;
         4: if Dual
            then StyleBlockProc := Style2_3Block
            else StyleBlockProc := Style2_4Block;
         5: StyleBlockProc := Style2_5Block;
         6: if Dual
            then StyleBlockProc := Style2_5Block
            else StyleBlockProc := Style2_6Block;
         7: StyleBlockProc := Style2_7Block;
         8: if Dual
            then StyleBlockProc := Style2_7Block
            else StyleBlockProc := Style2_8Block;
       end;
    3: case SubStyleToUse of
         1: StyleBlockProc := Style3_1Block;
         2: if Dual
            then StyleBlockProc := Style3_1Block
            else StyleBlockProc := Style3_2Block;
         3: StyleBlockProc := Style3_3Block;
         4: if Dual
            then StyleBlockProc := Style3_3Block
            else StyleBlockProc := Style3_4Block;
       end;
    4: case SubStyleToUse of
         1,3: StyleBlockProc := StyleBlockByArray;
         2,4: StyleBlockProc := StyleBlockByArrayReversed;
       end;
  end;

  ColsToUse := Cols;
  if ColsToUse = 0 then
    ColsToUse := Round(Data.Width / BlockWidth);
  if ColsToUse < 1 then
    ColsToUse := 1;
  if Puzzle and (Data.Width div ColsToUse < 15) then
    ColsToUse := Trunc(Data.Width / 15);
  if ColsToUse > Data.Width then
    ColsToUse := Data.Width;

  RowsToUse := Rows;
  if RowsToUse = 0 then
    RowsToUse := Round(Data.Height / BlockHeight);
  if RowsToUse < 1 then
    RowsToUse := 1;
  if Puzzle and (Data.Height div RowsToUse < 15) then
    RowsToUse := Trunc(Data.Height / 15);
  if RowsToUse > Data.Height then
    RowsToUse := Data.Height;

  BlockBounds := GetBlockBounds(Data, True, 1, 1);

  inherited;

  IsPixel :=
    (ColsToUse = Data.Width) and
    (RowsToUse = Data.Height);

  case StyleToUse of
    1: Style1BlocksOrder;
    4: case SubStyleToUse of
         1,2: Style4_1BlocksOrder;
         3,4: Style4_3BlocksOrder;
       end;
  end;

  if Puzzle and (not IsPixel) then
  begin
    if(Data.Width div ColsToUse) <= (Data.Height div RowsToUse)
    then ExtSize := Round((Data.Width  div ColsToUse) / 3.5)
    else ExtSize := Round((Data.Height div RowsToUse) / 3.5);

    PuzzleV_1 := CreatePuzzle(True , 1, True, 0);
    PuzzleV_2 := CreatePuzzle(True , 2, True, 0);
    PuzzleV_3 := CreatePuzzle(True , 3, True, 0);
    PuzzleV_4 := CreatePuzzle(True , 4, True, 0);
    PuzzleH_1 := CreatePuzzle(False, 1, True, 0);
    PuzzleH_2 := CreatePuzzle(False, 2, True, 0);
    PuzzleH_3 := CreatePuzzle(False, 3, True, 0);
    PuzzleH_4 := CreatePuzzle(False, 4, True, 0);
  end;
  DirtyRects.CheckBounds := True;
end;

procedure TBlockTransition.Finalize(Data: TTETransitionData);
begin
  if Puzzle then
  begin
    PuzzleV_1.Free;
    PuzzleV_1 := nil;
    PuzzleV_2.Free;
    PuzzleV_2 := nil;
    PuzzleV_3.Free;
    PuzzleV_3 := nil;
    PuzzleV_4.Free;
    PuzzleV_4 := nil;
    PuzzleH_1.Free;
    PuzzleH_1 := nil;
    PuzzleH_2.Free;
    PuzzleH_2 := nil;
    PuzzleH_3.Free;
    PuzzleH_3 := nil;
    PuzzleH_4.Free;
    PuzzleH_4 := nil;
  end;

  FreeMem(BlocksOrder);
  BlocksOrder := nil;

  inherited;
end;

function TBlockTransition.Smooth: Boolean;
begin
  Result := False;
end;

function TBlockTransition.CalcTotalFrames(Data: TTETransitionData): Longint;
begin
  Result := RowsToUse * ColsToUse;
  if Dual and (StyleToUse <> 1) then
    Result := (Result + 1) div 2;
end;

procedure TBlockTransition.Assign(Source: TPersistent); //EROC itnA
var
  Transition: TBlockTransition;
begin
  if Source is TBlockTransition
  then
  begin
    inherited;

    Transition := TBlockTransition(Source);
    Puzzle     := Transition.Puzzle;
    Dual       := Transition.Dual;
    if Transition.Rows <> 0
    then Rows := Transition.Rows
    else BlockHeight := Transition.BlockHeight;
    if Transition.Cols <> 0
    then Cols := Transition.Cols
    else BlockWidth := Transition.BlockWidth;
  end
  else inherited;
end;

class function TBlockTransition.GetEditor: String;
begin
  Result := 'TBlockTransitionEditor';
end;

function TBlockTransition.CountOfSubStyles(StyleValue: Word): Word;
begin
  if StyleValue = 0
  then Result := 0
  else
  begin
    Result := 1;

    case StyleValue of
      1: Result := 1;
      2: Result := 8;
      3: Result := 4;
      4: Result := 4;
    end;
  end;
end;

function TBlockTransition.CalculateReversedSubStyle(
  const StyleValue, SubStyleValue: Word): Word;
begin
  Result := SubStyleValue;

  case StyleValue of
    2: case SubStyleValue of
         1: Result := 2;
         2: Result := 1;
         3: Result := 4;
         4: Result := 3;
         5: Result := 6;
         6: Result := 5;
         7: Result := 8;
         8: Result := 7;
       end;
    3: case SubStyleValue of
         1: Result := 2;
         2: Result := 1;
         3: Result := 4;
         4: Result := 3;
       end;
    4: case SubStyleValue of
         1: Result := 2;
         2: Result := 1;
         3: Result := 4;
         4: Result := 3;
       end;
  end;
end;

function TBlockTransition.GetBlockBounds(Data: TTETransitionData;
  CheckPuzzle: Boolean; Col, Row: Integer): TRect;
var
  Left,
  Top,
  Right,
  Bottom: Integer;
begin
  if Col = 1
  then Left := 0
  else
  begin
    Left := Round(Data.Width / ColsToUse * (Col - 1));
    if CheckPuzzle and Puzzle and (((Col + Row) mod 2) = 1) then
      Dec(Left, ExtSize);
  end;

  if Row = 1
  then Top := 0
  else
  begin
    Top := Round(Data.Height / RowsToUse * (Row - 1));
    if CheckPuzzle and Puzzle and (((Col + Row) mod 2) = 0) then
      Dec(Top, ExtSize);
  end;

  if Col = ColsToUse
  then Right := Data.Width
  else
  begin
    Right := Round(Data.Width / ColsToUse * Col);
    if CheckPuzzle and Puzzle and (((Col + Row) mod 2) = 1) then
      Inc(Right, ExtSize);
  end;

  if Row = RowsToUse
  then Bottom := Data.Height
  else
  begin
    Bottom := Round(Data.Height / RowsToUse * Row);
    if CheckPuzzle and Puzzle and (((Col + Row) mod 2) = 0) then
      Inc(Bottom, ExtSize);
  end;

  Result := Rect(Left, Top, Right, Bottom);
end;

procedure TBlockTransition.ExecuteFrame(Data: TTETransitionData;
  CurrentFrame, Step, TotalFrames, LastExecutedFrame: Longint);
var
  i: Integer;
begin
  AllowScreenUpdate := Puzzle or (Step > 100);

  inherited;

  if AllowScreenUpdate and (Frame1bppMaskBmp <> nil) then
  begin
    if DirtyRects.Count > 1
    then
    begin
      for i := 0 to DirtyRects.Count-1 do
        FillRect(Frame1bppMaskBmp.Canvas.Handle, DirtyRects[i],
          GetStockObject(WHITE_BRUSH));
    end