Затухающее движение

Затухающее движение

По экрану движется отрезок, оставляя за собой затухающий след. Алгоритм основан на уроке "Мячик, отскакивающий от границ окна"

Разместите на форме два компонента Timer1: TTimer и PaintBox1: TPaintBox с вкладки System. В инспекторе объектов (Object Inspector) выставьте начальные значения свойств

Timer1:
 Enabled: false
 Interval: 20
 
TPaintBox1:
 Align: alClient
 
TForm1:
 Color: clBlack

Для работы программы понадобятся переменные и процедура движения. Нажмите F12 и перейдите в редактор кода. В разделах type, var и const впишите следующие типы и переменные

 
type
  TForm1 = class(TForm)
    Timer1: TTimer;
    PaintBox1: TPaintBox;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
TPoints= Record
  X,Y: Real;
  End;
 
Const
 CountPoint=50;  // Количество линий в фигуре
 DistLim=50;     // Расстояние до края формы откуда начинается поворот
 
var
  Form1: TForm1;
  Pn,Pn2: Array [1..300] of TPoints;  // Концы отрезков
  dx,dy,dx2,dy2: Real;    // Приращение движения

В разделе implementation создайте процедуру, которая будет отвечать за движение отрезка

Procedure DrawPoints;
Var i:integer;
Begin
With Form1.PaintBox1 do
 Begin
 For i:=2 to CountPoint do
    Begin
    Canvas.Pen.Color:=RGB(255-round(5*i),0,255-round(5*i));
    Canvas.MoveTo(Round(Pn[i].X),Round(Pn[i].Y));
    Canvas.LineTo(Round(Pn2[i].X),Round(Pn2[i].Y));
    end;
 end;
End;

Для компонента Timer1 на вкладке Events в инспекторе объектов напротив события OnTimer сделайте двойной щелчок. Это действие создаст автоматически процедуру procedure TForm1.Timer1Timer(Sender: TObject). Заполните ее

procedure TForm1.Timer1Timer(Sender: TObject);
begin
With PaintBox1 do
begin
if Pn[1].X<DistLim then dx:=dx-0.4;
if Pn[1].X>Width-DistLim then dx:=dx+0.4;
if Pn[1].Y<DistLim then dy:=dy-0.2;
if Pn[1].Y>Height-DistLim then dy:=dy+0.2;
if Pn2[1].X<DistLim then dx2:=dx2-0.4;
if Pn2[1].X>Width-DistLim then dx2:=dx2+0.4;
if Pn2[1].Y<DistLim then dy2:=dy2-0.2;
if Pn2[1].Y>Height-DistLim then dy2:=dy2+0.2;
end;
Pn[1].X:=Pn[2].X-dx;
Pn[1].Y:=Pn[2].Y-dy;
Pn2[1].X:=Pn2[2].X-dx2;
Pn2[1].Y:=Pn2[2].Y-dy2;
 
Move(Pn[1],Pn[2],CountPoint*SizeOf(TPoints));
Move(Pn2[1],Pn2[2],CountPoint*SizeOf(TPoints));
DrawPoints;
end;

Для формы Form1 на вкладке Events создайте аналогично для события OnCreate процедуру procedure TForm1.FormCreate(Sender: TObject); и впишите следующий код

procedure TForm1.FormCreate(Sender: TObject);
Var i: Integer;
begin
With PaintBox1 do
begin
Timer1.Enabled:=True;
Pn[1].X:=Width-DistLim*2;
Pn[1].Y:=Height-DistLim;
Pn2[1].X:=Width-DistLim;
Pn2[1].Y:=Height-DistLim*2;
dx:=4; dx2:=3;
dy:=4; dy2:=2;
 For i:=2 to CountPoint do
    Begin
    Pn[i].X:=Pn[i-1].X+dx;
    Pn[i].Y:=Pn[i-1].Y+dy;
    Pn2[i].X:=Pn2[i-1].X+dx2;
    Pn2[i].Y:=Pn2[i-1].Y+dy2;
    end;
end;
DrawPoints;
end;

Запустите программу. Run.

СКАЧАТЬ ПРОГРАММУРазмер
Lines.exe (300)384.5 кб

Отправил Чт, 11/23/2017 - 13:55

How to quickly lose weight in 15 days:
https://sites.google.com/site/weightlossluxury/best-25-weight-loss-ideas-on-pinterest-weight-loss-smoothies

Popular tags:
average weight loss a month after gastric bypass
calories for a man to lose weight
nutrition meal plans for weight loss
is weight loss surgery worth it
easy ways to lose weight while at school
weight loss fruit diet
best weight loss slow metabolism
what does skin do when you lose weight
weight loss obesity

Отправил Пт, 09/22/2017 - 10:31

drug costs
canadian rx pharmacy online

