Delphi World - Анимированная кнопка ПУСК
Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Анимированная кнопка ПУСК

Автор: 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. 

Проект Delphi World © Выпуск 2002 - 2017
Автор проекта: Эксклюзивные курсы программирования