openglapp.dpr

planet sistem on delphi by anonim

//------------------------------------------------------------------------
//
// Author      : Maarten Kronberger
// Email       : [e-mail]
// Website     : http://www.sulaco.co.za
// Date        : 03 November 2003
// Version     : 1.0
// Description : A Planetary System With moon
//
//------------------------------------------------------------------------
program OpenGLApp;

uses
  Windows,
  Messages,
  OpenGL;

const
  WND_TITLE = 'A Planetary System With moon by McCLaw (RedBook)';
  FPS_TIMER = 1;                     // Timer to calculate FPS
  FPS_INTERVAL = 1000;               // Calculate FPS every 1000 ms

  // User Constants



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 = 0;            // Counter for FPS
  ElapsedTime : Integer;             // Elapsed time between frames

  // User Variables

  spin : GLfloat = 0.0;              // Var used for the amount to rotate an object by

  year: GLint = 0;
  day : GLint = 0;
  hour : GLint = 0;
  AutoRun : boolean = True;

  // Quadric for sphere ( Dont worry too much about this now we'll handle this later)
  SphereQuadratic : gluQuadricObj;

{$R *.RES}

{------------------------------------------------------------------}
{  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;


{------------------------------------------------------------------}
{  Calculate the next rotation value an assign it to spin          }
{------------------------------------------------------------------}
procedure SpinDisplay();
begin
    spin := spin + 2.0;
    if spin > 360.0 then
        spin := spin - 360.0;
end;

procedure DayAdd();
begin
    day := (day + 10) mod 360;
end;

procedure DaySubtract();
begin
    day := (day - 10) mod 360;
end;

procedure HourAdd();
begin
    hour := (hour + 15) mod 360;
end;

procedure HourSubtract();
begin
    hour := (hour - 15) mod 360;
end;

procedure YearAdd();
begin
    year := (year + 5) mod 360;
end;

procedure YearSubtract();
begin
    year := (year - 5) mod 360;
end;


{------------------------------------------------------------------}
{  Function to draw the actual scene                               }
{------------------------------------------------------------------}
procedure glDraw();
begin
  glClearColor(0.0, 0.0, 0.0, 1.0); // Black Background
  glClear (GL_COLOR_BUFFER_BIT);    // Clear the colour  buffer
  glLoadIdentity();                 // Load a "clean" model matrix on the stack

  if AutoRun then
  begin
    HourAdd;
    DayAdd;
    YearAdd;
  end;

  glTranslatef(0.0,0.0,-5.0);                 // Move the scene 5 units back otherwise it will be directly on our camera and thus invisible
  glRotatef(45,1.0,0.0,0.0);                  // Rotate the scene 45 degrees on the x-axis so we can see the rotation properly
  glPushMatrix();                             // Copy the curent matrix and add it to the stack
    glColor3f (1.0, 1.0, 0.0);                // Set colour to Yellow
    gluSphere(SphereQuadratic, 0.8, 32, 32);  // draw sun
    glRotatef(year, 0.0, 1.0, 0.0);           // Rotate according to sun
    glTranslatef (2.0, 0.0, 0.0);             // Translate 2 units away from the sun
    glRotatef(day, 0.0, 1.0, 0.0);            // Rotate the planet according to the time of day 
    glColor3f (0.0, 1.0, 0.0);                // Set colour to green
    gluSphere(SphereQuadratic, 0.3, 32, 32);  // Draw smaller planet
    glPushMatrix();                           // Copy the curent matrix and add it to the stack
      glColor3f(0.5,0.5,0.5);                 // Set colour to grey
      glTranslatef (0.5, 0.0, 0.0);
      glRotatef(hour, 0.0, 1.0, 0.0);
      gluSphere(SphereQuadratic, 0.1, 32, 32);// Draw Moon
    glPopMatrix();                            // Restore the previous matrix
  glPopMatrix();                              // Restore the previous matrix

  // Flush the OpenGL Buffer
  glFlush();                        // ( Force the buffer to draw or send a network packet of commands in a networked system)

end;

{------------------------------------------------------------------}
{  Initialise OpenGL                                               }
{------------------------------------------------------------------}
procedure glInit();
begin
  glClearColor(0.0, 0.0, 0.0, 1.0); // Black Background
  glColor3f(1.0, 1.0, 1.0);         // Set the Polygon colour to white
  glShadeModel(GL_FLAT);            // Use Flat shading

  glPolygonMode(GL_FRONT_AND_BACK, GL_LINE);  // Draw Both front and back facing polygons as lines

  // Generate a sphere using the OpenGL utility Library
  SphereQuadratic := gluNewQuadric();		          // Create A Pointer To The Quadric Object (Return 0 If No Memory) (NEW)
  gluQuadricNormals(SphereQuadratic, GLU_SMOOTH);	// Create Smooth Normals (NEW)
  gluQuadricTexture(SphereQuadratic, GL_TRUE);	  // Create Texture Coords (NEW)
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, 20.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[76] then DayAdd;        // L
  if keys[75] then DaySubtract;   // K
  if keys[74] then YearAdd;       // J
  if keys[72] then YearSubtract;  // H
  if keys[65] then                // A
  begin
     keys[65] := False;
     AutoRun := not AutoRun;
  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 > 0) 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;