this slowpoke moves

Draw Antialiased Wireframe Icosahedron

program WireIcosahedron;

uses
  Windows,
  Messages,
  OpenGL;

const
  WND_TITLE = 'Antialiased Wireframe Icosahedron';
  FPS_TIMER = 1;                     
  FPS_INTERVAL = 1000;               
  X = 0.525731112119133606;
  Z = 0.850650808352039932;
  vdata : array [0..11] of array [0..2] of GLfloat = (
   (-X, 0.0, Z), (X, 0.0, Z), (-X, 0.0, -Z), (X, 0.0, -Z),
   (0.0, Z, X), (0.0, Z, -X), (0.0, -Z, X), (0.0, -Z, -X),
   (Z, X, 0.0), (-Z, X, 0.0), (Z, -X, 0.0), (-Z, -X, 0.0)
    );
  tindices : array [0..19] of array [0..2] of GLint = (
   (0,4,1), (0,9,4), (9,5,4), (4,5,8), (4,8,1),
   (8,10,1), (8,3,10),(5,3,8), (5,2,3), (2,7,3),
   (7,10,3), (7,6,10), (7,11,6), (11,0,6), (0,1,6),
   (6,1,10), (9,0,11), (9,11,2), (9,2,5), (7,2,11)
   );

var
  h_Wnd  : HWND;                     
  h_DC   : HDC;                      
  h_RC   : HGLRC;                    
  keys : Array[0..255] of Boolean;   
  FPSCount : Integer = 0;            
  ElapsedTime : Integer;             
  spin : GLfloat = 0.0;

{$R *.RES}
function IntToStr(Num : Integer) : String;  
begin
  Str(Num, result);
end;

procedure SpinDisplay();
begin
    spin := spin + 2.0;
    if spin > 360.0 then
        spin := spin - 360.0;
end;

procedure glDraw();
var i : GLint;
begin
  glClearColor(0.0, 0.0, 0.0, 1.0); 
  glClear (GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);    
  glLoadIdentity();                 
  glColor4f(1.0, 1.0, 1.0, 1.0);    
  glTranslatef(0.0,0.0,-10.0);      
  SpinDisplay();                    
  glRotatef(spin,1.0,1.0,1.0);      
  for i := 0 to 19 do               
  begin
   glBegin(GL_TRIANGLES);
      glVertex3fv(@vdata[tindices[i][0]][0]);
      glVertex3fv(@vdata[tindices[i][1]][0]);
      glVertex3fv(@vdata[tindices[i][2]][0]);
   glEnd();
  end;
  glFlush();                        
end;

procedure glInit();
begin
  glClearColor(0.0, 0.0, 0.0, 0.0);       
  glColor3f(1.0, 1.0, 1.0);               
  glEnable(GL_LINE_SMOOTH);               
  glEnable(GL_BLEND);                     
  glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); 
  glHint(GL_LINE_SMOOTH_HINT, GL_NICEST); 
  glLineWidth(1.5);                       
  glShadeModel(GL_FLAT);                  
  glDepthFunc(GL_LEQUAL);                 
  glEnable(GL_DEPTH_TEST);                
  glPolygonMode(GL_FRONT_AND_BACK,GL_LINE);
end;

procedure glResizeWnd(Width, Height : Integer);
begin
  if (Height = 0) then                
    Height := 1;
  glViewport(0, 0, Width, Height);    
  glMatrixMode(GL_PROJECTION);        
  glLoadIdentity();                   
  gluPerspective(45.0, Width/Height, 1.0, 30.0);  
  glMatrixMode(GL_MODELVIEW);         
  glLoadIdentity();                   
end;

procedure ProcessKeys;
begin
end;
function WndProc(hWnd: HWND; Msg: UINT;  wParam: WPARAM;  lParam: LPARAM): LRESULT; stdcall;
begin
  case (Msg) of
    WM_CREATE:
      begin
      end;
    WM_CLOSE:
      begin
        PostQuitMessage(0);
        Result := 0
      end;
    WM_KEYDOWN:       
      begin
        keys[wParam] := True;
        Result := 0;
      end;
    WM_KEYUP:         
      begin
        keys[wParam] := False;
        Result := 0;
      end;
    WM_SIZE:          
      begin
        glResizeWnd(LOWORD(lParam),HIWORD(lParam));
        Result := 0;
      end;
    WM_TIMER :                     
      begin
        if wParam = FPS_TIMER then
        begin
          FPSCount :=Round(FPSCount * 1000/FPS_INTERVAL);   
          SetWindowText(h_Wnd, PChar(WND_TITLE + '   [' + intToStr(FPSCount) + ' FPS]'));
          FPSCount := 0;
          Result := 0;
        end;
      end;
    else
      Result := DefWindowProc(hWnd, Msg, wParam, lParam);    
  end;
