VPF::Радиальное заполнение точками произвольного прямоу

VyachNik

Дата 19.2.2012, 19:09 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 4
Регистрация: 19.2.2012

Репутация: нет
Всего: нет

Доброго времени суток!
Помогите, пожалуйста, с решением задачи:
Дан произвольный прямоугольник со сторонами х=n, y=m. Левая верхняя точка прямоугольника имеет координаты х=0, у=0, а правая нижняя точка - х=n, y=m. Возьмем произвольную точку на прямоугольнике, например, х=n/2, y=m/2. Для удобства обозначим n/2=i, m/2=j. Требуется радиально заполнить прямоугольник точками от точки х=n/2, y=m/2 к краям прямоугольника, оптимизировать алгоритм заполнения таким образом, чтобы код был наименьшим. Например, заполнение точками может происходить так:
01. x=i y=j (i=n/2, j=m/2)
02. x=i+1 y=j
03. x=i+1 y=j+1
04. x=i y=j+1
05. x=i-1 y=j+1
06. x=i-1 y=j
07. x=i-1 y=j-1
08. x=i y=j-1
09. x=i+1 y=j-1
10. x=i+2 y=j-1
11. x=i+2 y=j
12. x=i+2 y=j+1
13. x=i+2 y=j+2
14. x=i+1 y=j+2
15. x=i y=j+2
16. x=i-1 y=j+2
17. x=i-2 y=j+2
18. x=i-2 y=j+1
19. x=i-2 y=j
20. x=i-2 y=j-1
21. x=i-2 y=j-2
22. x=i-1 y=j-2
23. x=i y=j-2
24. x=i+1 y=j-2
25. x=i+2 y=j-2
26. x=i+3 y=j-2
и т.д.

RomanEEP

Дата 20.2.2012, 16:29 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 424
Регистрация: 18.5.2006
Где: Коломна

Репутация: 1
Всего: 8

Можно заполнять прямоугольник горизонтальными линиями.
Допустим c1 - цвет центра, с2 - цвет вершин. R - половина диагонали.
Тогда цвет каждой точки считаем по формуле c = c1 + (c2 - c1)*r/R, где r- расстояние от центра прямоугольника до данной точки
или c = c1 + (c2 - c1)*sqrt(x*x+y*y)/R
Для заполнения каждой строки y считаем 2 коэффициента m = (c2-c1)/R; n = y*y, тогда
цвет каждой точки линии считаем по формуле с = с1+m*sqrt(x*x+n) - по этой формуле считаем все 3 или 4 компонента цвета и рисуем линию слева направо.
Для оптимизации можно по такому алгоритму заполнить только четверть прямоугольника и скопировать остальные части симметрично

--------------------

Электронные экзамены

Чучмек

Дата 20.2.2012, 18:37 (ссылка)

(нет голосов)

Загрузка ...

НЭТ БИЛЭТ

Профиль
Группа: Участник
Сообщений: 841
Регистрация: 11.5.2008
Где: СССР

Репутация: 2
Всего: 41

Код


procedure TForm1.Button1Click(Sender: TObject);
var r,f,dr,df:real;
x,y:integer;
begin

r:=0;
f:=2*pi;
dr:=0.6;
df:=f;
while r<500 do
begin
x:=trunc(r*cos(f));
y:=trunc(r*sin(f));
form1.Canvas.Pixels[x+500,y+500]:=255;
f:=f-df;
if f<=0 then
 begin
 f:=2*pi;
 r:=r+dr;
 df:=0.9/r;  
 end
end;

Это сообщение отредактировал(а) Чучмек - 20.2.2012, 22:45

--------------------

умную мысль держи при себе, а дурной - поделись с другими

VyachNik

Дата 20.2.2012, 21:49 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 4
Регистрация: 19.2.2012

Репутация: нет
Всего: нет

Цитата(Чучмек @ 20.2.2012, 18:37)

Код


procedure TForm1.Button1Click(Sender: TObject);
var r,f,dr,df:real;
x,y:integer;
begin

r:=0;
f:=2*pi;
dr:=1;
df:=f;
while r<500 do
begin
x:=trunc(r*cos(f));
y:=trunc(r*sin(f));
form1.Canvas.Pixels[x+500,y+500]:=255;
f:=f-df;
if f<=0 then
 begin
 f:=2*pi;
 r:=r+dr;
 df:=2.65/(f*r);  
 end
end;

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

Чучмек

Дата 20.2.2012, 22:07 (ссылка)

(нет голосов)

Загрузка ...

НЭТ БИЛЭТ

Профиль
Группа: Участник
Сообщений: 841
Регистрация: 11.5.2008
Где: СССР

Репутация: 2
Всего: 41

