• Viernes 8 de Noviembre de 2024, 19:00

Autor Tema:  Acceso A Pixeles Y Pintado En Pantalla Rápidos  (Leído 3345 veces)

Amilius

  • Miembro HIPER activo
  • ****
  • Mensajes: 665
    • Ver Perfil
Acceso A Pixeles Y Pintado En Pantalla Rápidos
« en: Domingo 26 de Junio de 2005, 06:32 »
0
Este truco es para graficar rápidamente con delphi, aplicable a juegos 2d y para tratamiento de pixeles:

Esto me costó unas buenas horas de investigación con los archivos de ayuda de delphi (win32.hlp), una buena página de funciones de windows: http://www.winprog.org/tutorial y también una revisada al archivo fuente "graphics.pas".

La idea es pasar lo más rápido posible un pedazo de memoria cuyos bits puedes manejar de la forma que quieras a la pantalla. Generalmente al usar Delphi esto significa tener un Tbitmap y acceder a los pixeles con el scanline. El problema es que no quería llamar al scanline (vieron todo el codigo que tiene?*) por cada línea. Tampoco llamar al .draw (vieron todo el codigo que tiene?*) cada vez que tenga que mostrar una imagen en pantalla.

* Se que ese código extra le da toda la potencia y simplicidad de uso del GDI al Delphi, pero para este caso específico donde sólo tu parte de código trabaja con el bitmap y lo que más quieres es velocidad todo ese código no es pertinente. De todas formas se puede utilizar las comodidades de las clases de delphi, como el Tbitmap.loadFromFile() y copiarlo al hbitmap con el bitblt() y Tcanvas.handle para obtener el "HDC".

IMPORTANTE:

+ EL ejemplo es para pixeles de 16 bits.
+ El formato de color a 16bits es A-5-5-5, 5 bits para cada canal RGB.
+ Hay que tener en cuenta que cada línea del bitmap DEBE estar alineado a DWORD. Si ANCHO_BMP_RENDER es múltiplo de 4 no hay problema para cualquier número de bits por pixel. Para 16bits basta que sea múltiplo de 2, pero para 24 y 8bits tiene que ser múltiplo de 4. Para 32bits no hay problema.

EN EL FORMULARIO:
Agregar un botón, enlazar el evento "onclick" a "Button1Click", enlazar el oncreate y ondestroy al form1.

