unit main;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, DIB, ExtCtrls;
const
ANCHO_BMP_RENDER=256;
ALTO_BMP_RENDER=128;
PIXELES_BMP_RENDER=ANCHO_BMP_RENDER*ALTO_BMP_RENDER;
BYTES_BMP_RENDER=PIXELES_BMP_RENDER*2;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormPaint(Sender: TObject);
private
{ Private declarations }
hdcBuffer:HDC;
hbmBuffer,hbmBufferOriginal:HBITMAP;
InfoBM:PBITMAPINFO;
fPixeles:pointer;
procedure CrearBitmapRender;
procedure EliminarBitmapRender;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
function GDICheck(n:integer):integer;
begin
result:=n;
if n=0 then
showmessage('Error GDI: #'+inttostr(GetLastError));
end;
procedure TForm1.CrearBitmapRender;
var HDCPrincipal:HDC;
begin
getMem(infoBM,sizeof(TBitmapInfo));
with InfoBM^,bmiHeader do
begin
biSize:=sizeof(TBITMAPINFOHEADER);//40
biWidth:=ANCHO_BMP_RENDER;
biHeight:=-ALTO_BMP_RENDER;//Para un Bitmap "TOP->DOWN"
biPlanes:=1;
biBitCount:=16;
biCompression:=0;
biSizeImage:=BYTES_BMP_RENDER;
biXPelsPerMeter:=0;
biYPelsPerMeter:=0;
biClrUsed:=0;
biClrImportant:=0;
end;
HDCPrincipal:=getDC(handle);
if longbool(HDCPrincipal) then
begin
hdcBuffer:=CreateCompatibleDC(HDCPrincipal);
hbmBuffer:=GDICheck(CreateDIBSection(hdcBuffer,InfoBM^,DIB_RGB_COLORS,fPixeles,0,0));
hbmBufferOriginal := SelectObject(hdcBuffer, hbmBuffer);//Viene con uno que no usaremos
releaseDC(handle,HDCPrincipal);
end;
end;
procedure TForm1.EliminarBitmapRender;
begin
if (hdcBuffer<>0) then
begin
SelectObject(hdcBuffer, hbmBufferOriginal);//Para que sea eliminado junto con el hbitmap
DeleteDC(hdcBuffer);
end;
if (hbmBuffer<>0) then
DeleteObject(hbmBuffer);
if InfoBM<>nil then
freemem(InfoBM);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
CrearBitmapRender;
end;
procedure TForm1.Button1Click(Sender: TObject);
type TPixeles=array[0..ALTO_BMP_RENDER-1,0..ANCHO_BMP_RENDER-1] of word;
PPixeles=^TPixeles;
TPixeles2=array[0..PIXELES_BMP_RENDER-1] of word;
PPixeles2=^TPixeles2;
var i:integer;
begin
//Tres formas de acceder a los pixeles
for i:=0 to 5000 do
PPixeles(fPixeles)[random(ALTO_BMP_RENDER),random(ANCHO_BMP_RENDER)]:=random(32);
for i:=0 to 5000 do
PPixeles2(fPixeles)[random(PIXELES_BMP_RENDER)]:=random(32) shl 5;
for i:=0 to 5000 do
word(pointer(integer(fPixeles)+(random(PIXELES_BMP_RENDER) shl 1))^):=random(32) shl 10;
BitBlt(canvas.handle, 0, 0, ANCHO_BMP_RENDER, ALTO_BMP_RENDER, hdcBuffer, 0, 0, SRCCOPY);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
EliminarBitmapRender;
end;
procedure TForm1.FormPaint(Sender: TObject);
begin
BitBlt(canvas.handle,0,0, ANCHO_BMP_RENDER, ALTO_BMP_RENDER, hdcBuffer, 0, 0, SRCCOPY);
end;
end.