Как сделать подъем круга по линии учитывая движение самого круга в пространстве?

[Katerina1993]

Здравствуйте сделала такую вещь, что при клике по холсту высчитывается координаты ближайшей точки и круг цепляется веревкой за точки расположенные на холсте, разумеется при соединении точки с кругом сам круг начинает двигаться, держась за веревку. Другими словами круг начинает раскачиваться на веревке словно на паутине (Например Человек Паук 2002 года, там была сцена где Питер Паркер сделал первый полет на паутине врезавшись в рекламный щит). На всякий случай прикладываю гифку.
(Немножко мигает).

Мне нужно чтобы при нажатии кнопки на клавиатуре вверх(up) объект подымался по веревки при этом сохраняя силу движения (раскачивания) на веревки.

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 
mousedownevt:=True;
end;
 
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 
mouseupevt := True;
end;
 
…
procedure TForm1.Timer1Timer(Sender: TObject);
var pt:TPoint;
a1:Integer;
a2,m:Integer;
 
var mousex,mousey:Integer;
begin
 
if upb then
  Form1.Caption:='True'
else
  Form1.Caption:='False';

Код полностью.

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, Unit2,Math;
 
type
  TForm1 = class(TForm)
    Timer1: TTimer;
    Label1: TLabel;
    procedure Timer1Timer(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormKeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 TPlayer = class
 private
  x0,y0,radius,QA,wA,AA,zA,FB,LB,GB,T,FC,oB,yB,vB,HB,k,LC,P,S:Integer;
  visible:Boolean;
  color:TColor;
 public
  constructor Create(_x,_y,_r,_QA,_wA,_AA,_zA,_FB,_LB,_GB,_T,_FC,_oB,_yB,_vB,_HB,_k,_LC,_P,_S:Integer;_color:TColor;_visible:Boolean);
  procedure Draw(Cs:TCanvas);
 end;
 TDot = class
 private
  x0,y0,radius,k,p:Integer;
  visible:Boolean;
  color:TColor;
 public
  constructor Create(_x,_y,_r,_k,_p:Integer;_color:TColor;_visible:Boolean);
  procedure Draw(Cs:TCanvas);
end;
 procedure a(mousex,mousey:Integer);
 function DC(HC, p:Integer):Integer;
 procedure GA();
var
  Form1: TForm1;
  Player: TPlayer;
  dt: Array[0..3] Of TDot;
  dt1:TDot;
  dt2:TDot;
  dt3:TDot;
  dt4:TDot;
  xmov:Integer = 0;
  ymov:Integer = 0;
  mousedownevt:Boolean;
  mouseupevt:Boolean;
  upb:Boolean;
implementation
 
{$R *.dfm}
 
constructor TDot.Create(_x,_y,_r,_k,_p:Integer;_color:TColor;_visible:Boolean);
begin
  inherited Create;
 
 
  x0:=_x;
  y0:=_y;
  radius:=_r;
  color:=_color;
  k:=_k;
  p:=_p;
  visible:=_visible;
end;
procedure TDot.Draw(Cs: TCanvas);
begin
 
  Form2.Memo1.Lines.Add(IntToStr(radius));
  Form1.Canvas.Brush.Color:=color;
 
  Cs.Arc(x0,y0,x0+radius*2,y0+radius*2,radius,radius,radius,radius);
end;
 
constructor TPlayer.Create(_x,_y,_r,_QA,_wA,_AA,_zA,_FB,_LB,_GB,_T,_FC,_oB,_yB,_vB,_HB,_k,_LC,_P,_S:Integer;_color:TColor;_visible:Boolean);
begin
  inherited Create;
  x0 := _x;
  y0 := _y;
  color:=_color;
  radius := _r;
  QA:=_QA;
  wA:=_wA;
  AA:=_AA;
  zA:=_zA;
  FB:=_FB;
  LB:=_LB;
  GB := _GB;
  T := _T;
  FC := _FC;
  oB := _oB;
  yB := _yB;
  zA := _zA;
  FB := _FB;
  vB := _vB;
  HB := _HB;
  k := _k;
  LC := _LC;
  P := _P;
  S := _S;
  visible:=_visible;
end;
 
procedure TPlayer.Draw(Cs: TCanvas);
begin
  //x0 := ;
 // y0 := y;
      
  Form1.Canvas.Brush.Color:=color;
  Cs.Arc(x0,y0,x0+radius*2,y0+radius*2,radius,radius,radius,radius);
end;
 
procedure TForm1.Timer1Timer(Sender: TObject);
var pt:TPoint;
a1:Integer;
a2,m:Integer;
 
var mousex,mousey:Integer;
begin
 
if upb then
  Form1.Caption:='True'
else
  Form1.Caption:='False';
 
pt:=Form1.ScreenToClient(Mouse.CursorPos);
//pt := Mouse.CursorPos;
Form1.Canvas.Brush.Color:=clWhite;
Form1.Canvas.FillRect(Form1.ClientRect);
xmov := xmov+5;
 
 
dt[0].Draw(Form1.Canvas);
dt[1].Draw(Form1.Canvas);
dt[2].Draw(Form1.Canvas);
dt[3].Draw(Form1.Canvas);
 
 
mousex := pt.X;
mousey := pt.Y;
 
if mousex < 0 then
  mousex := 0;
if mousey < 0 then
  mousey := 0;
 
Form1.Caption:='X= '+IntToStr(mousex)+' Y= '+IntToStr(mousey);
 
if mousedownevt = True then
begin
 
a(mousex, mousey);
Player.LB:=Player.QA;
 
end;
 
if (mouseupevt=True) and (Player.LB = Player.QA) or
(Player.QA <> -1) and (dt[Player.QA].visible=false) then
begin
 GA();
 Player.LB := Player.QA;
end;
 mousedownevt := false;
 mouseupevt := false;
 Player.AA:=Player.AA+1;
 
 if Player.AA >= 30 div 10 then
 begin
     Player.AA := Player.AA - 30 div 10;
     Player.wA:=Player.wA+1;
      if (Player.wA >= 3) then
          Player.wA := 3
       else
       begin
            if ((2 = Player.wA) and (-1 = Player.QA)) then
            begin
               a(Player.zA, Player.FB);
            end;
                    
       end;
       Player.oB := Player.FC;
       Player.yB := Player.GB;
       Player.HB := Player.LC;
       Player.P := Player.P + Player.vB;
       Player.FC := Player.FC + Player.k;
                        
       Player.GB := Player.GB + Player.P;
 
       Player.LC := Player.LC + Player.S;
       if Player.QA <> -1 then
       begin
        a1 := Round(dt[Player.QA].x0 + dt[Player.QA].k / 10);
        a2 := Round(dt[Player.QA].y0 + dt[Player.QA].P / 10);
        m := Round(Sqrt(Power(Player.FC - a1, 2) +
        Power(Player.GB - a2, 2)));
        Player.FC := Round((Player.FC - a1) * Player.T div m + a1);
        Player.GB := Round((Player.GB - a2) * Player.T div m + a2);
 
 
 
         Player.LC := Round(ArcSin((Player.GB - a2) div Player.T)* 180 / Pi - 90);
 
         if Player.FC < a1 then
         begin
            Player.LC := Player.LC * -1;
         end;
         if Player.LC - Player.HB > 180 then
                  begin
                        Player.HB := Player.HB + 360;
                  end;
          if Player.HB - Player.LC > 180 then
          begin
            Player.HB := Player.HB - 360;
          end;
          Player.k := Player.FC - Player.oB;
          Player.P := Player.GB - Player.yB;
          Player.S := Player.LC - Player.HB;
      end;
 
 end;
 Form2.Label1.Caption :=FloatToStr(Player.FC * Player.AA / 30);
 Player.x0 := Round(Player.FC * Player.AA / 30 * 10 + Player.oB * (1 - Player.AA / 30 * 10));
 Player.y0 := Round(Player.GB * Player.AA / 30 * 10 + Player.yB * (1 - Player.AA / 30 * 10));
 Player.Draw(Form1.Canvas);
 
 if Player.QA <> -1 then
 begin
  
    Form1.Canvas.MoveTo(Round(Player.x0+Player.radius),Round(Player.y0+Player.radius/2));
    Form1.Canvas.LineTo(Round(dt[Player.QA].x0+dt[Player.QA].radius),Round(dt[Player.QA].y0+dt[Player.QA].radius));
 end;
 
end;
 
procedure GA();
begin
  Player.QA := -1;
end;
 
procedure a(mousex,mousey:Integer);
begin
 
  Player.QA := DC(mousex,mousey);
 
   if Player.QA <> -1 then
   begin
     Player.T := Round(Sqrt(Math.Power(Player.FC - dt[Player.QA].x0, 2) +
                            Math.Power(Player.GB - dt[Player.QA].y0, 2)));
   end;
end;
function DC(HC, p:Integer):Integer;
var t1,t2,i:Integer;
begin
 t1 := 1000000000;
 t2 := 0;
 for i:=0 to High(dt) do
 begin
    
    if Math.Power(HC - dt[i].x0,2) +
    Math.Power(p - dt[i].y0,2) < t1  then
    begin
      t2 := i;
      t1 := Round(Power(HC - dt[i].x0, 2) + Power(p - dt[i].y0, 2));
    
    end;
 end;
  if 1000000000 = t1 then
  begin
            result:=-1;
  end;
 
  result:=t2;
end;
 
procedure TForm1.FormShow(Sender: TObject);
begin
 
Player:=TPlayer.Create(100,100,14,-1,0,0,50,10,0,
0,0,0,0,0,15,0,250 div 10,0,1,1,clRed,True);
 
dt[0]:=TDot.Create(75,75,8,25,0,clRed,True);
dt[1]:=TDot.Create(150,100,8,25,1,clRed,True);
dt[2]:=TDot.Create(300,125,8,25,1,clRed,True);
dt[3]:=TDot.Create(400,125,8,25,1,clRed,True);
 
 
Timer1.Enabled:=True;
end;
 
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 
mousedownevt:=True;
end;
 
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
//ShowMessage('UP');
mouseupevt := True;
end;
 
procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
if Key = vk_UP then
 upb:=false;
end;
 
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
if Key = vk_UP then
 upb:=true;
 
end;
 
end.

Сообщение отредактировано: Katerina1993 - 10.03.23, 22:38

[Feldsher]

Шарик ведь уже качается? Делаете кнопку верх - длину веревки в минус

[macomics]

Мигает оно потому что вы опять всю перерисовку делаете в процедуре таймера.

Включите Form1.DoubleBuffer := True; при создании окна и переместите код из TForm1.Timer1Timer в TForm1.FormPaint
А в TForm1.Timer1Timer надо просто перерисовывать окно (Repaint)/

Для того, чтобы шарик поднимался вверх просто уменьшайте длину верёвки. Сейчас она удлиняется за счёт разницы в расстоянии до точек зацепки

a1 := Round(dt[Player.QA].x0 + dt[Player.QA].k / 10);
a2 := Round(dt[Player.QA].y0 + dt[Player.QA].P / 10);
m := Round(Sqrt(Power(Player.FC - a1, 2) +
Power(Player.GB - a2, 2)));

Вот вычисляется расстояние от точки игрока до точки зацепки. Уменьшите значение m и он будет подниматься по верёвке.

Сообщение отредактировано: macomics - 11.03.23, 08:58

[Katerina1993]

macomics, не знаю в чем дело? Пыталась воспользоваться вашим советом, но когда я переношу прорисовку в onPaint, таймер перестает работать. Код другого примера.

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;
 
type
  TForm1 = class(TForm)
    Image1: TImage;
    Button1: TButton;
    Timer1: TTimer;
    Label1: TLabel;
    procedure Timer1Timer(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormKeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormPaint(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
  TBall = class
  x0,y0,radius,SpeedX,SpeedY:Integer;
  color:TColor;
  public
   constructor Create(_x,_y,_r,_speedx,_speedy:Integer;_color:TColor);
   procedure Draw(Cs:TCanvas);
  end;
var
  Form1: TForm1;
  leftb,rightb,downb,upb : Boolean;
  ball:TBall;
implementation
 
{$R *.dfm}
  constructor TBall.Create(_x,_y,_r,_speedx,_speedy:Integer;_color:TColor);
  begin
    inherited Create;
    x0:=_x;
    y0:=_y;
    radius:=_r;
    SpeedX:=_speedx;
    SpeedY:=_speedy;
    color:=_color;
  end;
  procedure TBall.Draw(Cs: TCanvas);
  begin
   Form1.Image1.Canvas.Brush.Color := color;
   Form1.Image1.Canvas.Pen.Color := clBlack;
   Form1.Image1.Canvas.Ellipse(x0,y0,x0+radius,y0+radius);
  end;
 
procedure TForm1.Timer1Timer(Sender: TObject);
begin
 
 Label1.Caption:='False';
// Form1.Image1.Repaint;
// Repaint;
 ball.x0 := ball.x0 + 5;
 
 if upb then
  Label1.Caption:='True'
 else
  Label1.Caption:='False';
 
 
 
end;
 
procedure TForm1.FormShow(Sender: TObject);
begin
 
//Form1.DoubleBuffered := True;
ball := TBall.Create(140,140,50,0,0,clRed);
Timer1.Enabled:=True;
end;
 
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
case key of vk_RIGHT: rightb := true;
vk_LEFT: leftb := true;
vk_UP: upb := true;
vk_DOWN: downb := true;
end;
end;
 
procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
case Key of
vk_RIGHT: rightb := false;
vk_LEFT: leftb := false;
vk_UP: upb := false;
vk_DOWN: downb := false;
end;
end;
 
procedure TForm1.FormPaint(Sender: TObject);
begin
 Image1.Canvas.Brush.Color:=clWhite;
 Image1.Canvas.FillRect(Form1.ClientRect);
 ball.Draw(Image1.Canvas);
end;
 
end.

[macomics]

А точно таймер не работает?

unit Unit1;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls;
 
type
 
  { TBall }
 
  TBall = class
      x0,y0,radius,SpeedX,SpeedY:Integer;
      color:TColor;
   public
      constructor Create(_x,_y,_r,_speedx,_speedy:Integer;_color:TColor);
      procedure Draw(Cs:TCanvas);
   end;
 
  { TForm1 }
 
  TForm1 = class(TForm)
    Button1: TButton;
    Image1: TImage;
    Label1: TLabel;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure Image1Paint(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
 
  public
 
  end;
 
var
   Form1: TForm1;
   leftb,rightb,downb,upb : Boolean;
   ball:TBall;
 
implementation
 
{$R *.lfm}
 
constructor TBall.Create(_x,_y,_r,_speedx,_speedy:Integer;_color:TColor);
begin
   inherited Create;
   x0:=_x;
   y0:=_y;
   radius:=_r;
   SpeedX:=_speedx;
   SpeedY:=_speedy;
   color:=_color;
end;
 
procedure TBall.Draw(Cs: TCanvas);
begin
   Form1.Image1.Canvas.Brush.Color := color;
   Form1.Image1.Canvas.Pen.Color := clBlack;
   Form1.Image1.Canvas.Ellipse(x0,y0,x0+radius,y0+radius);
end;
 
{ TForm1 }
 
procedure TForm1.Timer1Timer(Sender: TObject);
var
   status: String;
begin
   status := FormatDateTime('YYYY-MM-DD hh:mm:ss', Now);
   Repaint;
   ball.x0 := ball.x0 + 5;
   if upb then
      Label1.Caption:='True' + status
   else
      Label1.Caption:='False ' + status;
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
   Form1.DoubleBuffered := True;
   ball := TBall.Create(140,140,50,0,0,clRed);
   // Timer1.Enabled:=True;
end;
 
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState
  );
begin
   case key of
   VK_RIGHT: rightb := true;
   VK_LEFT: leftb := true;
   VK_UP: upb := true;
   VK_DOWN: downb := true;
   end;
end;
 
procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
   case Key of
   VK_RIGHT: rightb := false;
   VK_LEFT: leftb := false;
   VK_UP: upb := false;
   VK_DOWN: downb := false;
   end;
end;
 
procedure TForm1.Image1Paint(Sender: TObject);
begin
   Image1.Canvas.Brush.Color:=clWhite;
   Image1.Canvas.FillRect(Form1.ClientRect);
   ball.Draw(Image1.Canvas);
end;
 
end.

У меня вот часики тикают.

Скорее всего фокус ввода от формы съела кнопка и не проходят нажатия на клавиши.

Сообщение отредактировано: macomics - 11.03.23, 16:42

[Katerina1993]

Попыталась сделать. При нажатии кнопки быстро подымается к точке и если отпустить то быстро падает иногда выстреливает куда-то в бок. Пример в анимации.

Если объект находится слишком низко, то при нажатии кнопки он подымается как на пружине резко вверх пример во второй анимации.


Как сделать плавное подъем и чтобы в случае отпускание он оставался на том же месте, при этом учитывая колебания раскачивания?

Код я перенесла в Timer, и добавила Repaint, как мне рекомендовали.

Еще поменяла Arc на Ellipse, так как Arc почему-то не перекрашивается в нужный цвет.

Код полностью:

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, Unit2,Math;
 
type
  TForm1 = class(TForm)
    Timer1: TTimer;
    Label1: TLabel;
    procedure Timer1Timer(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormKeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormPaint(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 TPlayer = class
 private
  x0,y0,radius,QA,wA,AA,zA,FB,LB,GB,T,FC,oB,yB,vB,HB,k,LC,P,S:Integer;
  visible:Boolean;
  color:TColor;
 public
  constructor Create(_x,_y,_r,_QA,_wA,_AA,_zA,_FB,_LB,_GB,_T,_FC,_oB,_yB,_vB,_HB,_k,_LC,_P,_S:Integer;_color:TColor;_visible:Boolean);
  procedure Draw(Cs:TCanvas);
 end;
 TDot = class
 private
  x0,y0,radius,k,p:Integer;
  visible:Boolean;
  color:TColor;
 public
  constructor Create(_x,_y,_r,_k,_p:Integer;_color:TColor;_visible:Boolean);
  procedure Draw(Cs:TCanvas);
end;
 procedure a(mousex,mousey:Integer);
 function DC(HC, p:Integer):Integer;
 procedure GA();
var
  Form1: TForm1;
  Player: TPlayer;
  dt: Array[0..3] Of TDot;
  dt1:TDot;
  dt2:TDot;
  dt3:TDot;
  dt4:TDot;
  xmov:Integer = 0;
  ymov:Integer = 0;
  mousedownevt:Boolean;
  mouseupevt:Boolean;
  upb:Boolean;
  d:Integer=1;
implementation
 
{$R *.dfm}
 
constructor TDot.Create(_x,_y,_r,_k,_p:Integer;_color:TColor;_visible:Boolean);
begin
  inherited Create;
 
 
  x0:=_x;
  y0:=_y;
  radius:=_r;
  color:=_color;
  k:=_k;
  p:=_p;
  visible:=_visible;
end;
procedure TDot.Draw(Cs: TCanvas);
begin
 
  Form2.Memo1.Lines.Add(IntToStr(radius));
  Form1.Canvas.Brush.Color:=color;
  Cs.Ellipse(x0,y0,x0+radius*2,y0+radius*2);
  //Cs.Arc(x0,y0,x0+radius*2,y0+radius*2,radius,radius,radius,radius);
end;
 
constructor TPlayer.Create(_x,_y,_r,_QA,_wA,_AA,_zA,_FB,_LB,_GB,_T,_FC,_oB,_yB,_vB,_HB,_k,_LC,_P,_S:Integer;_color:TColor;_visible:Boolean);
begin
  inherited Create;
  x0 := _x;
  y0 := _y;
  color:=_color;
  radius := _r;
  QA:=_QA;
  wA:=_wA;
  AA:=_AA;
  zA:=_zA;
  FB:=_FB;
  LB:=_LB;
  GB := _GB;
  T := _T;
  FC := _FC;
  oB := _oB;
  yB := _yB;
  zA := _zA;
  FB := _FB;
  vB := _vB;
  HB := _HB;
  k := _k;
  LC := _LC;
  P := _P;
  S := _S;
  visible:=_visible;
end;
 
procedure TPlayer.Draw(Cs: TCanvas);
begin
 
 
  Form1.Canvas.Brush.Color:=color;
  Cs.Ellipse(x0,y0,x0+radius*2,y0+radius*2);
 //Cs.Arc(x0,y0,x0+radius*2,y0+radius*2,radius,radius,radius,radius);
end;
 
procedure TForm1.Timer1Timer(Sender: TObject);
begin
Repaint;
 
 
end;
 
procedure GA();
begin
  Player.QA := -1;
end;
 
procedure a(mousex,mousey:Integer);
begin
 
  Player.QA := DC(mousex,mousey);
 
   if Player.QA <> -1 then
   begin
     Player.T := Round(Sqrt(Math.Power(Player.FC - dt[Player.QA].x0, 2) +
                            Math.Power(Player.GB - dt[Player.QA].y0, 2)));
   end;
end;
function DC(HC, p:Integer):Integer;
var t1,t2,i:Integer;
begin
 t1 := 1000000000;
 t2 := 0;
 for i:=0 to High(dt) do
 begin
 
    if Math.Power(HC - dt[i].x0,2) +
    Math.Power(p - dt[i].y0,2) < t1  then
    begin
      t2 := i;
      t1 := Round(Power(HC - dt[i].x0, 2) + Power(p - dt[i].y0, 2));
 
    end;
 end;
  if 1000000000 = t1 then
  begin
            result:=-1;
  end;
 
  result:=t2;
end;
 
procedure TForm1.FormShow(Sender: TObject);
begin
 //250 div 10
Player:=TPlayer.Create(100,100,14,-1,0,0,50,10,0,
0,0,0,0,0,15,0,250 div 10,0,1,1,clRed,True);
 
dt[0]:=TDot.Create(75,75,8,25,0,clGreen,True);
dt[1]:=TDot.Create(150,100,8,25,1,clGreen,True);
dt[2]:=TDot.Create(300,125,8,25,1,clGreen,True);
dt[3]:=TDot.Create(400,125,8,25,1,clGreen,True);
 
 
Timer1.Enabled:=True;
end;
 
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 
mousedownevt:=True;
end;
 
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
//ShowMessage('UP');
mouseupevt := True;
end;
 
procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
 
 
 
if Key = vk_UP then
 upb:=false;
end;
 
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
 
if Key = vk_UP then
 upb:=true;
 
end;
 
procedure TForm1.FormPaint(Sender: TObject);
var pt:TPoint;
a1:Integer;
a2,m:Integer;
mousex,mousey:Integer;
a3:Integer;
begin
  d:=1;
if upb then
  d:=d*-1;
 
Label1.Caption:=IntToStr(d);
 
 
pt:=Form1.ScreenToClient(Mouse.CursorPos);
//pt := Mouse.CursorPos;
Form1.Canvas.Brush.Color:=clWhite;
Form1.Canvas.FillRect(Form1.ClientRect);
xmov := xmov+5;
 
 
dt[0].Draw(Form1.Canvas);
dt[1].Draw(Form1.Canvas);
dt[2].Draw(Form1.Canvas);
dt[3].Draw(Form1.Canvas);
 
 
mousex := pt.X;
mousey := pt.Y;
 
if mousex < 0 then
  mousex := 0;
if mousey < 0 then
  mousey := 0;
 
Form1.Caption:='X= '+IntToStr(mousex)+' Y= '+IntToStr(mousey);
 
if mousedownevt = True then
begin
 
a(mousex, mousey);
Player.LB:=Player.QA;
 
end;
 
if (mouseupevt=True) and (Player.LB = Player.QA) or
(Player.QA <> -1) and (dt[Player.QA].visible=false) then
begin
 GA();
 Player.LB := Player.QA;
end;
 mousedownevt := false;
 mouseupevt := false;
 Player.AA:=Player.AA+1;
 
 if Player.AA >= 30 div 10 then
 begin
     Player.AA := Player.AA - 30 div 10;
     Player.wA:=Player.wA+1;
      if (Player.wA >= 3) then
          Player.wA := 3
       else
       begin
            if ((2 = Player.wA) and (-1 = Player.QA)) then
            begin
               a(Player.zA, Player.FB);
            end;
 
       end;
       Player.oB := Player.FC;
       Player.yB := Player.GB;
       Player.HB := Player.LC;
       Player.P := Player.P + Player.vB;
       Player.FC := Player.FC + Player.k;
 
       Player.GB := Player.GB + Player.P;
 
       Player.LC := Player.LC + Player.S;
       if Player.QA <> -1 then
       begin
        a1 := Round(dt[Player.QA].x0 + dt[Player.QA].k / 10);
        a2 := Round(dt[Player.QA].y0 + dt[Player.QA].P / 10);
        m := Round(Sqrt(Power(Player.FC - a1*d, 2) + Power(Player.GB - a2*d, 2)));
        Player.FC := Round((Player.FC - a1) * Player.T div m + a1);
        Player.GB := Round((Player.GB - a2) * Player.T div m + a2);
 
 
 
         Player.LC := Round(ArcSin((Player.GB - a2) div Player.T)* 180 / Pi - 90);
 
         if Player.FC < a1 then
         begin
            Player.LC := Player.LC * -1;
         end;
         if Player.LC - Player.HB > 180 then
                  begin
                        Player.HB := Player.HB + 360;
                  end;
          if Player.HB - Player.LC > 180 then
          begin
            Player.HB := Player.HB - 360;
          end;
          Player.k := Player.FC - Player.oB;
          Player.P := Player.GB - Player.yB;
          Player.S := Player.LC - Player.HB;
      end;
 
 end;
// a3 := 30;
 Form2.Label1.Caption :=FloatToStr(Player.FC * Player.AA / 30);
 Player.x0 := Round(Player.FC * Player.AA / 30 * 10 + Player.oB * (1 - Player.AA / 30 * 10));
 Player.y0 := Round(Player.GB * Player.AA / 30 * 10 + Player.yB * (1 - Player.AA / 30 * 10));
 Player.Draw(Form1.Canvas);
 
 if Player.QA <> -1 then
 begin
 
    Form1.Canvas.MoveTo(Round(Player.x0+Player.radius),Round(Player.y0+Player.radius/2));
    Form1.Canvas.LineTo(Round(dt[Player.QA].x0+dt[Player.QA].radius),Round(dt[Player.QA].y0+dt[Player.QA].radius));
 end;
 
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
Form1.DoubleBuffered:=True;
end;
 
end.

[macomics]

Для начала надо поработать над анимацией. У вас должен быть таймер, который управляет перерисовкой. Но этот таймер нужен лишь для того, чтобы принудительно перерисовывать окно и генерировать кадры анимации. А вот расчёт кадра анимации лучше всего делать относительно реального времени. Так анимация не будет зависеть от частоты кадров и будет наиболее адекватно отображаться во времени.

unit Unit1;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls;
 
type
  TPointAim = packed record
    Position: TPoint;
    Pressed: Boolean;
  end;
  TPointLink = packed record
    Position: TPoint;
    Speed: TPoint;
    Accelerarion: TPoint;
    Link: LongInt;
    Rope: LongInt;
  end;
 
  { TForm1 }
 
  TForm1 = class(TForm)
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; _X, _Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; _X, _Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; _X, _Y: Integer);
    procedure FormPaint(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
 
  public
 
  end;
 
var
  Form1: TForm1;
  balance: TPointLink = (Position: (X: 25; Y: 10); Speed: (X: 0; Y: 0); Accelerarion: (X: 0; Y: 98000); Link: -1; Rope: 0);
  points: array [0 .. 3] of TPoint = ((x:80; y:100), (x:150; y:120), (x:200; y:80), (x:250; y:110));
  curpos: TPointAim = (Position: (X: 0; Y: 0); Pressed: False);
  latest: TDateTime;
 
implementation
 
{$R *.lfm}
 
{ TForm1 }
 
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Repaint;
end;
 
function dst(X, Y: LongInt): Double;
begin
   dst := sqrt(X * X + Y * Y);
end;
 
procedure TForm1.FormPaint(Sender: TObject);
var
   i: LongInt;
   t: TDateTime;
begin
   t := latest;
   latest := Now;
   t := (latest - t) * 86400;
   for i := Low(points) to High(points) do begin
      Canvas.Arc(points[i].x - 10, points[i].y - 10, points[i].x + 10, points[i].y + 10, 0, 5760);
      with curpos.Position do if (curpos.Pressed) and (dst(X - points[i].x, Y - points[i].y) < sqrt(800)) then begin
         Canvas.Arc(points[i].x - 7, points[i].y - 7, points[i].x + 7, points[i].y + 7, 0, 5760);
         if (balance.Link = -1) or (balance.Link <> i) then begin
            balance.Link := i;
            balance.Rope := Round(dst(X - points[i].x, Y - points[i].y));
         end;
      end;
   end;
   with balance do begin
      inc(Position.X, Round(Speed.X * t + Accelerarion.X * t * t / 2000));
      inc(Position.Y, Round(Speed.Y * t + Accelerarion.Y * t * t / 2000));
      inc(Speed.X, Round(Accelerarion.X * t / 1000));
      inc(Speed.Y, Round(Accelerarion.Y * t / 1000));
// Вот тут я ограничиваю движения объекта границами окна
//-------------------------------------------------------
      if Position.X < 6 then begin
         Position.X := 6;
         Speed.X := 0;
         Accelerarion.X := 40000;
         if Position.X < ClientWidth div 2 then
            inc(Accelerarion.Y, Round(100000 * Random))
         else
            dec(Accelerarion.Y, Round(100000 * Random));
      end;
      if Position.Y < 6 then begin
         Position.Y := 6;
         Speed.Y := 0;
         Accelerarion.Y := 98000;
         if Position.Y < ClientHeight div 2 then
            inc(Accelerarion.X, Round(25000 * Random))
         else
            dec(Accelerarion.X, Round(25000 * Random));
      end;
      if Position.X > ClientWidth - 6 then begin
         Position.X := ClientWidth - 6;
         Speed.X := 0;
         Accelerarion.X := -43000;
         if Position.X < ClientWidth div 2 then
            inc(Accelerarion.Y, Round(100000 * Random))
         else
            dec(Accelerarion.Y, Round(100000 * Random));
      end;
      if Position.Y > ClientHeight - 6 then begin
         Position.Y := ClientHeight - 6;
         Speed.Y := 0;
         Accelerarion.Y := -98000;
         if Position.Y < ClientHeight div 2 then
            inc(Accelerarion.X, Round(25000 * Random))
         else
            dec(Accelerarion.X, Round(25000 * Random));
      end;
//-------------------------------------------------------
   end;
   with balance.Position, Canvas do Arc(X - 5, Y - 5, X + 5, Y + 5, 0, 5760);
end;
 
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; _X, _Y: Integer);
begin
   with curpos.Position do begin
     X := _X;
     Y := _Y;
     curpos.Pressed := True;
   end;
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
   Randomize;
   latest := Now;
end;
 
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; _X,
  _Y: Integer);
begin
   with curpos.Position do
      if curpos.Pressed then begin
         X := _X;
         Y := _Y;
      end;
end;
 
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; _X, _Y: Integer);
begin
   curpos.Pressed := False;
end;
 
end.

Напечатал эту программу и завис наблюдая за объектом. Анимация опасная штука. Чуть позже, как будет время, добавлю зацепку к объектам и эффект маятника при раскачивании на верёвке.

[RusSun]

to macomics Вот на Delphi твой код с Lasar'я, но мне кажется, что оно также забавно работает.
То есть без картинки как у тебя это работает в Lasar'e - не понятно)) Без намёка. Просто как есть.
Там arc немного отличается поэтому добавил два параметра в delphi 8мь параметров в Lasar'e arc c 6тью параметрами.
Без притензии.

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls;
type
  TPointAim = packed record
    Position: TPoint;
    Pressed: Boolean;
  end;
  TPointLink = packed record
    Position: TPoint;
    Speed: TPoint;
    Accelerarion: TPoint;
    Link: LongInt;
    Rope: LongInt;
  end;
type
  TForm1 = class(TForm)
    Timer1: TTimer;
    procedure FormPaint(Sender: TObject);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; _X, _Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; _X, _Y: Integer);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; _X, _Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
  balance: TPointLink = (Position: (X: 25; Y: 10); Speed: (X: 0; Y: 0); Accelerarion: (X: 0; Y: 98000); Link: -1; Rope: 0);
  points: array [0 .. 3] of TPoint = ((x:80; y:100), (x:150; y:120), (x:200; y:80), (x:250; y:110));
  latest: TDateTime;
  curpos: TPointAim = (Position: (X: 0; Y: 0); Pressed: False);
implementation
 
{$R *.dfm}
function dst(X, Y: LongInt): Double;
begin
   dst := sqrt(X * X + Y * Y);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Randomize;
latest := Now;
end;
 
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; _X, _Y: Integer);
begin
  with curpos.Position do begin
     X := _X;
     Y := _Y;
     curpos.Pressed := True;
   end;