end;

procedure glKillWnd(Fullscreen : Boolean);
begin
  if Fullscreen then             
  begin
    ChangeDisplaySettings(devmode(nil^), 0);
    ShowCursor(True);
  end;
  if (not wglMakeCurrent(h_DC, 0)) then
    MessageBox(0, 'Release of DC and RC failed!', 'Error', MB_OK or MB_ICONERROR);
  if (not wglDeleteContext(h_RC)) then
  begin
    MessageBox(0, 'Release of rendering context failed!', 'Error', MB_OK or MB_ICONERROR);
    h_RC := 0;
  end;
  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;
  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;
  if (not UnRegisterClass('OpenGL', hInstance)) then
  begin
    MessageBox(0, 'Unable to unregister window class!', 'Error', MB_OK or MB_ICONERROR);
    hInstance := 0;
  end;
end;

function glCreateWnd(Width, Height : Integer; Fullscreen : Boolean; PixelDepth : Integer) : Boolean;
var
  wndClass : TWndClass;         
  dwStyle : DWORD;              
  dwExStyle : DWORD;            
  dmScreenSettings : DEVMODE;   
  PixelFormat : GLuint;         
  h_Instance : HINST;           
  pfd : TPIXELFORMATDESCRIPTOR;  
begin
  h_Instance := GetModuleHandle(nil);       
  ZeroMemory(@wndClass, SizeOf(wndClass));  
  with wndClass do                    
  begin
    style         := CS_HREDRAW or    
                     CS_VREDRAW or    
                     CS_OWNDC;        
    lpfnWndProc   := @WndProc;        
    hInstance     := h_Instance;
    hCursor       := LoadCursor(0, IDC_ARROW);
    lpszClassName := 'OpenGL';
  end;
  if (RegisterClass(wndClass) = 0) then  
  begin
    MessageBox(0, 'Failed to register the window class!', 'Error', MB_OK or MB_ICONERROR);
    Result := False;
    Exit
  end;
  if Fullscreen then
  begin
    ZeroMemory(@dmScreenSettings, SizeOf(dmScreenSettings));
    with dmScreenSettings do begin              
      dmSize       := SizeOf(dmScreenSettings);
      dmPelsWidth  := Width;                    
      dmPelsHeight := Height;                   
      dmBitsPerPel := PixelDepth;               
      dmFields     := DM_PELSWIDTH or DM_PELSHEIGHT or DM_BITSPERPEL;
    end;
    if (ChangeDisplaySettings(dmScreenSettings, CDS_FULLSCREEN) = DISP_CHANGE_FAILED) then
    begin
      MessageBox(0, 'Unable to switch to fullscreen!', 'Error', MB_OK or MB_ICONERROR);
      Fullscreen := False;
    end;
  end;
  if (Fullscreen) then
  begin
    dwStyle := WS_POPUP or                
               WS_CLIPCHILDREN            
               or WS_CLIPSIBLINGS;        
    dwExStyle := WS_EX_APPWINDOW;         
    ShowCursor(False);                    
  end
  else
  begin
    dwStyle := WS_OVERLAPPEDWINDOW or     
               WS_CLIPCHILDREN or         
               WS_CLIPSIBLINGS;           
    dwExStyle := WS_EX_APPWINDOW or       
                 WS_EX_WINDOWEDGE;        
  end;
  h_Wnd := CreateWindowEx(dwExStyle,      
                          'OpenGL',       
                          WND_TITLE,      
                          dwStyle,        
                          0, 0,           
                          Width, Height,  
                          0,              
                          0,              
                          h_Instance,     
                          nil);           
  if h_Wnd = 0 then
  begin
    glKillWnd(Fullscreen);                
    MessageBox(0, 'Unable to create window!', 'Error', MB_OK or MB_ICONERROR);
    Result := False;
    Exit;
  end;
  h_DC := GetDC(h_Wnd);
  if (h_DC = 0) then
  begin
    glKillWnd(Fullscreen);
    MessageBox(0, 'Unable to get a device context!', 'Error', MB_OK or MB_ICONERROR);
    Result := False;
    Exit;
  end;
  with pfd do
  begin
    nSize           := SizeOf(TPIXELFORMATDESCRIPTOR); 
    nVersion        := 1;                    
    dwFlags         := PFD_DRAW_TO_WINDOW    
                       or PFD_SUPPORT_OPENGL 
                       or PFD_DOUBLEBUFFER;  
    iPixelType      := PFD_TYPE_RGBA;        
    cColorBits      := PixelDepth;           
    cRedBits        := 0;                    
    cRedShift       := 0;                    
    cGreenBits      := 0;                    
    cGreenShift     := 0;                    
    cBlueBits       := 0;                    
    cBlueShift      := 0;                    
    cAlphaBits      := 0;                    
    cAlphaShift     := 0;                    
    cAccumBits      := 0;                    
    cAccumRedBits   := 0;                    
    cAccumGreenBits := 0;                    
    cAccumBlueBits  := 0;                    
    cAccumAlphaBits := 0;                    
    cDepthBits      := 16;                   
    cStencilBits    := 0;                    
    cAuxBuffers     := 0;                    
    iLayerType      := PFD_MAIN_PLANE;       
    bReserved       := 0;                    
    dwLayerMask     := 0;                    
    dwVisibleMask   := 0;                    
    dwDamageMask    := 0;                     
  end;
  PixelFormat := ChoosePixelFormat(h_DC, @pfd);
  if (PixelFormat = 0) then
  begin
    glKillWnd(Fullscreen);
    MessageBox(0, 'Unable to find a suitable pixel format', 'Error', MB_OK or MB_ICONERROR);
    Result := False;
    Exit;
  end;
  if (not SetPixelFormat(h_DC, PixelFormat, @pfd)) then
  begin
    glKillWnd(Fullscreen);
    MessageBox(0, 'Unable to set the pixel format', 'Error', MB_OK or MB_ICONERROR);
    Result := False;
    Exit;
  end;
  h_RC := wglCreateContext(h_DC);
  if (h_RC = 0) then
  begin
    glKillWnd(Fullscreen);
    MessageBox(0, 'Unable to create an OpenGL rendering context', 'Error', MB_OK or MB_ICONERROR);
    Result := False;
    Exit;
  end;
  if (not wglMakeCurrent(h_DC, h_RC)) then
  begin
    glKillWnd(Fullscreen);
    MessageBox(0, 'Unable to activate OpenGL rendering context', 'Error', MB_OK or MB_ICONERROR);
    Result := False;
    Exit;
  end;
  SetTimer(h_Wnd, FPS_TIMER, FPS_INTERVAL, nil);
  ShowWindow(h_Wnd, SW_SHOW);
  SetForegroundWindow(h_Wnd);
  SetFocus(h_Wnd);
  glResizeWnd(Width, Height);
  glInit(); 
  Result := True;
