Текущий архив: 2009.01.04;
Скачать: CL | DM;

Вниз

Как нарисовать спираль Fermat с отрисовкой в писелах?   Найти похожие ветки 

← →
Dr. Andrew   (2007-08-26 15:02) [0]

Добрый день! Мастера подскажите как нарисовать спираль Fermat с отрисовкой в писелах? Что-то вроде этого:

procedure CreateSpiral(FWidth, FHeight : Integer; Rotangle : Double);
     var X, Y, Ox, Oy : Integer;
         Theta, Dist : Double;
         clr : Byte;
         temp : Double;
begin
 // here there will be a centre!
 Ox := MulDiv(FWidth,  1, 2);
 Oy := MulDiv(FHeight, 1, 2);
 Theta := 0;
 for Y := 0 to Pred(FHeight) do
 begin
   for X := 0 to Pred(FWidth) do
   begin
      Dist := Sqrt(Sqr(X - Ox) + Sqr(Y - Oy));
      Theta := -ArcTan2(y - Oy, x - Ox) + Rotangle;
      temp := Theta + Dist;
      clr  := 255*Sign(Sin(temp));
      if clr <> 255 then
        если не равно белому цвету, то заполнять пикселами переднего плана (например, clBlue);
   end;
 end;
end;

---

← →
MBo ©   (2007-08-26 15:33) [1]


procedure TForm1.Button2Click(Sender: TObject);
var
 i, x, y, cx, cy, MaxR: Integer;
 a, theta, R: Double;
begin
  a := 20;
  cx := 200;
  cy := 200;
  maxR := 200;
  i := 0;
  repeat
    theta := i * 0.2 /(2 * pi);
    R := a * Sqrt(theta);
    if R > MaxR then
      Break;
    x := cx + Round(R * Cos(theta));
    y := cy + Round(R * Sin(theta));
    Canvas.Pixels[x, y] := clBlack;
    Inc(i);
  until False;
end;


---

← →
Dr. Andrew   (2007-08-26 15:38) [2]

Спасибо за пример, но а если все же ближе к моему коду как можно изменить код MBo?

---

← →
Dr. Andrew   (2007-08-26 15:38) [3]

с отрисовкой поп пикселам.

---

← →
MBo ©   (2007-08-26 16:03) [4]

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

---

← →
Dr. Andrew   (2007-08-26 16:08) [5]

Необходимость в том, чтобы ускорить отрисовку и сделать листья спирали (или лист спирали) с изменяемой шириной, а не просто линией или в виде отдельных пикселей. Все как можно приблизить код к моему примеру? Спасибо!

---

← →
Dr. Andrew   (2007-08-26 16:13) [6]

И еще - это R := a*Power(theta, 1/2) или R := a*Sqrt(theta) - спираль Ферма, R :=theta - это спираль Архимеда, а так R := a*1/Sqrt(theta) должна бы быть спираль Lituus, но выпадает постоянно ошибка неверного деления на ноль. Почему?

---

← →
MBo ©   (2007-08-26 16:19) [7]

>*1/Sqrt(theta) должна бы быть спираль Lituus, но выпадает постоянно ошибка неверного деления на ноль. Почему?

проверяй, что theta не равно нулю (лучше - не меньше некой константы, скажем, 10e-3

---

← →
Dr. Andrew   (2007-08-26 17:09) [8]

1) все же остается необходимость в том, чтобы ускорить отрисовку и сделать листья спирали (или лист спирали) с изменяемой шириной, а не просто линией или в виде отдельных пикселей. Все как можно приблизить код к моему примеру?
2) проверка theta на 0 или  10e-3:
if theta > 0 или 10e-3 then
 R := a * 1/Sqrt(theta)
все равно вызывает прежнюю ошибку.

Спасибо!

---

← →
исследователь ©   (2007-08-27 08:58) [9]

пиши лог, можно будет посмотреть, где падает, или юзай средства Delphi

---

← →
Dr. Andrew   (2007-08-27 09:52) [10]

Доброе утро! Мастера, пожалуйста, подскажите, как все же соединить коды двух вариантов? Пример который привел Mbo работает отлично, но мне нужна конструкция именно такая (пока она строит спираль Архимеда, а мне нужны другие типы, например Ферат или Галилея):

