Быстрая отрисовка

Вопросы программирования на Free Pascal, использования компилятора и утилит.

Модератор: Модераторы

Re: Быстрая отрисовка

Сообщение Mavlyudov » 16.05.2018 16:24:46

Pavia
Показывайте код. Целиком выложите проект

Вот код через OpenGL
Код: Выделить всё
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,OpenGL, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  dc:hdc;
//  hrc:HGLRC;
BitMap : TBitMap;


implementation

{$R *.dfm}
procedure SetDCPixelFormat (hdc : HDC);
var
pfd : TPixelFormatDescriptor;
nPixelFormat : Integer;
begin
//FillChar(pfd, SizeOf (pfd), 0);
pfd.dwFlags := PFD_DRAW_TO_WINDOW or PFD_SUPPORT_OPENGL or PFD_DOUBLEBUFFER;
nPixelFormat :=ChoosePixelFormat (hdc, @pfd);
SetPixelFormat(hdc, nPixelFormat, @pfd);
wglMakeCurrent(hDC, wglCreateContext(hDC));
end;

procedure MakeDC(DC:HWND);
begin
SetDCPixelFormat(DC);

glViewport(0,0,form1.ClientWidth,form1.ClientHeight);
glMatrixMode(GL_PROJECTION);
glLoadIdentity;
glOrtho( 0, form1.ClientWidth,form1.ClientHeight,0, -1, 1 );
glMatrixMode(GL_MODELVIEW);
glLoadIdentity;
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
Form1.Width:=1024;
Form1.Height:=768;
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.Button1Click(Sender: TObject);
var
i,j,t:integer;
begin
t:=GetTickCount;
for i:=0 to form1.ClientWidth do begin
for j:=0 to form1.ClientHeight do begin
WritePoint(DC,i,j,clred);
end;
end;
t:=GetTickCount-t;
Form1.Caption :=IntToStr(t)+' ms';
SwapBuffers(DC);
end;
end.


Теперь вопрос про отрисовку через SetDIBitsToDevice

Alex2013
Зачем вообще на точках зацикливаться ?


Потому что хочется перекомпилировать одну программу, в которой используется SetPixel, но чтобы можно было отрисовку делать универсальной,
используется
Код: Выделить всё
Type MyPixel=procedure(DC:HDC;x,y:integer;ic:TColorRef);
var
  PPutPixel:MyPixel;


Впрочем, полный код ниже.
вопрос: как правильно вынести отрисовку отдельно, а не для каждого пиксела?
Верно ли задавать размерность массива wth:=1; hth:=1; SetLength(bBytes, wth*hth)? Или надо по размеру изображения

Код: Выделить всё
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,math;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

Type MyPixel=procedure(DC:HDC;x,y:integer;ic:TColorRef);

var
  Form1: TForm1;
  PPutPixel:MyPixel;
  fwth,fhth:integer;
  DC:HDC;

implementation

{$R *.dfm}

procedure draw3(DC:HDC;x,y:integer;ic:TColorRef);
var
   bBytes: array of longint;
   yc, xc: Longint;
   bi: BITMAPINFO;
  wth,hth:integer;
begin
wth:=1; hth:=1;
   with bi.bmiHeader do begin
      biSize := sizeof(bi);
      biBitCount := 32;
      biCompression := BI_RGB;
      biPlanes := 1;
      biWidth := wth;
      biHeight := hth;
   end;

  SetLength(bBytes, wth*hth);
   for xc:=Low(bBytes) to High(bBytes) do begin
      bBytes[xc] :=clBlue;
   end; // xc
   SetDIBitsToDevice
     (dc,
      x,
      y,
      bi.bmiHeader.biWidth,
      bi.bmiHeader.biHeight,
      0, 0, 0,
      bi.bmiHeader.biHeight,
      @bBytes[0],
      bi, DIB_RGB_COLORS);
end;

procedure TForm1.Button1Click(Sender: TObject);
var i,j:integer;
begin
DC:=GetDC(Form1.Handle);
PPutPixel:=Draw3;
for i:=0 to fwth-1 do begin
for j:=0 to fhth-1 do begin
PPutPixel(DC,i,j,clred);
end;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
fwth:=form1.Width;
fhth:=form1.Height;
end;

end.
Mavlyudov
новенький
 
Сообщения: 20
Зарегистрирован: 24.01.2010 20:35:23

Re: Быстрая отрисовка

Сообщение Alex2013 » 18.05.2018 02:54:24

Mavlyudov писал(а):[

Alex2013
Зачем вообще на точках зацикливаться ?


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


Если там ТОЛЬКО вывод точек (точечный график неких случайных величин ) то возможно смысл есть ...
Но если дело обстоит иначе то тут уже моя очередь делать "рука лицо pcx" :idea: ... если я правильно понял то далее в проекте будут как минимум линии, а возможно другие примитивы.
Вопрос, что мешает сделать их рисование как прямой вызов соответствующих процедур из API вместо того что-бы пытаться "медленно и печально " строить тоже самое ПО ТОЧКА ? :shock: :roll:
Зы
Я тут сам наверное буду пытаться создать некий "нулевой слой" для своих проектов но основой там точно будет нормальный набор примитивов : линии ,круги, полигоны, эллипсы,прямоугольники... и т.п. а точки если будут то "на всякий пожарный " а не как основа . Еще раз повторяю разница в реализации рисования готового примитива и доступа к пикселю может быть ЧУДОВИЩНАЯ . (Может действительно получится как сказа Zub "Эпическое сражение" класса "карьерный экскаватор" против "детского совочка " ) То есть, каким бы умным алгоритмом не рисовать по точкам и каким бы методом доступа к пикселю не пользоваться, никто не получит равной эффективность с качественными алгоритмами и/или аппаратным ускорением методов изначально заточенных на рисование примитивов целиком, а не по точкам .... Что кстати отлично показал Zub ! Причем там есть не слабые резервы, что видно по использованию вроде как "чисто софтварной " библиотеки OpenCV .
Зы Зы
За наглядностью ходить далеко не надо ! Вон у тебя закраска формы в "два цикла " а если просто цвет поменять ?(form1.color:=Rgb(Random( 255),Random( 255),Random( 255)); ) там скорее всего даже измерить время этой операции нормально (точнее "честно") не получиться, настолько быстро и кешированно "закраска" будет происходить ... :idea:
Alex2013
энтузиаст
 
Сообщения: 879
Зарегистрирован: 03.04.2013 11:59:44

Пред.

Вернуться в Free Pascal Compiler

Кто сейчас на конференции

Сейчас этот форум просматривают: Google [Bot] и гости: 1

Рейтинг@Mail.ru
cron