1

Я написала код, который на форме рисует треугольничек Серпинского в полярной и декартовой системе. Хотела ещё сделать анимацию кругляшка или квадратика, который будет бегать по внешнему треугольничку. Просто по кругу, от одной точки к другой. Как это лучше всего будет сделать?

Я всё рисую на Канвасе в самой форме на ивенте OnPaint Вот весь код:

unit Unit3;
interface
uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs;

type
  TPolar = class(TForm)
    procedure FormPaint(Sender: TObject);
    procedure FormResize(Sender: TObject);
  end;

var
  Polar: TPolar;

implementation

{$R *.dfm}

Uses Unit1, Unit2;

procedure Serp(aCanvas :TCanvas; A, B, C :TPoint; n :integer);
  var x1, x2, x3, y1, y2, y3: real;
  begin
    aCanvas.MoveTo(A.X, A.Y);
    aCanvas.LineTo(B.X, B.Y);
    aCanvas.LineTo(C.X, C.Y);
    aCanvas.LineTo(A.X, A.Y);
    if n > 0 then
    begin
      Serp(aCanvas, A, Point((A.X + B.X) div 2, (A.Y + B.Y) div 2), Point((A.X + C.X) div 2, (A.Y + C.Y) div 2), n-1);
      Serp(aCanvas, B, Point((B.X + C.X) div 2, (B.Y + C.Y) div 2), Point((B.X + A.X) div 2, (B.Y + A.Y) div 2), n-1);
      Serp(aCanvas, C, Point((C.X + A.X) div 2, (C.Y + A.Y)div 2), Point((C.X + B.X) div 2, (C.Y + B.Y) div 2), n-1);
    end;

  end;

procedure TPolar.FormPaint(Sender: TObject);
  var
  A, B, C :TPoint;
  Scale :Integer;
  Ratio :integer;
  towhat :integer;
  i :integer;
  MaxPoint :integer;
  MaxPointX :integer;

begin
  Scale := 40;
  Ratio := (ClientWidth + ClientHeight) div Scale;
  //showmessage(IntToStr(Ratio));

  //Очистка экрана
  Canvas.Brush.Color := clWhite;
  Canvas.FillRect(ClientRect);

  Canvas.Brush.Color := clNavy;
  var P := ClientRect.CenterPoint;

  A.X := StrToInt(MainForm.EditAx.Text) * Ratio;
  A.Y := - StrToInt(MainForm.EditAy.Text) * Ratio;
  B.X := StrToInt(MainForm.EditBx.Text) * Ratio;
  B.Y := - StrToInt(MainForm.EditBy.Text) * Ratio;
  C.X := StrToInt(MainForm.EditCx.Text) * Ratio;
  C.Y := - StrToInt(MainForm.EditCy.Text) * Ratio;

  A := (A+P); B := B+P; C := C+P;

  var MaxX, MaxY, MinX, MinY :TPoint;

  MaxX.X := ClientWidth; MaxX.Y := P.Y;
  MinX.X := -ClientWidth; MaxX.Y := P.Y;
  MaxY.X := P.X; MaxY.Y := -ClientHeight;
  MinY.X := P.X; MinY.Y := ClientHeight;

  // рисуем нулевой луч
  with Polar.Canvas do
  begin

    Pen.Width := 3;
    MoveTo(P.X, P.Y);
    LineTo(MaxX.X, P.Y);
    MoveTo(P.X, P.Y);
    LineTo(P.X, MaxY.Y);
    MoveTo(P.X, P.Y);
    LineTo(P.X, MinY.Y);
    MoveTo(P.X, P.Y);
    LineTo(MinX.X, P.Y);

    if A.X > B.X then
    begin
      if A.X > C.X then
      begin
        towhat := A.X;
        MaxPoint := 1;
      end

      else begin
        towhat := C.X;
        MaxPoint := 3;
      end;

    end
    else
    begin
      if B.X > C.X then begin
        towhat := B.X;
        MaxPoint := 2;
      end
        else begin
        towhat := C.X;
        MaxPoint := 3;
        end;
    end;

    towhat := (towhat - P.X) div ratio;

    //рисуем круги радиуса r(i)
    for i := 1 to towhat do
    begin
      Pen.Width := 1;
      Brush.Style := bsClear;
      Ellipse(P.X - Ratio * i, P.Y - Ratio * i, P.X + Ratio * i, P.Y + Ratio * i);

    end;
  end;


  //рисуем градусные линии

  case MaxPoint of
    1 : MaxPointX := (P.X - A.X) div Ratio;
    2 : MaxPointX := (P.X - B.X) div Ratio;
    3 : MaxPointX := (P.X - C.X) div Ratio;
  end;

  for i := 0 to 11 do
  begin
    Polar.Canvas.MoveTo(P.X, P.Y);
    Polar.Canvas.LineTo(P.X + Round(Ratio * MaxPointX * -Cos(i*2*Pi/12)), P.Y - Round( Ratio * MaxPointX * -Sin(i*2*Pi/12)));
    Polar.Canvas.TextOut(Canvas.PenPos.X, Canvas.PenPos.Y, ' ' + intToStr(30 * i));

  end;

  //треугольничек

  Serp(Polar.Canvas, A, B, C, 3);

  // анимация


