(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
WinRAR 5.x 1 лицензия
Panda Global Protection - ESD версия - на 1 устройство - (лицензия на 1 год)
Allround Automation PL/SQL Developer Single user license
Stimulsoft Reports Server Team 10 users
Microsoft 365 Business Standard (corporate)
 
Другие предложения...
 
Курсы обучения   WWW.ITSHOP.RU
 
Другие предложения...
 
Магазин сертификационных экзаменов   WWW.ITSHOP.RU
 
Другие предложения...
 
3D Принтеры | 3D Печать   WWW.ITSHOP.RU
 
Другие предложения...
 
Новости по теме
 
Рассылки Subscribe.ru
Информационные технологии: CASE, RAD, ERP, OLAP
Новости ITShop.ru - ПО, книги, документация, курсы обучения
Программирование на Microsoft Access
CASE-технологии
СУБД Oracle "с нуля"
Краткие описания программ и ссылки на них
Новые программы для Windows
 
Статьи по теме
 
Новинки каталога Download
 
Исходники
 
Документация
 
 



    
rambler's top100 Rambler's Top100