Фонарь

← →
DM_A (2004-02-29 15:35) [0]

Я хочу сделать полностью чёрную Image1. Только при направлении на неё мышью в некоем радиусе она будет светлой.Помогите пожалуйста.

← →
TButton © (2004-02-29 16:28) [1]

вобщем...
PutPixel(x,y: integer; c: TColor; s: TCanvas);
begin
...
end;
сканлайном выводит пиксель на битмапу

твой вопрос:
procedure glow(x, y, r: integer; color: TColor); var i, j: integer; begin for i:=0 to Image1.Width do for j:=0 to Image1.Height do begin if SQRT((x-i)*(x-i)+(y-j)*(y-j))<=r then PutPixel(i,j,color,Image1.Canvas); end; end;

это был вариант №1, в котором получается окружность однородного цвета, не очень интересно. поэтому переходим к варианту №2

procedure glow(x, y, r: integer; color: TColor); var i, j, d, m: integer; r, g, b: byte; begin for i:=0 to Image1.Width do for j:=0 to Image1.Height do begin d:=SQRT((x-i)*(x-i)+(y-j)*(y-j)); m:=(r-d)/r; if m<0 then m:=0; r:=Round(GetRValue(color)*m); g:=Round(GetGValue(color)*m); b:=Round(GetBValue(color)*m); PutPixel(i,j,RGB(r,g,b),Image1.Canvas); end; end;
в этом варианте рассчитывается переменная m (multiplier есси не ошибся) которая определяется как отношения расстояния от центра окружности к ее радиусу, она обеспечивает нам постепенное (равномерное) затухание от центра к краю. Задание на дом по эксперементируйте с формулой определения m. Подсказка: если затухание должно начинаться не от центра, а скажем, от середины отнимите от d половину r.

← →
TButton © (2004-02-29 17:08) [2]

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

← →
Asteroid © (2004-03-01 02:07) [3]

> TButton © (29.02.04 17:08) [2]
Есть WinAPI-евский SetPixel( dc: GDC; x, y: Integer; colour: Cardinal ).

← →
MBo © (2004-03-01 06:57) [4]

>TButton
В Статьи загляни (для TBitmap)

← →
TButton © (2004-03-01 19:00) [5]

сенкс *реверанс*

← →
TButton © (2004-03-01 20:43) [6]

на счет скорости вывода. проведем эксперемент)))

вариант#1
procedure TForm1.DXTimer1Timer(Sender: TObject; LagCount: Integer); var i, j, n, dc, z: integer; begin dc:=GetDC(handle); z:=GetTickCount; for j:=0 to 255 do for i:=0 to 255 do begin n:=random(256); SetPixel(dc, i, j, RGB(n,n,n)) end; ReleaseDC(handle,dc); z:=GetTickCount-z; Caption:=InttoStr(z); end;
дает показатель 190-210(мс)
вариант#2
procedure TForm1.DXTimer1Timer(Sender: TObject; LagCount: Integer); var i, j, n, dc, z: integer; begin z:=GetTickCount; for j:=0 to 255 do for i:=0 to 255 do begin n:=random(256); Canvas.Pixels[i,j]:=RGB(n,n,n); end; z:=GetTickCount-z; Caption:=InttoStr(z); end;
дает показатель 200-220

"А если не видно разницы, зачем же платить больше?"

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

← →
TButton © (2004-03-01 20:52) [7]

в порядке эксперемента блитал на канву битмапу(256х256) по 1000 раз. получилось 810-870мс, т.е. 0.8-0.9мс на 1 блитинг... осталось тока разобраться с тем, как подготовить изображение для блитинга.

← →
TButton © (2004-03-01 20:57) [8]

в порядке эксперимента)) выяснил, что заполнение array[0..255,0..256] of TColor; занимает 3-4 мс. +~1мс на блитинг получится 4-5мс против 200 началиных, в ФПСах тоже очень красиво цифра смотрится 200-250. но! array ведь не блитнешь... или блитнешь?

← →
TButton © (2004-03-01 21:54) [9]

