Форум на Исходниках.RU https://forum.sources.ru Форум на Исходниках.RU Форум на Исходниках.RU https://forum.sources.ru/index.php?showtopic=433590&view=findpost&p=3888947 Fri, 31 Mar 2023 17:22:18 +0000 Как сделать подъем круга по линии учитывая движение самого круга в пространстве? https://forum.sources.ru/index.php?showtopic=433590&view=findpost&p=3888947
    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.
]]> RusSun Delphi: Общие вопросы https://forum.sources.ru/index.php?showtopic=433590&view=findpost&p=3888940 Fri, 31 Mar 2023 14:55:36 +0000 Как сделать подъем круга по линии учитывая движение самого круга в пространстве? https://forum.sources.ru/index.php?showtopic=433590&view=findpost&p=3888940
       TPointFlt = packed record
          X, Y: Double;
       end;
изменили её на TPoint. Т.е. изначально это были вещественные значения, а стали целые и вы получили эту самую E2010 Incompatible types: 'Integer' and 'Extended']]> macomics Delphi: Общие вопросы https://forum.sources.ru/index.php?showtopic=433590&view=findpost&p=3888937 Fri, 31 Mar 2023 14:40:39 +0000 Как сделать подъем круга по линии учитывая движение самого круга в пространстве? https://forum.sources.ru/index.php?showtopic=433590&view=findpost&p=3888937
    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) должно быть" ? :oops:]]> RusSun Delphi: Общие вопросы https://forum.sources.ru/index.php?showtopic=433590&view=findpost&p=3888866 Thu, 30 Mar 2023 13:01:02 +0000 Как сделать подъем круга по линии учитывая движение самого круга в пространстве? https://forum.sources.ru/index.php?showtopic=433590&view=findpost&p=3888866 Я же не написал inc(Acceleration.X, 10000 * Random);]]> macomics Delphi: Общие вопросы https://forum.sources.ru/index.php?showtopic=433590&view=findpost&p=3888865 Thu, 30 Mar 2023 12:57:41 +0000 Как сделать подъем круга по линии учитывая движение самого круга в пространстве? https://forum.sources.ru/index.php?showtopic=433590&view=findpost&p=3888865 Цитата macomics @
Только зачем скорость и ускорение сделали целочисленными? Так они будут работать не плавно.


    ...
      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']]> RusSun Delphi: Общие вопросы https://forum.sources.ru/index.php?showtopic=433590&view=findpost&p=3888847 Thu, 30 Mar 2023 09:16:36 +0000 Как сделать подъем круга по линии учитывая движение самого круга в пространстве? https://forum.sources.ru/index.php?showtopic=433590&view=findpost&p=3888847
Изначально у меня эти параметры тоже были целыми, но я изменил их на вещественные. Так стало работать более плавно.]]> macomics Delphi: Общие вопросы https://forum.sources.ru/index.php?showtopic=433590&view=findpost&p=3888837 Thu, 30 Mar 2023 01:37:27 +0000 Как сделать подъем круга по линии учитывая движение самого круга в пространстве? https://forum.sources.ru/index.php?showtopic=433590&view=findpost&p=3888837
    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.
]]> RusSun Delphi: Общие вопросы https://forum.sources.ru/index.php?showtopic=433590&view=findpost&p=3888651 Mon, 27 Mar 2023 12:06:06 +0000 Как сделать подъем круга по линии учитывая движение самого круга в пространстве? https://forum.sources.ru/index.php?showtopic=433590&view=findpost&p=3888651
    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.
Как то так будет с угловой скоростью. Но чтобы было поавно стоит определить еще и параметры массы.]]> macomics Delphi: Общие вопросы https://forum.sources.ru/index.php?showtopic=433590&view=findpost&p=3888048 Thu, 16 Mar 2023 22:44:36 +0000 Как сделать подъем круга по линии учитывая движение самого круга в пространстве? https://forum.sources.ru/index.php?showtopic=433590&view=findpost&p=3888048 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 @
Линия рисуется как-то странно

Потому что не правильно указали координаты
       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 @
Многие выражения пришлось окружить Round иначе выдает ошибку что требуется целочисленные, а то при расчетах выходят цифры с плавающей точкой.

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

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

