[Pascal] Kolo

0

Potrzebuje algorytmu rysujacego kolo ... tylko ze
1)kolo to musi byc rysowane calutkie pixel po pixelu (tak jakby byl to sznurek)
2)zeby bylo ono ciagle (spotkalem sie z algorytmami ktore dla wiekszych kol rysuja rozstrzelone pixele)
3)zeby kolo bylo symetryczne (4 osie) :)
4)kazdy pixel musi byc liczony tylko raz

<ort>Prubowalem </ort>juz z czyms takim x:=round(xs+rcos(t)) y:=round(ys+rsin(t)) ale trzeba bylo t mnozyc przez ulamki i <ort>w ogóle </ort>kolko do bani wychodzi (patrz 2,3 i 4).
obecnie przerabiam (deoptymalizuje :P) algorytm Bresenhama ale topornie mi to idzie. Mam problemy z jego zrozumieniem i mam przeczucie ze uzyje zbyt wielu zmiennych. Prosze o pomoc.

0

x = ox + sin(rdegtorad(alpha))
y = oy + cos(r
degtorad(alpha))

daj lineto zamiast rysowania pixeli, kąt zwiększaj o ułamki jeśli jest duże i możesz zapisywać w tablicy które pixele już były narysowane (albo po prostu porównywać if (x <> stareX) and (y <> stareY) then begin
lineto(x, y)
stareX := x;
stareY := y;
end;

degtorad(alpha) = alpha * pi/180

0

Zle sie wyrazilem :P chocilo mi oczywiscie o OKRAG.
Przepraszam za blad. Rozumiem ze pomysl z tablicami mozna zastosowac takze do okregu ale watpie zeby w moim wypadku wypalil dla wiekszych okregow.
Zwiekszanie kata o ulamki powoduje (przynajmniej w moim wypadku) obliczanie jednego pixela po kilka razy wiec tez odpada.

0

no to ja też źle przeczytałem, mówiłem o okręgu ;P liczy po kilka razy, możesz poszukać zależności między żądanym przyrostem kąta a promieniem okręgu, poza tym napisałem ci żebyś sprawdzał czy pixel się różni od poprzedniego, wtedy właściwie nic nie przeszkadza że tylko obliczy pixel parę razy, co innego jak już ma go wyrysować

0

Pierwszy link od goory w Googlach ;):
http://www.republika.pl/wmula/prog/bresenham.html

Na forme daj butona, i Image:

procedure TForm1.circle(x0, y0, r: Integer);

  procedure circle_points(x, y: Integer);
  begin
    Image1.Canvas.Pixels[x0 - x, y0 - y] := clBlack;
    Image1.Canvas.Pixels[x0 - x, y0 + y] := clBlack;
    Image1.Canvas.Pixels[x0 + x, y0 - y] := clBlack;
    Image1.Canvas.Pixels[x0 + x, y0 + y] := clBlack;
    Image1.Canvas.Pixels[x0 - y, y0 - x] := clBlack;
    Image1.Canvas.Pixels[x0 - y, y0 + x] := clBlack;
    Image1.Canvas.Pixels[x0 + y, y0 - x] := clBlack;
    Image1.Canvas.Pixels[x0 + y, y0 + x] := clBlack;
  end;

var
  x, y, d : Integer;
  deltaA, deltaB : Integer;
begin
  d := 5 - 4 * r;
  x := 0;
  y := r;
  deltaA := (-2 * r + 5) * 4;
  deltaB := 3 * 4;
  while (x < y) do
    begin
      circle_points(x, y);
      if d > 0 then
        begin
          d := d + deltaA;
          y := y - 1;
          x := x + 1;
          deltaA := deltaA + (4 * 4);
          deltaB := deltaB + (2 * 4);
        end
      else
        begin
          d := d + deltaB;
          x := x + 1;
          deltaA := deltaA + (2 * 4);
          deltaB := deltaB + (2 * 4);
        end;
    end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  circle(100, 100, 100);
end;

Raczej dziala, przerobilem na szybko ale nie recze w 100% za efekty bo nie znam Pythona :p

0