end;
 
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; _X,
  _Y: Integer);
begin
  with curpos.Position do
      if curpos.Pressed then begin
         X := _X;
         Y := _Y;
      end;
end;
 
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; _X, _Y: Integer);
begin
  curpos.Pressed := False;
end;
 
 
procedure TForm1.FormPaint(Sender: TObject);
var
   i: LongInt;
   t: TDateTime;
begin
   t := latest;
   latest := Now;
   t := (latest - t) * 86400;
   for i := Low(points) to High(points) do begin
      Canvas.Arc(points[i].x - 10, points[i].y - 10, points[i].x + 10, points[i].y + 10, 0, 5760,0,5760);
      with curpos.Position do if (curpos.Pressed) and (dst(X - points[i].x, Y - points[i].y) < sqrt(800)) then begin
         Canvas.Arc(points[i].x - 7, points[i].y - 7, points[i].x + 7, points[i].y + 7, 0, 5760,0,5760);
         if (balance.Link = -1) or (balance.Link <> i) then begin
            balance.Link := i;
            balance.Rope := Round(dst(X - points[i].x, Y - points[i].y));
         end;
      end;
   end;
   with balance do begin
      inc(Position.X, Round(Speed.X * t + Accelerarion.X * t * t / 2000));
      inc(Position.Y, Round(Speed.Y * t + Accelerarion.Y * t * t / 2000));
      inc(Speed.X, Round(Accelerarion.X * t / 1000));
      inc(Speed.Y, Round(Accelerarion.Y * t / 1000));