Замечу вот что. Сейчас шарик, когда повис на верёвке, все равно продолжает набирать скорость. Вот это надо будет перевести в моментальное ускорение и он будет болтаться на верёвке изображая маятник (с вектором покоя совпадающим с вектором ускорения).]]> macomics Delphi: Общие вопросы https://forum.sources.ru/index.php?showtopic=433590&view=findpost&p=3888047 Thu, 16 Mar 2023 21:54:23 +0000 Как сделать подъем круга по линии учитывая движение самого круга в пространстве? https://forum.sources.ru/index.php?showtopic=433590&view=findpost&p=3888047 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 Delphi: Общие вопросы https://forum.sources.ru/index.php?showtopic=433590&view=findpost&p=3887934 Thu, 16 Mar 2023 00:27:08 +0000 Как сделать подъем круга по линии учитывая движение самого круга в пространстве? https://forum.sources.ru/index.php?showtopic=433590&view=findpost&p=3887934 Feldsher Delphi: Общие вопросы https://forum.sources.ru/index.php?showtopic=433590&view=findpost&p=3887869 Wed, 15 Mar 2023 11:15:01 +0000 Как сделать подъем круга по линии учитывая движение самого круга в пространстве? https://forum.sources.ru/index.php?showtopic=433590&view=findpost&p=3887869
Project1.zip (, : 80) ]]> macomics Delphi: Общие вопросы https://forum.sources.ru/index.php?showtopic=433590&view=findpost&p=3887865 Wed, 15 Mar 2023 10:56:21 +0000 Как сделать подъем круга по линии учитывая движение самого круга в пространстве? https://forum.sources.ru/index.php?showtopic=433590&view=findpost&p=3887865 2.zip (, : 82) ]]> RusSun Delphi: Общие вопросы https://forum.sources.ru/index.php?showtopic=433590&view=findpost&p=3887862 Wed, 15 Mar 2023 10:36:18 +0000 Как сделать подъем круга по линии учитывая движение самого круга в пространстве? https://forum.sources.ru/index.php?showtopic=433590&view=findpost&p=3887862 Цитата RusSun @
Там 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.
Но я не делал еще расчет угловых скоростей

Добавлено
Цитата ^D^ima @
Прикрепите пожалуйста файл проекта целиком, :thanks:

Какой файл проекта. Весь проект из одного модуля.
    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 Delphi: Общие вопросы https://forum.sources.ru/index.php?showtopic=433590&view=findpost&p=3887853 Wed, 15 Mar 2023 08:24:16 +0000 Как сделать подъем круга по линии учитывая движение самого круга в пространстве? https://forum.sources.ru/index.php?showtopic=433590&view=findpost&p=3887853 ^D^ima Delphi: Общие вопросы https://forum.sources.ru/index.php?showtopic=433590&view=findpost&p=3887839 Wed, 15 Mar 2023 04:42:00 +0000 Как сделать подъем круга по линии учитывая движение самого круга в пространстве? https://forum.sources.ru/index.php?showtopic=433590&view=findpost&p=3887839 То есть без картинки как у тебя это работает в Lasar'e - не понятно)) Без намёка. Просто как есть.
Там arc немного отличается поэтому добавил два параметра в delphi 8мь параметров в Lasar'e arc c 6тью параметрами.
Без притензии. :thanks:

    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 Delphi: Общие вопросы https://forum.sources.ru/index.php?showtopic=433590&view=findpost&p=3887826 Tue, 14 Mar 2023 15:41:12 +0000 Как сделать подъем круга по линии учитывая движение самого круга в пространстве? https://forum.sources.ru/index.php?showtopic=433590&view=findpost&p=3887826
    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.
Напечатал эту программу и завис наблюдая за объектом. Анимация опасная штука. Чуть позже, как будет время, добавлю зацепку к объектам и эффект маятника при раскачивании на верёвке.]]> macomics Delphi: Общие вопросы https://forum.sources.ru/index.php?showtopic=433590&view=findpost&p=3887810 Tue, 14 Mar 2023 13:23:07 +0000 Как сделать подъем круга по линии учитывая движение самого круга в пространстве? https://forum.sources.ru/index.php?showtopic=433590&view=findpost&p=3887810 user posted image
Если объект находится слишком низко, то при нажатии кнопки он подымается как на пружине резко вверх пример во второй анимации.
user posted image

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

Код я перенесла в 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.
]]> Katerina1993 Delphi: Общие вопросы https://forum.sources.ru/index.php?showtopic=433590&view=findpost&p=3887595 Sat, 11 Mar 2023 16:41:25 +0000 Как сделать подъем круга по линии учитывая движение самого круга в пространстве? https://forum.sources.ru/index.php?showtopic=433590&view=findpost&p=3887595
    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 Delphi: Общие вопросы https://forum.sources.ru/index.php?showtopic=433590&view=findpost&p=3887589 Sat, 11 Mar 2023 13:00:21 +0000 Как сделать подъем круга по линии учитывая движение самого круга в пространстве? https://forum.sources.ru/index.php?showtopic=433590&view=findpost&p=3887589 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.
]]> Katerina1993 Delphi: Общие вопросы https://forum.sources.ru/index.php?showtopic=433590&view=findpost&p=3887577 Sat, 11 Mar 2023 08:57:29 +0000 Как сделать подъем круга по линии учитывая движение самого круга в пространстве? https://forum.sources.ru/index.php?showtopic=433590&view=findpost&p=3887577
Включите 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 Delphi: Общие вопросы https://forum.sources.ru/index.php?showtopic=433590&view=findpost&p=3887574 Sat, 11 Mar 2023 05:32:00 +0000 Как сделать подъем круга по линии учитывая движение самого круга в пространстве? https://forum.sources.ru/index.php?showtopic=433590&view=findpost&p=3887574 Feldsher Delphi: Общие вопросы https://forum.sources.ru/index.php?showtopic=433590&view=findpost&p=3887567 Fri, 10 Mar 2023 22:30:51 +0000 Как сделать подъем круга по линии учитывая движение самого круга в пространстве? https://forum.sources.ru/index.php?showtopic=433590&view=findpost&p=3887567 (Немножко мигает).
user posted image
Мне нужно чтобы при нажатии кнопки на клавиатуре вверх(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 Delphi: Общие вопросы