Zaleznosci szukalem i szukam dalej ale chyba nie ma to sensu poniewaz kolo narysowane tym sposobem wyglada roznie zaleznie od zastosowanego kata. Im zastosujemy mniejszy kat tym otrzymamy po mniejszej ilosci powtorzen dokladniejsze kolo (przy zastosowaniu tego sposobu symetryczny okrag o przomieniu 99 i zwiekszaniu kata o 0.001 [cos(t*0.001)] na moim gracie nie powstaje nawet po minucie - brakuje mu kilka pixeli) za to algorytm Bresenhama radzi sobie z tym praktycznie Od razu. Tyle ze on rysuje kolo po kawalku.

0

spc przerabialem to samo. I wlasnie to rysuje kolo po kawaleczku tzn po 1/8. Mi chodzi o to zeby nie dzielilo na 8 czesci tylko narysowalo za 1 zamachem... tak jak czlowiek bez odrywania dlugopisu od kartki.

0

To ja proponuję takie rozwiązanie:

uses Graph, Crt;

var grDriver: integer;
    grMode: integer;

    ix,iy: integer;
    ir : double;
const r = 100;
      x = 200;
      y = 200;
begin
grDriver := Detect;
InitGraph(grDriver, grMode, '');
if GraphResult = grOk then
   begin
   for ix:=x-r to x+r do
       for iy:=y-r to y+r do
           begin
           ir := sqrt(sqr(x-ix)+sqr(y-iy));
           if (ir<r+0.5) and (ir>r-0.5) then
              PutPixel(ix, iy, WHITE)
{//Opcja: pseudo antialiasing :) }
{
           else if (ir<r+1) and (ir>r-1) then
              PutPixel(ix, iy, LIGHTGRAY)
           else if (ir<r+1.5) and (ir>r-1.5) then
              PutPixel(ix, iy, DARKGRAY)
}           end;
   repeat until keypressed;
   CloseGraph;
   end;
end.

Pamiętaj, że stopień jajowatości zależy od rozdzielczości. Musiałbyś jeszcze wyliczyć współczynniki i mnożyć przez współrzędne, by zredukować wpływ rozdzielczości.

0

Szczawik, to juz fucktycznie jest lepsze, ale dla odmiany jest jakbys rysowal dwoma dlugopisami na raz... Kurde, nie ma matematyka na forum?

0
spc napisał(a)

Kurde, nie ma matematyka na forum?

no teoretycznie programiści powinni być dobrymi matematykami, ja też taki będe - tato mi mówił (Just Kidding) no ale to jeszcze parę latek może

serio to spc, ciężko w pascalu wrzucić na formę buttona ...

jak author, chcesz tylko to żeby okrąg się rysował bo kawałku to daj pętle 0 - 359 do Arc - parametry: ox, oy, od kąta, do kąta, r
np dajesz Arc(50, 50, 0, 180, 45); i masz pół okręgu

albo:

{$N+}
uses Graph, Crt;

var grDriver: integer;
    grMode: integer;

    ix,k,iy,x,y: integer;
    w, r: double;
const ox = 320;
      oy = 240;
begin
grDriver := Detect;
InitGraph(grDriver, grMode, '\tp7\bgi\');
if GraphResult = grOk then
   begin
     r := 10;
     w := 0;
     MoveTo(round(ox + r), oy);
     ix := 0;
     iy := 0;
     while r < 320 do begin
       r := r + 0.2;
       w := w + sqrt(r / 20);
       x := round(r * cos(w * PI/180));
       y := round(r * sin(w * PI/180));
       if (x <> ix) or (y <> iy) then begin
         LineTo(ox + x, oy + y);
         ix := x;
         iy := y;
       end;
       delay(10);
     end;
   repeat until keypressed;
   CloseGraph;
   end;
end.

trochę nie styka no ale jest (Just Kidding Again) - och jakież to ja mam fajne żarty - powinienem prowadzić familiade

0

Osz kurde, troche mnie wczoraj zakrecilo nie zwrocilem uwagi na to ze to ma byc w Pascalu :p

1 użytkowników online, w tym zalogowanych: 0, gości: 1