Шустрый
Профиль
Группа: Участник
Сообщений: 55
Регистрация: 7.6.2009
Где: Харьков
Репутация: нет
Всего: нет
|
Помогите оптимизировать код для вывода на квадратик изображения gold.bmp размером 16 на 16 пикселей. Т. е. убрать все лишнее из кода. | Код | unit frmMain;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls, OpenGL;
type
TfrmGL = class(TForm)
Timer: TTimer;
procedure FormCreate(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
DC: HDC;
hrc: HGLRC;
Bitmap: TBitmap;
Bits: Array [0..15, 0..15, 0..2] of GLubyte;
procedure SetDCPixelFormat;
procedure BmpTexture;
protected
procedure WMPaint(var Msg: TWMPaint); message WM_PAINT;
end;
var
frmGL: TfrmGL;
implementation
{$R *.DFM}
{çàãðóçêà è èíèöèàëèçàöèÿ òåêñòóðû }
procedure TfrmGL.BmpTexture;
var
i, j: Integer;
begin
bitmap := TBitmap.Create;
bitmap.LoadFromFile('gold.bmp'); // çàãðóçêà òåêñòóðû èç ôàéëà
{--- çàïîëíåíèå áèòîâîãî ìàññèâà ---}
For i := 0 to 15 do
For j := 0 to 15 do begin
bits [i, j, 0] := GetRValue(bitmap.Canvas.Pixels[i,j]);
bits [i, j, 1] := GetGValue(bitmap.Canvas.Pixels[i,j]);
bits [i, j, 2] := GetBValue(bitmap.Canvas.Pixels[i,j]);
end;
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA,
16, 16, // çäåñü çàäàåòñÿ ðàçìåð òåêñòóðû
0, GL_RGB, GL_UNSIGNED_BYTE, @Bits);
glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_DECAL);
glEnable(GL_TEXTURE_2D);
end;
{=========Çàäàåì ôîðìàò ïèêñåëÿ===============}
procedure TfrmGL.SetDCPixelFormat;
var
nPixelFormat: Integer;
pfd: TPixelFormatDescriptor;
begin
FillChar(pfd, SizeOf(pfd), 0);
pfd.dwFlags := PFD_DRAW_TO_WINDOW or
PFD_SUPPORT_OPENGL or
PFD_DOUBLEBUFFER;
nPixelFormat := ChoosePixelFormat(DC, @pfd);
SetPixelFormat(DC, nPixelFormat, @pfd);
end;
{==========Ñîçäàíèå ôîðìû====================}
procedure TfrmGL.FormCreate(Sender: TObject);
begin
DC := GetDC(Handle);
SetDCPixelFormat;
hrc := wglCreateContext(DC);
wglMakeCurrent(DC, hrc);
glEnable(GL_DEPTH_TEST);// ðàçðåøàåì òåñò ãëóáèíû
glEnable(GL_LIGHTING); // ðàçðåøàåì ðàáîòó ñ îñâåùåííîñòüþ
glEnable(GL_LIGHT0); // âêëþ÷àåì èñòî÷íèê ñâåòà 0
BmpTexture;
end;
{=============Èçìåíåíèå ðàçìåðîâ ôîðìû============}
procedure TfrmGL.FormResize(Sender: TObject);
begin
glViewport(0, 0, ClientWidth, ClientHeight);
glMatrixMode(GL_PROJECTION);
glLoadIdentity;
gluPerspective(30.0, ClientWidth / ClientHeight, 1.0, 9.0);
glMatrixMode(GL_MODELVIEW);
glLoadIdentity;
glTranslatef(0.0, 0.0, -5.0);
glRotatef(90.0, 1.0, 0.0, 0.0);
end;
{==Ðèñîâàíèå êàðòèíêè, îáðàáîòêà ñîîáùåíèÿ WM_PAINT=====}
procedure TfrmGL.WMPaint(var Msg: TWMPaint);
var
ps : TPaintStruct;
begin
BeginPaint(Handle, ps);
glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
glBegin (GL_QUADS);
glTexCoord2d (1.0, 0.0);
glVertex3f (-1.0, 1.0, 1.0);
glTexCoord2d (1.0, 1.0);
glVertex3f (1.0, 1.0, 1.0);
glTexCoord2d (0.0, 1.0);
glVertex3f (1.0, 1.0, -1.0);
glTexCoord2d (0.0, 0.0);
glVertex3f (-1.0, 1.0, -1.0);
glEnd;
SwapBuffers(DC);
EndPaint(Handle, ps);
end;
{========Êîíåö ðàáîòû ïðèëîæåíèÿ====================}
procedure TfrmGL.FormDestroy(Sender: TObject);
begin
wglMakeCurrent(0, 0);
wglDeleteContext(hrc);
ReleaseDC(Handle, DC);
DeleteDC (DC);
end;
end.
|
Помогите сделать нормальную вещь из этого примера. |
Вывод текстуры OpenGl под Delphi. Вывод текстуры OpenGl под Delphi. 
Дата 19.6.2009, 23:03 (
Загрузка ...
