Форум: "Игры";
Текущий архив: 2003.05.22;
Скачать: [xml.tar.bz2];

Вниз

Па-ма-ги-те!!!   Найти похожие ветки 

← →
PaRL   (2002-12-12 22:12) [0]

Это пример пермещения ромба по форме. Когда мы перместили ромб в некоторую точку - он закрепился. Когда мы снова пробуем его перемещать - он перемещается в середину.
Почему?

unit MainU;

interface

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

type
TfmMain = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private

public
procedure SetDCPixelFormat;
procedure ScreenToSpace(mouseX, mouseY : GLInt; var X, Y : GLFloat);
procedure Render(mode : GLEnum); //Визуализация
function DoSelect(x, y : GLint) : GLint; //Select
procedure MassInit(pos : integer); //инициация
protected
procedure WMPaint(var Mes : TWMPaint); message WM_PAINT;
end;

var
fmMain: TfmMain;

implementation

type
TObj = record
Up : array [0..1] of glfloat;
Left : array [0..1] of glfloat;
Down : array [0..1] of glfloat;
Right : array [0..1] of glfloat;
x, y : GLUint;
W, H : GLFloat;
ObjType : (Paral, Quad, Romb);
end;

const MatA : array [0..3] of glfloat = (0.7, 0.2, 0.3, 1.0);
MatD : array [0..3] of glfloat = (0.7, 0.4, 0.5, 1.0);
MatS : array [0..3] of glfloat = (0.1, 0.6, 0.7, 1.0);

pos : array [0..3] of glfloat = (0, 0, -5.5, 1);

var DC : HDC;
hrc : HGLRC;
xc0, yc0, xc, yc, m, n : glFloat;

flgDrag : boolean; //OBJmove-флаг
flgInit : boolean; //MassInit-флаг

vp : array [0..3] of GLint; //Viewport-буфер
selectBuf : array [0..128] of GLuint; //Select-буфер

obj : array of TObj;

{$R *.dfm}

{================================================================
Координаты, высота и ширина объекта}
procedure TfmMain.MassInit(pos : integer);
begin
obj[pos].W := 1;
obj[pos].H := 1;

obj[pos].Up[0] := m;
obj[pos].Up[1] := -obj[pos].H/2+n;

obj[pos].Left[0] := -obj[pos].W/2+m;
obj[pos].Left[1] := n;

obj[pos].Down[0] := m;
obj[pos].Down[1] := obj[pos].H/2+n;

obj[pos].Right[0] := obj[pos].W/2+m;
obj[pos].Right[1] := n;
end;

{======================================================================
Функция выбора объектов}
function TfmMain.DoSelect(x, y : GLint) : GLint;
begin
glRenderMode(GL_SELECT); // режим выбора
// режим выбора нужен для работы следующих команд
glInitNames; // инициализация стека имен
glPushName(0); // помещение имени в стек имен

glGetIntegerv(GL_VIEWPORT, @vp);

glMatrixMode(GL_PROJECTION);
glLoadIdentity;
gluPickMatrix(x, ClientHeight - y, 2, 2, @vp);
gluPerspective(50.0, ClientWidth/ClientHeight, 1.0, 20.0);
glViewport(0, 0, ClientWidth, ClientHeight);
glMatrixMode(GL_MODELVIEW);

glClear(GL_COLOR_BUFFER_BIT);

Render(GL_SELECT); // рисуем массив объектов с выбором

Result := glRenderMode(GL_RENDER);
SendMessage(Handle, WM_SIZE, 0, 0) //????
end;

{=======================================================================
Визуализация. }
procedure TfmMain.Render(mode : GLEnum);
begin
glMaterialfv(GL_FRONT, GL_AMBIENT, @MatA);
glMaterialfv(GL_FRONT, GL_DIFFUSE, @MatD);
glMaterialfv(GL_FRONT, GL_SPECULAR, @MatS);

if mode = GL_SELECT then glLoadName(1);
glPushMatrix;
glBegin(GL_QUADS);
glVertex2fv(@obj[0].Up); //верх1
glVertex2fv(@obj[0].Left); //лево1
glVertex2fv(@obj[0].Down); //низ1
glVertex2fv(@obj[0].Right); //право1
glEnd;
glPopMatrix;
end;

{=======================================================================
Перевод оконных координат в OpenGL}
{procedure TfmMain.ScreenToSpace (mouseX, mouseY : GLInt; var X, Y : GLFloat);
begin
X := 8 * (mouseX - ClientWidth/2) / ClientWidth;
Y := 5.6 * (ClientHeight/2 - mouseY) / ClientHeight;
end;
}
procedure TfmMain.ScreenToSpace (mouseX, mouseY : GLInt; var X, Y : GLFloat);
var
Viewport : Array [0..3] of GLInt;
mvMatrix, ProjMatrix : Array [0..15] of GLDouble;
RealY : GLint ;
wx, wy, wz : GLdouble ;
Zval : GLfloat;
begin
FillChar(ViewPort, SizeOf(ViewPort), 0);
FillChar(ProjMatrix, SizeOf(ProjMatrix), 0);
FillChar(mvMatrix, SizeOf(mvMatrix), 0);

