Народ, помогите мне пожалуйста найти ошибку в программе.
В ней впринципе всё работает, но при повороте изображения, начинает по полной загружатся оперативная и виртуальная память, и в конце концов, комп глюкает.
Чтобы вам не искать ошибку по всему коду, то могу точно сказать что память, перегружается из-за, Nurbs поверхности, хотя у меня там написана процедура удаления её. Описание её идёт после слов (** Бумага ****), и само удаление в конце процедуры FormPaint| Код |
unit Unit1;
interface
uses
Windows, Messages, Forms, Classes, Controls, ExtCtrls, ComCtrls,
StdCtrls, Dialogs, SysUtils, OpenGL, Menus;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
private
hrc: HGLRC;
Position: Array [0..3] of GLFloat;
end;
TBitmapHeader= array[0..53] of byte;
TRGB=record
b,g,r:byte;
end;
TRGBA=record
b,g,r,a:byte;
end;
TRGBArray=array[0..4096] of TRGB;
TRGBAArray=array[0..4096] of TRGBA;
PRGBAArray=^TRGBAArray;
GLArr=array[0..3]of GLFloat;
var
Form1: TForm1;
uknot:array[0..7] of GLFloat = (0, 0, 0, 0, 1, 1, 1, 1);
vknot:array[0..7] of GLFloat = (0, 0, 0, 0, 1, 1, 1, 1);
ctlarray:array[0..3,0..3,0..2] of GLFloat =
(
(//U[1]
(-0.8,0.8,0.5), //V[1]
(-0.5,1,0.2), //V[2]
(0.5,1,0.2), //V[3]
(0.8,0.8,0.5)), //V[4]
(//U[2]
(-1, 0.5, 0.5), //V[1]
(-0.5, 0.5, -0.2),//V[2]
(0.5, 0.5, -0.2), //V[3]
(1, 0.5, 0.5)), //V[4]
(//U[3]
(-1, -0.5, 0.4), //V[1]
(-0.5,-0.5,-0.2), //V[2]
(0.5, -0.5, -0.2), //V[3]
(1, -0.5, 0.4)), //V[4]
(//U[4]
(-0.8, -0.8, 0.5),//V[1]
(-0.5, -1, 0.2), //V[2]
(0.5, -1, 0.2), //V[3]
(0.8, -0.8, 0.5)) //V[4]
);
wX, wY: single;
rX, rY: single;
rotate: Boolean;
dc:hdc;
QuadObj: GLUquadricObj;
Nurbs:GluNurbsObj;
implementation
{$R *.DFM}
procedure TForm1.FormPaint(Sender: TObject);
begin
glClearColor (0, 0.5, 1, 1.0);
glClear (GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
glEnable(GL_COLOR_MATERIAL);
glEnable (GL_DEPTH_TEST);
glEnable (GL_AUTO_NORMAL);
glEnable (GL_NORMALIZE);
//Установка тени
glEnable (GL_LIGHTING);
glEnable (GL_LIGHT0);
Position [0] := 100;
Position [1] := 5;
Position [2] := -5;
Position [3] := 0;
glLightfv (GL_LIGHT0, GL_POSITION, @position);
glPushMatrix();
glRotatef (rx, 0, 1, 0);
glRotatef (rY, 1, 0, 1);
(******************** Бумага **************************************************)
hrc:=wglCreateContext(Canvas.Handle);
wglMakeCurrent(canvas.Handle, hrc);
Nurbs:=gluNewNurbsRenderer;
glMatrixMode(GL_MODELVIEW);
glPushMatrix;
glLoadIdentity;
glRotatef(rX+15,0,1,0);
glRotatef(ry+65,1,0,0);
gluNurbsProperty(Nurbs,Glu_DISPLAY_MODE, GLU_OUTLINE_POLYGON);
gluBeginSurface(Nurbs);
gluNurbsSurface(Nurbs,4*2,@uknot,4*2,@vknot,4*3,3,@ctlarray,4,4,GL_MAP2_VERTEX_3);
gluEndSurface(Nurbs);
QuadObj:=gluNewQuadric;
gluQuadricDrawStyle(QuadObj, GLU_FILL);
gluQuadricTexture (QuadObj,true);
glRotatef(rX+45,0,1,0);
glRotatef(ry+300,1,0,0);
(******************** Стержень ************************************************)
//Стержень (наконечник)
glPushMatrix();
glRotatef(-90, 90, -90, -90);
glTransLatef(0.3, 0.04, -0.32);
glColor3f(4, 1, 0);
gluCylinder(QuadObj, 0, 0.008, 0.03, 10, 10);
glPopMatrix();
//Стержень (продолжение наконечника)
glPushMatrix();
glRotatef(-90, 90, -90, -90);
glTransLatef(0.3, 0.04, -0.29);
glColor3f(4, 1, 0);
gluCylinder(QuadObj, 0.008, 0.008, 0.04, 10, 10);
glPopMatrix();
//Стержень (место с чернилами)
glPushMatrix();
glRotatef(-90, 90, -90, -90);
glTransLatef(0.3, 0.04, -0.25);
glColor3f(0, 0, 0);
gluCylinder(QuadObj, 0.01, 0.01, 0.45, 10, 10);
glPopMatrix();
//Стержень (место с чернилами(где они закончились))
glPushMatrix();
glRotatef(-90, 90, -90, -90);
glTransLatef(0.3, 0.04, 0.2);
glColor3f(1, 1, 1);
gluCylinder(QuadObj, 0.01, 0.01, 0.5, 10, 10);
glPopMatrix();
(******************** Поверхность ручки ***************************************)
//Конец ручки
glPushMatrix();
glRotatef(-90, 90, -90, -90);
glTransLatef(0.3, 0.04, -0.28);
glColor3f(8, 8, 1);
gluCylinder(QuadObj, 0.012, 0.03, 0.1, 10, 10);
glPopMatrix();
//Место между которым держут ручку и наконечником
glPushMatrix();
glRotatef(-90, 90, -90, -90);
glTransLatef(0.3, 0.04, -0.18);
glColor3f(1,1, 1);
gluCylinder(QuadObj, 0.033, 0.035, 0.05, 10, 10);
glPopMatrix();
//Место за которое держут ручку
glPushMatrix();
glRotatef(-90, 90, -90, -90);
glTransLatef(0.3, 0.04, -0.13);
glColor3f(0,0.6, 0.8);
gluCylinder(QuadObj, 0.033, 0.035, 0.2, 10, 10);
glPopMatrix();
//Прозрачное место ручки
glPushMatrix();
glRotatef(-90, 90, -90, -90);
glTransLatef(0.3, 0.04, 0.07);
glColor3f(1,1, 1);
gluCylinder(QuadObj, 0.033, 0.035, 0.5, 10, 10);
glPopMatrix();
//То, чем закручивают стержень (без наконечника)
glPushMatrix();
glRotatef(-90, 90, -90, -90);
glTransLatef(0.3, 0.04, 0.57);
glColor3f(0,0, 1);
gluCylinder(QuadObj, 0.033, 0.033, 0.14, 10, 10);
glPopMatrix();
//Наконечник
glPushMatrix();
glRotatef(-90, 90, -90, -90);
glTransLatef(0.3, 0.04, 0.71);
glColor3f(0,0,1);
gluCylinder(QuadObj, 0.033, 0, 0.005, 10, 10);
glPopMatrix();
glPopMatrix();
SwapBuffers(dc);
glPopMatrix;
glFlush;
gluDeleteNurbsRenderer(Nurbs); //Удаление Nurbs-поверхности
end;
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);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
dc:=getdc(Handle);
SetDCPixelFormat(dc);
hrc := wglCreateContext(dc);
wglMakeCurrent(dc, hrc);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
gluDeleteQuadric (QuadObj);
wglMakeCurrent (0, 0);
wglDeleteContext (hrc);
ReleaseDC (Handle, DC);
DeleteDC(DC);
end;
(******************** Перемещение с помощью мыши*******************************)
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
wX:=X;
wY:=Y;
rotate:=true;
InvalidateRect(handle, nil, false);
end;
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
rotate:=false;
InvalidateRect(handle, nil, false);
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if rotate then
begin
rX := rX+(X-wX)/2;
rY := rY+(Y-wY)/2;
wX := X;
wY := Y;
InvalidateRect(handle, nil, false);
end;
end;
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
If Key = vk_escape then Close;
end;
end.
|
|
