15 мая 2023 года "Исходники.РУ" отмечают своё 23-летие!
Поздравляем всех причастных и неравнодушных с этим событием!
И огромное спасибо всем, кто был и остаётся с нами все эти годы!

Главная Форум Журнал Wiki DRKB Discuz!ML Помощь проекту


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

Автор: I MD.CIPTAYASA

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

Совместимость: Все версии 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;

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.