Нужна помощь в изменении кода

Вопросы программирования и использования среды Lazarus.

Модератор: Модераторы

Нужна помощь в изменении кода

Сообщение werewolf65 » 18.09.2012 15:20:26

Нужно изменить анимацию так,чтоб солнце двигалось по прямой


unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, ExtCtrls, Math;

type
TForm1 = class(TForm)
PaintBox: TPaintBox;
BitBtn: TBitBtn;
Timer: TTimer;
procedure BitBtnClick(Sender: TObject);
procedure TimerTimer(Sender: TObject);
private
Bmp, bmp1: TBitMap;
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
w,h, x, y, t, a, b, c, x1, y1, ok: Integer;
implementation

{$R *.dfm}


procedure TForm1.BitBtnClick(Sender: TObject);
begin

with PaintBox.Canvas do
begin
w:= PaintBox.Width;
h:= PaintBox.Height;
a:= 400;
b:=140;
c:=40;
ok := 0;
Pen.Color:= clBlack;
Pen.Width:=0;
Brush.Color := clBlue;
Rectangle(0, 0, w, h-200);


Pen.Color:= clGreen;
Brush.Color := clGreen;
Rectangle(0, h-201, w, h);

Pen.Color:= clBlack;

Brush.Color:=RGB(250, 235, 215);
Rectangle(a-40, b+100, a+40, b+150);

MoveTo(a, b+80);
LineTo(a+40, b+100);
MoveTo(a, b+80);
LineTo(a-40, b+100);
FloodFill(a, b+90, clBlack, fsBorder);

Brush.Color:=RGB( 255, 228, 181);
Rectangle(a+30, b+135, a+38,b+148);

Brush.Color :=clWhite;
Rectangle(a-30, b+125, a-10, b+140);
Rectangle(a, b+125, a+20, b+140);



t := 170;
Timer.Enabled:=true;

Bmp:=TBitMap.Create;
Bmp.Width:=PaintBox.Width;
Bmp.Height:=PaintBox.Height;
Bmp.Canvas.CopyRect(Rect(0, 0, PaintBox.Width, PaintBox.Height),PaintBox.Canvas,Rect(0, 0, PaintBox.Width, PaintBox.Height));
Brush.Color := RGB(100, 100, 100);
FloodFill(1, 1, clBlack, fsBorder);

Brush.Color :=RGB(218, 165, 32 );
Rectangle(a-30, b+125, a-10, b+140);
Rectangle(a, b+125, a+20, b+140);
bmp1:=TBitMap.Create;
bmp1.Width:=PaintBox.Width;
bmp1.Height:=PaintBox.Height;
bmp1.Canvas.CopyRect(Rect(0, 0, PaintBox.Width, PaintBox.Height),PaintBox.Canvas,Rect(0, 0, PaintBox.Width, PaintBox.Height));
Pen.Color:= RGB(100, 100, 100);
Pen.Width:= 0;
end;
end;

procedure TForm1.TimerTimer(Sender: TObject);
begin
if Bmp=nil then begin
PaintBox.Color := RGB(0, 0, 0);
bmp:=TBitmap.Create;
Bmp.Width:=PaintBox.Width;
Bmp.Height:=PaintBox.Height;
end;
if Bmp1=nil then begin
PaintBox.Color := RGB(0, 0, 0);
bmp1:=TBitmap.Create;
Bmp1.Width:=PaintBox.Width;
Bmp1.Height:=PaintBox.Height;
end;
t:=(t+1)MOD 360;
Timer.Interval:= 15;
with PaintBox.Canvas do
begin
Brush.Color := clWhite;
x:= Round(a*cos(DegtoRad(t)))+(w div 2);
y:= Round(b*sin(DegToRad(t)))+(h div 2);
//y:=Round(Sqrt((1-sqr(x+w/2)/a*a)/sqr(b)));
if (x+20>0) and (x-20<w) and (y+20<h/2) then
begin
Pen.Width:= 1;
PaintBox.Canvas.CopyRect(Rect(0, 0, PaintBox.Width, PaintBox.Height),Bmp.Canvas,Rect(0, 0, PaintBox.Width, PaintBox.Height));
Brush.Color := RGB(255,215, 0);
Ellipse(x-20, y-20, x+20, y+20);
x1:= 30;
end
else
begin
x1:=x1+3;
y1:= ((Sqr(x1-(w div 2))) div 700)+15;
PaintBox.Canvas.CopyRect(Rect(0, 0, PaintBox.Width, PaintBox.Height),bmp1.Canvas,Rect(0, 0, PaintBox.Width, PaintBox.Height));
Brush.Color := RGB(255 ,222 ,173 );
Ellipse(x1-20, y1-20, x1+20, y1+20);
Brush.Color := RGB(100, 100, 100);
Ellipse(x1-20-10, ((Sqr(x1-10-(w div 2))) div 700)+15-20, x1-10+20, ((Sqr(x1-10-(w div 2))) div 700)+15+20);
end;
// if (x<0) and (x+20>0) and (y+20<h/2) then
// begin
// c:= (c+30);
// if c>250 then
// c:=250;
// Brush.Color := RGB(c, c, c);
// FloodFill(1, 1, clBlack, fsBorder);
//
// end;
// if (x<w) and (x+20>w) and (y+20<h/2) then
// begin
// c:= (c-30);
// if c<50 then
// c:=50;
// Brush.Color := RGB(c, c, c);
// FloodFill(1, 1, clBlack, fsBorder);
// end;

end;


end;
end.
werewolf65
незнакомец
 
Сообщения: 1
Зарегистрирован: 18.09.2012 15:08:56

Re: Нужна помощь в изменении кода

Сообщение mad_nazgul » 18.09.2012 16:28:33

А в чем проблема?
В методе TimerTime
Есть 3 переменные X, Y и T
Вас интересует X и Y
Сделайте изменение X и Y таким образом чтобы они были в линейной зависимости.

Грубо говоря, для примера.

X = T
Y = a*X +c
Где a и с коэффициенты, которые подберете сами.
mad_nazgul
новенький
 
Сообщения: 10
Зарегистрирован: 20.04.2009 19:28:50


Вернуться в Lazarus

Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 213

Рейтинг@Mail.ru