procedure CreateSpiral(FWidth, FHeight : Integer; Rotangle : Double);
    var X, Y, Ox, Oy : Integer;
        Theta, Dist : Double;
        clr : Byte;
        temp : Double;
begin
// here there will be a centre!
Ox := MulDiv(FWidth,  1, 2);
Oy := MulDiv(FHeight, 1, 2);
Theta := 0;
for Y := 0 to Pred(FHeight) do
begin
  for X := 0 to Pred(FWidth) do
  begin
     Dist := Sqrt(Sqr(X - Ox) + Sqr(Y - Oy));
     Theta := -ArcTan2(y - Oy, x - Ox) + Rotangle;
     temp := Theta + Dist;
     clr  := 255*Sign(Sin(temp));
     if clr <> 255 then
       если не равно белому цвету, то заполнять пикселами переднего плана (например, clBlue);
  end;
end;
end;

Как можно код ниже модернизировать под мою конструкцию?

procedure TForm1.Button2Click(Sender: TObject);
var
i, x, y, cx, cy, MaxR: Integer;
a, theta, R: Double;
begin
 a := 20;
 cx := 200;
 cy := 200;
 maxR := 200;
 i := 0;
 repeat
   theta := i * 0.2 /(2 * pi);
   R := a * Sqrt(theta);
   if R > MaxR then
     Break;
   x := cx + Round(R * Cos(theta));
   y := cy + Round(R * Sin(theta));
   Canvas.Pixels[x, y] := clBlack;
   Inc(i);
 until False;
end;

Все спасибо за практический совет!

---

← →
Dr. Andrew   (2007-08-28 12:44) [11]

Уважаемые мастера, может все же кто-то может подсказать хоть какую строчку надо менять в коде Вариант №1, чтобы он строил спираль Фермат? Всем спасибо!

---

← →
Jeer ©   (2007-08-28 14:00) [12]

> Dr. Andrew   (28.08.07 12:44) [11]



> хоть какую строчку надо менять


17-ю извилину.

Начни думать, разбираться и все получится.

---

← →
Dr. Andrew   (2007-08-28 15:18) [13]

Спасибо за совет, если бы не думал и не разбирался, то не написал бы первый код. Но, в в том-то и дело что столкнулся с проблемой и поэтому обратился к более знающим Мастерам.

---

← →
sdubaruhnul   (2007-08-29 22:08) [14]


procedure TformMain.btnDrawClick(Sender: TObject);
var
 Centre: TPoint;
 SpiralWidth, SpiralHeight: Integer;
var
 x, y: Integer;
 angle: Extended;
 a2, r2, delta: Extended;
 ARect: TRect;
begin
 Centre := Point(ClientWidth div 2, ClientHeight div 2);
 SpiralWidth := 400;  SpiralHeight := 300;

 ARect := Rect(Centre.x - SpiralWidth div 2, Centre.y - SpiralHeight div 2,
     Centre.x + SpiralWidth div 2, Centre.y + SpiralHeight div 2);

 Canvas.DrawFocusRect(ARect);

 // Угол считается против часовой стрелки (глядя на экран).
 // Координатная ось x совпадает с углом 0°.

 // r^2 = ± a^2 * angle

 a2 := sqr(40); // уже в квадрате
 delta := 0.03;

 for y := ARect.Top to ARect.Bottom do
   for x := ARect.Left to ARect.Right do
     begin
       angle := ArcTan2(Centre.y - y, x - Centre.x);
       { if ((x = Centre.X+50) and (y = Centre.Y-50)) then
         Caption := FloatToStr(angle); }
       if (angle < 0) then angle := angle + 2 * pi;

       // Полученный угол обобщается до angle + (2 * pi * n),
       // где n должно быть натуральным, что мы и проверяем.

       r2 := sqr(x - Centre.x) + sqr(Centre.y - y);

       delta := sqrt(r2) * 0.0002 + 0.01;

       // Чем ближе к центру, тем большая точная нужна.
       // Поэтому delta пропорциональная расстоянию sqrt(r2).

       if (frac(abs((r2 / a2 - angle) / (2 * pi))) < delta) then
         begin
           // Положительная часть
           Canvas.Pixels[x,y] := clBlack;
           // Отрицательная часть
           Canvas.Pixels[Centre.x - (x - Centre.x),
             Centre.y - (y - Centre.y)] := clBlack;
         end;
     end;
