teblock.pas

delphi2007界面效果控件源码

     $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;
  BlockData: TBlockData;
begin
  BlockData  := TBlockData(Data.Custom);
  Monochrome := MaskBmp.PixelFormat = pf1bit;
  TotFrames  := RowsToUse * ColsToUse;
  if StyleToUse = 1
  then
  begin
    DualToUse       := False;
    Data.UpdateRect := Rect(0, 0, Data.Width, Data.Height);
  end
  else
  begin
    DualToUse       := Dual;
    Data.UpdateRect := Rect(0, 0, 0, 0);
    if DualToUse then
    begin
      CurrentFrame := CurrentFrame * 2;
      Step         := Step * 2;
    end;
  end;
  CalcDirtyRects := CalcDirtyRects and (Step <= 650);
  if BlockData.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 Data.AllowDeviceUpdate and
     BlockData.IsPixel      and
     Draw                   and
     Monochrome             and
     (StyleToUse = 1)
  then
  begin
    for i := CurrentFrame-Step+1 to CurrentFrame do
    begin
      Value := BlockData.BlocksOrder[i];
      Row   := Value shr 16;
      Col   := (Value and $0000FFFF) - 1;
      if CalcDirtyRects then
        Data.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
  begin
    for i := CurrentFrame-Step+1 to CurrentFrame do
    begin
      BlockData.StyleBlockProc(Data, i, TotFrames, Col, Row, DualToUse);
      if not Data.AllowDeviceUpdate
      then
      begin
        if BlockData.IsPixel
        then
        begin
          Dec(Col);
          aux  := @Mask[((RowsToUse - Row) * MaskScanLineSize) + (Col shr 5)];
          aux^ := aux^ and ColMasks1bit[Col and $1F];
          if Data.Device.IsRGB
          then SetPixelV(Data.DeviceCanvas.Handle, Col, Row-1,
                 GetPixel(Data.DstBmp.Canvas.Handle, Col, Row-1))
          else BitBlt(Data.DeviceCanvas.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.DeviceCanvas.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 BlockData.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(Data.UpdateRect, DirtyRect, Data.UpdateRect);
        end
        else
        begin
          DirtyRect   := GetBlockBounds(Data, Puzzle, Col, Row);
          BlockBounds := GetBlockBounds(Data, False , Col, Row);
          if StyleToUse <> 1 then
            Windows.UnionRect(Data.UpdateRect, DirtyRect, Data.UpdateRect);
          if Draw then
          begin
            if Puzzle
            then
            begin
              if((Col + Row) mod 2) = 0
              then
              begin
                if BlockBounds.Right - BlockBounds.Left = BlockData.PuzzleV_1.Width
                then
                begin
                  if BlockBounds.Bottom - BlockBounds.Top = BlockData.PuzzleH_1.Height
                  then PuzzleMask := BlockData.PuzzleV_1
                  else PuzzleMask := BlockData.PuzzleV_3;
                end
                else
                begin
                  if BlockBounds.Bottom - BlockBounds.Top = BlockData.PuzzleH_2.Height
                  then PuzzleMask := BlockData.PuzzleV_2
                  else PuzzleMask := BlockData.PuzzleV_4;
                end;

                BitBlt(MaskBmp.Canvas.Handle, BlockBounds.Left,
                  BlockBounds.Top - BlockData.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 + BlockData.ExtSize,
                    BlockBounds.Bottom));
                if Col = ColsToUse then
                  MaskBmp.Canvas.FillRect(Rect(BlockBounds.Right - BlockData.ExtSize,
                    BlockBounds.Top, BlockBounds.Right, BlockBounds.Bottom));
              end
              else
              begin
                if BlockBounds.Right - BlockBounds.Left = BlockData.PuzzleV_1.Width
                then
                begin
                  if BlockBounds.Bottom - BlockBounds.Top = BlockData.PuzzleH_1.Height
                  then PuzzleMask := BlockData.PuzzleH_1
                  else PuzzleMask := BlockData.PuzzleH_3;
                end
                else
                begin
                  if BlockBounds.Bottom - BlockBounds.Top = BlockData.PuzzleH_2.Height
                  then PuzzleMask := BlockData.PuzzleH_2
                  else PuzzleMask := BlockData.PuzzleH_4;
                end;

                BitBlt(MaskBmp.Canvas.Handle, BlockBounds.Left - BlockData.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 + BlockData.ExtSize));
                if Row = RowsToUse then
                  MaskBmp.Canvas.FillRect(Rect(BlockBounds.Left,
                    BlockBounds.Bottom - BlockData.ExtSize, BlockBounds.Right,
                    BlockBounds.Bottom));
              end;
            end
            else MaskBmp.Canvas.FillRect(BlockBounds);
          end;
        end;
        if CalcDirtyRects and Data.AllowDeviceUpdate then
          Data.DirtyRects.AddRect(DirtyRect);
      end;
    end;
  end;
