Помогите исправить ошибку в Lazarus Pascal, не вращается фигура

Question

Помогите исправить ошибку в Lazarus Pascal, не вращается фигура

Антон Разумов Профи (552), закрыт 1 год назад

Помогите пожалуйста, есть код в котором должна вращаться звезда относительно своего центра(также звезда должна увеличиваться, менять цвета, обводку по кнопкам, это у меня получилось) но не могу сделать так чтобы вращалась звезда всё уже сделал но у меня не получается в чём ошибка не понимаю

Дополнен 1 год назад

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
Classes, SysUtils, Forms, Controls, ExtCtrls, Graphics, StdCtrls;

type
{ TForm1 }

TForm1 = class(TForm)
Shape1: TShape;
Timer1: TTimer;
ChangeBorderColorButton: TButton;
ChangeStarColorButton: TButton;
procedure FormCreate(Sender: TObject);
procedure Shape1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape1Paint(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure ChangeBorderColorButtonClick(Sender: TObject);
procedure ChangeStarColorButtonClick(Sender: TObject);
private
rotationAngle: Integer;
scaleFactor: Double;
scaleFactorDelta: Double;
StarColors: array of TColor;
currentColorIndex: Integer;
public
{ public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
rotationAngle := 0;
scaleFactor := 1.0;
scaleFactorDelta := 0.05;

SetLength(StarColors, 5);
StarColors[0] := clRed;
StarColors[1] := clBlue;
StarColors[2] := clGreen;
StarColors[3] := clYellow;
StarColors[4] := clPurple;

currentColorIndex := 0;

Timer1.Interval := 100;
Timer1.Enabled := True;

Дополнен 1 год назад

Shape1.Brush.Color := StarColors[currentColorIndex];

Shape1.Left := (ClientWidth - Shape1.Width) div 2;
Shape1.Top := (ClientHeight - Shape1.Height) div 2;

ChangeBorderColorButton := TButton.Create(Self);
ChangeBorderColorButton.Parent := Self;
ChangeBorderColorButton.Caption := 'Change Border Color';
ChangeBorderColorButton.Left := 10;
ChangeBorderColorButton.Top := 10;
ChangeBorderColorButton.OnClick := @ChangeBorderColorButtonClick;

ChangeStarColorButton := TButton.Create(Self);
ChangeStarColorButton.Parent := Self;
ChangeStarColorButton.Caption := 'Change Star Color';
ChangeStarColorButton.Left := 10;
ChangeStarColorButton.Top := 40;
ChangeStarColorButton.OnClick := @ChangeStarColorButtonClick;
end;

procedure TForm1.Shape1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Inc(currentColorIndex);
if currentColorIndex >= Length(StarColors) then
currentColorIndex := 0;

Shape1.Brush.Color := StarColors[currentColorIndex];
end;

procedure TForm1.Shape1Paint(Sender: TObject);
begin
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
scaleFactor := scaleFactor + scaleFactorDelta;
if (scaleFactor < 0.5) or (scaleFactor > 2.0) then
scaleFactorDelta := -scaleFactorDelta;

Shape1.Shape := stStar;
Shape1.Height := Round(50 * scaleFactor);
Shape1.Width := Round(50 * scaleFactor);

Shape1.Height := Round(Shape1.Height * 2);
Shape1.Width := Round(Shape1.Width * 2);

Inc(rotationAngle, 5);
Shape1.Brush.Color := StarColors[currentColorIndex];

Shape1.Left := (ClientWidth - Shape1.Width) div 2;
Shape1.Top := (ClientHeight - Shape1.Height) div 2;
end;

Дополнен 1 год назад

procedure TForm1.ChangeBorderColorButtonClick(Sender: TObject);
begin
Shape1.Pen.Color := RGBToColor(Random(256), Random(256), Random(256));
Shape1.Pen.Width := 4;
end;

procedure TForm1.ChangeStarColorButtonClick(Sender: TObject);
begin
Inc(currentColorIndex);
if currentColorIndex >= Length(StarColors) then
currentColorIndex := 0;

Shape1.Brush.Color := StarColors[currentColorIndex];
end;

end.

Answer 1

Alex_Klab Мастер (1229) 1 год назад

Пояснил бы хоть, что ИЗ отвечает за поворот. Откуда и докуда

Антон РазумовПрофи (552) 1 год назад

procedure TForm1.Timer1Timer(Sender: TObject);
begin
// Здесь происходит изменение поворота звезды
Inc(rotationAngle, 5); // Увеличиваем угол поворота на 5 градусов каждый раз

Alex_Klab Мастер (1229) Антон Разумов, Боюсь тебя расстроить, но в данной процедуре фигура не поворачивается, потому что ты её не вращаешь... Ты ей смотрю изменяешь высоту, ширину, положение по координата, но не вижу что ты её вращаешь. Ты изменяешь rotationAngle. Но ты его не применяешь же нигде, переменная тупо болтается в пространстве

Антон РазумовПрофи (552) 1 год назад

Остальной код обновляет размер и положение звезды

Alex_KlabМастер (1229) 1 год назад

https://habr.com/ru/articles/539420/
Афинные преобразования. Статься на хабре.

Ты берешь массив точек, по которым строится звезда.
И для КАЖДОЙ точки выполняешь преобразование вида.

 newX = x * cos(rotationAngle) + y * sin(rotationAngle);
newY = -x * sin(rotationAngle) + y * cos(rotationAngle);

Ну и переменной присваиваешь новые координаты.

Только есть один подвох, если координата находится не в начале системы координат, то от будет как бы двигаться вокруг системы координат

Поэтому фигуру надо:

1. Переместить к началу координат
2. Повернуть
3. Вернуть к исходным координатам

Антон РазумовПрофи (552) 1 год назад

Спасибо за помощь)) прочитал статью, немного подумав попробовал и всё получилось