end;

procedure TPolar.FormResize(Sender: TObject);
begin
  Invalidate;
end;

end.

1 ответ 1

1

Для того, чтобы видеть анимацию, нужно завести TTimer, и из его события OnTimer вызывать перерисовку (как у вас Invalidate из Resize).

Заведите глобальный счётчик (Integer поле формы).По таймеру (с периодом не менее 20-50 мс) перед Invalidate увеличиваете его. В OnPaint рисуете треугольник Серпинского, затем отрисовываете кружок на внешнем периметре, определяя его позицию по счётчику. Например, пусть счётчик Cnt меняется от 0 до 59. Тогда сторону треугольника определяете как Cnt div 20, а позицию на стороне как Cnt mod 20.

procedure Timer1.Timer(Sender);
begin
  Cnt := (Cnt + 1) mod 60;
  Invalidate;
end;

procedure FormPaint();

//всё, что было

case Cnt div 20:
  0: begin P0 := A; P1 :=  B; end;
  1: begin P0 := B; P1 :=  C; end;
  2: begin P0 := C; P1 :=  A; end;
end;
 
t := Cnt mod 20;
cx := (P0.X * (20 - t) + P1.X * t) div 20;
cy := (P0.Y * (20 - t) + P1.Y * t) div 20;
//отрисовка кружка в позиции cx, cy

Возможный вариант для того случая, если хочется видеть промежуточные этапы: при рисовании считаете количество нарисованных треугольников или линий. Как дошли до значения счётчика - в текущей позиции нарисовали кружочек, прекратили рекурсию. Через некоторое время обнулили счётчик.

Хорошо ли это будет смотреться для Серпинского - не знаю.

7
  • @Kromster Этот момент мне не вполне понятен был. Просто бегание по периметру внешнего тр-ка несложно сделать, но что это будет демонстрировать?
    – MBo
    12 июл 2022 в 6:15
  • "но что это будет демонстрировать?" - глубоко копаете, это же скорее всего просто учебное задание ))
    – Kromster
    12 июл 2022 в 6:16
  • ОК, попробую такой вариант добавить ;)
    – MBo
    12 июл 2022 в 6:17
  • задание учебное, так точно. А анимацию по периметру внешнего треугольника я хочу сделать, потому что мне надо просто сделать какую-нибудь анимацию, чтобы была, воот. я пыталась сделать через таймер и всё такое, но он просто линию мне рисовал. а про серпинского и всё остальное я написала так, для полноты картины, не знаю, вдруг от этого что-то меняется
    – rawhu
    12 июл 2022 в 6:24
  • @rawhu ОК, предложил, как по периметру бегать.
    – MBo
    12 июл 2022 в 6:27

Ваш ответ

By clicking “Отправить ответ”, you agree to our terms of service and acknowledge you have read our privacy policy.

Всё ещё ищете ответ? Посмотрите другие вопросы с метками или задайте свой вопрос.