Анимированная кнопка ПУСК



Автор: I MD.CIPTAYASA

Если вы используете приведённый здесь код, ваша кнопка ПУСК будет извиваться как в экстазе. На форму предварительно нужно вынести Image, Timer и две кнопки: CopyPuskBtn и AnimateBtn. Последняя должна быть неактивна изначально. Timer - отключен, его свойство Interval должно быть установлено в оптимальное значение - испытывайте.


unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, ShellAPI, ExtCtrls, StdCtrls;
const
MAX_BUFFER = 6;
type
TForm1 = class(TForm)
CopyPuskBtn: TButton;
Timer1: TTimer;
AnimateBtn: TButton;
Image1: TImage;
procedure FormCreate(Sender: TObject);
procedure CopyPuskBtnClick(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure AnimateBtnClick(Sender: TObject);
procedure Edit1KeyPress(Sender: TObject; var Key: Char);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
HW: HWND;
DC: HDC;
R: TRect;
FNumber: integer;
Buffer: array [1 .. MAX_BUFFER] of TBitmap;
TrayIcon: TNotifyIconData;
procedure CreateFrames;
procedure DestroyFrames;
procedure BuildFrames;
procedure NotifyIcon(var Msg : TMessage); message WM_USER + 100;
procedure OnMinimizeEvt(Sender : TObject);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses
Math;
{$R *.DFM}
// Создаём буфер для спрайтов
procedure TForm1.CreateFrames;
var
i: integer;
begin
for i := 1 to MAX_BUFFER do
begin
Buffer[i] := TBitmap.Create;
with Buffer[i] do
begin
Height := R.Bottom - R.Top;
Width := R.Right - R.Left;
Canvas.Brush.Color := clBtnFace;
Canvas.Pen.Color := clBtnFace;
Canvas.Rectangle(0, 0, Buffer[i].Width, Buffer[i].Height);
end;
end;
end;
procedure TForm1.DestroyFrames;
var
i: integer;
begin
for i := 1 to MAX_BUFFER do
Buffer[i].Destroy;
end;
// Подготавливает сегменты/спрайты для анимации
procedure TForm1.BuildFrames;
var
i, j, k, H, W: integer;
Y: double;
begin
H := R.Bottom - R.Top;
W := R.Right - R.Left;
Image1.Width := W;
Image1.Height := H;
for i := 1 to MAX_BUFFER-1 do //Буфер [MAX_BUFFER] используется для хранения оригинального битмапа
for j := 1 to W do
for k := 1 to H do
begin
Y := 2 * Sin((j * 360 / W) * (pi / 180) - 20 * i);
Buffer[i].Canvas.Pixels[j, k - Round(Y)] := Buffer[6].Canvas.Pixels[j, k];
end;
end;
procedure TForm1.OnMinimizeEvt(Sender: TObject);
begin
ShowWindow(Application.Handle, SW_HIDE);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
HW := FindWindowEx(FindWindow('Shell_TrayWnd', nil), 0, 'Button', nil);
GetWindowRect(HW, R);
DC := GetWindowDC(HW);
CreateFrames;
FNumber := 1;
TrayIcon.cbSize := SizeOf(TrayIcon);
TrayIcon.Wnd := Form1.Handle;
TrayIcon.uID := 100;
TrayIcon.uFlags := NIF_MESSAGE + NIF_ICON + NIF_TIP;
TrayIcon.uCallbackMessage := WM_USER + 100;
TrayIcon.hIcon := Application.Icon.Handle;
Shell_NotifyIcon(NIM_ADD, @TrayIcon);
Application.OnMinimize := OnMinimizeEvt;
end;
procedure TForm1.NotifyIcon(var Msg : TMessage);
begin
case Msg.LParam of
WM_LBUTTONDBLCLK:
begin
ShowWindow(Application.Handle, SW_SHOW);
Application.Restore;
end;
end;
end;
procedure TForm1.CopyPuskBtnClick(Sender: TObject);
begin
//Получаем изображение оригинальной кнопки, чтобы потом использовать его
//когда анимация завершится
BitBlt(Buffer[MAX_BUFFER].Canvas.Handle, 0, 0, R.Right - R.Left, R.Bottom - R.Top, DC, 0, 0, SRCCOPY);
BuildFrames;
Image1.Canvas.Draw(0, 0, Buffer[MAX_BUFFER]);
AnimateBtn.Enabled := true;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
Timer1.Enabled := false;
BitBlt(DC, 0, 0, R.Right - R.Left, R.Bottom - R.Top, Buffer[MAX_BUFFER].Canvas.Handle, 0, 0, SRCCOPY);
ReleaseDC(HW, DC);
DestroyFrames; // не забудьте сделать это !!!
Shell_NotifyIcon(NIM_DELETE, @TrayIcon);
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
BitBlt(DC, 0, 0, R.Right - R.Left, R.Bottom - R.Top, Buffer[FNumber].Canvas.Handle, 0, 0, SRCCOPY);
Inc(FNumber);
if FNumber > MAX_BUFFER - 1 then
FNumber := 1;
end;
procedure TForm1.AnimateBtnClick(Sender: TObject);
begin
Timer1.Enabled := not Timer1.Enabled;
if not Timer1.Enabled then
begin
BitBlt(DC, 0, 0, R.Right - R.Left, R.Bottom - R.Top, Buffer[MAX_BUFFER].Canvas.Handle, 0, 0, SRCCOPY);
AnimateBtn.Caption := '&Animate';
CopyPuskBtn.Enabled := true;
end
else
begin
AnimateBtn.Caption := '&Stop';
CopyPuskBtn.Enabled := false;
end;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := caNone;
PostMessage(Form1.Handle, WM_DESTROY, 0, 0);
Application.Terminate;
end;
end.


Далее: Изменить размер кнопки ПУСК »»