294 lines
9.7 KiB
ObjectPascal
294 lines
9.7 KiB
ObjectPascal
unit TB2Anim;
|
|
|
|
{
|
|
Toolbar2000
|
|
Copyright (C) 1998-2005 by Jordan Russell
|
|
All rights reserved.
|
|
|
|
The contents of this file are subject to the "Toolbar2000 License"; you may
|
|
not use or distribute this file except in compliance with the
|
|
"Toolbar2000 License". A copy of the "Toolbar2000 License" may be found in
|
|
TB2k-LICENSE.txt or at:
|
|
http://www.jrsoftware.org/files/tb2k/TB2k-LICENSE.txt
|
|
|
|
Alternatively, the contents of this file may be used under the terms of the
|
|
GNU General Public License (the "GPL"), in which case the provisions of the
|
|
GPL are applicable instead of those in the "Toolbar2000 License". A copy of
|
|
the GPL may be found in GPL-LICENSE.txt or at:
|
|
http://www.jrsoftware.org/files/tb2k/GPL-LICENSE.txt
|
|
If you wish to allow use of your version of this file only under the terms of
|
|
the GPL and not to allow others to use your version of this file under the
|
|
"Toolbar2000 License", indicate your decision by deleting the provisions
|
|
above and replace them with the notice and other provisions required by the
|
|
GPL. If you do not delete the provisions above, a recipient may use your
|
|
version of this file under either the "Toolbar2000 License" or the GPL.
|
|
|
|
$jrsoftware: tb2k/Source/TB2Anim.pas,v 1.11 2005/02/16 08:15:58 jr Exp $
|
|
}
|
|
|
|
interface
|
|
|
|
{$I TB2Ver.inc}
|
|
{$Q-}
|
|
|
|
uses
|
|
Windows, Messages, SysUtils, Classes;
|
|
|
|
const
|
|
WM_TB2K_STEPANIMATION = WM_USER + $555;
|
|
WM_TB2K_ANIMATIONENDED = WM_USER + $556;
|
|
|
|
type
|
|
TTBAnimationDirection = set of (tbadLeft, tbadRight, tbadDown, tbadUp);
|
|
|
|
procedure TBStartAnimation(const AWnd: HWND; const ABlend: Boolean;
|
|
const ADirection: TTBAnimationDirection);
|
|
procedure TBStepAnimation(const Msg: TMessage);
|
|
procedure TBEndAnimation(const Wnd: HWND);
|
|
|
|
implementation
|
|
|
|
{ Notes to self:
|
|
- It originally had the NOMIRRORBITMAP flag on the BitBlt calls, because
|
|
Windows 2000's AnimateWindow function has it. But it had to be removed
|
|
because on Windows 98 with the Standard VGA or VMware video driver, it
|
|
caused no bits to be blitted, even though Windows 98 is supposed to
|
|
support NOMIRRORBITMAP according to the documentation. I don't think it's
|
|
necessary anyway.
|
|
}
|
|
|
|
const
|
|
DCX_USESTYLE = $10000;
|
|
WS_EX_LAYERED = $80000;
|
|
NOMIRRORBITMAP = $80000000;
|
|
ULW_ALPHA = 2;
|
|
|
|
type
|
|
PAnimateThreadFuncData = ^TAnimateThreadFuncData;
|
|
TAnimateThreadFuncData = record
|
|
SequenceID: Integer;
|
|
Wnd: HWND;
|
|
Time: Integer;
|
|
Blending: Boolean;
|
|
CurStep: Integer;
|
|
DC, BmpDC: HDC;
|
|
Bmp: HBITMAP;
|
|
ScreenClientRect: TRect;
|
|
Size: TPoint;
|
|
LastPos: TPoint;
|
|
Direction: TTBAnimationDirection;
|
|
AnimateThreadAbort: BOOL;
|
|
AnimationEnded: BOOL;
|
|
StepMessagePending: BOOL;
|
|
end;
|
|
|
|
var
|
|
UpdateLayeredWindowProc: function(Handle: THandle; hdcDest: HDC;
|
|
pptDst: PPoint; _psize: PSize; hdcSrc: HDC; pptSrc: PPoint;
|
|
crKey: COLORREF; pblend: PBLENDFUNCTION; dwFlags: DWORD): BOOL; stdcall;
|
|
|
|
function AnimateThreadFunc(Parameter: Pointer): Integer;
|
|
var
|
|
StartTime, FrameStartTime, NextFrameStartTime: DWORD;
|
|
StartStep, ElapsedTime, I: Integer;
|
|
P: TPoint;
|
|
begin
|
|
Result := 0;
|
|
StartTime := GetTickCount;
|
|
FrameStartTime := StartTime;
|
|
with PAnimateThreadFuncData(Parameter)^ do begin
|
|
StartStep := CurStep;
|
|
while not AnimateThreadAbort do begin
|
|
ElapsedTime := FrameStartTime - StartTime;
|
|
if (ElapsedTime < 0) or (ElapsedTime >= Time) then
|
|
Break;
|
|
I := StartStep + ((255 * ElapsedTime) div Time);
|
|
if (I < 0) or (I >= 255) then
|
|
Break;
|
|
|
|
GetCursorPos(P);
|
|
if (P.X <> LastPos.X) or (P.Y <> LastPos.Y) then begin
|
|
if PtInRect(ScreenClientRect, P) then
|
|
Break;
|
|
LastPos := P;
|
|
end;
|
|
|
|
if I > CurStep then begin
|
|
CurStep := I;
|
|
if InterlockedExchange(Integer(StepMessagePending), 1) = 0 then
|
|
SendNotifyMessage(Wnd, WM_TB2K_STEPANIMATION, 0, SequenceID);
|
|
end;
|
|
|
|
{ Wait until the timer has ticked at least 10 msec }
|
|
NextFrameStartTime := GetTickCount;
|
|
while NextFrameStartTime - FrameStartTime < 10 do begin
|
|
{ We don't know the rate of the system timer, so check every 5 msec
|
|
to see if it's incremented }
|
|
Sleep(5);
|
|
NextFrameStartTime := GetTickCount;
|
|
end;
|
|
FrameStartTime := NextFrameStartTime;
|
|
end;
|
|
AnimationEnded := True;
|
|
SendNotifyMessage(Wnd, WM_TB2K_STEPANIMATION, 0, SequenceID);
|
|
end;
|
|
end;
|
|
|
|
threadvar
|
|
AnimateThreadHandle: THandle;
|
|
AnimateData: TAnimateThreadFuncData;
|
|
AnimationSequenceID: Integer;
|
|
|
|
procedure FinalizeAnimation;
|
|
begin
|
|
with PAnimateThreadFuncData(@AnimateData)^ do begin
|
|
if Blending then
|
|
SetWindowLong(Wnd, GWL_EXSTYLE,
|
|
GetWindowLong(Wnd, GWL_EXSTYLE) and not WS_EX_LAYERED)
|
|
else
|
|
SetWindowRgn(Wnd, 0, False);
|
|
BitBlt(DC, 0, 0, Size.X, Size.Y, BmpDC, 0, 0, SRCCOPY);
|
|
DeleteDC(BmpDC);
|
|
DeleteObject(Bmp);
|
|
ReleaseDC(Wnd, DC);
|
|
SendNotifyMessage(Wnd, WM_TB2K_ANIMATIONENDED, 0, 0);
|
|
end;
|
|
end;
|
|
|
|
procedure TBEndAnimation(const Wnd: HWND);
|
|
begin
|
|
if (AnimateThreadHandle <> 0) and
|
|
((Wnd = 0) or (AnimateData.Wnd = Wnd)) then begin
|
|
AnimateData.AnimateThreadAbort := True;
|
|
WaitForSingleObject(AnimateThreadHandle, INFINITE);
|
|
CloseHandle(AnimateThreadHandle);
|
|
AnimateThreadHandle := 0;
|
|
|
|
FinalizeAnimation;
|
|
end;
|
|
end;
|
|
|
|
procedure TBStartAnimation(const AWnd: HWND; const ABlend: Boolean;
|
|
const ADirection: TTBAnimationDirection);
|
|
var
|
|
ZeroPt: TPoint;
|
|
R: TRect;
|
|
ThreadID: DWORD;
|
|
Blend: TBlendFunction;
|
|
Rgn: HRGN;
|
|
begin
|
|
TBEndAnimation(0);
|
|
|
|
ZeroPt.X := 0;
|
|
ZeroPt.Y := 0;
|
|
|
|
Inc(AnimationSequenceID);
|
|
FillChar(AnimateData, SizeOf(AnimateData), 0);
|
|
{ Note: The pointer cast avoids GetTls calls for every field access }
|
|
with PAnimateThreadFuncData(@AnimateData)^ do begin
|
|
SequenceID := AnimationSequenceID;
|
|
Wnd := AWnd;
|
|
Blending := ABlend and Assigned(UpdateLayeredWindowProc);
|
|
Direction := ADirection;
|
|
GetCursorPos(LastPos);
|
|
GetClientRect(Wnd, ScreenClientRect);
|
|
MapWindowPoints(Wnd, 0, ScreenClientRect, 2);
|
|
GetWindowRect(Wnd, R);
|
|
DC := GetDCEx(Wnd, 0, DCX_WINDOW or DCX_CACHE {or DCX_USESTYLE ?});
|
|
Size.X := R.Right - R.Left;
|
|
Size.Y := R.Bottom - R.Top;
|
|
Bmp := CreateCompatibleBitmap(DC, Size.X, Size.Y {or $01000000 ?});
|
|
BmpDC := CreateCompatibleDC(DC);
|
|
// AnimateWindow calls SetLayout, but I'm not sure that we need to.
|
|
//if Assigned(SetLayoutProc) then
|
|
// SetLayoutProc(BmpDC, 0);
|
|
SelectObject(BmpDC, Bmp);
|
|
//SetBoundsRect(BmpDC, nil, DCB_RESET or DCB_ENABLE);
|
|
SendMessage(Wnd, WM_PRINT, WPARAM(BmpDC), PRF_NONCLIENT or PRF_CLIENT or
|
|
PRF_ERASEBKGND or PRF_CHILDREN);
|
|
//GetBoundsRect
|
|
if Blending then begin
|
|
SetWindowLong(Wnd, GWL_EXSTYLE, GetWindowLong(Wnd, GWL_EXSTYLE) or WS_EX_LAYERED);
|
|
Time := 175; { actually more like ~147 because CurStep starts at 40 }
|
|
CurStep := 40;
|
|
Longint(Blend) := 0;
|
|
Blend.BlendOp := AC_SRC_OVER;
|
|
Blend.SourceConstantAlpha := CurStep;
|
|
UpdateLayeredWindowProc(Wnd, 0, @R.TopLeft, @Size, BmpDC, @ZeroPt, 0,
|
|
@Blend, ULW_ALPHA);
|
|
end
|
|
else begin
|
|
Time := 150;
|
|
CurStep := 0;
|
|
Rgn := CreateRectRgn(0, 0, 0, 0);
|
|
if not BOOL(SetWindowRgn(Wnd, Rgn, False)) then
|
|
DeleteObject(Rgn); { just in case }
|
|
end;
|
|
{ These are the same flags AnimateWindow uses. SWP_ASYNCWINDOWPOS is
|
|
needed or else it doesn't "save bits" properly.
|
|
Note: SWP_ASYNCWINDOWPOS seems to have no effect on Windows 95 & NT 4.0,
|
|
so bits behind the window are not saved & restored correctly. }
|
|
SetWindowPos(Wnd, 0, 0, 0, 0, 0, SWP_NOSIZE or SWP_NOMOVE or
|
|
SWP_NOZORDER or SWP_NOACTIVATE or SWP_SHOWWINDOW or SWP_NOREDRAW or
|
|
SWP_NOOWNERZORDER or SWP_ASYNCWINDOWPOS);
|
|
end;
|
|
|
|
AnimateThreadHandle := BeginThread(nil, 0, AnimateThreadFunc, @AnimateData,
|
|
CREATE_SUSPENDED, ThreadID);
|
|
if AnimateThreadHandle = 0 then begin
|
|
{ just in case... }
|
|
FinalizeAnimation;
|
|
Exit;
|
|
end;
|
|
ResumeThread(AnimateThreadHandle);
|
|
end;
|
|
|
|
procedure TBStepAnimation(const Msg: TMessage);
|
|
var
|
|
Rgn: HRGN;
|
|
Blend: TBlendFunction;
|
|
X, Y: Integer;
|
|
begin
|
|
if Msg.LParam <> AnimationSequenceID then
|
|
{ ignore messages dangling in the queue from aborted animation sequences }
|
|
Exit;
|
|
with PAnimateThreadFuncData(@AnimateData)^ do begin
|
|
if not AnimationEnded then begin
|
|
if Blending then begin
|
|
Longint(Blend) := 0;
|
|
Blend.BlendOp := AC_SRC_OVER;
|
|
Blend.SourceConstantAlpha := AnimateData.CurStep;
|
|
UpdateLayeredWindowProc(Wnd, 0, nil, nil, 0, nil, 0, @Blend, ULW_ALPHA);
|
|
end
|
|
else begin
|
|
if tbadDown in Direction then
|
|
Y := MulDiv(Size.Y, AnimateData.CurStep, 255) - Size.Y
|
|
else if tbadUp in Direction then
|
|
Y := Size.Y - MulDiv(Size.Y, AnimateData.CurStep, 255)
|
|
else
|
|
Y := 0;
|
|
if tbadRight in Direction then
|
|
X := MulDiv(Size.X, AnimateData.CurStep, 255) - Size.X
|
|
else if tbadLeft in Direction then
|
|
X := Size.X - MulDiv(Size.X, AnimateData.CurStep, 255)
|
|
else
|
|
X := 0;
|
|
Rgn := CreateRectRgn(X, Y, X + Size.X, Y + Size.Y);
|
|
if not BOOL(SetWindowRgn(Wnd, Rgn, False)) then
|
|
DeleteObject(Rgn); { just in case }
|
|
BitBlt(DC, X, Y, Size.X, Size.Y, BmpDC, 0, 0, SRCCOPY);
|
|
end;
|
|
end
|
|
else
|
|
TBEndAnimation(Wnd);
|
|
StepMessagePending := False;
|
|
end;
|
|
end;
|
|
|
|
initialization
|
|
UpdateLayeredWindowProc := GetProcAddress(GetModuleHandle(user32),
|
|
'UpdateLayeredWindow');
|
|
finalization
|
|
TBEndAnimation(0);
|
|
end.
|