(495) 925-0049, ITShop интернет-магазин 229-0436, Учебный Центр 925-0049
  Главная страница Карта сайта Контакты
Поиск
Вход
Регистрация
Рассылки сайта
 
 
 
 
 

Анимируйте ваше приложение! (исходники)

Источник: codingclub
Руденко Е.В.

Когда неделю назад я подумал сделать свое приложение более "живым", то решил создать процедуру, которая бы анимировала средства управления. Это оказалось более трудным делом, чем я предполагал.

Итак, нижеприведенный код - это результат почти недели "тяжелой" работы. Вероятно много можно сделать для увеличения функциональности и повышения скорости данной программы.

Небольшое описание используемых параметров:

  • Control: В качестве этой переменной используется любой компонент - наследник класса TControl . Если компонент не является наследником TControl, но имеет свойства Left и Top , все равно поместите его на месте TControl. Поскольку процедура обращается только к Свойствам Top и Left , то это сработает OK.
  • Dest: Величина типа TPoint , которая показывает , где остановится Control (на текущей форме) после анимации.
  • PixPTick: Pixels Per Tick. Любая величина (рекомендуется 2-4) от 0 и выше. Она не изменяет положение Control точно на каждый шаг (tick). Чем выше эта величина , тем быстрее движение.
procedure MoveControl(var Control: TControl; Dest: TPoint; PixPTick: Integer);
var
StartTick, OldTick, CurTick, TickDif: Cardinal;
Steps: Integer;
begin
StartTick :=3D GetTickCount;
CurTick :=3D StartTick;
Steps :=3D 0;
// Переводит Control в соответствии с Dest.y и PixPTick
if Control.Top <> Dest.y then // Проводит необходимые вычисления
if Control.Top < Dest.y then
while (Control.Top <> 0) and (Dest.y <> 0) and // Устраняет деление на 0
// Проверка на необходимость дальнейшей регулировки
((Dest.y - Control.Top) mod PixPTick <> 0) do
Control.Top :=3D Control.Top - 1
else
while (Control.Top <> 0) and (Dest.y <> 0) and // Устраняет деление на 0
// Проверка на необходимость дальнейшей регулировки
((Control.Top - Dest.y) mod PixPTick <> 0) do
Control.Top :=3D Control.Top + 1;
// Переводит Control в соответствии с Dest.x и PixPTick
if Control.Left <> Dest.x then // Проводит необходимые вычисления
if Control.Left < Dest.x then
while (Control.Left <> 0) and (Dest.x <> 0) and // Устраняет деление на 0
// Проверка на необходимость дальнейшей регулировки
((Dest.x - Control.Left) mod PixPTick <> 0) do
Control.Left :=3D Control.Left - 1
else
while (Control.Left <> 0) and (Dest.x <> 0) and // Устраняет деление на 0
// Проверка на необходимость дальнейшей регулировки
((Control.Left - Dest.x) mod PixPTick <> 0) do
Control.Left :=3D Control.Left + 1;
repeat
Application.ProcessMessages; // Реакция приложения на ввод пользователя
OldTick :=3D CurTick; // Время последнего фрейма
CurTick :=3D GetTickCount; // Текущее время
TickDif :=3D CurTick - OldTick; // Разница во времени
// По крайней мере 1 миллисекунда прошла с момента показа последнего фрейма
if TickDif > 0 then 
begin 
Inc(Steps);
if Control.Left > Dest.x then
Control.Left :=3D Control.Left - PixPTick
else if Control.Left < Dest.x then
Control.Left :=3D Control.Left + PixPTick; 

if (Control.Top > Dest.y) then
Control.Top :=3D Control.Top - PixPTick
else if (Control.Top < Dest.y) then
Control.Top :=3D Control.Top + PixPTick;
end;
// Если прошло больше 150 шагов (что маловероятно), движение 
// остановится, чтобы не войти в бесконечный цикл. Измените данную величину
// в соответствии с вашими требованиями, или удалите ее.
until ((Control.Left =3D Dest.x) and (Control.Top =3D Dest.y)) or (Steps > 150);
end;

Ссылки по теме


 Распечатать »
 Правила публикации »
  Написать редактору 
 Рекомендовать » Дата публикации: 26.01.2007 
 

Магазин программного обеспечения   WWW.ITSHOP.RU
Advanced Data Export VCL Suite (with sources) + 1 Year Maintenance
SAP® Crystal Dashboard Design Departmental 2016 WIN INTL NUL
VMware Fusion 10 Pro, ESD
SAP® Crystal Reports 2016 WIN INTL NUL
VMware Horizon Apps Standard, v7 : 10 Pack (Named User)
 
Другие предложения...
 
Курсы обучения   WWW.ITSHOP.RU
 
Другие предложения...
 
Магазин сертификационных экзаменов   WWW.ITSHOP.RU
 
Другие предложения...
 
3D Принтеры | 3D Печать   WWW.ITSHOP.RU
 
Другие предложения...
 
Новости по теме
 
Рассылки Subscribe.ru
Информационные технологии: CASE, RAD, ERP, OLAP
Новости ITShop.ru - ПО, книги, документация, курсы обучения
Программирование на Microsoft Access
CASE-технологии
СУБД Oracle "с нуля"
Компьютерные книги. Рецензии и отзывы
Каждый день новые драйверы для вашего компьютера!
 
Статьи по теме
 
Новинки каталога Download
 
Исходники
 
Документация
 
 



    
rambler's top100 Rambler's Top100