VPF::помогите сгенерировать картинку

Sniper

Дата 14.8.2005, 14:51 (ссылка)

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

Загрузка ...

Опытный

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

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

Значит так:
Нужно программно сгенерировать круг такой чтобы в центре был например зелёныйцвет и он по радиусу сводился к чёрному.

сел делать

Код


var
Bits: Array [0..31, 0..31, 0..2] of Integer;

procedure gen_circle;
var i, j:Ineteger;
begin
//пробегаемся по всем точкам
    For i := 0 to 31 do
      For j := 0 to 31 do begin
// записываем цвет для каждой точки
        bits [i, j, 0] := GetRValue();
        bits [i, j, 1] := GetGValue();
        bits [i, j, 2] := GetBValue(); 
    end;
end;

и ничерта не понятно... по идее нужно мерять расстояние каждой точки с центром и в зависимости от этого ставить цвет...

Это сообщение отредактировал(а) Sniper - 14.8.2005, 14:51

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

"Я испытываю отвращение к системе, разработаннной для "пользователя", если в слове "пользователь" закодировано уничижительное значение "тупой и примитивный".
Кен Томпсон, создатель Unix

s-mike

Дата 14.8.2005, 17:18 (ссылка)

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

Загрузка ...

Опытный

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

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

Что-то в этом роде:

Код


uses
  Math;

procedure TForm1.FormPaint(Sender: TObject);
const
  MinSize = 10;
  CircleStep = 5;
var
  L, W, MaxSize, Color, ColorStep: Integer;
begin
  Color := clBlack;
  MaxSize := Min(ClientHeight, CLientWidth) - 20;
  if MaxSize <= 0 then Exit;
  ColorStep := 255 * CircleStep div MaxSize;
  W := MaxSize;
  while W > MinSize do
  begin
    Canvas.Pen.Color := {Color}RGB(0, Color, 0);;
    Canvas.Brush.Color := {Color}RGB(0, Color, 0);;
    L := (MaxSize - W) div 2;
    Canvas.Ellipse(L, L, L + W, L + W);
    Dec(W, CircleStep);
    Inc(Color, ColorStep);
  end;
end;

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

Преферанс для Android на базе исходников Марьяжа

Illusion Dolphin

Дата 14.8.2005, 17:41 (ссылка)

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

Загрузка ...

Эксперт

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

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

Вот вариант побыстрее и с заливкой иммитирующей круг а не конус smile

Код



uses
  ... math;

Type
  TRGB=record
  b,g,r : byte;
  end;

    ARGB=array [0..1] of TRGB;
    PARGB=^ARGB;
    PRGB = ^TRGB;
...

procedure TForm1.FormPaint(Sender: TObject);
var
  i,j : integer;
  b : TBitmap;
  p : pargb;
  cx,cy,r,l : extended;
  rr,gg,bb : byte;
begin
 rr:=GetRvalue(ColorToRGB(Color));
 gg:=GetGvalue(ColorToRGB(Color));
 bb:=GetBvalue(ColorToRGB(Color));
 b:=tbitmap.create;
 b.pixelformat:=pf24bit;
 b.Width:=500;
 b.Height:=500;
 cx:=b.Width / 2;
 cy:=b.Height / 2;
 l:=b.Height /2 ;
 for i:=0 to b.Height-1 do
 begin
  p:=b.ScanLine[i];
  for j:=0 to b.Width-1 do
  begin
   r:=sqrt(sqr(cx-j)+sqr(cy-i));
   if r>l then
   begin
    p[j].r:=rr;
    p[j].b:=bb;
    p[j].g:=gg;
   end else
   begin
    p[j].r:=0;
    p[j].b:=0;
    p[j].g:=round($FF*(1-sqr(r/l)));
   end;
  end;
 end;
 Canvas.Draw(0,0,b);
 b.Free;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 ClientWidth:=500;
 ClientHeight:=500;
end;

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

В мире всего две бесконечности: вселенная и человеческая глупость... На счёт вселенной я не уверен.
Шифрование и организация фотографий - Photo Database 4.5

Sniper

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

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

Загрузка ...

Опытный

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

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

Illusion Dolphin
+ тебе в благодарность за столь нужный мне код!
Спасибо.

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

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