// Вот тут я ограничиваю движения объекта границами окна
//-------------------------------------------------------
      if Position.X < 6 then begin
         Position.X := 6;
         Speed.X := 0;
         Accelerarion.X := 40000;
         if Position.X < ClientWidth div 2 then
            inc(Accelerarion.Y, Round(100000 * Random))
         else
            dec(Accelerarion.Y, Round(100000 * Random));
      end;
      if Position.Y < 6 then begin
         Position.Y := 6;
         Speed.Y := 0;
         Accelerarion.Y := 98000;
         if Position.Y < ClientHeight div 2 then
            inc(Accelerarion.X, Round(25000 * Random))
         else
            dec(Accelerarion.X, Round(25000 * Random));
      end;
      if Position.X > ClientWidth - 6 then begin
         Position.X := ClientWidth - 6;
         Speed.X := 0;
         Accelerarion.X := -43000;
         if Position.X < ClientWidth div 2 then
            inc(Accelerarion.Y, Round(100000 * Random))
         else
            dec(Accelerarion.Y, Round(100000 * Random));
      end;
      if Position.Y > ClientHeight - 6 then begin
         Position.Y := ClientHeight - 6;
         Speed.Y := 0;
         Accelerarion.Y := -98000;
         if Position.Y < ClientHeight div 2 then
            inc(Accelerarion.X, Round(25000 * Random))
         else
            dec(Accelerarion.X, Round(25000 * Random));
      end;
