Недавно добавленные исходники

•  TDictionary Custom Sort  507

•  Fast Watermark Sources  873

•  3D Designer  1 803

•  Sik Screen Capture  1 456

•  Patch Maker  1 459

•  Айболит (remote control)  1 387

•  ListBox Drag & Drop  1 157

•  Доска для игры Реверси  21 253

•  Графические эффекты  1 336

•  Рисование по маске  1 274

•  Перетаскивание изображений  1 085

•  Canvas Drawing  962

•  Рисование Луны  802

•  Поворот изображения  754

•  Рисование стержней  801

•  Paint on Shape  486

•  Генератор кроссвордов  747

•  Головоломка Paletto  659

•  Теорема Монжа об окружностях  839

•  Пазл Numbrix  607

•  Заборы и коммивояжеры  835

•  Игра HIP  549

•  Игра Go (Го)  522

•  Симулятор лифта  544

•  Программа укладки плитки  505

•  Генератор лабиринта  560

•  Проверка числового ввода  520

•  HEX View  595

•  Физический маятник  522

•  Задача коммивояжера  556

 
скрыть


Delphi FAQ - Часто задаваемые вопросы

| Базы данных | Графика и Игры | Интернет и Сети | Компоненты и Классы | Мультимедиа |
| ОС и Железо | Программа и Интерфейс | Рабочий стол | Синтаксис | Технологии | Файловая система |



Анимированная кнопка ПУСК



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





Похожие по теме исходники

Спуск с горы




Copyright © 2004-2022 "Delphi Sources" by BrokenByte Software. Delphi World FAQ

Группа ВКонтакте   Facebook   Ссылка на Twitter   Ссылка на Telegram