очевидно, корень проблемы в windows.SeTPixel. корни которого уходят в gdi32.dll, где и теряются. проследить корни BitBlt не удалось(( жаль, "знал бы прикуп - жил бы в Сочи"

← →
Asteroid © (2004-03-02 02:25) [10]

> TButton © (01.03.04 21:54) [9]
BitBlt там же (в gdi32.dll)
А если ты используешь DX, лучше вообще залочить (Lock) поверхность и рисовать напрямую (тебе будет дан указатель на память).

← →
TButton © (2004-03-02 04:42) [11]

>BitBlt там же (в gdi32.dll)
я это подозревал, но не знал наверняка. DX я не пользую (в данной ситуации), но можно по подробнее про Lock, указатель и как в память на которую мне тыкнули писАть.

← →
nexxiss © (2004-03-02 12:36) [12]

>TButton
Если убрать из цикла лишние операторы присвоения и освобождение канвы перед замером времени, то должно работать побыстрее.

← →
TButton © (2004-01-23 13:43) [13]

>Если убрать из цикла лишние операторы присвоения и освобождение
>канвы перед замером времени, то должно работать побыстрее.

:) ты так думаешь? 65536 присвоений делались за 3-4 мс(читай выше), а вобще, на данный момент вопрос стоит так: "как array of TColor блитнуть на канву"

← →
Vertex (2004-03-03 03:23) [14]

var
Bitmap: TBitmap;
BP: array of array of ^TBitmap;

procedure TForm1.Create(...);
x,y :integer;
begin
bwidth:=...;
bheight:=...;
//создаем битмап нужного размера
Bitmap:=TBitmap.Create;
Bitmap.Width:=bwidth;
Bitmap.Height:=bheight;

//забиваем матрицу указателей на пиксели битмапа
SetLength(BP,bwidth);
for x:=0 to bwidth-1 do
begin
SetLength(BP,bheight);
for y:=0 to bheight-1 do
BP[x,y]:=@(Bitmap.Pixels[x,y]);
end;
end;

//далее пользуемся массивом указателей если нужен прямой доступ к пикселям и битмапом для блитинга и т.д.
//моно написать процедуру типа
procedure SetPixel(x,y:integer;c:TColor);
begin
BP[x,y]^:=c;
end;
//но если обойтись без нее не будете тратить такты на вызов
//если использовать не динамический массив то получите тоже выигрыш в скорости (обращение к элементам динамического раз в 50 медленее)
А ваще совет попробуйте fastdib - лучшее что видел в этом роде, доступ к пикселям оченььььь быстрый. Для вашей проблемы в самый раз.

← →
TButton © (2004-03-03 05:18) [15]

>BP: array of array of ^TBitmap;
может of TColor?

← →
Vertex (2004-03-03 05:41) [16]

2TButton сорри опечатка, ты прав

← →
TButton © (2004-03-03 05:46) [17]

procedure TForm1.FormCreate(Sender: TObject); var x, y: integer; begin bmp:=TBitMap.Create; bmp.Height:=256; bmp.Width:=256; for x:=0 to 255 do for y:=0 to 255 do BP[x,y]:=addr(bmp.Canvas.Pixels[x,y]); end;
Variable required, типа конкретный пиксель это не переменная и адрес его получить не реально.

← →
TButton © (2004-03-03 20:56) [18]

кстати, камень в огород ScanLine, работает он очччень медленно, ~500мс на битмапе 256х256

← →
Vertex (2004-03-04 00:37) [19]

2TButton
так не получилось?
делфи под рукой нет, но я так делал, должно работать
с addr тоже не выходит?
сам подумай, если это массив, значит элементы должны иметь адрес и его ты в любом случае получить можешь

← →
TButton © (2004-03-04 03:49) [20]

это не массив, это пропертя, надо по ковыряться в исходниках канваса.

← →
Vertex (2004-03-04 05:19) [21]

доберусь до делфи, кину рабочий пример

← →
MBo © (2004-03-04 07:04) [22]

>TButton
Все же загляни в статьи ("Поставить точку")

← →
Sapersky © (2004-03-04 13:42) [23]

А ваще совет попробуйте fastdib

Тем более что там есть процедура Lightmap, которая делает требуемый эффект :)

← →
TButton © (2004-03-04 17:19) [24]

2 Sapersky ©
fastdib не интересно
2 MBo ©
статью читал... или по крайней мере собирался... на всяк случай поду по читаю)

← →
TButton © (2004-03-04 17:28) [25]

все понятно... было бы если б я небыл в асме ноль. проще скачать исходник и пользовать в свое удовольствие... но это всеравно не спортивно)

← →
MBo © (2004-03-04 17:30) [26]

