Анимированная кнопка Пуск?

=== Анимированная кнопка Пуск? ===
Итак, если Вам надоело привычное статическое изображение кнопки "Пуск", то предлагаю немного оживить её :) Надеюсь, что это доставит Вам удовольствие. 
unit Main; 
interface 
uses 
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
 StdCtrls, ExtCtrls,ShellAPI; 
const 
 MAX_BUFFER = 6; 
type 
 TForm1 = class(TForm) 
 Button1: TButton; 
 Timer1: TTimer; 
 Button2: TButton; 
 Image1: TImage; 
 Edit1: TEdit; 
 Label1: TLabel; 
 Label2: TLabel; 
 Label3: TLabel; 
 Button3: TButton; 
 procedure FormCreate(Sender: TObject); 
 procedure Button1Click(Sender: TObject); 
 procedure FormDestroy(Sender: TObject); 
 procedure Timer1Timer(Sender: TObject); 
 procedure Button2Click(Sender: TObject); 
 procedure Edit1KeyPress(Sender: TObject; var Key: Char); 
 procedure FormClose(Sender: TObject; var Action: TCloseAction); 
 procedure Button3Click(Sender: TObject); 
 private 
 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); 
 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; 
 Buffer[i].Height := R.Bottom-R.Top; 
 Buffer[i].Width := R.Right-R.Left; 
 Buffer[i].Canvas.Brush.Color := clBtnFace; 
 Buffer[i].Canvas.Pen.Color := clBtnFace; 
 Buffer[i].Canvas.Rectangle(0, 0, Buffer[i].Width, Buffer[i].Height); 
 end; 
end; 
procedure TForm1.DestroyFrames; 
var 
 i: Integer; 
begin 
 for i := 1 to MAX_BUFFER do 
 begin 
 Buffer[i].Destroy; 
 end; 
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.Button1Click(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]); 
 Button2.Enabled := True; 
 if Edit1.Text <> then 
 Timer1.Interval := StrToInt(Edit1.Text) 
 else 
 begin 
 Timer1.Interval := 100; 
 Edit1.Text := '100'; 
 end; 
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.Button2Click(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); 
 Button2.Caption := '&Animate'; 
 Button1.Enabled := True; 
 end 
 else 
 begin 
 Button2.Caption := '&Stop'; 
 Button1.Enabled := False; 
 end; 
end; 
// Обеспечиваем ввод числовых значений
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char); 
begin 
 if not (Key in ['0'..'9']) and (Key <> Chr(VK_BACK)) then 
 Key := #0; 
end; 
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); 
begin 
 Action := caNone; 
 Application.Minimize; 
end; 
procedure TForm1.Button3Click(Sender: TObject); 
begin 
 PostMessage(Form1.Handle,WM_DESTROY,0,0); 
 Application.Terminate; 
end; 
end.
Author: I MD.CIPTAYASA
Source: Взято из http://forum.sources.ru
ID: 01796