Модератор: Модераторы
zub » 10.05.2018 21:09:14
Alex2013 » 10.05.2018 23:17:00
zub писал(а):>>или использовать компонент OpenGLContext;
нет такого компонента.
Не точно название сказал ? Ну извиняюсь ... Вот небольшой тестик разных способов отрисовки (gdi,gdi+,agg,ogl) мне была интересна простая отрисовка линий, поэтому в тесте только линии.
в Form1.OpenGLPaint можно посмотреть настройку матриц для попиксельного соответствия gl<->canvasas
zub » 10.05.2018 23:47:14
Alex2013 » 11.05.2018 00:05:02
zub писал(а):кстати, про ошибаюсь. писал большую телегу, но видимо редактирование поста забыл закончить.
>>6 Если программа будет писаться только под Виндовс можно получить неслабое ускорение вывода векторной графики используя Метафайлы
Неслабое ускорение от метафайла ты не получишь. Это всеголишь способ сохранить последовательность вызова операций рисования.
Если ты их вызываешь паралельно делая какието сложные расчеты (или как у тебя из тормозного скрипта) - повторная отрисовка метафайлом будет гораздо быстрее... но это не ускорение вывода графики, а кэширование промежуточных результатов вычислений
zub » 11.05.2018 00:05:43
Alex2013 » 11.05.2018 00:13:54
zub писал(а):>>Кстати в какой версии Лазаря это чудо собирать ? (в 1.6 что на планшете стоит не собирается )
Чудо это когда говоришь что неработает и не говоришь сообщение об ошибке, но зачемто рассказываешь где оно стоит
Собирать надо в актуальной на текущий момент версии. Если нравятся постарше, убери модную строчку "DesignTimePPI = 113" из lfm, и незабудт при этом почистить lib
Draw 10000 random lines
OpenGL :.....15 msec
Canvas :....161 msec
...AGG :...3672 msec
GDIPlus :...5168 msec
zub » 11.05.2018 00:35:15
Alex2013 » 11.05.2018 01:10:19
- Код: Выделить всё
procedure DrawLine(Var BB:TBitmap;x1,y1, x2,y2: Integer);
var b,dx,dy,y,x,i:integer;
begin
dx:=abs(x2-x1);
dy:=abs(y2-y1);
if dx >= dy then
begin
if (x1<x2) then
for i := x1 to x2 do
begin
y:=Round(((y2-y1)/(x2-x1))*i + (y1-x1*((y2-y1)/(x2-x1))));
SetPix(BB,i,y,$FF);
end;
if (x2<x1) then
for i := x2 to x1 do
begin
y:=Round(((y2-y1)/(x2-x1))*i + (y1-x1*((y2-y1)/(x2-x1))));
SetPix(BB,i,y,$FF);
end;
end;
if dx<dy then
begin
if (y1<y2) then
for i := y1 to y2 do
begin
x:=Round(((x2-x1)/(y2-y1))*i + (x1-y1*((x2-x1)/(y2-y1))));
SetPix(BB,x,i,$FF);
end;
if (y2<y1) then
for i := y2 to y1 do
begin
x:=Round(((x2-x1)/(y2-y1))*i + (x1-y1*((x2-x1)/(y2-y1))));
SetPix(BB,x,i,$FF);
end;
end;
zub » 11.05.2018 11:20:49
OpenGL driver info: NVIDIA Corporation GeForce GTX 680/PCIe/SSE2 4.6.0 NVIDIA 397.31
Draw 10000 random lines
Canvas: 12msec
GDIPlus: 458msec
AGG: 714msec
OpenGL: 2msec
Alex2013 » 11.05.2018 12:27:25
zub » 11.05.2018 13:10:37
Alex2013 » 11.05.2018 13:31:34
zub писал(а):>>SetPix - как раз "работает напрямую с указателем"
В каком месте это он работает напрямую?
Выкладывай свой вариант, вспомню спектрумовское детство, сделаю:
Canvas:
Alex byte:
zub byte:
OpenGL:
Зря ты канвас выкинул, это какраз ориентир. агг и гди+ - никуда негодно
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:=Pointer(BB.RawImage.Data);
N:=Y*(BB.Width*3)+X*3;
pa^[n] :=Blue(C);
pa^[n+1]:=Green(C);
pa^[n+2]:=red(C);
//Bb.EndUpdate;
end;
zub » 11.05.2018 13:36:50
Pavia » 11.05.2018 13:38:25
Alex2013 » 11.05.2018 13:42:43
//бывший GDI (сделано вчера за десять минут по этому совсем не фонтан )
procedure TForm1.GDIPaint(Sender: TObject);
var
i:integer;
w,h:integer;
LPTime:Tdatetime;
tv1,tv2:GDBVertex;
Function InR(AA,B,C:Longint):Boolean;
begin
InR:=((AA>=B) And (AA<=C));
End;
// Только 24 Бита !
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:=Pointer(BB.RawImage.Data);
N:=Y*(BB.Width*3)+X*3;
pa^[n] :=Blue(C);
pa^[n+1]:=Green(C);
pa^[n+2]:=red(C);
//Bb.EndUpdate;
end;
procedure DrawLine(Var BB:TBitmap;x1,y1, x2,y2: Integer);
var b,dx,dy,y,x,i:integer;
begin
dx:=abs(x2-x1);
dy:=abs(y2-y1);
if dx >= dy then
begin
if (x1<x2) then
for i := x1 to x2 do
begin
y:=Round(((y2-y1)/(x2-x1))*i + (y1-x1*((y2-y1)/(x2-x1))));
SetPix(BB,i,y,$FF);
end;
if (x2<x1) then
for i := x2 to x1 do
begin
y:=Round(((y2-y1)/(x2-x1))*i + (y1-x1*((y2-y1)/(x2-x1))));
SetPix(BB,i,y,$FF);
end;
end;
if dx<dy then
begin
if (y1<y2) then
for i := y1 to y2 do
begin
x:=Round(((x2-x1)/(y2-y1))*i + (x1-y1*((x2-x1)/(y2-y1))));
SetPix(BB,x,i,$FF);
end;
if (y2<y1) then
for i := y2 to y1 do
begin
x:=Round(((x2-x1)/(y2-y1))*i + (x1-y1*((x2-x1)/(y2-y1))));
SetPix(BB,x,i,$FF);
end;
end;
// Form1.Image1.Picture.Bitmap.Assign(bmp);
end;
Const BB:TBitmap=nil;
begin
w:=TPanel(Sender).Width;
h:=TPanel(Sender).Height;
needtransform:=CheckBox1.Checked;
// If bb=nil then begin
BB:=TBitmap.Create;
bb.PixelFormat:=pf24bit;
bb.SetSize(w,h);
// end;
Bb.BeginUpdate; ;
LPTime:=now();
for i:=1 to SpinEdit1.Value do
begin
tv1:=GetRandomVertex(w,h,w);
tv2:=GetRandomVertex(w,h,w);
DrawLine(BB,round(tv1.x),round(tv1.y),round(tv2.x),round(tv2.y));
// TPanel(Sender).canvas.Line(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;
Label1.Caption:=' Byte : '+inttostr(round(lptime*10e7))+'msec';
processresult;
end;
Pavia писал(а):Alex2013
Чёто у вас медленно.
Вот у меня линии рисуются на ровне с GDI в Delphi чутка быстрее в лазарусе медленнее.
16-20 мс
Вернуться в Free Pascal Compiler
Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 1