![Wink :wink:](./images/smilies/icon_wink.gif)
canvas 408 мс
LazyLine 205 мс
Вернее это canvas проседает в 2 раза.
Модератор: Модераторы
Pavia писал(а):Есть ещё один чит. Если увеличить число линий в 10 раз то мой код начинает обгонять canvas в 2 раза.![]()
canvas 408 мс
LazyLine 205 мс
Вернее это canvas проседает в 2 раза.
procedure LazyLine(BB:TBitmap; x1,y1,x2,y2:Integer); overload;
var e,i,x,y,dx,dy,sx,sy:Integer;
step:Integer;
begin
step:=0;
if (BB=nil)then exit;
if step=0 then
begin
x:=x1;
y:=y1;
dx:=Abs(x2-x1);
dy:=Abs(y2-y1);
sx:=Sign(x2-x1);
sy:=Sign(y2-y1);
if (dx=0) and (dy=0) then
begin
//Bmp.SetPixel
SetPix(BB,x,y, clRed);
Exit;
end;
if dy<dx then
begin
e:=2*dy-dx;
i:=1;
repeat
SetPix(BB,x,y, clRed);
while e>=0 do
begin
y:=y+sy;
e:=e-2*dx;
end;
x:=x+sx;
e:=e+2*dy;
i:=i+1;
until i>dx;
SetPix(BB,x,y, clRed);
end else
begin
e:=2*dx-dy;
i:=1;
repeat
SetPix(BB,x,y, clRed);
while e>=0 do
begin
x:=x+sx;
e:=e-2*dy;
end;
y:=y+sy;
e:=e+2*dx;
i:=i+1;
until i>dy;
SetPix(BB,x,y, clRed);
end;
end;
end;
Procedure SetPix(Var BB:TBitmap;X,Y,C:Integer);
Type
TA=Array[0..1] of byte;
var
PA:^TA;
n:integer;
begin
if bb = NIL then exit;
if not InR(x,0,bb.Width-1) then exit;
if not InR(y,0,bb.Height-1) then exit;
//Bb.BeginUpdate; ;
pa:=bb.ScanLine[y];
N:=X*3;
pa^[n] :=Blue(C);
pa^[n+1]:=Green(C);
pa^[n+2]:=red(C);
//Bb.EndUpdate;
end;
Alex2013 писал(а): Кстати добавил чуть "испорченный" LazyLine в тест Зуба получил 714 ms
OpenGL driver info: ATI Technologies Inc. AMD Radeon HD 6310 Graphics 4.2.11762 Compatibility Profile Context
Draw 10000 random lines
OpenGL....: 6 msec
Canvas....: 128 msec
Alex Byte.: 1381 msec
AGG.......: 4997 msec
GDIPlu....: 5082 msec
OpenGL driver info: NVIDIA Corporation GeForce GTX 680/PCIe/SSE2 4.6.0 NVIDIA 397.31
Draw 10000 random lines
Canvas: 61msec
Alex Byte : 177msec
Zub Byte : 47msec
OpenGL: 3msec
OpenGL driver info: NVIDIA Corporation GeForce GTX 680/PCIe/SSE2 4.6.0 NVIDIA 397.31
Draw 1000000 random lines
Canvas: 5711msec
Alex Byte : 17656msec
Zub Byte : 3341msec
OpenGL: 126msec
OpenGL driver info: NVIDIA Corporation GeForce GTX 680/PCIe/SSE2 4.6.0 NVIDIA 397.31
Draw 10000 random lines
Canvas: 60msec
Alex Byte : 178msec
Zub Byte : 36msec
OpenGL: 0msec
OpenGL driver info: NVIDIA Corporation GeForce GTX 680/PCIe/SSE2 4.6.0 NVIDIA 397.31
Draw 1000000 random lines
Canvas: 5396msec
Alex Byte : 17365msec
Zub Byte : 3293msec
OpenGL: 86msec
OpenGL driver info: NVIDIA Corporation GeForce GTX 680/PCIe/SSE2 4.6.0 NVIDIA 390.48
Draw 10000 random lines
Canvas: 15msec
Alex Byte : 155msec
Zub Byte : 36msec
OpenGL: 1msec
OpenGL driver info:
Draw 10000 random lines
Canvas: 15msec
Alex Byte : 166msec
Zub Byte : 32msec
Label4
OpenGL driver info: NVIDIA Corporation NVIDIA GeForce GTX 680 OpenGL Engine 2.1 NVIDIA-10.30.25 355.11.10.10.30.120
Draw 10000 random lines
Canvas: 296msec
Alex Byte : 176msec
Zub Byte : 34msec
OpenGL: 6msec
zub писал(а):Твои кучи топиков про быстрое рисование были слиты первой попавшейся реализацией брезенхема взятой с какойто вики. + заменил вычисление пикселя через координаты на операции непосредственно с указателем. реализация колхозная донельзя и рости есть куда. Повод тебе задуматься. чуть позже дам результаты с кубунты на этойже машине
procedure TForm1.AlexBypePaint(Sender: TObject);
var
i:integer;
w,h:integer;
LPTime:Tdatetime;
tv1,tv2:GDBVertex;
// Только 24 Бита !
var BL:Integer;
Procedure SetPix(Var BB:TBitmap;X,Y,C:Integer);
Type
TA=Array[0..1] of byte;
var
PA:^TA;
n:integer;
begin
//Bb.BeginUpdate; ;
pa:=Pointer(BB.RawImage.Data+Y*BL);
N:=X*3;
pa^[n] :=Blue(C);
pa^[n+1]:=Green(C);
pa^[n+2]:=red(C);
//Bb.EndUpdate;
end;
procedure LazyLine(BB:TBitmap; x1,y1,x2,y2:Integer); overload;
var e,i,x,y,dx,dy,sx,sy:Integer;
step:Integer;
begin
step:=0;
if (BB=nil)then exit;
if step=0 then
begin
x:=x1;
y:=y1;
dx:=Abs(x2-x1);
dy:=Abs(y2-y1);
sx:=Sign(x2-x1);
sy:=Sign(y2-y1);
if (dx=0) and (dy=0) then
begin
//Bmp.SetPixel
SetPix(BB,x,y, clRed);
Exit;
end;
if dy<dx then
begin
e:=2*dy-dx;
i:=1;
repeat
SetPix(BB,x,y, clRed);
while e>=0 do
begin
y:=y+sy;
e:=e-2*dx;
end;
x:=x+sx;
e:=e+2*dy;
i:=i+1;
until i>dx;
SetPix(BB,x,y, clRed);
end else
begin
e:=2*dx-dy;
i:=1;
repeat
SetPix(BB,x,y, clRed);
while e>=0 do
begin
x:=x+sx;
e:=e-2*dy;
end;
y:=y+sy;
e:=e+2*dx;
i:=i+1;
until i>dy;
SetPix(BB,x,y, clRed);
end;
end;
end;
Const BB:TBitmap=nil;
begin
w:=TPanel(Sender).Width;
h:=TPanel(Sender).Height;
needtransform:=CheckBox1.Checked;
BB:=TBitmap.Create;
bb.PixelFormat:=pf24bit;
bb.SetSize(w,h);
BL:=BB.RawImage.Description.BitsPerLine div 8;
LPTime:=now();
Bb.BeginUpdate;
for i:=1 to SpinEdit1.Value do
begin
tv1:=GetRandomVertex(w,h,w);
tv2:=GetRandomVertex(w,h,w);
LazyLine(BB,round(tv1.x),round(tv1.y),round(tv2.x),round(tv2.y));
end;
Bb.EndUpdate;
TPanel(Sender).Canvas.Draw(0,0,bb);
lptime:=now()-LPTime;
bb.Free;
Label2.Caption:='Alex Byte : '+inttostr(round(lptime*10e7))+'msec';
processresult;
end;
OpenGL driver info: ATI Technologies Inc. AMD Radeon HD 6310 Graphics 4.2.11762 Compatibility Profile Context
Draw 10000 random lines
OpenGL : 7 msec
OpenCV : 58 msec
Canvas : 138 msec
Zub Byte : 142 msec
uses
Classes, gl,
SysUtils, FileUtil, OpenGLContext, Forms, Controls, Graphics, Dialogs,
ExtCtrls, StdCtrls, Spin, Buttons, math,OpenCV,IPL;
//OpenCV,IPL можно взять из моей "трубы" + от туда-же opencv_core231.dll
...
procedure TForm1.AlexBypePaint(Sender: TObject);
...
Var
cs: CvSize;
cvCP1,cvCP2:cvPoint;
const
frame: PIplImage=nil ;
begin
w:=TPanel(Sender).Width;
h:=TPanel(Sender).Height;
needtransform:=CheckBox1.Checked;
BB:=TBitmap.Create;
bb.PixelFormat:=pf24bit;
bb.SetSize(w,h);
BL:=BB.RawImage.Description.BitsPerLine div 8;
If not CheckBox2.Checked then begin
// тут тоже что и было раньше...
end else begin
//*******************************************************
//* Подключение Опен ЦВ *
//*******************************************************
Cs.width:=w;
Cs.height:=h;
if Frame = nil then Frame:= cvCreateImage( cs, 8, 3 );
FillChar(Frame^.ImageData^, Frame^.ImageSize,0);// Как вытесняется чистить все-же полезно
// иначе непонятно что получается при изменении количества линий
LPTime:=now();
for i:=1 to SpinEdit1.Value do
begin
tv1:=GetRandomVertex(w,h,w);
tv2:=GetRandomVertex(w,h,w);
//DrawLine
cvCP1.x:=round(tv1.x); cvCP1.y:=round(tv1.y);
cvCP2.x:=round(tv2.x); cvCP2.y:=round(tv2.y);
cvLine(Frame, cvCP1, cvCP2, CV_RGB(0, 255, 0));
end;
IplImage2Bitmap(Frame,BB);
lptime:=now()-LPTime;
// Иначе было бы не честно по отношению к OpenCV
// в чистом OpenCV была бы одна пересылка
// Но разница всего менее 10 msec (на HP635)
TPanel(Sender).Canvas.Draw(0,0,bb);
end;
bb.Free;
If not CheckBox2.Checked then
Label2.Caption:='Alex Byte : '+inttostr(round(lptime*10e7))+'msec'
Else Label2.Caption:='OpenCV : '+inttostr(round(lptime*10e7))+'msec';
processresult;
end;
var
Form1: TForm1;
dc:hdc;
hrc:HGLRC;
implementation
{$R *.dfm}
procedure SetDCPixelFormat (hdc : HDC);
var
pfd : TPixelFormatDescriptor;
nPixelFormat : Integer;
begin
FillChar(pfd, SizeOf (pfd), 0);
pfd.dwFlags :=PFD_SUPPORT_OPENGL or PFD_DOUBLEBUFFER;
nPixelFormat :=ChoosePixelFormat (hdc, @pfd);
SetPixelFormat(hdc, nPixelFormat, @pfd);
end;
procedure MakeDC(DC:HWND);
begin
SetDCPixelFormat(DC);
hrc := wglCreateContext(DC);
wglMakeCurrent(DC, hrc);
//glClearColor (0.0, 0.0, 0.75, 1.0);
glMatrixMode (GL_PROJECTION);
//glLoadIdentity;
glFrustum (-1, 1, -1, 1, 2, 20);
glMatrixMode (GL_MODELVIEW);
//glLoadIdentity;
glTranslatef(0.0, 0.0, -6.0);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
DC:=GetDC(Handle);
MakeDC(DC);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
wglMakeCurrent(0, 0);
wglDeleteContext(hrc);
ReleaseDC(Handle, DC);
DeleteDC(DC);
end;
procedure WritePoint(DC:HDC; x,y:integer;ic:TColorREF);
var
r,g,b:DWORD;
begin
r:=GetRValue(ic);
g:=GetGValue(ic);
b:=GetBValue(ic);
glPointSize(1);
glColor3f(r,g,b);
glBegin(GL_POINTS);
glVertex2f(x,y);
glEnd;
end;
procedure TForm1.FormPaint(Sender: TObject);
begin
WritePoint(DC,1,1,clyellow);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
SwapBuffers(DC);
end;
Есть ли OpenGLContext для делфи? или что можно вместо него исопльзовать?(не могу откомпилировтаь gditestforalex_OCV)
это глупый вопрос. Можно использовать glut, GLScene, в конце концов вынести всё что мешает в отдельный модуль.Mavlyudov писал(а):Можно как-то сократить?
Mavlyudov писал(а):Еще вопрос: Координаты x,y для отрисовки точки - это же не координаты пиксела? ставлю WritePoint(DC,1,1,clyellow); рисует непонятно где (где-то справа)? Как сопоставить с координатами на форме?
Pavia писал(а):Поправил OpenCV пару строк. Там картинка не пересоздавалась.
Добавил свою библиотеку.
У Zub был выход за приделы массива, добавил выравнивание.
gditestforalex_OCV.7z
Alex2013 писал(а):Антивирус ругается .... Trojan:Win32/Spursint.F!cl
Вернуться в Free Pascal Compiler
Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 61