Форум программистов [Powered by Invision Power Board]

Код

program PWindowApi;

uses
  Windows,
  Messages;

const
  FPS_TIMER = 1; 
  FPS_INTERVAL = 1000;

var
  Window:HWND; 
  HDC:HDC;     
  HRC:HGLRC;   
  FPSCount : Integer = 1;           
  ElapsedTime : Integer;            
  keys : Array[0..255] of Boolean;  


function WndProc(hWnd: HWND; Msg: UINT;  wParam: WPARAM;  lParam: LPARAM): LRESULT; stdcall;
begin
  case (Msg) of
    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_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
  DestroyWindow(h_Wnd);
  UnRegisterClass('OpenGL', hInstance);
end;


function glCreateWnd(Width, Height : Integer; Fullscreen : Boolean; PixelDepth : Integer) : Boolean;
var
  wndClass : TWndClass;       
  dwStyle : DWORD;              
  dwExStyle : DWORD;           
  dmScreenSettings : DEVMODE;   
  h_Instance : HINST;          
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;

    dwStyle := WS_OVERLAPPEDWINDOW or     
               WS_CLIPCHILDREN or         
               WS_CLIPSIBLINGS;           
    dwExStyle := WS_EX_APPWINDOW or       
                 WS_EX_WINDOWEDGE;        


  h_Wnd := CreateWindowEx(dwExStyle, 'OpenGL',WND_TITLE,dwStyle,0, 0, Width, Height,0, h_Instance,nil);          

  SetTimer(h_Wnd, FPS_TIMER, FPS_INTERVAL, nil);

  ShowWindow(h_Wnd, SW_SHOW);
  SetForegroundWindow(h_Wnd);
  SetFocus(h_Wnd);

  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;

      if (keys[VK_ESCAPE]) then           
        finished := True
      else
        ProcessKeys;                      
    end;
  end;
  glKillWnd(FALSE);
  Result := msg.wParam;
end;


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