glGetIntegerv (GL_VIEWPORT, @Viewport);
glGetDoublev (GL_MODELVIEW_MATRIX, @mvMatrix);
glGetDoublev (GL_PROJECTION_MATRIX, @ProjMatrix);

RealY := viewport[3] - mouseY - 1;
glReadPixels(mouseX, RealY, 1, 1, GL_DEPTH_COMPONENT, GL_FLOAT, @Zval);

gluUnProject (mouseX, RealY, Zval, @mvMatrix, @ProjMatrix, @Viewport, wx, wy, wz);
X := wx; Y := wy;
end;


---

← →
PaRL   (2002-12-12 22:13) [1]

продолжение



{=======================================================================
Контекст устройства}
procedure TfmMain.SetDCPixelFormat;
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(DC, @pfd);
SetPixelFormat(DC, nPixelFormat, @pfd);
end;

{=======================================================================
PAINT}
procedure TfmMain.WMPaint(var Mes : TWMPAINT);
var ps : TPaintStruct;
begin
BeginPaint(Handle, ps);
glClearColor(0.9, 0.9, 0.3, 1.0);
glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
glLoadIdentity;
glTranslatef(0.0, 0.0, -6.0);
if flgInit = false then MassInit(0);

flgInit := true;
Render(GL_RENDER);

SwapBuffers(DC);
EndPaint(Handle, ps);
end;

procedure TfmMain.FormCreate(Sender: TObject);
begin
Application.Title := "GL";
DC := GetDC(Handle);
SetDCPixelFormat;
hrc := wglCreateContext(DC);
wglMakeCurrent(dc, hrc);

glEnable(GL_DEPTH_TEST); // разрешаем тест глубины
glEnable(GL_LIGHTING);
glEnable(GL_LIGHT0);

glLightfv(GL_LIGHT0, GL_POSITION, @pos);
glSelectBuffer(SizeOf (selectBuf), @selectBuf);
SetLength(obj, 1);
end;

procedure TfmMain.FormDestroy(Sender: TObject);
begin
obj := nil;
wglMakeCurrent(0, 0);
wglDeleteContext(hrc);
ReleaseDC(Handle, DC);
DeleteDC(DC);
end;

procedure TfmMain.FormResize(Sender: TObject);
begin
glViewport(0, 0, ClientWidth, ClientHeight);
glMatrixMode(GL_PROJECTION);
glLoadIdentity;
gluPerspective(50.0, ClientWidth / ClientHeight, 1.0, 20.0);
glMatrixMode(GL_MODELVIEW);
MassInit(0);
InvalidateRect(Handle, nil, False);
end;

procedure TfmMain.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
hit, hits, id: GLUint;
begin
id := 0;
hits := DoSelect (X, Y);
For hit := 1 to hits do
id := SelectBuf[(hit - 1)* 4 + 3];

if id = 1 then
begin
flgDrag := true;
InvalidateRect(Handle, nil, False);
end;
ScreenToSpace(X, Y, xC0, yC0);
end;

procedure TfmMain.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if flgDrag then
begin
ScreenToSpace(X, Y, xC, yC);
m := xc - xc0;
n := yc - yc0;
MassInit(0);
InvalidateRect(handle, nil, False);
end;
end;

procedure TfmMain.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if flgDrag then
begin
flgInit := true;
InvalidateRect(Handle, nil, False);
end;
flgDrag := false;
end;

end.


---

← →
PaRL   (2002-12-12 22:14) [2]

И ещё. Почему в процедуре DoSelect надо посылать сообщение WM_SIZE, чтобы всё работало корректно?
Я смотрел в документации - там нет этого.

---

← →
PaRL   (2002-12-13 19:38) [3]

Всем спасибо, с перемещением я разобрался. Осталось только DoSelect.
Пожалуйста, посмотрите.

---

← →
Ketmar   (2002-12-14 14:52) [4]

вы бы полный проект где положили. мне, например, лень создавать форму. если б был проект, я бы еще скомпилил да глянул, а так...

Satanas Nobiscum! 14-Dec-XXXVII A.S.

---

← →
PaRL   (2002-12-14 21:59) [5]

Но если учесть, что в моём проекте одна форма, юнит которой я привёл...


> вы бы полный проект где положили


Куда положить?

---

Страницы: 1 вся ветка

Форум: "Игры";
Текущий архив: 2003.05.22;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.47 MB
Время: 0.007 c