//-------------------------------------------------------
   end;
   with balance.Position, Canvas do Arc(X - 5, Y - 5, X + 5, Y + 5, 0, 5760,0,5760)
end;
 
 
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Repaint;
end;
 
end.

Сообщение отредактировано: RusSun - 15.03.23, 04:48

[^D^ima]

Прикрепите пожалуйста файл проекта целиком,

[macomics]

Цитата RusSun @ 15.03.23, 04:42

Там arc немного отличается поэтому добавил два параметра в delphi 8мь параметров в Lasar'e arc c 6тью параметрами.

У меня есть arc с 8-ю параметрами. Считать лень было. Использовал вариант с 6-ю параметрами. Странно, что на Delphi её нету.

unit Unit1;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls;
 
type
  TPointAim = packed record
    Position: TPoint;
    Pressed: Boolean;
  end;
  TPointLink = packed record
    Position: TPoint;
    Speed: packed record
      X, Y: Double;
    end;
    Accelerarion: packed record
      X, Y: Double;
    end;
    Link: LongInt;
    Rope: LongInt;
  end;
 
  { TForm1 }
 
  TForm1 = class(TForm)
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; _X, _Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; _X, _Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; _X, _Y: Integer);
    procedure FormPaint(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
 
  public
 
  end;
 
var
  Form1: TForm1;
  balance: TPointLink = (Position: (X: 25; Y: 10); Speed: (X: 0; Y: 0); Accelerarion: (X: 0; Y: 98000); Link: -1; Rope: 0);
  points: array [0 .. 3] of TPoint = ((x:80; y:100), (x:150; y:120), (x:200; y:80), (x:250; y:110));
  curpos: TPointAim = (Position: (X: 0; Y: 0); Pressed: False);
  latest: TDateTime;
 
implementation
 
{$R *.lfm}
 
{ TForm1 }
 
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Repaint;
end;
 
function dst(X, Y: LongInt): Double;
begin
   dst := sqrt(X * X + Y * Y);
end;
 
function dst(X, Y: Double): Double;
begin
   dst := sqrt(X * X + Y * Y);
end;
 
procedure TForm1.FormPaint(Sender: TObject);
var
   i, d: LongInt;
   t: TDateTime;
   c: Double;
begin
   t := latest;
   latest := Now;
   t := (latest - t) * 86400;
   for i := Low(points) to High(points) do begin
      Canvas.Arc(points[i].x - 10, points[i].y - 10, points[i].x + 10, points[i].y + 10, points[i].x, points[i].y - 10, points[i].x, points[i].y - 10);
      with curpos.Position do if (curpos.Pressed) and (dst(X - points[i].x, Y - points[i].y) < sqrt(800)) then begin
         Canvas.Arc(points[i].x - 7, points[i].y - 7, points[i].x + 7, points[i].y + 7, points[i].x, points[i].y - 7, points[i].x, points[i].y - 7);
         if (balance.Link = -1) or (balance.Link <> i) then begin
            balance.Link := i;
            balance.Rope := Round(dst(balance.Position.X - points[i].x, balance.Position.Y - points[i].y));
         end;
      end else if not curpos.Pressed then balance.Link := -1;
   end;
   with balance do begin
      inc(Position.X, Round(Speed.X * t + Accelerarion.X * t * t / 2000));
      inc(Position.Y, Round(Speed.Y * t + Accelerarion.Y * t * t / 2000));
      Speed.X := Speed.X + Accelerarion.X * t / 1000;
      Speed.Y := Speed.Y + Accelerarion.Y * t / 1000;
      if Link <> -1 then begin
         d := Round(dst(points[Link].x - Position.X, points[Link].y - Position.Y));
         if d > Rope then begin
            inc(Position.X, Round((d - Rope) * (points[Link].x - Position.X) / Rope));
            inc(Position.Y, Round((d - Rope) * (points[Link].y - Position.Y) / Rope));
            c := dst(balance.Speed.x, balance.Speed.Y);
            balance.Speed.X := 1000 * balance.Speed.X / c;
            balance.Speed.Y := 1000 * balance.Speed.Y / c;
         end;
      end;
      if Position.X < 6 then begin
         Position.X := 6;
         Speed.X := 0;
         Accelerarion.X := 40000;
         if Position.X < ClientWidth div 2 then
            Accelerarion.Y := Accelerarion.Y + 100000 * Random
         else
            Accelerarion.Y := Accelerarion.Y - 100000 * Random;
      end;
      if Position.Y < 6 then begin
         Position.Y := 6;
         Speed.Y := 0;
         Accelerarion.Y := 98000;
         if Position.Y < ClientHeight div 2 then
            Accelerarion.X := Accelerarion.X + 25000 * Random
         else
            Accelerarion.X := Accelerarion.X - 25000 * Random;
      end;
      if Position.X > ClientWidth - 6 then begin
         Position.X := ClientWidth - 6;
         Speed.X := 0;
         Accelerarion.X := -43000;
         if Position.X < ClientWidth div 2 then
            Accelerarion.Y := Accelerarion.Y + 100000 * Random
         else
            Accelerarion.Y := Accelerarion.Y - 100000 * Random;
      end;
      if Position.Y > ClientHeight - 6 then begin
         Position.Y := ClientHeight - 6;
         Speed.Y := 0;
         Accelerarion.Y := -98000;
         if Position.Y < ClientHeight div 2 then
            Accelerarion.X := Accelerarion.X + 25000 * Random
         else
            Accelerarion.X := Accelerarion.X - 25000 * Random;
      end;
   end;
   with balance.Position, Canvas do begin
      if balance.Link <> -1 then
         Canvas.Line(balance.Position, points[balance.Link]);
      Arc(X - 5, Y - 5, X + 5, Y + 5, X, Y - 5, X, Y - 5);
   end;
end;
 
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; _X, _Y: Integer);
begin
   with curpos.Position do begin
     X := _X;
     Y := _Y;
     curpos.Pressed := True;
   end;
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
   Randomize;
   latest := Now;
