unit
Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, OpenGL, StdCtrls, ExtCtrls, Jpeg, DIB;
type
TForm1 =
class
(TForm)
Timer1: TTimer;
OD1: TOpenDialog;
DXDIB1: TDXDIB;
procedure
FormCreate(Sender: TObject);
procedure
FormDestroy(Sender: TObject);
procedure
FormResize(Sender: TObject);
procedure
Timer1Timer(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
);
procedure
FormDblClick(Sender: TObject);
private
nX, nY, oX, oY, oxx, oyy: GLDouble;
dr:
boolean
;
Pic: TPicture;
public
function
SetPixFormat(DC: HDC):
boolean
;
procedure
doQuard(ListInd:
integer
);
procedure
doDraw;
end
;
var
Form1: TForm1;
DC: HDC;
HRC: HGLRC;
implementation
{$R *.dfm}
function
TForm1
.
SetPixFormat(DC: HDC):
boolean
;
var
pfd: PIXELFORMATDESCRIPTOR;
ppfd: PPIXELFORMATDESCRIPTOR;
pixFormat:
integer
;
begin
ppfd:= @pfd;
ppfd
.
nSize:= SizeOf(PIXELFORMATDESCRIPTOR);
ppfd
.
nVersion:=
1
;
ppfd
.
dwFlags:= PFD_DRAW_TO_WINDOW
xor
PFD_SUPPORT_OPENGL
xor
PFD_DOUBLEBUFFER;
ppfd
.
dwLayerMask:= PFD_MAIN_PLANE;
ppfd
.
iPixelType:= PFD_TYPE_RGBA;
ppfd
.
cColorBits:=
32
;
ppfd
.
cDepthBits:=
32
;
ppfd
.
cAccumBits:=
0
;
ppfd
.
cStencilBits:=
0
;
pixFormat:= ChoosePixelFormat(DC, ppfd);
if
(pixFormat =
0
)
or
not
SetPixelFormat(DC, pixFormat, ppfd)
then
begin
ShowMessage(
'NONONO'
);
Result:=
false
;
exit;
end
;
Result:=
true
;
end
;
procedure
TForm1
.
FormCreate(Sender: TObject);
var
p: TGLArrayf4;
d: TGLArrayf3;
begin
DC:= GetDC(Handle);
if
not
SetPixFormat(DC)
then
exit;
HRC:= wglCreateContext(DC);
wglMakeCurrent(DC, HRC);
glClearColor(
0.2
,
0.2
,
0.2
,
1.0
);
glEnable(GL_COLOR_MATERIAL
or
GL_DEPTH_TEST);
dr:=
false
;
nX:= -
400.0
; nY:= -
400.0
;
Pic:= TPicture
.
Create;
end
;
procedure
TForm1
.
FormDestroy(Sender: TObject);
begin
wglMakeCurrent(
0
,
0
);
wglDeleteContext(HRC);
ReleaseDC(Handle, DC);
DeleteDC(DC);
Pic
.
Free;
end
;
procedure
TForm1
.
FormResize(Sender: TObject);
begin
glViewPort(
0
,
0
, ClientWidth, ClientHeight);
glMatrixMode(GL_PROJECTION);
glLoadIdentity;
glOrtho(-
500
,
500
, -
500
,
500
,
2
,
1200
);
gluLookAt(
0
,
0
,
500
,
0
,
0
,
0
,
0
,
1
,
0
);
glMatrixMode(GL_MODELVIEW);
doDraw;
end
;
procedure
TForm1
.
doQuard(ListInd:
integer
);
begin
glClear(GL_DEPTH_BUFFER_BIT
xor
GL_COLOR_BUFFER_BIT);
glBegin(GL_QUADS);
glColor3f(
0
,
0
,
1
);
glVertex3f(nX, nY,
0
);
glColor3f(
0
,
1
,
0
);
glVertex3f(nX +
800
, nY,
0
);
glColor3f(
1
,
0
,
0
);
glVertex3f(nX +
800
, nY +
800
,
0
);
glColor3f(
0
,
1
,
1
);
glVertex3f(nX, nY +
800
,
0
);
glEnd;
SwapBuffers(DC);
end
;
procedure
TForm1
.
Timer1Timer(Sender: TObject);
begin
doDraw;
end
;
procedure
TForm1
.
FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y:
Integer
);
var
xx, yy: GLDouble;
begin
oX:= nX; oY:= nY;
xx:=
500
- (X / ClientWidth) *
1000
;
yy:=
500
- (
1
- Y / ClientHeight) *
1000
;
begin
dr:=
true
;
oxx:= xx; oyy:= yy;
end
;
end
;
procedure
TForm1
.
FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y:
Integer
);
var
xx, yy: GLDouble;
begin
if
dr
then
begin
xx:=
500
- (X / ClientWidth) *
1000
;
yy:=
500
- (
1
- Y / ClientHeight) *
1000
;
nX:= oX - xx + oxx;
nY:= oY - yy + oyy;
doDraw;
end
;
end
;
procedure
TForm1
.
FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y:
Integer
);
begin
dr:=
false
;
end
;
procedure
TForm1
.
FormDblClick(Sender: TObject);
begin
if
OD1
.
Execute
then
begin
Pic
.
LoadFromFile(OD1
.
FileName);
end
;
end
;
procedure
TForm1
.
doDraw;
begin
doQuard(
1
);
end
;
end
.