end;

procedure TformMain.btnDraw2Click(Sender: TObject);
var
i, x, y, cx, cy, MaxR: Integer;
a, theta, R: Double;
begin
 a := 40;
 cx := ClientWidth div 2;
 cy := ClientHeight div 2;
 maxR := 200;
 i := 0;
 repeat
   theta := i * 0.1 /(2 * pi);
   R := a * Sqrt(theta);
   if R > MaxR then Break;
   // Положительная часть
   x := cx - Round(R * Cos(theta));
   y := cy + Round(R * Sin(theta));
   Canvas.Pixels[x, y] := clSilver;
   // Отрицательная часть
   x := cx + Round(R * Cos(theta));
   y := cy - Round(R * Sin(theta));
   Canvas.Pixels[x, y] := clSilver;
   Inc(i);
 until False;
end;


2 способа, можешь сравнить.

---

← →
Dr. Andrew   (2007-08-30 07:07) [15]

Спасибо, sdubaruhnul! Первая процедура очень близка к моему первому варианту. Вы настоящий Мастер! Спасибо! Можно ли продолжить дискуссию с Вами? Меня интресует вот еще какие вопросы:

1) как сделать прорисовку с использованием ScanLine и сделать ширину витков регулируемой? Чтобы строилась спираль не сплошной линией в 1 пиксель, а в виде ленты, закручивающейся по спирали Фермат.
2) И еще, это (первый вариант) можно считать базовым? Как можно, например, из него нарисовать прочие спирали - например спираль Галилея?

Спасибо и жду продолжения дискуссии.

---

← →
Dr. Andrew   (2007-08-30 08:14) [16]

Спасибо, sdubaruhnul! Спасибо протестировал - первый вариант (btnDrawClick) то, что нужно, только почему-то первый виток рисуется утолщенным в два раза. Как это исправить? Где погрешность или ошибка в коде?

---

← →
sdubaruhnul   (2007-08-30 15:40) [17]

>Dr. Andrew   (30.08.07 07:07) [15], [16]

Этот вариант сложно считать базовым, потому что естественная форма задания спиралей - в полярных координатах. В этих координатах спираль задаётся функцией - каждому углу Theta ставится в соответствие одно значение радиуса r (в случае ± разбиваем на две функции). И когда я говорю функция, подразумеваю явную функцию, заданную формулой, которую только и надо, что вычислить.

В декартовой системе координат спираль задаётся уравнением, которое редко когда имеет приличную форму и которое надо заранее расчитать. Попробуй, например, вывести уравнение той же спирали Ферма.

В моём варианте кода приходится переводить из декартовой в полярную, а однозначно перевести угол невозможно, только в общей форме (логично, что 0° это и 360° и 720° и т.д). Отсюда дополнительные сложности.

В общем, если считать базовым такой вариант, в котором ты изменяешь всего одну строчку - формулу спирали, то нет, это не базовый вариант.

Утолщённую линию не знаю точно как поправить, нужно варьировать коэффициенты в формуле: delta := sqrt(r2) * 0.0002 + 0.01;

Другой способ - поменять систему проверки, а именно проверять в цикле все возможные углы:


procedure TformMain.btnDraw3Click(Sender: TObject);
var
 Centre: TPoint;
 SpiralWidth, SpiralHeight: Integer;
var
 x, y: Integer;
 angle, max_angle: Extended;
 a2, r2, delta: Extended;
 ARect: TRect;