end;
 
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; _X,
  _Y: Integer);
begin
   with curpos.Position do
      if curpos.Pressed then begin
         X := _X;
         Y := _Y;
      end;
end;
 
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; _X, _Y: Integer);
begin
   curpos.Pressed := False;
end;
 
end.

Но я не делал еще расчет угловых скоростей

Добавлено 15.03.23, 10:41

Цитата ^D^ima @ 15.03.23, 08:24

Прикрепите пожалуйста файл проекта целиком,

Какой файл проекта. Весь проект из одного модуля.

program project1;
 
{$mode objfpc}{$H+}
 
uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Interfaces, // this includes the LCL widgetset
  Forms, Unit1
  { you can add units after this };
 
{$R *.res}
 
begin
  RequireDerivedFormResource:=True;
  Application.Scaled:=True;
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

Не думаю, что Project1.lpr вам чем-то поможет.

Сообщение отредактировано: macomics - 15.03.23, 11:18

[RusSun]

Прикреплённый файл2.zip (16,71 Кбайт, скачиваний: 35)

[macomics]

Вот, если поможет

Прикреплённый файлProject1.zip (130,9 Кбайт, скачиваний: 38)

Сообщение отредактировано: macomics - 15.03.23, 11:19

[Feldsher]

ТС должен признаться уже, после такой помощи

[Katerina1993]

macomics, что то нето, я подправила код потому, что не работает, может быть это в более высокой версии работает, но у меня Delphi7. Тут в коде две функции

function dst(X, Y: LongInt): Double;
begin
   dst := sqrt(X * X + Y * Y);
end;

они конфликтуют.
Я не знаю что за процедура

Canvas.Line(balance.Position, points[balance.Link]);

Но у меня её нет.
Поэтому вот так.

 with balance.Position, Canvas do
   begin
     Canvas.MoveTo(X, Y);
     if balance.Link <> -1 then
         Canvas.LineTo(balance.Position.X, points[balance.Link].Y);
     Arc(X - 5, Y - 5, X + 5, Y + 5, 0, 5760,0,5760)
   end;

Линия рисуется как-то странно, вниз. Шарик падает с зависанием. Вот пример кода:

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls;
type
  TPointAim = packed record
    Position: TPoint;
    Pressed: Boolean;
  end;
  TPointLink = packed record
    Position: TPoint;
    Speed: TPoint;
    Accelerarion: TPoint;
    Link: LongInt;
    Rope: LongInt;
  end;
type
  TForm1 = class(TForm)
    Timer1: TTimer;
    procedure FormPaint(Sender: TObject);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; _X, _Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; _X, _Y: Integer);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; _X, _Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
  balance: TPointLink = (Position: (X: 25; Y: 10); Speed: (X: 0; Y: 0); Accelerarion: (X: 0; Y: 98000); Link: -1; Rope: 0);
  points: array [0 .. 3] of TPoint = ((x:80; y:100), (x:150; y:120), (x:200; y:80), (x:250; y:110));
  curpos: TPointAim = (Position: (X: 0; Y: 0); Pressed: False);
  latest: TDateTime;
implementation
 
{$R *.dfm}
function dst(X, Y: LongInt): Double;
begin
   dst := sqrt(X * X + Y * Y);
end;
 
 
procedure TForm1.FormCreate(Sender: TObject);
begin
Randomize;
latest := Now;
end;
 
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; _X, _Y: Integer);
begin
   with curpos.Position do begin
     X := _X;
     Y := _Y;
     curpos.Pressed := True;
   end;
end;
 
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; _X,
  _Y: Integer);
begin
  with curpos.Position do
      if curpos.Pressed then begin
         X := _X;
         Y := _Y;
      end;
end;
 
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; _X, _Y: Integer);
begin
  curpos.Pressed := False;
end;
 
 
procedure TForm1.FormPaint(Sender: TObject);
var
   i, d: LongInt;
   t: TDateTime;
   c: Double;
begin
   t := latest;
   latest := Now;
   t := (latest - t) * 86400;
   for i := Low(points) to High(points) do begin
      Canvas.Arc(points[i].x - 10, points[i].y - 10, points[i].x + 10, points[i].y + 10, points[i].x, points[i].y - 10, points[i].x, points[i].y - 10);
      with curpos.Position do if (curpos.Pressed) and (dst(X - points[i].x, Y - points[i].y) < sqrt(800)) then begin
         Canvas.Arc(points[i].x - 7, points[i].y - 7, points[i].x + 7, points[i].y + 7, points[i].x, points[i].y - 7, points[i].x, points[i].y - 7);
         if (balance.Link = -1) or (balance.Link <> i) then begin
            balance.Link := i;
            balance.Rope := Round(dst(balance.Position.X - points[i].x, balance.Position.Y - points[i].y));
         end;
      end else if not curpos.Pressed then balance.Link := -1;
   end;
   with balance do begin
      inc(Position.X, Round(Speed.X * t + Accelerarion.X * t * t / 2000));
      inc(Position.Y, Round(Speed.Y * t + Accelerarion.Y * t * t / 2000));
      Speed.X := Speed.X + Round(Accelerarion.X * t / 1000);
      Speed.Y := Speed.Y + Round(Accelerarion.Y * t / 1000);
      //inc(Speed.X, Round(Accelerarion.X * t / 1000));
      //inc(Speed.Y, Round(Accelerarion.Y * t / 1000));
// Вот тут я ограничиваю движения объекта границами окна
//-------------------------------------------------------
      if Link <> -1 then begin
         d := Round(dst(points[Link].x - Position.X, points[Link].y - Position.Y));
         if d > Rope then begin
            inc(Position.X, Round((d - Rope) * (points[Link].x - Position.X) / Rope));
            inc(Position.Y, Round((d - Rope) * (points[Link].y - Position.Y) / Rope));
            c := dst(balance.Speed.x, balance.Speed.Y);
            balance.Speed.X := 1000 * Round(balance.Speed.X / c);
            balance.Speed.Y := 1000 * Round(balance.Speed.Y / c);
         end;
      end;
      if Position.X < 6 then begin
         Position.X := 6;
         Speed.X := 0;
         Accelerarion.X := 40000;
         if Position.X < ClientWidth div 2 then
            Accelerarion.Y := Round(Accelerarion.Y + 100000 * Random)
         else
            Accelerarion.Y := Round(Accelerarion.Y - 100000 * Random);
      end;
      if Position.Y < 6 then begin
         Position.Y := 6;
         Speed.Y := 0;
         Accelerarion.Y := 98000;
         if Position.Y < ClientHeight div 2 then
            Accelerarion.X := Round(Accelerarion.X + 25000 * Random)
         else
            Accelerarion.X := Round(Accelerarion.X - 25000 * Random);
      end;
     if Position.X > ClientWidth - 6 then begin
         Position.X := ClientWidth - 6;
         Speed.X := 0;
         Accelerarion.X := -43000;
         if Position.X < ClientWidth div 2 then
            Accelerarion.Y := Round(Accelerarion.Y + 100000 * Random)
         else
            Accelerarion.Y := Round(Accelerarion.Y - 100000 * Random);
      end;
     if Position.Y > ClientHeight - 6 then begin
         Position.Y := ClientHeight - 6;
         Speed.Y := 0;
         Accelerarion.Y := -98000;
         if Position.Y < ClientHeight div 2 then
            Accelerarion.X := Round(Accelerarion.X + 25000 * Random)
         else
            Accelerarion.X := Round(Accelerarion.X - 25000 * Random);
      end;
//-------------------------------------------------------
   end;
   //with balance.Position, Canvas do begin
     // if balance.Link <> -1 then
      //   Canvas.Line(balance.Position, points[balance.Link]);
      //Arc(X - 5, Y - 5, X + 5, Y + 5, X, Y - 5, X, Y - 5);
   //end;
   with balance.Position, Canvas do
   begin
     Canvas.MoveTo(X, Y);
     if balance.Link <> -1 then
         Canvas.LineTo(balance.Position.X, points[balance.Link].Y);
     Arc(X - 5, Y - 5, X + 5, Y + 5, 0, 5760,0,5760)
   end;
end;
 
 
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Repaint;
end;
 
end.

Многие выражения пришлось окружить Round иначе выдает ошибку что требуется целочисленные, а то при расчетах выходят цифры с плавающей точкой.

Сообщение отредактировано: Katerina1993 - 16.03.23, 21:56

[macomics]

Чтобы функции работали вместе в Delphi 7 надо добавить слово overload

function dst(X, Y: LongInt): Double; overload;
begin
   dst := sqrt(X * X + Y * Y);
end;
 
function dst(X, Y: Double): Double; overload;
begin
   dst := sqrt(X * X + Y * Y);
end;

Цитата Katerina1993 @ 16.03.23, 21:54

Линия рисуется как-то странно

Потому что не правильно указали координаты

   with balance.Position, Canvas do begin
      if balance.Link <> -1 then begin
         Canvas.MoveTo(X, Y);
         Canvas.LineTo(points[balance.Link].x, points[balance.Link].y);
      end;
      Arc(X - 5, Y - 5, X + 5, Y + 5, X, Y - 5, X, Y - 5);
   end;

Цитата Katerina1993 @ 16.03.23, 21:54

Многие выражения пришлось окружить Round иначе выдает ошибку что требуется целочисленные, а то при расчетах выходят цифры с плавающей точкой.

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

Шарик пока только зависает на верёвке. Я пока не хочу вспоминать физику с геометрией и вычислять моментальную скорость для получения эффекта маятника. Как будет свободное время, тогда добавлю и эти вычисления к проекту.

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

Сообщение отредактировано: macomics - 16.03.23, 22:50

[macomics]

unit Unit1;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls;
 
type
   TPointFlt = packed record
      X, Y: Double;
   end;
   TPointAim = packed record
      Position: TPoint;
      Pressed: Boolean;
   end;
   TPointLink = packed record
      Position: TPoint;
      Speed: TPointFlt;
      Accelerarion: TPointFlt;
      Link: LongInt;
      Rope: LongInt;
      Cycle: Boolean;
   end;
 
  { TForm1 }
 
  TForm1 = class(TForm)
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; _X, _Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; _X, _Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; _X, _Y: Integer);
    procedure FormPaint(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
 
  public
 
  end;
 
var
  Form1: TForm1;
  balance: TPointLink = (Position: (X: 25; Y: 10); Speed: (X: 0; Y: 0); Accelerarion: (X: 0; Y: 98000); Link: -1; Rope: 0; Cycle: False);
  points: array [0 .. 3] of TPoint = ((x:80; y:100), (x:150; y:120), (x:200; y:80), (x:250; y:110));
  curpos: TPointAim = (Position: (X: 0; Y: 0); Pressed: False);
  latest: TDateTime;
 
implementation
 
{$R *.lfm}
 
{ TForm1 }
 
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Repaint;
end;
 
function dst(X, Y: LongInt): Double; overload;
begin
   dst := sqrt(X * X + Y * Y);
end;
 
function dst(X, Y: Double): Double; overload;
begin
   dst := sqrt(X * X + Y * Y);
end;
 
procedure TForm1.FormPaint(Sender: TObject);
var
   i: LongInt;
   t: TDateTime;
   c: Double;
   u: TPointFlt;
   z, v, w: TPoint;
   s: TColor;
begin
   t := latest;
   latest := Now;
   t := (latest - t) * 86400;
   for i := Low(points) to High(points) do begin
      Canvas.Arc(points[i].x - 10, points[i].y - 10, points[i].x + 10, points[i].y + 10, points[i].x, points[i].y - 10, points[i].x, points[i].y - 10);
      with balance, curpos.Position do if (curpos.Pressed) and (dst(X - points[i].x, Y - points[i].y) < sqrt(800)) then begin
         Canvas.Arc(points[i].x - 7, points[i].y - 7, points[i].x + 7, points[i].y + 7, points[i].x, points[i].y - 7, points[i].x, points[i].y - 7);
         if (Link = -1) or (Link <> i) then begin
            Link := i;
            Rope := Round(dst(Position.X - points[i].x, Position.Y - points[i].y));
         end;
      end else if not curpos.Pressed then balance.Link := -1;
   end;
   with balance do begin
      if Link <> -1 then begin
         u.X := Position.X + t * (Speed.X + t * Accelerarion.X / 2000);
         u.Y := Position.Y + t * (Speed.Y + t * Accelerarion.Y / 2000);
         c := dst(points[Link].x - u.X, points[Link].y - u.Y);
         if (not Cycle) and (c < Rope) then begin
            Position.X := Round(u.X);
            Position.Y := Round(u.Y);
            Speed.X := Speed.X + t * Accelerarion.X / 1000;
            Speed.Y := Speed.Y + t * Accelerarion.Y / 1000;
         end else begin
            Cycle := True;
            if c > Rope then begin
               Position.X := Round(u.X + (c - Rope) * (points[Link].x - Position.X) / Rope);
               Position.Y := Round(u.Y + (c - Rope) * (points[Link].y - Position.Y) / Rope);
            end;
            c := dst(Accelerarion.X / 1000, Accelerarion.Y / 1000);
            u.X := (c / Rope) * (points[Link].x - Position.X) + Accelerarion.X / 1000;
            u.Y := (c / Rope) * (points[Link].y - Position.Y) + Accelerarion.Y / 1000;
            inc(Position.X, Round(t * (Speed.X + t * u.X / 2)));
            inc(Position.Y, Round(t * (Speed.Y + t * u.Y / 2)));
            Speed.X := Speed.X + t * u.X;
            Speed.Y := Speed.Y + t * u.Y;
            z := Point(Round(Position.X + u.X - Accelerarion.X / 1000), Round(Position.Y + u.Y - Accelerarion.Y / 1000));
            v := Point(Round(Position.X + Accelerarion.X / 1000), Round(Position.Y + Accelerarion.Y / 1000));
            w := Point(Round(Position.X + u.X), Round(Position.Y + u.Y));
         end;
      end else begin
         inc(Position.X, Round(t * (Speed.X + t * Accelerarion.X / 2000)));
         inc(Position.Y, Round(t * (Speed.Y + t * Accelerarion.Y / 2000)));
         Speed.X := Speed.X + t * Accelerarion.X / 1000;
         Speed.Y := Speed.Y + t * Accelerarion.Y / 1000;
         Cycle := False;
      end;
      if Position.X < 6 then begin
         Position.X := 6;
         Speed.X := 0;
         Accelerarion.X := 40000;
         if Position.X < ClientWidth div 2 then
            Accelerarion.Y := Accelerarion.Y + 100000 * Random
         else
            Accelerarion.Y := Accelerarion.Y - 100000 * Random;
      end;
      if Position.Y < 6 then begin
         Position.Y := 6;
         Speed.Y := 0;
         Accelerarion.Y := 98000;
         if Position.Y < ClientHeight div 2 then
            Accelerarion.X := Accelerarion.X + 25000 * Random
         else
            Accelerarion.X := Accelerarion.X - 25000 * Random;
      end;
      if Position.X > ClientWidth - 6 then begin
         Position.X := ClientWidth - 6;
         Speed.X := 0;
         Accelerarion.X := -43000;
         if Position.X < ClientWidth div 2 then
            Accelerarion.Y := Accelerarion.Y + 100000 * Random
         else
            Accelerarion.Y := Accelerarion.Y - 100000 * Random;
      end;
      if Position.Y > ClientHeight - 6 then begin
         Position.Y := ClientHeight - 6;
         Speed.Y := 0;
         Accelerarion.Y := -98000;
         if Position.Y < ClientHeight div 2 then
            Accelerarion.X := Accelerarion.X + 25000 * Random
         else
            Accelerarion.X := Accelerarion.X - 25000 * Random;
      end;
   end;
   with balance, balance.Position, Canvas, Canvas.Pen do begin
      if balance.Link <> -1 then begin
         MoveTo(X, Y);
         LineTo(points[balance.Link].x, points[balance.Link].y);
      end;
      Arc(X - 5, Y - 5, X + 5, Y + 5, X, Y - 5, X, Y - 5);
      if Cycle then begin
         s := Color;
         Width := 1;
         Style := psDashDotDot;
         Color := clGreen;
         MoveTo(z.x, z.y);
         LineTo(X, Y);
         Color := clBlue;
         LineTo(v.x, v.y);
         Width := 2;
         Style := psSolid;
         Color := clPurple;
         MoveTo(w.x, w.y);
         LineTo(X, Y);
         Width := 1;
         Color := s;
      end;
   end;
end;
 
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; _X, _Y: Integer);
begin
   with curpos.Position do begin
     X := _X;
     Y := _Y;
     curpos.Pressed := True;
   end;
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
   Randomize;
   latest := Now;
end;
 
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; _X,
  _Y: Integer);
begin
   with curpos.Position do
      if curpos.Pressed then begin
         X := _X;
         Y := _Y;
      end;
end;
 
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; _X, _Y: Integer);
begin
   curpos.Pressed := False;
end;
 
end.

Как то так будет с угловой скоростью. Но чтобы было поавно стоит определить еще и параметры массы.

[RusSun]

В Delphi

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls;
type
   TPointFlt = packed record
      X, Y: Double;
   end;
type
  TPointAim = packed record
    Position: TPoint;
    Pressed: Boolean;
  end;
  TPointLink = packed record
    Position: TPoint;
    Speed: TPoint;
    Accelerarion: TPoint;
    Link: LongInt;
    Rope: LongInt;
    Cycle: Boolean;
  end;
type
  TForm1 = class(TForm)
    Timer1: TTimer;
    procedure FormPaint(Sender: TObject);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; _X, _Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; _X, _Y: Integer);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; _X, _Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
  balance: TPointLink = (Position: (X: 25; Y: 10); Speed: (X: 0; Y: 0); Accelerarion: (X: 0; Y: 98000); Link: -1; Rope: 0);
  points: array [0 .. 3] of TPoint = ((x:80; y:100), (x:150; y:120), (x:200; y:80), (x:250; y:110));
  latest: TDateTime;
  curpos: TPointAim = (Position: (X: 0; Y: 0); Pressed: False);
implementation
 
{$R *.dfm}
function dst(X, Y: LongInt): Double;overload;
begin
   dst := sqrt(X * X + Y * Y);
end;
function dst(X, Y: Double): Double; overload;
begin
   dst := sqrt(X * X + Y * Y);
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
Randomize;
latest := Now;
end;
 
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; _X, _Y: Integer);
begin
  with curpos.Position do begin
     X := _X;
     Y := _Y;
     curpos.Pressed := True;
   end;
end;
 
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; _X,
  _Y: Integer);
begin
  with curpos.Position do
      if curpos.Pressed then begin
         X := _X;
         Y := _Y;
      end;
end;
 
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; _X, _Y: Integer);
begin
  curpos.Pressed := False;
end;
 
 
procedure TForm1.FormPaint(Sender: TObject);
var
   i: LongInt;
   t: TDateTime;
   c: Double;
   u: TPointFlt;
   z, v, w: TPoint;
   s: TColor;
begin
   t := latest;
   latest := Now;
   t := (latest - t) * 86400;
   for i := Low(points) to High(points) do begin
      Canvas.Arc(points[i].x - 10, points[i].y - 10, points[i].x + 10, points[i].y + 10, points[i].x, points[i].y - 10, points[i].x, points[i].y - 10);
      with balance, curpos.Position do if (curpos.Pressed) and (dst(X - points[i].x, Y - points[i].y) < sqrt(800)) then begin
         Canvas.Arc(points[i].x - 7, points[i].y - 7, points[i].x + 7, points[i].y + 7, points[i].x, points[i].y - 7, points[i].x, points[i].y - 7);
         if (Link = -1) or (Link <> i) then begin
            Link := i;
            Rope := Round(dst(Position.X - points[i].x, Position.Y - points[i].y));
         end;
      end else if not curpos.Pressed then balance.Link := -1;
   end;
   with balance do begin
      if Link <> -1 then begin
         u.X := Position.X + t * (Speed.X + t * Accelerarion.X / 2000);
         u.Y := Position.Y + t * (Speed.Y + t * Accelerarion.Y / 2000);
         c := dst(points[Link].x - u.X, points[Link].y - u.Y);
         if (not Cycle) and (c < Rope) then begin
            Position.X := Round(u.X);
            Position.Y := Round(u.Y);
            Speed.X := Round(Speed.X + t * Accelerarion.X / 1000);
            Speed.Y := Round(Speed.Y + t * Accelerarion.Y / 1000);
         end else begin
            Cycle := True;
            if c > Rope then begin
               Position.X := Round(u.X + (c - Rope) * (points[Link].x - Position.X) / Rope);
               Position.Y := Round(u.Y + (c - Rope) * (points[Link].y - Position.Y) / Rope);
            end;
            c := dst(Accelerarion.X / 1000, Accelerarion.Y / 1000);
            u.X := (c / Rope) * (points[Link].x - Position.X) + Accelerarion.X / 1000;
            u.Y := (c / Rope) * (points[Link].y - Position.Y) + Accelerarion.Y / 1000;
            inc(Position.X, Round(t * (Speed.X + t * u.X / 2)));
            inc(Position.Y, Round(t * (Speed.Y + t * u.Y / 2)));
            Speed.X := Round(Speed.X + t * u.X);
            Speed.Y := Round(Speed.Y + t * u.Y);
            z := Point(Round(Position.X + u.X - Accelerarion.X / 1000), Round(Position.Y + u.Y - Accelerarion.Y / 1000));
            v := Point(Round(Position.X + Accelerarion.X / 1000), Round(Position.Y + Accelerarion.Y / 1000));
            w := Point(Round(Position.X + u.X), Round(Position.Y + u.Y));
         end;
      end else begin
         inc(Position.X, Round(t * (Speed.X + t * Accelerarion.X / 2000)));
         inc(Position.Y, Round(t * (Speed.Y + t * Accelerarion.Y / 2000)));
         Speed.X := Round(Speed.X + t * Accelerarion.X / 1000);
         Speed.Y := Round(Speed.Y + t * Accelerarion.Y / 1000);
         Cycle := False;
      end;
      if Position.X < 6 then begin
         Position.X := 6;
         Speed.X := 0;
         Accelerarion.X := 40000;
         if Position.X < ClientWidth div 2 then
            Accelerarion.Y := Round(Accelerarion.Y + 100000 * Random)
         else
            Accelerarion.Y := Round(Accelerarion.Y - 100000 * Random);
      end;
      if Position.Y < 6 then begin
         Position.Y := 6;
         Speed.Y := 0;
         Accelerarion.Y := 98000;
         if Position.Y < ClientHeight div 2 then
            Accelerarion.X := Round(Accelerarion.X + 25000 * Random)
         else
            Accelerarion.X := Round(Accelerarion.X - 25000 * Random);
      end;
      if Position.X > ClientWidth - 6 then begin
         Position.X := ClientWidth - 6;
         Speed.X := 0;
         Accelerarion.X := -43000;
         if Position.X < ClientWidth div 2 then
            Accelerarion.Y := Round(Accelerarion.Y + 100000 * Random)
         else
            Accelerarion.Y := Round(Accelerarion.Y - 100000 * Random);
      end;
      if Position.Y > ClientHeight - 6 then begin
         Position.Y := ClientHeight - 6;
         Speed.Y := 0;
         Accelerarion.Y := -98000;
         if Position.Y < ClientHeight div 2 then
            Accelerarion.X := Round(Accelerarion.X + 25000 * Random)
         else
            Accelerarion.X := Round(Accelerarion.X - 25000 * Random);
      end;
   end;
   with balance, balance.Position, Canvas, Canvas.Pen do begin
      if balance.Link <> -1 then begin
         MoveTo(X, Y);
         LineTo(points[balance.Link].x, points[balance.Link].y);
      end;
      Arc(X - 5, Y - 5, X + 5, Y + 5, X, Y - 5, X, Y - 5);
      if Cycle then begin
         s := Color;
         Width := 1;
         Style := psDashDotDot;
         Color := clGreen;
         MoveTo(z.x, z.y);
         LineTo(X, Y);
         Color := clBlue;
         LineTo(v.x, v.y);
         Width := 2;
         Style := psSolid;
         Color := clPurple;
         MoveTo(w.x, w.y);
         LineTo(X, Y);
         Width := 1;
         Color := s;
      end;
   end;
end;
 
 
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Repaint;
end;
 
end.

[macomics]