Alex_Klab Мастер (1229) Антон Разумов, Статья не самая грамотная, но в разы лучше чем ничего. Очень рад, что получилось

Answer 2

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
lcltype, StdCtrls;

type

{ TForm1 }

TForm1 = class(TForm)
Shape1: TShape;
Shape2: TShape;
Shape3: TShape;
Timer1: TTimer;
procedure FormCreate(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure Timer1Timer(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;

var
Form1: TForm1;
x1,x2,state,speed,h,zero,score:integer;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.Timer1Timer(Sender: TObject);
var rd:extended;
begin
if shape1.Top>=zero then state:=0;
if shape1.top<=zero-h then state:=2;
if state=1 then shape1.Top:=shape1.Top-speed;
if state=2 then shape1.Top:=shape1.Top+speed;
shape2.Left:=shape2.Left-speed;
shape3.Left:=shape3.Left-speed;
if shape2.Left<0 then shape2.Left:=form1.Width;
if shape3.Left<0 then shape3.Left:=form1.Width;
rd:=sqrt(sqr((shape1.Left+shape1.Width)-(shape2.Left+shape2.Width))+sqr((shape1.Top+shape1.Height)-(Shape2.Top+shape2.Height)));
if rd<shape1.Height then timer1.Enabled:=false;
rd:=sqrt(sqr((shape1.Left+shape1.Width)-(shape3.Left+shape3.Width))+sqr((shape1.Top+shape1.Height)-(Shape3.Top+shape3.Height)));
if rd<shape1.Height then timer1.Enabled:=false;
inc(score);
form1.Caption:=inttostr(score)+' '+floattostr(rd);
speed:=(score div 100) +1;
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState
);
begin
if key=VK_SPACE then if state=0 then begin
state:=1;
shape1.Top:=shape1.Top-speed;
end;
if key=VK_ESCAPE then FormCreate(nil);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
timer1.Interval:=50;
timer1.Enabled:=true;
state:=0;
speed:=4;
h:=70;
zero:=176;
score:=0;
end;

end.

Answer 3

Jurijus Zaksas Искусственный Интеллект (450036) 1 год назад

А почему она должна вращаться? У шейпа нет параметра угла поворота, хочешь что-то покрутить - рисуй это что-то сам.

Антон РазумовПрофи (552) 1 год назад

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