>TButton
Там приводятся и аналоги на Паскале, если ты о статье.

← →
TButton © (2004-03-04 22:40) [27]

попробовал я qpixels )))))))) нет слов. скорость, такая что аж дурно становится, до сих пор не могу понять как это я без него раньше жил...

← →
lyeh © (2004-03-07 03:10) [28]

2 TButton ©
Ну чего ты на Scanline наезжаешь? Вот у него как раз супер скорость

Создай форму, скинь на нее TImage, назови Image1, загрузи в него картинку для бэкграунда размером 256х256, затем кинь TPaintBox с именем PBox - и вот код проги

unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls, Buttons, Math; type TForm1 = class(TForm) Image1: TImage; PBox: TPaintBox; procedure PBoxMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure PBoxMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure FormCreate(Sender: TObject); private { Private declarations } public procedure glow(x, y, radius: integer; color: TColor); { Public declarations } end; PBytes = ^TBytes; TBytes = array[0..0] of Byte; var Form1: TForm1; GlowColor:Tcolor; implementation {$R *.dfm} procedure tform1.glow(x, y, radius: integer; color: TColor); var i, j:integer; d, m: single; r, g, b: byte; bmp: Tbitmap; line:pbytes; begin bmp:=tbitmap.Create; bmp.Width:=Image1.Width; bmp.Height:=Image1.height; bmp.PixelFormat:=pf24bit; bitblt(bmp.Canvas.Handle, 0, 0, bmp.Width, bmp.Height, image1.Canvas.Handle, 0, 0, srccopy); begin for j:=0 to bmp.Height-1 do begin line:=bmp.ScanLine[j]; for i:=0 to bmp.Width-1 do begin d:=SQRT((x-i)*(x-i)+(y-j)*(y-j)); m:=(radius-d)/radius; if m<0 then m:=0; r:=Round(GetRValue(color)*m); g:=Round(GetGValue(color)*m); b:=Round(GetBValue(color)*m); line[i*3]:=min(line[i*3]+b, 255); // синий пиксел line[i*3+1]:=min(line[i*3+1]+g, 255); // зеленый line[i*3+2]:=min(line[i*3+2]+r, 255); // красный end; end; end; bitblt(pbox.Canvas.Handle, 0, 0, pbox.Width, pbox.Height, bmp.Canvas.Handle, 0, 0, srccopy); bmp.free; end; procedure TForm1.PBoxMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin Glow(x, y, 64, glowcolor); end; procedure TForm1.PBoxMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin GlowColor := RGB(random(256),Random(256),Random(256)); end; procedure TForm1.FormCreate(Sender: TObject); begin Glowcolor:=$FFAABBCC; end; end.

Води мышью для еффекта фонаря

А что как нибудь просто готовую картинку выводить ?
аля партиции ?

← →
Vertex (2004-03-08 02:27) [31]

type ... TRGBColor = record r,g,b:^Byte; end; PBytes = ^TBytes; TBytes = array[0..0] of Byte; const wimage = 256; himage = 256; var fmMain: TfmMain; bmp:TBitmap; pixels:array [0..wimage-1,0..himage-1] of TRGBColor; mx,my,t:integer; implementation {$R *.DFM} procedure TfmMain.Glow(_x,_y,_r:integer; _c:TColor); var x,y,cr,cg,cb,x1,y1,x2,y2:integer; r,alpha:real; begin cr:=GetRValue(_c); cg:=GetGValue(_c); cb:=GetBValue(_c); //проход ведем только квадрата в который вписана наша окружность glow x1:=max(_x-_r,0); y1:=max(_y-_r,0); x2:=min(_x+_r,wimage-1); y2:=min(_y+_r,himage-1); for x:=x1 to x2 do for y:=y1 to y2 do begin r:=sqrt(sqr(x-_x)+sqr(y-_y)); //меняем тока те пиксели которые принадлежат окружности if r<=_r then begin //вычисляем коэффециент прозрачности alpha:=r/_r; //устанавливаем значение линейной интерполяции pixels[x,y].r^:=trunc(alpha*(pixels[x,y].r^)+(1-alpha)*cr); pixels[x,y].g^:=trunc(alpha*(pixels[x,y].g^)+(1-alpha)*cg); pixels[x,y].b^:=trunc(alpha*(pixels[x,y].b^)+(1-alpha)*cb); end; end; end; procedure TfmMain.FormCreate(Sender: TObject); var x,y:integer; line:pbytes; begin bmp:=TBitmap.Create; bmp.Width:=256; bmp.Height:=256; bmp.PixelFormat:=pf24bit; //отчистить обязательно, видимо массивы пикселей не создаются до первой записи for x:=0 to wimage-1 do for y:=0 to himage-1 do begin bmp.Canvas.Pixels[x,y]:=$FFFFFFFF; end; //создадим массив указателей на пиксели, чтобы не терять время на вызов scanline for y:=0 to himage-1 do begin line:=bmp.ScanLine[y]; for x:=0 to wimage-1 do begin pixels[x,y].b:=@line[x*3]; pixels[x,y].g:=@line[x*3+1]; pixels[x,y].r:=@line[x*3+2]; end; end; end; procedure TfmMain.FormDestroy(Sender: TObject); begin bmp.Destroy; end; procedure TfmMain.Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin //можно отчистить и картинкой // bmp.Canvas.Rectangle(0,0,wimage,himage); bmp.Canvas.Draw(0,0,Image2.Picture.Bitmap); Glow(x,y,50,clRed); image1.Canvas.Draw(0,0,bmp); end;