Только зачем скорость и ускорение сделали целочисленными? Так они будут работать не плавно. Хотя у ускорения и сохраняется 3 десятичных разрядов в дробной части (у Acceleration везде стоит деление на 1000), но у скорости этого нету.

Изначально у меня эти параметры тоже были целыми, но я изменил их на вещественные. Так стало работать более плавно.

[RusSun]

Цитата macomics @ 30.03.23, 09:16

Только зачем скорость и ускорение сделали целочисленными? Так они будут работать не плавно.

...
  else
            Accelerarion.X := Accelerarion.X - 25000 * Random;
...

[Pascal Error] Unit1.pas(183): E2010 Incompatible types: 'Integer' and 'Extended'
[Pascal Fatal Error] Project1.dpr(5): F2063 Could not compile used unit 'Unit1.pas'

[macomics]

Так Acceleration как раз вещественного типа (Double) должно быть, а не Integer
Я же не написал inc(Acceleration.X, 10000 * Random);

Сообщение отредактировано: macomics - 30.03.23, 13:02

[RusSun]

TPointLink = packed record
    Position: TPoint;
    Speed: TPoint;
    Accelerarion: TPoint;
    Link: LongInt;
    Rope: LongInt;
    Cycle: Boolean;
  end;
type

А Accelerarion: TPoint; Это
А Tpoint в свою очередь -> Описание
Кому лень
|||||||||||||||||
VVVVVVVVVVVVVVVVVV
Там по ссылке это описание
|||||||||||||||||
VVVVVVVVVVVVVVVVVV

TPoint
ТипСодержит целочисленные значения X и YTypes unit
  type TPoint = packed record
   X: Longint;
   Y: Longint;
end;

Поэтому Incompatible types: 'Integer' and 'Extended' тогда вопрос как изменить -> "TPointLink = packed record" чтобы "TPoint;" был -> "Acceleration как раз вещественного типа (Double) должно быть" ?

Сообщение отредактировано: RusSun - 31.03.23, 14:42

[macomics]

Я вам об этом и говорю, зачем вы вместо объявленной у меня структуры TPointFlt

   TPointFlt = packed record
      X, Y: Double;
   end;

изменили её на TPoint. Т.е. изначально это были вещественные значения, а стали целые и вы получили эту самую E2010 Incompatible types: 'Integer' and 'Extended'

[RusSun]

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls;
type
   TPointFlt = packed record
      X, Y: Double;
   end;
   TPointAim = packed record
      Position: TPoint;
      Pressed: Boolean;
   end;
   TPointLink = packed record
      Position: TPoint;
      Speed: TPointFlt;
      Accelerarion: TPointFlt;
      Link: LongInt;
      Rope: LongInt;
      Cycle: Boolean;
   end;
 
  { TForm1 }
 
  TForm1 = class(TForm)
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; _X, _Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; _X, _Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; _X, _Y: Integer);
    procedure FormPaint(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
 
  public
 
  end;
 
var
  Form1: TForm1;
  balance: TPointLink = (Position: (X: 25; Y: 10); Speed: (X: 0; Y: 0); Accelerarion: (X: 0; Y: 98000); Link: -1; Rope: 0; Cycle: False);
  points: array [0 .. 3] of TPoint = ((x:80; y:100), (x:150; y:120), (x:200; y:80), (x:250; y:110));
  curpos: TPointAim = (Position: (X: 0; Y: 0); Pressed: False);
  latest: TDateTime;
 
implementation
 
{$R *.dfm}
 
{ TForm1 }
 
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Repaint;
end;
 
function dst(X, Y: LongInt): Double; overload;
begin
   dst := sqrt(X * X + Y * Y);
end;
 
function dst(X, Y: Double): Double; overload;
begin
   dst := sqrt(X * X + Y * Y);
end;
 
procedure TForm1.FormPaint(Sender: TObject);
var
   i: LongInt;
   t: TDateTime;
   c: Double;
   u: TPointFlt;
   z, v, w: TPoint;
   s: TColor;
begin
   t := latest;
   latest := Now;
   t := (latest - t) * 86400;
   for i := Low(points) to High(points) do begin
      Canvas.Arc(points[i].x - 10, points[i].y - 10, points[i].x + 10, points[i].y + 10, points[i].x, points[i].y - 10, points[i].x, points[i].y - 10);
      with balance, curpos.Position do if (curpos.Pressed) and (dst(X - points[i].x, Y - points[i].y) < sqrt(800)) then begin
         Canvas.Arc(points[i].x - 7, points[i].y - 7, points[i].x + 7, points[i].y + 7, points[i].x, points[i].y - 7, points[i].x, points[i].y - 7);
         if (Link = -1) or (Link <> i) then begin
            Link := i;
            Rope := Round(dst(Position.X - points[i].x, Position.Y - points[i].y));
         end;
      end else if not curpos.Pressed then balance.Link := -1;
   end;
   with balance do begin
      if Link <> -1 then begin
         u.X := Position.X + t * (Speed.X + t * Accelerarion.X / 2000);
         u.Y := Position.Y + t * (Speed.Y + t * Accelerarion.Y / 2000);
         c := dst(points[Link].x - u.X, points[Link].y - u.Y);
         if (not Cycle) and (c < Rope) then begin
            Position.X := Round(u.X);
            Position.Y := Round(u.Y);
            Speed.X := Speed.X + t * Accelerarion.X / 1000;
            Speed.Y := Speed.Y + t * Accelerarion.Y / 1000;
         end else begin
            Cycle := True;
            if c > Rope then begin
               Position.X := Round(u.X + (c - Rope) * (points[Link].x - Position.X) / Rope);
               Position.Y := Round(u.Y + (c - Rope) * (points[Link].y - Position.Y) / Rope);
            end;
            c := dst(Accelerarion.X / 1000, Accelerarion.Y / 1000);
            u.X := (c / Rope) * (points[Link].x - Position.X) + Accelerarion.X / 1000;
            u.Y := (c / Rope) * (points[Link].y - Position.Y) + Accelerarion.Y / 1000;
            inc(Position.X, Round(t * (Speed.X + t * u.X / 2)));
            inc(Position.Y, Round(t * (Speed.Y + t * u.Y / 2)));
            Speed.X := Speed.X + t * u.X;
            Speed.Y := Speed.Y + t * u.Y;
            z := Point(Round(Position.X + u.X - Accelerarion.X / 1000), Round(Position.Y + u.Y - Accelerarion.Y / 1000));
            v := Point(Round(Position.X + Accelerarion.X / 1000), Round(Position.Y + Accelerarion.Y / 1000));
            w := Point(Round(Position.X + u.X), Round(Position.Y + u.Y));
         end;
      end else begin
         inc(Position.X, Round(t * (Speed.X + t * Accelerarion.X / 2000)));
         inc(Position.Y, Round(t * (Speed.Y + t * Accelerarion.Y / 2000)));
         Speed.X := Speed.X + t * Accelerarion.X / 1000;
         Speed.Y := Speed.Y + t * Accelerarion.Y / 1000;
         Cycle := False;
      end;
      if Position.X < 6 then begin
         Position.X := 6;
         Speed.X := 0;
         Accelerarion.X := 40000;
         if Position.X < ClientWidth div 2 then
            Accelerarion.Y := Accelerarion.Y + 100000 * Random
         else
            Accelerarion.Y := Accelerarion.Y - 100000 * Random;
      end;
      if Position.Y < 6 then begin
         Position.Y := 6;
         Speed.Y := 0;
         Accelerarion.Y := 98000;
         if Position.Y < ClientHeight div 2 then
            Accelerarion.X := Accelerarion.X + 25000 * Random
         else
            Accelerarion.X := Accelerarion.X - 25000 * Random;
      end;
      if Position.X > ClientWidth - 6 then begin
         Position.X := ClientWidth - 6;
         Speed.X := 0;
         Accelerarion.X := -43000;
         if Position.X < ClientWidth div 2 then
            Accelerarion.Y := Accelerarion.Y + 100000 * Random
         else
            Accelerarion.Y := Accelerarion.Y - 100000 * Random;
      end;
      if Position.Y > ClientHeight - 6 then begin
         Position.Y := ClientHeight - 6;
         Speed.Y := 0;
         Accelerarion.Y := -98000;
         if Position.Y < ClientHeight div 2 then
            Accelerarion.X := Accelerarion.X + 25000 * Random
         else
            Accelerarion.X := Accelerarion.X - 25000 * Random;
      end;
   end;
   with balance, balance.Position, Canvas, Canvas.Pen do begin
      if balance.Link <> -1 then begin
         MoveTo(X, Y);
         LineTo(points[balance.Link].x, points[balance.Link].y);
      end;
      Arc(X - 5, Y - 5, X + 5, Y + 5, X, Y - 5, X, Y - 5);
      if Cycle then begin
         s := Color;
         Width := 1;
         Style := psDashDotDot;
         Color := clGreen;
         MoveTo(z.x, z.y);
         LineTo(X, Y);
         Color := clBlue;
         LineTo(v.x, v.y);
         Width := 2;
         Style := psSolid;
         Color := clPurple;
         MoveTo(w.x, w.y);
         LineTo(X, Y);
         Width := 1;
         Color := s;
      end;
   end;
end;
 
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; _X, _Y: Integer);
begin
   with curpos.Position do begin
     X := _X;
     Y := _Y;
     curpos.Pressed := True;
   end;
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
   Randomize;
   latest := Now;
end;
 
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; _X,
  _Y: Integer);
begin
   with curpos.Position do
      if curpos.Pressed then begin
         X := _X;
         Y := _Y;
      end;
end;
 
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; _X, _Y: Integer);
begin
   curpos.Pressed := False;
end;
 
end.