Идем по кругу, с каждым оборотом увеличиваем радиус.
Шаг радиуса dr
Шаг поворота df (вот здесь завтык , должно быть df:=k/r; а не df:=k/(f*r);

dr=0.6
df=0.9/r

Если сделать больше - будут не зарисованные точки

Это сообщение отредактировал(а) Чучмек - 20.2.2012, 22:50

--------------------

умную мысль держи при себе, а дурной - поделись с другими

RomanEEP

Дата 21.2.2012, 13:16 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 424
Регистрация: 18.5.2006
Где: Коломна

Репутация: 1
Всего: 8

Код


procedure FillRectangleRadial(Canvas: TCanvas; Rect: TRect;
  BorderColor, CenterColor: TColor);
var
  k: Integer;
  C1, C2: TRGBQuad;
  R: Double;
  mR, mG, mB: Double;

  procedure DrawLine(Index: Integer);
  var
    i: Integer;
    Color: TRGBQuad;
    n: Double;
    RVal, GVal, BVal: Integer;
    x: Double;
    t: Double;
  begin
    n := Sqr(Index - (Rect.Top + Rect.Bottom) * 0.5);
    x := -(Rect.Right - Rect.Left) * 0.5;
    for i := Rect.Left to Rect.Right do
    begin
      t := sqrt(x*x + n);
      RVal := Round(C1.rgbRed + mR * t);
      GVal := Round(C1.rgbGreen + mG * t);
      BVal := Round(C1.rgbBlue + mB * t);
      Canvas.Pixels[i, Index] := RGB(RVal, GVal, BVal);
      x := x + 1;
    end;
  end;

begin
  C1 := TRGBQuad(CenterColor);
  C2 := TRGBQuad(BorderColor);
  R := Sqrt(Sqr(Rect.Left - Rect.Right) + Sqr(Rect.Top - Rect.Bottom)) * 0.5;
  if R > 1 then
  begin
    mR := (c2.rgbRed - c1.rgbRed) / R;
    mG := (c2.rgbGreen - c1.rgbGreen) / R;
    mB := (c2.rgbBlue - c1.rgbBlue) / R;
    for k := Rect.Top to Rect.Bottom do
      DrawLine(k);
  end;
end;

--------------------

Электронные экзамены

RomanEEP

Дата 21.2.2012, 15:29 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 424
Регистрация: 18.5.2006
Где: Коломна

Репутация: 1
Всего: 8

Более быстрая альтернатива на скайлайне:

Код


procedure FillRectangleRadial(Canvas: TCanvas; Rect: TRect;
  BorderColor, CenterColor: TColor);
var
  k: Integer;
  C1, C2: TRGBQuad;
  R: Double;
  mR, mG, mB: Double;
  Bitmap: TBitmap;
  Pixels: PByteArray;

  procedure DrawLine(Index: Integer);
  var
    i: Integer;
    n: Double;
    RVal, GVal, BVal: Integer;
    x: Double;
    t: Double;
    PixIndex: Integer;
  begin
    n := Sqr(Index - (Rect.Top + Rect.Bottom) * 0.5);
    x := -(Rect.Right - Rect.Left) * 0.5;
    PixIndex := 0;
    for i := 1 to Bitmap.Width do
    begin
      t := sqrt(x*x + n);
      RVal := Round(C1.rgbRed + mR * t);
      GVal := Round(C1.rgbGreen + mG * t);
      BVal := Round(C1.rgbBlue + mB * t);
      Pixels[PixIndex] := RVal;
      Pixels[PixIndex + 1] := GVal;
      Pixels[PixIndex + 2] := BVal;
      x := x + 1;
      PixIndex := PixIndex + 4;
    end;
    Pixels := Pointer(Integer(Pixels) - Bitmap.Width * 4);
  end;

begin
  C1 := TRGBQuad(CenterColor);
  C2 := TRGBQuad(BorderColor);
  R := Sqrt(Sqr(Rect.Left - Rect.Right) + Sqr(Rect.Top - Rect.Bottom)) * 0.5;
  if R > 1 then
  begin
    Bitmap := TBitmap.Create;
    try
      Bitmap.PixelFormat := pf32bit;
      Bitmap.SetSize(Rect.Right - Rect.Left + 1, Rect.Bottom - Rect.Top + 1);
      Pixels := Bitmap.ScanLine[0];
      mR := (c2.rgbRed - c1.rgbRed) / R;
      mG := (c2.rgbGreen - c1.rgbGreen) / R;
      mB := (c2.rgbBlue - c1.rgbBlue) / R;
      for k := Rect.Top to Rect.Bottom do
        DrawLine(k);
      Canvas.Draw(Rect.Left, Rect.Top, Bitmap);
    finally
      Bitmap.Free;
    end;
  end;
end;

--------------------

Электронные экзамены

Чучмек

Дата 21.2.2012, 21:18 (ссылка)

(нет голосов)

Загрузка ...

НЭТ БИЛЭТ

Профиль
Группа: Участник
Сообщений: 841
Регистрация: 11.5.2008
Где: СССР

Репутация: 2
Всего: 41

RomanEEP, Это принципиально разные вещи - градиент и радиальное заполнение.

Это сообщение отредактировал(а) Чучмек - 21.2.2012, 21:19

--------------------

умную мысль держи при себе, а дурной - поделись с другими

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Звук, графика и видео \| Следующая тема »