?? tunnel.dpr
字號:
program Tunnel;
uses
Windows,
Messages,
OpenGL,
BMP;
const
WND_TITLE = 'Tunnel App by Jan Horn';
FPS_TIMER = 1; // Timer to calculate FPS
FPS_INTERVAL = 1000; // Calculate FPS every 1000 ms
TEXTURE_SPEED = 1/50;
type glCoord = Record
X, Y, Z : glFLoat;
end;
var
h_Wnd : HWND; // Global window handle
h_DC : HDC; // Global device context
h_RC : HGLRC; // OpenGL rendering context
keys : Array[0..255] of Boolean; // Holds keystrokes
FPSCount : Integer = 1; // Counter for FPS
ElapsedTime : Integer; // Elapsed time between frames
// Textures
TunnelTex : glUint;
// User vaiables
Tunnels : Array[0..32, 0..32] of glCoord;
Angle : glFloat;
Speed : glFloat;
Manual : Boolean;
{$R *.RES}
procedure glBindTexture(target: GLenum; texture: GLuint); stdcall; external opengl32;
{------------------------------------------------------------------}
{ Function to convert int to string. (No sysutils = smaller EXE) }
{------------------------------------------------------------------}
function IntToStr(Num : Integer) : String; // using SysUtils increase file size by 100K
begin
Str(Num, result);
end;
{------------------------------------------------------------------}
{ Function to draw the actual scene }
{------------------------------------------------------------------}
procedure glDraw();
var I, J : Integer;
C, J1, J2 : glFloat;
begin
glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT); // Clear The Screen And The Depth Buffer
glLoadIdentity(); // Reset The View
glTranslatef(0.0,0.0,-4.2);
if Manual then
Angle :=Angle + speed
else
Angle :=ElapsedTime/14;
// setup tunnel coordinates
for I :=0 to 12 do
begin
for J :=0 to 32 do
begin
Tunnels[I, J].X :=(3 - J/12)*cos(2*pi/12*I) + 2*sin((Angle+2*j)/29) + cos((Angle+2*j)/13) - 2*sin(Angle/29) - cos(Angle/13);
Tunnels[I, J].Y :=(3 - J/12)*sin(2*pi/12*I) + 2*cos((Angle+2*j)/33) + sin((Angle+2*j)/17) - 2*cos(Angle/33) - sin(Angle/17);
Tunnels[I, J].Z :=-J;
end;
end;
// draw tunnel
For J :=0 to 30 do
begin
J1 :=J/32 + Angle*TEXTURE_SPEED; // precalculate texture v coords for speed
J2 :=(J+1)/32 + Angle*TEXTURE_SPEED;
// near the end of the tunnel, fade the effect away
if J > 24 then
C :=1.0-(J-24)/10
else
C :=1.0;
glColor3f(C, C, C);
glBegin(GL_QUADS);
For I :=0 to 11 do
begin
glTexCoord2f((I-3)/12, J1); glVertex3f(Tunnels[ I, J ].X, Tunnels[ I, J ].Y, Tunnels[ I, J ].Z);
glTexCoord2f((I-2)/12, J1); glVertex3f(Tunnels[I+1, J ].X, Tunnels[I+1, J ].Y, Tunnels[I+1, J ].Z);
glTexCoord2f((I-2)/12, J2); glVertex3f(Tunnels[I+1, J+1].X, Tunnels[I+1, J+1].Y, Tunnels[I+1, J+1].Z);
glTexCoord2f((I-3)/12, J2); glVertex3f(Tunnels[ I, J+1].X, Tunnels[ I, J+1].Y, Tunnels[ I, J+1].Z);
end;
glEnd();
end;
end;
{------------------------------------------------------------------}
{ Initialise OpenGL }
{------------------------------------------------------------------}
procedure glInit();
begin
glClearColor(0.0, 0.0, 0.0, 0.0); // Black Background
glShadeModel(GL_SMOOTH); // Enables Smooth Color Shading
glClearDepth(1.0); // Depth Buffer Setup
glEnable(GL_DEPTH_TEST); // Enable Depth Buffer
glDepthFunc(GL_LESS); // The Type Of Depth Test To Do
glHint(GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST); //Realy Nice perspective calculations
glEnable(GL_TEXTURE_2D); // Enable Texture Mapping
LoadTexture('tunnel.bmp', TunnelTex);
Speed :=0;
Angle :=0;
Manual :=FALSE;
end;
{------------------------------------------------------------------}
{ Handle window resize }
{------------------------------------------------------------------}
procedure glResizeWnd(Width, Height : Integer);
begin
if (Height = 0) then // prevent divide by zero exception
Height := 1;
glViewport(0, 0, Width, Height); // Set the viewport for the OpenGL window
glMatrixMode(GL_PROJECTION); // Change Matrix Mode to Projection
glLoadIdentity(); // Reset View
gluPerspective(45.0, Width/Height, 1.0, 100.0); // Do the perspective calculations. Last value = max clipping depth
glMatrixMode(GL_MODELVIEW); // Return to the modelview matrix
glLoadIdentity(); // Reset View
end;
{------------------------------------------------------------------}
{ Processes all the keystrokes }
{------------------------------------------------------------------}
procedure ProcessKeys;
begin
if (keys[VK_UP]) then
begin
if Manual =FALSE then
begin
Manual :=TRUE;
speed := 0.5;
end
else
Speed :=Speed + 0.005;
end;
if (keys[VK_DOWN]) then
begin
if Manual =FALSE then
begin
Manual :=TRUE;
speed := 0.5;
end
else
Speed :=Speed - 0.005;
end
end;
{------------------------------------------------------------------}
{ Determines the application抯 response to the messages received }
{------------------------------------------------------------------}
function WndProc(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin
case (Msg) of
WM_CREATE:
begin
// Insert stuff you want executed when the program starts
end;
WM_CLOSE:
begin
PostQuitMessage(0);
Result := 0
end;
WM_KEYDOWN: // Set the pressed key (wparam) to equal true so we can check if its pressed
begin
keys[wParam] := True;
Result := 0;
end;
WM_KEYUP: // Set the released key (wparam) to equal false so we can check if its pressed
begin
keys[wParam] := False;
Result := 0;
end;
WM_SIZE: // Resize the window with the new width and height
begin
glResizeWnd(LOWORD(lParam),HIWORD(lParam));
Result := 0;
end;
WM_TIMER : // Add code here for all timers to be used.
begin
if wParam = FPS_TIMER then
begin
FPSCount :=Round(FPSCount * 1000/FPS_INTERVAL); // calculate to get per Second incase intercal is less or greater than 1 second
SetWindowText(h_Wnd, PChar(WND_TITLE + ' [' + intToStr(FPSCount) + ' FPS]'));
FPSCount := 0;
Result := 0;
end;
end;
else
Result := DefWindowProc(hWnd, Msg, wParam, lParam); // Default result if nothing happens
end;
end;
{---------------------------------------------------------------------}
{ Properly destroys the window created at startup (no memory leaks) }
{---------------------------------------------------------------------}
procedure glKillWnd(Fullscreen : Boolean);
begin
if Fullscreen then // Change back to non fullscreen
begin
ChangeDisplaySettings(devmode(nil^), 0);
ShowCursor(True);
end;
// Makes current rendering context not current, and releases the device
// context that is used by the rendering context.
if (not wglMakeCurrent(h_DC, 0)) then
MessageBox(0, 'Release of DC and RC failed!', 'Error', MB_OK or MB_ICONERROR);
// Attempts to delete the rendering context
if (not wglDeleteContext(h_RC)) then
begin
MessageBox(0, 'Release of rendering context failed!', 'Error', MB_OK or MB_ICONERROR);
h_RC := 0;
end;
// Attemps to release the device context
if ((h_DC = 1) and (ReleaseDC(h_Wnd, h_DC) <> 0)) then
begin
MessageBox(0, 'Release of device context failed!', 'Error', MB_OK or MB_ICONERROR);
h_DC := 0;
end;
// Attempts to destroy the window
if ((h_Wnd <> 0) and (not DestroyWindow(h_Wnd))) then
begin
MessageBox(0, 'Unable to destroy window!', 'Error', MB_OK or MB_ICONERROR);
h_Wnd := 0;
end;
// Attempts to unregister the window class
if (not UnRegisterClass('OpenGL', hInstance)) then
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -