teblock.pas

delphi2007界面效果控件源码

    IncCol      := 1;
    IncRow      := 0;
    R           := Rect(0, 1, ColsToUse + 1, RowsToUse + 1);
    GetMem(BlockData.BlocksOrder, (TotalBlocks+1) * 4);
    BlockData.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;
            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;
      BlockData.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(BlockData.BlocksOrder, (TotalBlocks+1) * 4);
    BlockData.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;
      BlockData.BlocksOrder[i] := (Row shl 16) + Col;
    end;
  end;

var
  BlockBounds: TRect;
begin
  BlockData   := TBlockData.Create(Data);
  Data.Custom := BlockData;
  BlockData.StyleBlockProc := nil;
  BlockData.BlocksOrder    := nil;

  case StyleToUse of
    1: BlockData.StyleBlockProc := StyleBlockByArray;
    2: case SubStyleToUse of
         1: BlockData.StyleBlockProc := Style2_1Block;
         2: if Dual
            then BlockData.StyleBlockProc := Style2_1Block
            else BlockData.StyleBlockProc := Style2_2Block;
         3: BlockData.StyleBlockProc := Style2_3Block;
         4: if Dual
            then BlockData.StyleBlockProc := Style2_3Block
            else BlockData.StyleBlockProc := Style2_4Block;
         5: BlockData.StyleBlockProc := Style2_5Block;
         6: if Dual
            then BlockData.StyleBlockProc := Style2_5Block
            else BlockData.StyleBlockProc := Style2_6Block;
         7: BlockData.StyleBlockProc := Style2_7Block;
         8: if Dual
            then BlockData.StyleBlockProc := Style2_7Block
            else BlockData.StyleBlockProc := Style2_8Block;
       end;
    3: case SubStyleToUse of
         1: BlockData.StyleBlockProc := Style3_1Block;
         2: if Dual
            then BlockData.StyleBlockProc := Style3_1Block
            else BlockData.StyleBlockProc := Style3_2Block;
         3: BlockData.StyleBlockProc := Style3_3Block;
         4: if Dual
            then BlockData.StyleBlockProc := Style3_3Block
            else BlockData.StyleBlockProc := Style3_4Block;
       end;
    4: case SubStyleToUse of
         1,3: BlockData.StyleBlockProc := StyleBlockByArray;
         2,4: BlockData.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;

  BlockData.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 BlockData.IsPixel) then
  begin
    if(Data.Width div ColsToUse) <= (Data.Height div RowsToUse)
    then BlockData.ExtSize := Round((Data.Width  div ColsToUse) / 3.5)
    else BlockData.ExtSize := Round((Data.Height div RowsToUse) / 3.5);

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

function TBlockTransition.Smooth(Device: TTETransitionDevice): Boolean;
begin
  Result := False;
end;

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

procedure TBlockTransition.Assign(Source: TPersistent);
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;
  BlockData: TBlockData;
begin
  BlockData := TBlockData(Data.Custom);

  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, BlockData.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, BlockData.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, BlockData.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, BlockData.ExtSize);
  end;

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

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

  inherited;

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

procedure TBlockTransition.MaskFrame(MaskBmp: TBitmap; CurrentFrame, Step,
  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,