📄 tepush.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 + -