begin
 Centre := Point(ClientWidth div 2, ClientHeight div 2);
 SpiralWidth := 400;  SpiralHeight := 300;

 ARect := Rect(Centre.x - SpiralWidth div 2, Centre.y - SpiralHeight div 2,
     Centre.x + SpiralWidth div 2, Centre.y + SpiralHeight div 2);

 Canvas.DrawFocusRect(ARect);

 // Угол считается против часовой стрелки (глядя на экран).
 // Координатная ось x совпадает с углом 0°.

 // r^2 = ± a^2 * angle

 a2 := sqr(40); // уже в квадрате
 delta := 0.7;

 max_angle := (sqr(SpiralWidth div 2) + sqr(SpiralWidth div 2)) / a2;

 for y := ARect.Top to ARect.Bottom do
   for x := ARect.Left to ARect.Right do
     begin
       angle := ArcTan2(Centre.y - y, x - Centre.x);
       if (angle < 0) then angle := angle + 2 * pi;

       r2 := sqr(x - Centre.x) + sqr(Centre.y - y);

       while (angle <= max_angle) do
         begin
         if (abs(sqrt(a2 * angle) - sqrt(r2)) < delta) then
             begin
               // Положительная часть
               Canvas.Pixels[x,y] := clBlack;
               // Отрицательная часть
               Canvas.Pixels[Centre.x - (x - Centre.x),
                 Centre.y - (y - Centre.y)] := clBlack;
             end;
           angle := angle + 2 * pi;
         end;
     end;
end;


Теперь delta - это погрешность расстояния пиксела до идеальной линии спирали. Варьируя delta можно изменять толщину линии.

---

← →
Dr. Andrew   (2007-08-30 16:11) [18]

Спасибо обязательно протестирую. Пожалуйста, останьтесь в диалоге со-мной, хотя бы по емайл (мой teachsoft@kharkov.ukrtel.net). Вы единственный кто так отлично разбирается в этих спиралях здесь. Спасибо!

---

← →
Dr. Andrew   (2007-08-31 08:21) [19]

Доброе утро, sdubaruhnul! Можете еще помочь со спиралью Галилея (r = a*(1 - m*θ^2)) и  Poinsot (r=sech(θ/3))? Спасибо.

---

← →
sdubaruhnul   (2007-09-03 22:58) [20]


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

type
 TDrawType = (dtMaxRadius, dtMaxAngle);

type
 TformMain = class(TForm)
   btnDraw1: TButton;
   btnDraw2: TButton;
   rbArchimedes: TRadioButton;
   rbFermat: TRadioButton;
   rbGalilei: TRadioButton;
   rbPoinsot: TRadioButton;
   editCoeff: TEdit;
   procedure btnDraw1Click(Sender: TObject);
   procedure btnDraw2Click(Sender: TObject);
   procedure rbArchimedesClick(Sender: TObject);
   procedure rbFermatClick(Sender: TObject);
   procedure rbGalileiClick(Sender: TObject);
   procedure rbPoinsotClick(Sender: TObject);
   procedure FormCreate(Sender: TObject);
 private
   HowToDraw: TDrawType; // for plotting by angle only  
 end;

function RoArchimedes(A, Theta: Extended): Extended;
function RoFermat(A, Theta: Extended): Extended;
function RoGalilei(A, Theta: Extended): Extended;
function RoPoinsot(A, Theta: Extended): Extended;

var
 formMain: TformMain;
 Ro: function (A, Theta: Extended): Extended;

implementation

{$R *.dfm}

function RoArchimedes(A, Theta: Extended): Extended;
begin
 Result := A * Theta;
end;

function RoFermat(A, Theta: Extended): Extended;
begin
 Result := A * Power(Theta, 1/2);
end;

function RoGalilei(A, Theta: Extended): Extended;
begin
 Result := A * (1 - sqr(Theta));
end;

function RoPoinsot(A, Theta: Extended): Extended;
begin
 Result := A * SecH(Theta/3);
end;

procedure TformMain.btnDraw1Click(Sender: TObject);
var
i, x, y, cx, cy, MaxR, MaxT: Integer;
a, theta, R: Double;
begin
 Canvas.Brush.Color := clBtnFace;
 Canvas.FillRect(ClientRect);

 try
   StringReplace(editCoeff.Text, ".", DecimalSeparator, [rfReplaceAll]);
   StringReplace(editCoeff.Text, ",", DecimalSeparator, [rfReplaceAll]);
   a := StrToFloat(editCoeff.Text);
 except
   on E: EConvertError do
     begin
       MessageDlg("Cannot convert coefficient A to number!",
         mtError, [mbOK], 0);
       Exit;
     end;
 end;

 cx := ClientWidth div 2;
 cy := ClientHeight div 2;
 MaxR := 200;
 MaxT := 1000;
 i := 0;
 repeat
   theta := i * 0.001 * (2 * pi);
   R := Ro(a, theta);

   case HowToDraw of
     dtMaxRadius: if abs(R) > MaxR then Break;
     dtMaxAngle:  if abs(Theta) > MaxT then Break;
   end;

   x := cx - Round(R * Cos(theta));
   y := cy + Round(R * Sin(theta));
   Canvas.Pixels[x,y] := clRed;
   Inc(i);
 until False;