end;

function WinMain(hInstance : HINST; hPrevInstance : HINST;
                 lpCmdLine : PChar; nCmdShow : Integer) : Integer; stdcall;
var
  msg : TMsg;
  finished : Boolean;
  DemoStart, LastTime : DWord;
begin
  finished := False;
  if not glCreateWnd(800, 600, FALSE, 32) then
  begin
    Result := 0;
    Exit;
  end;
  DemoStart := GetTickCount();            
  while not finished do
  begin
    if (PeekMessage(msg, 0, 0, 0, PM_REMOVE)) then 
    begin
      if (msg.message = WM_QUIT) then     
        finished := True
      else
      begin                               
  	TranslateMessage(msg);
        DispatchMessage(msg);
      end;
    end
    else
    begin
      Inc(FPSCount);                      
      LastTime :=ElapsedTime;
      ElapsedTime :=GetTickCount() - DemoStart;     
      ElapsedTime :=(LastTime + ElapsedTime) DIV 2; 
      glDraw();                           
      SwapBuffers(h_DC);                  
      if (keys[VK_ESCAPE]) then           
        finished := True
      else
        ProcessKeys;                      
    end;
  end;
  glKillWnd(FALSE);
  Result := msg.wParam;
end;

begin
  WinMain( hInstance, hPrevInst, CmdLine, CmdShow );
end.

Keine Kommentare:

Kommentar veröffentlichen

Beliebte Posts

Translate