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

Автор: I MD.CIPTAYASA

Итак, если Вам надоело привычное статическое изображение кнопки "Пуск", то предлагаю немного оживить её :) Надеюсь, что это доставит Вам удовольствие.

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.

Взято из https://forum.sources.ru