2 Vertex
Посмотрел я вот на твой пример, и заметил несколько назначительных недостатков :)

1) Все рисуется Alpha"ой а не Add"ом - так фонарь не получится
2) Слишком много заранее определленных переменных - и все для того, чтобы лишний раз пикселы не просчитывать?
3) Все ужасно мерцает
4) Скорость "супер"!

← →
pianiiKa3ax (2004-03-08 17:25) [33]

Фсех девушек с 8 марта.
2lyeh. Я пра паследний пример. А чо, сначала в буфер никак нельзя рисовать? Он (вертекс) по-моему ето и имел ввиду. Попробуй отрисовать эдак хотябы 5 пять линий сразу на екран, ет типа даж гдиишными LineTo. Чо мерцать думашь не будет?
2вертекс все верно, что угодно, НО сначала рисуй в буфер. И скорость BitBlt осуждать - совершенно несостоятельно - вполне приемлемая скорость, если вы не стремитесь к хз каким фпс

2 pianiiKa3ax
1) Сначала научись по-русски выражаться :)
2) Ты мой пример [28] просмотри, скомпилируй - ничего не мерцает, скорость хорошая, и код небольшой. Если ты там не увидел буфера, это твои проблемы...

← →
ka3ax (2004-03-09 07:32) [35]

2 lyeh
:) сорри
Не надо, конечно, за комп нетрезвым садиться :)
Больше не буду.
пример [28] тогда не смотрел, посмотрел [31]
Сейчас посмотрел - все правильно. Единственое замечание - буфер не создавать/разрушать каждый раз при перемещении фонаря. Создать при создании формы, освободить - при разрушении.
К тому же использовать TImage в данном случае - неоправданно. На сколько я знаю, у TImage есть свой буфер, то есть при копировании Вашего буфера на TImage он сначала будет скопирован в буфер TImage, а затем на экран. Лишнее время и память. Лучше использовать TPaintBox.

← →
ka3ax (2004-03-09 08:07) [36]

+
я явно торможу.
Про замечание на счет TImage - забудьте, еще раз просмотрел код, все увидел.
Замечание про буфер (создание/освобождение) по-прежнему в силе.

2 ka3ax
Да, можно и заранее создавать буфер, а при выходе его освобождать, но скорость явно не увеличится... В DelphiX, например, все спрайты есть классы, а значит создаются и освождаются подобно битмэпам или кнопкам... Другое дело, если бы мы каждый раз при прорисовке создавали буфер и по-новой загружали в него бэкграунд из файла :)

← →
Vertex (2004-03-11 04:08) [38]

2lyeh ступил написал альфу виноват
буфер не создавал не суть важно я хотел идею объяснить
то что быстрее прочитать указатели заранее - факт, не оспоришь, тем более это не моя идея (в каком то примере видел)
и опять же вернусь к fastdib, бесполезные споры на тему сканлайн и пикселс - лучше фэстдиба не сделаем.

Народ! Делайте всё через SetDIBitsToDevice - ни тормозов, ни проблем с получением адресов точек! :))))

2 Vertex
>> лучше фэстдиба не сделаем
Да

Фонарь Найти похожие ветки