Анимируйте ваше приложение!

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

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

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

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;   
Теги:
Control, PixPTick, CurTick, регулировки, необходимость, дальнейшей, while, TControl, Устраняет, Steps, Проверка, соответствии, OldTick, TickDif, StartTick, величина, остановится, сделать, TPoint, вычисления, компонент, Проводит, Integer, фрейма, Переводит, GetTickCount, begin, последнего, изменяет, procedure, рекомендуется, Cardinal, MoveControl, Анимируйте, repeat
Добавлено: 17 Июля 2018 08:04:35 Добавил: Андрей Ковальчук Нравится 0
Добавить
Комментарии:
Нету комментариев для вывода...