end;

procedure TformMain.btnDraw2Click(Sender: TObject);
var
 Centre: TPoint;
 SpiralWidth, SpiralHeight: Integer;
var
 x, y: Integer;
 angle, max_angle: Extended;
 a, r2, delta: Extended;
 ARect: TRect;
begin
 Centre := Point(ClientWidth div 2, ClientHeight div 2);
 SpiralWidth := 400;  SpiralHeight := 300;

 ARect := Rect(Centre.x - SpiralWidth div 2, Centre.y - SpiralHeight div 2,
     Centre.x + SpiralWidth div 2, Centre.y + SpiralHeight div 2);

 Canvas.DrawFocusRect(ARect);

 Canvas.Brush.Color := clBtnFace;
 Canvas.FillRect(ClientRect);

 try
   StringReplace(editCoeff.Text, ".", DecimalSeparator, [rfReplaceAll]);
   StringReplace(editCoeff.Text, ",", DecimalSeparator, [rfReplaceAll]);
   a := StrToFloat(editCoeff.Text);
 except
   on E: EConvertError do
     begin
       MessageDlg("Cannot convert coefficient A to number!",
         mtError, [mbOK], 0);
       Exit;
     end;
 end;

 // Угол считается против часовой стрелки (глядя на экран).
 // Координатная ось x совпадает с углом 0°.

 delta := 0.7; // Также задаёт толщину

 // Максимальный возможный угол в данном прямоугольнике нужно
 // расчитывать отдельно для каждой спирали, поэтому для упрощения
 // здесь берётся максимальный угол для Fermat"s spiral как самый
 // большой при равном A и возрастающем радиусе.
 max_angle := (sqr(SpiralWidth div 2) + sqr(SpiralWidth div 2)) / 100;

 for y := ARect.Top to ARect.Bottom do
   for x := ARect.Left to ARect.Right do
     begin
       angle := ArcTan2(Centre.y - y, x - Centre.x);
       if (angle < 0) then angle := angle + 2 * pi;

       r2 := sqr(x - Centre.x) + sqr(Centre.y - y);

       while (angle <= max_angle) do
         begin
         if (abs(abs(Ro(a, angle)) - sqrt(r2)) < delta) then
             Canvas.Pixels[x,y] := clBlack;
           angle := angle + 2 * pi;
         end;
     end;
end;

procedure TformMain.rbArchimedesClick(Sender: TObject);
begin
 Ro := RoArchimedes;
 editCoeff.Text := "15";
 HowToDraw := dtMaxRadius;
end;

procedure TformMain.rbFermatClick(Sender: TObject);
begin
 Ro := RoFermat;
 editCoeff.Text := "35";
 HowToDraw := dtMaxRadius;
end;

procedure TformMain.rbGalileiClick(Sender: TObject);
begin
 Ro := RoGalilei;
 editCoeff.Text := "1";
 HowToDraw := dtMaxRadius;
end;

procedure TformMain.rbPoinsotClick(Sender: TObject);
begin
 Ro := RoPoinsot;
 editCoeff.Text := "200";
 HowToDraw := dtMaxAngle;  
end;

procedure TformMain.FormCreate(Sender: TObject);
begin
 rbArchimedesClick(Self);
end;


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

Всё, дальше сам.

---

← →
Dr. Andrew   (2007-09-04 00:08) [21]

Спасибо!

---

Страницы: 1 вся ветка

Текущий архив: 2009.01.04;
Скачать: CL | DM;

Наверх

Память: 0.55 MB
Время: 0.014 c