tunnel.dpr

用delphi编写的一个3D隧道演示程序

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