buying prescription drugs canada
[url=http://canadianpharmacyrxbsl.com/?what-is-viagra]what is viagra[/url]
canadian pharmacy online
xanax withdrawal symptoms

Отправил Чт, 09/21/2017 - 20:42

buy online prescription drugs
canadian pharmacies shipping to usa
cheap drugs online
[url=http://canadianpharmacyrxbsl.com/?erectile-dysfunction-symptoms]erectile dysfunction symptoms[/url]
international pharmacies that ship to the usa
kamagra 100

Отправил Чт, 09/21/2017 - 14:43

online discount pharmacy
canadian online pharmacies
mexican pharmacies online
[url=http://canadianpharmacyrxbsl.com/?prednisolon-5mg]prednisolon 5mg[/url]
canada pharmacies without script
cadista methylprednisolone

Отправил Чт, 09/21/2017 - 00:39

get prescription online
canadian online pharmacies
no prescription pharmacies
[url=http://canadianpharmacyrxbsl.com/?viagra-alternative]viagra alternative[/url]
no prescription pharmacies
ciproxin 500

Отправил Ср, 09/20/2017 - 11:47

canadian discount pharmacy
canadian drugs
canadian pharmacies shipping to usa
[url=http://canadianpharmacyrxbsl.com/?furosemida-40-mg]furosemida 40 mg[/url]
the canadian pharmacy
metformin for weight loss

Отправил Пт, 09/08/2017 - 04:11

cialis farmacia similares

buy generic cialis

como tomar el medicamento cialis

[url=http://cialisxrm.com/]cialis generic[/url]

Отправил Втр, 08/29/2017 - 22:06

http://andlinux.ru/forum/index.php/topic,4358.new.html#new
http://www.gxsq.com/bbs/forum.php?mod=forumdisplay&fid=2
http://www.cannabismacrography.com/viewtopic.php?f=21&t=141971
http://paniqo.org/viewtopic.php?f=96&t=100833
http://www.prowforum.pl/viewtopic.php?f=39&t=98862
http://imdbcommunity.com/community/viewtopic.php?f=29&t=262121
http://haustier-forum.info/viewtopic.php?f=6&t=27689
http://andlinux.ru/forum/index.php/topic,3967.new.html#new
http://paniqo.org/viewtopic.php?f=38&t=109456
http://cityofusa.sk/Forum/phpBB3/viewtopic.php?f=4&t=345842
http://forum.ggczat.eu/member.php?action=profile&uid=117
http://forum.xn--80aauneuk5f.com/index.php?topic=72337.new#new
http://forum.aishabaitrust.com/viewtopic.php?f=11&t=60940
http://imdbcommunity.com/community/viewtopic.php?f=18&t=261830
http://www.architecte-construction.com/forum/viewtopic.php?f=20&t=174647

Отправил Втр, 08/29/2017 - 06:38

http://wishmaster2-0.myjino.ru/forum/index.php?topic=174514.new#new
http://hookah-zone.com/forums/index.php?topic=392649.new#new
http://www.ausvoters.org/viewtopic.php?f=9&t=220922
http://www.ausvoters.org/viewtopic.php?f=14&t=214986
http://forum.29k2.ru/viewtopic.php?f=12&t=13672
http://clubseatgdl.com.mx/foro/viewtopic.php?f=16&t=10542
http://ubergrabphilippines.com/forum/viewtopic.php?f=12&t=54538
http://forums.orangineers.com/viewtopic.php?f=6&t=26518
http://www.cannabismacrography.com/viewtopic.php?f=35&t=143060
http://standbydba.com/forum/index.php?topic=293777.new#new
http://forum.shtylm.com/index.php/topic,122567.new.html#new
http://www.hocdforum.com/phpbb/viewtopic.php?f=2&t=204061
http://www.architecte-construction.com/forum/viewtopic.php?f=14&t=180188
https://www.grandline-rpg.fr/forum/viewtopic.php?f=5&t=18635
http://midmissouri-airsoft.net/forum/viewtopic.php?f=15&t=538781

Отправил Вс, 07/16/2017 - 21:37

We sell the sale of iPhones 7 directly from Apple warehouses unofficially for 30% of the market value. Always available and in large quantities:
1. New Apple iPhone 7 Plus 256 GB (Jet Black) (FACTORY UNLOCKED) International Version no warrants - $ 303
2. New Apple iPhone 7 Plus 256GB Factory Unlocked CDMA / GSM Smartphone - Black (Certified Refurbished) - $ 307
3. New Apple iPhone 7 PLUS (5.5-inch) A1661 128GB Unlocked Smartphone for GSM + CDMA Carriers - Rose Gold - $ 303
We work all over the world and only on an advance payment, we accept only bitcoin. Attention!!! We do not work with Russia and the CIS countries. When ordering from 10 pcs. The price is 20% of the market value. We have a priority in wholesale customers. If you do not trust us, or you do not like something, you pass by, we will not respond to stupid reports. To receive the details for payment, please write to the e-mail: apple@apple-cheap-iphone.xyz

Отправил Ср, 07/05/2017 - 18:08

Открылся новый магазин все по 50 рублей, например определенный товар стоит 5000 рублей или 7000 рублей то у нас вы можете найти его всего за 50 рублей: http://shop-50-rubley.xyz
магазин ежедневно пополняется, к концу недели будет очень богатый ассортимент.

Отправил Пнд, 06/26/2017 - 04:17

If you have a desire to learn how to earn from $ 500 per day and work only for yourself, then write to us at email: admin@makemoneyonline.universalxyzdom.xyz

Последние комментарии

  • Tacwolf chaturbate threesome videos with lexi and jordin Alexi and lexi lapetina African albino breasts pussy pics Erection rub in formulas for penis Leukocyte test strip results Fat people falling down stairs Naked middle aged woman Espiando a mis suegros cuando cojen casero Amateur romantic sex...
  • Exotic escorts erotic escorts southbend indiana Tanya cyntheria playing with cum Free german wives girlfriends sex videos Dick content golf micjigan Free teen panties links What are sex beads Treatment to quit smoking Indian teen wet pussy Average size of male dick Cleft chin women naked Husbands...
  • Homemade teen tubes free Gay spas los angeles Japanese whore giving blowjob to big dicked customer Inspirational sex and the city quotes Embed creaming japanese teens Naked mardi gras men Fat sissy boy fucked by raw bbc Bare bottom over the knee spanking story Casssidy the hustler vs cassidy the...

Счетчики