end;

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

function TBlockTransition.GetInfo(Device: TTETransitionDevice):
  TTETransitionInfo;
begin
  Result := inherited GetInfo(Device) +
    [
      tetiThreadSafe,
      tetiUseDirtyRects
    ];
end;

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

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

procedure TBlockTransition.Style2_1Block(Data: TTETransitionData; 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(Data: TTETransitionData; CurrentFrame,
  TotFrames: Longint; var Col, Row: Integer; Dual: Boolean);
begin
  Style2_1Block(Data, TotFrames - CurrentFrame + 1, TotFrames, Col, Row, False);
end;

procedure TBlockTransition.Style2_3Block(Data: TTETransitionData; 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(Data: TTETransitionData; CurrentFrame,
  TotFrames: Longint; var Col, Row: Integer; Dual: Boolean);
begin
  Style2_3Block(Data, TotFrames - CurrentFrame + 1, TotFrames, Col, Row, False);
end;

procedure TBlockTransition.Style2_5Block(Data: TTETransitionData; 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(Data: TTETransitionData; CurrentFrame,
  TotFrames: Longint; var Col, Row: Integer; Dual: Boolean);
begin
  Style2_5Block(Data, TotFrames - CurrentFrame + 1, TotFrames, Col, Row, False);
end;

procedure TBlockTransition.Style2_7Block(Data: TTETransitionData; 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(Data: TTETransitionData; CurrentFrame,
  TotFrames: Longint; var Col, Row: Integer; Dual: Boolean);
begin
  Style2_7Block(Data, TotFrames - CurrentFrame + 1, TotFrames, Col, Row, False);
end;

procedure TBlockTransition.Style3_1Block(Data: TTETransitionData; 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(Data: TTETransitionData; CurrentFrame,
  TotFrames: Longint; var Col, Row: Integer; Dual: Boolean);
begin
  Style3_1Block(Data, TotFrames - CurrentFrame + 1, TotFrames, Col, Row, False);
end;

procedure TBlockTransition.Style3_3Block(Data: TTETransitionData; 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(Data: TTETransitionData; CurrentFrame,
  TotFrames: Longint; var Col, Row: Integer; Dual: Boolean);
begin
  Style3_3Block(Data, TotFrames - CurrentFrame + 1, TotFrames, Col, Row, False);
end;

{ TBlockData }

destructor TBlockData.Destroy;
begin
  if Assigned(PuzzleV_1) then
  begin
    PuzzleV_1.Canvas.Unlock;
    PuzzleV_1.Free;
  end;
  if Assigned(PuzzleV_2) then
  begin
    PuzzleV_2.Canvas.Unlock;
    PuzzleV_2.Free;
  end;
  if Assigned(PuzzleV_3) then
  begin
    PuzzleV_3.Canvas.Unlock;
    PuzzleV_3.Free;
  end;
  if Assigned(PuzzleV_4) then
  begin
    PuzzleV_4.Canvas.Unlock;
    PuzzleV_4.Free;
  end;
  if Assigned(PuzzleH_1) then
  begin
    PuzzleH_1.Canvas.Unlock;
    PuzzleH_1.Free;
  end;
  if Assigned(PuzzleH_2) then
  begin
    PuzzleH_2.Canvas.Unlock;
    PuzzleH_2.Free;
  end;
  if Assigned(PuzzleH_3) then
  begin
    PuzzleH_3.Canvas.Unlock;
    PuzzleH_3.Free;
  end;
  if Assigned(PuzzleH_4) then
  begin
    PuzzleH_4.Canvas.Unlock;
    PuzzleH_4.Free;
  end;

  FreeMem(BlocksOrder);

  inherited;
end;

initialization

  TERegisterTransition(TBlockTransition);

end.