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

---

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

Пример:

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; 

implementati!
on 

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; 

// Анимация начинается здесь
procedur!
e 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.

Автор: I MD.CIPTAYASA (kadekcipta@hotmail.com)
Источник: http://www.sources.ru/delphi/

»»» Прислать свои комментарии

Дорогие друзья! Мы рады представить вам новый совместный проект сайтов www.rsdn.ru, delphi.mastak.ru и www.optim.ru - профессиональный журнал для программистов RSDN Magazine.
Несомненно, ваше мнение о необходимости такого журнала, содержании рубрик и темах отдельных статей поможет сделать журнал более полезным и интересным. Высказать свое мнение, проголосовать или же подписаться вы можете на сайте. Без вашего участия, нам будет трудно сделать правильный журнал!
На сайте выложен анонс пилотного выпуска журнала, вступительное слово от редакции.