Código: Text
  1.  
  2. unit main;
  3.  
  4. interface
  5.  
  6. uses
  7.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  8.   StdCtrls, DIB, ExtCtrls;
  9.  
  10.  
  11. const
  12.   ANCHO_BMP_RENDER=256;
  13.   ALTO_BMP_RENDER=128;
  14.   PIXELES_BMP_RENDER=ANCHO_BMP_RENDER*ALTO_BMP_RENDER;
  15.   BYTES_BMP_RENDER=PIXELES_BMP_RENDER*2;
  16.  
  17. type
  18.  
  19.   TForm1 = class(TForm)
  20.     Button1: TButton;
  21.     procedure Button1Click(Sender: TObject);
  22.     procedure FormCreate(Sender: TObject);
  23.     procedure FormDestroy(Sender: TObject);
  24.     procedure FormPaint(Sender: TObject);
  25.   private
  26.     { Private declarations }
  27.     hdcBuffer:HDC;
  28.     hbmBuffer,hbmBufferOriginal:HBITMAP;
  29.     InfoBM:PBITMAPINFO;
  30.     fPixeles:pointer;
  31.     procedure CrearBitmapRender;
  32.     procedure EliminarBitmapRender;
  33.   public
  34.     { Public declarations }
  35.   end;
  36.  
  37. var
  38.   Form1: TForm1;
  39.  
  40. implementation
  41.  
  42. {$R *.DFM}
  43.  
  44. function GDICheck(n:integer):integer;
  45. begin
  46.   result:=n;
  47.   if n=0 then
  48.     showmessage('Error GDI: #'+inttostr(GetLastError));
  49. end;
  50.  
  51. procedure TForm1.CrearBitmapRender;
  52. var HDCPrincipal:HDC;
  53. begin
  54.   getMem(infoBM,sizeof(TBitmapInfo));
  55.   with InfoBM^,bmiHeader do
  56.   begin
  57.     biSize:=sizeof(TBITMAPINFOHEADER);//40
  58.     biWidth:=ANCHO_BMP_RENDER;
  59.     biHeight:=-ALTO_BMP_RENDER;//Para un Bitmap "TOP->DOWN"
  60.     biPlanes:=1;
  61.     biBitCount:=16;
  62.     biCompression:=0;
  63.     biSizeImage:=BYTES_BMP_RENDER;
  64.     biXPelsPerMeter:=0;
  65.     biYPelsPerMeter:=0;
  66.     biClrUsed:=0;
  67.     biClrImportant:=0;
  68.   end;
  69.   HDCPrincipal:=getDC(handle);
  70.   if longbool(HDCPrincipal) then
  71.   begin
  72.     hdcBuffer:=CreateCompatibleDC(HDCPrincipal);
  73.     hbmBuffer:=GDICheck(CreateDIBSection(hdcBuffer,InfoBM^,DIB_RGB_COLORS,fPixeles,0,0));
  74.     hbmBufferOriginal := SelectObject(hdcBuffer, hbmBuffer);//Viene con uno que no usaremos
  75.     releaseDC(handle,HDCPrincipal);
  76.   end;
  77. end;
  78.  
  79. procedure TForm1.EliminarBitmapRender;
  80. begin
  81.   if (hdcBuffer<>0) then
  82.   begin
  83.     SelectObject(hdcBuffer, hbmBufferOriginal);//Para que sea eliminado junto con el hbitmap
  84.     DeleteDC(hdcBuffer);
  85.   end;
  86.   if (hbmBuffer<>0) then
  87.     DeleteObject(hbmBuffer);
  88.   if InfoBM<>nil then
  89.     freemem(InfoBM);
  90. end;
  91.  
  92. procedure TForm1.FormCreate(Sender: TObject);
  93. begin
  94.   CrearBitmapRender;
  95. end;
  96.  
  97. procedure TForm1.Button1Click(Sender: TObject);
  98. type TPixeles=array[0..ALTO_BMP_RENDER-1,0..ANCHO_BMP_RENDER-1] of word;
  99.      PPixeles=^TPixeles;
  100.      TPixeles2=array[0..PIXELES_BMP_RENDER-1] of word;
  101.      PPixeles2=^TPixeles2;
  102. var i:integer;
  103. begin
  104. //Tres formas de acceder a los pixeles
  105.   for i:=0 to 5000 do
  106.     PPixeles(fPixeles)[random(ALTO_BMP_RENDER),random(ANCHO_BMP_RENDER)]:=random(32);
  107.   for i:=0 to 5000 do
  108.     PPixeles2(fPixeles)[random(PIXELES_BMP_RENDER)]:=random(32) shl 5;
  109.   for i:=0 to 5000 do
  110.     word(pointer(integer(fPixeles)+(random(PIXELES_BMP_RENDER) shl 1))^):=random(32) shl 10;
  111.   BitBlt(canvas.handle, 0, 0, ANCHO_BMP_RENDER, ALTO_BMP_RENDER, hdcBuffer, 0, 0, SRCCOPY);
  112. end;
  113.  
  114. procedure TForm1.FormDestroy(Sender: TObject);
  115. begin
  116.   EliminarBitmapRender;
  117. end;
  118.  
  119. procedure TForm1.FormPaint(Sender: TObject);
  120. begin
  121.   BitBlt(canvas.handle,0,0, ANCHO_BMP_RENDER, ALTO_BMP_RENDER, hdcBuffer, 0, 0, SRCCOPY);
  122. end;
  123.  
  124. end.
  125.  
  126.