⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 tepush.pas

📁 Do your applications look a little boring? Would you like to get spectacular yet easy to use visual
💻 PAS
字号:
unit tePush;

interface

{$INCLUDE teDefs.inc}

uses
  SysUtils, Classes, TransEff, teTimed,
  {$ifdef CLX}
  QGraphics;
  {$else}
  Windows, Messages, Graphics;
  {$endif CLX}

type
  TPushTransition = class(TTimedTransitionEffect)
  private
  protected
    IsClipped: Boolean;

    procedure Initialize(Data: TTETransitionData; var Frames: Longint); override;
    procedure ExecuteFrame(Data: TTETransitionData;
      CurrentFrame, Step, TotalFrames, LastExecutedFrame: Longint); override;
    function  GetPixelFormat: TPixelFormat; override;
    function  NeedSrcImage: Boolean; override;
  public
    constructor Create(AOwner: TComponent{$ifdef DP} = nil{$endif}); override;
    class function Description: String; override;

  published
    property Direction default tedDown;
    property Reversed;
  end;

implementation

uses teRender;

constructor TPushTransition.Create(AOwner: TComponent);
begin
  inherited;

  AllowedDirections := [tedRight, tedLeft, tedDown, tedUp];
  Direction := tedDown;
end;

class function TPushTransition.Description: String;
begin
  Result := 'Push';
end;

procedure TPushTransition.Initialize(Data: TTETransitionData; var Frames: Longint);
begin
  inherited;

  case DirectionToUse of
    tedDown : Frames := Data.Height;
    tedUp   : Frames := Data.Height;
    tedRight: Frames := Data.Width;
    tedLeft : Frames := Data.Width;
  end;

  if Data.Bitmap <> nil then
    BitBlt(Data.Bitmap.Canvas.Handle, 0, 0, Data.Width, Data.Height,
      Data.SrcBmp.Canvas.Handle, 0, 0, cmSrcCopy);
end;

procedure TPushTransition.ExecuteFrame(Data: TTETransitionData;
  CurrentFrame, Step, TotalFrames, LastExecutedFrame: Longint);
var
  ScrollRect,
  ClipRect,
  UpdateRect,
  SrcRect: TRect;
  xDesp,
  yDesp,
  DstXDesp,
  DstYDesp,
  SrcXDesp,
  SrcYDesp: Integer;
begin
  inherited;

  xDesp    := 0;
  yDesp    := 0;
  DstXDesp := 0;
  DstYDesp := 0;
  SrcXDesp := 0;
  SrcYDesp := 0;

  case DirectionToUse of
    tedDown:
      begin
        yDesp    := Step;
        DstYDesp := Data.Height - CurrentFrame;
        if IsClipped
        then
        begin
          SrcRect    := Rect(0, CurrentFrame, Data.Width, Data.Height );
          UpdateRect := Rect(0, 0, Data.Width, CurrentFrame);
        end
        else UpdateRect := Rect(0, 0, Data.Width, Step);
      end;
    tedUp:
      begin
        yDesp    := -Step;
        if IsClipped
        then
        begin
          SrcRect    := Rect(0, 0, Data.Width, Data.Height - CurrentFrame);
          UpdateRect := Rect(0, Data.Height - CurrentFrame, Data.Width,
            Data.Height);
          SrcYDesp   := CurrentFrame;
        end
        else
        begin
          UpdateRect := Rect(0, Data.Height - Step, Data.Width, Data.Height);
          DstYDesp   := CurrentFrame;
        end;
      end;
    tedRight:
      begin
        xDesp    := Step;
        DstXDesp := Data.Width - CurrentFrame;
        if IsClipped
        then
        begin
          SrcRect := Rect(CurrentFrame, 0, Data.Width, Data.Height);
          UpdateRect := Rect(0, 0, CurrentFrame, Data.Height);
        end
        else UpdateRect := Rect(0, 0, Step, Data.Height);
      end;
    tedLeft:
      begin
        xDesp    := -Step;
        if IsClipped
        then
        begin
          SrcRect    := Rect(0, 0, Data.Width - CurrentFrame, Data.Height);
          UpdateRect := Rect(Data.Width - CurrentFrame, 0, Data.Width,
            Data.Height);
          SrcXDesp   := CurrentFrame;
        end
        else
        begin
          UpdateRect := Rect(Data.Width - Step, 0, Data.Width, Data.Height);
          DstXDesp   := CurrentFrame;
        end;
      end;
  end;

  if not IsClipped
  then
  begin
    ScrollRect := Rect(0, 0, Data.Width, Data.Height);
    ClipRect   := Rect(0, 0, Data.Width, Data.Height);
    ScrollDC(Data.Canvas.Handle, xDesp, yDesp, ScrollRect, ClipRect, 0, nil);
  end
  else
    BitBlt(Data.Canvas.Handle, SrcRect.Left, SrcRect.Top,
      SrcRect.Right - SrcRect.Left, SrcRect.Bottom - SrcRect.Top,
      Data.SrcBmp.Canvas.Handle, SrcXDesp, SrcYDesp, cmSrcCopy);

  BitBlt(Data.Canvas.Handle, UpdateRect.Left, UpdateRect.Top,
    UpdateRect.Right - UpdateRect.Left, UpdateRect.Bottom - UpdateRect.Top,
    Data.DstBmp.Canvas.Handle, DstXDesp, DstYDesp, cmSrcCopy);
end;

function TPushTransition.GetPixelFormat: TPixelFormat;
begin
  // Timing doesn't work fine with ScrollDC and DDBs  //EROC itnA
  Result := DevicePixelFormat(False);
end;

function TPushTransition.NeedSrcImage: Boolean;
begin
  IsClipped := Clipped;
  Result    := IsClipped;
end;

initialization

  TERegisterTransition(TPushTransition);

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -