basicelectric.dpr

Delphi7编程80例(完全版)

          FPSCount := 0;
          Result := 0;
        end;
      end;
    else
      Result := DefWindowProc(hWnd, Msg, wParam, lParam);
  end;
end;

procedure glKillWnd(Fullscreen : Boolean);
begin
  if SndHandle > 0 then   // 释放声音资源
  begin
    waveOutSetVolume(0, $FFFFFFFF);  // 重新设置双声道
    FreeResource(SndHandle);
  end;
  if Fullscreen then             // 改变到非全屏模式
  begin
    ChangeDisplaySettings(devmode(nil^), 0);
    ShowCursor(True);
  end;
  if (not wglMakeCurrent(h_DC, 0)) then   //切换当前渲染设备
    MessageBox(0, '切换当前渲染设备失败!', '错误', MB_OK or MB_ICONERROR);
  if (not wglDeleteContext(h_RC)) then   // 删除渲染设备
  begin
    MessageBox(0, '删除渲染设备失败!', '错误', MB_OK or MB_ICONERROR);
    h_RC := 0;
  end;
  if ((h_DC = 1) and (ReleaseDC(h_Wnd, h_DC) <> 0)) then  // 释放设备环境
  begin
    MessageBox(0, '释放设备环境失败!', '错误', MB_OK or MB_ICONERROR);
    h_DC := 0;
  end;
  if ((h_Wnd <> 0) and (not DestroyWindow(h_Wnd))) then   //销毁窗口
  begin
    MessageBox(0, '不能销毁窗口!', '错误', MB_OK or MB_ICONERROR);
    h_Wnd := 0;
  end;
  if (not UnRegisterClass('OpenGL', hInstance)) then    //注销窗口类型
  begin
    MessageBox(0, '不能注销窗口类型!', '错误', MB_OK or MB_ICONERROR);
    hInstance := 0;
  end;
end;

//创建Opengl显示窗口，并进行相关的设备设置
function glCreateWnd(Width, Height : Integer; Fullscreen : Boolean; PixelDepth : Integer) : Boolean;
var
  wndClass : TWndClass;         // 窗口类型
  dwStyle : DWORD;              // 窗口风格
  dwExStyle : DWORD;            // 窗口扩张风格
  dmScreenSettings : DEVMODE;   // 屏幕设置
  PixelFormat : GLuint;         // OpenGL渲染设置
  h_Instance : HINST;           // 当前实例
  pfd : TPIXELFORMATDESCRIPTOR; //OpenGL窗口相关设置
  ResHandle : THandle;          //声音资源句柄
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, '注册窗口类型失败!', '错误', 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, '不能切换到全屏!', '错误', 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', APP_TITLE, dwStyle, 0, 0,
                          Width, Height,0,0,h_Instance,nil);
  if h_Wnd = 0 then
  begin
    glKillWnd(Fullscreen);   //取消所有已经改变的设置
    MessageBox(0, '不能创建窗口!', '错误', MB_OK or MB_ICONERROR);
    Result := False;
    Exit;
  end;
  //获取一个设备环境
  h_DC := GetDC(h_Wnd);
  if (h_DC = 0) then
  begin
    glKillWnd(Fullscreen);
    MessageBox(0, '不能获取一个设备环境!', '错误', MB_OK or MB_ICONERROR);
    Result := False;
    Exit;
  end;
  //设置OpenGL窗口
  with pfd do
  begin
    nSize           := SizeOf(TPIXELFORMATDESCRIPTOR); // Size Of This Pixel Format Descriptor
    nVersion        := 1;                    // The version of this data structure
    dwFlags         := PFD_DRAW_TO_WINDOW or PFD_SUPPORT_OPENGL or PFD_DOUBLEBUFFER;  // Supports double buffering
    iPixelType      := PFD_TYPE_RGBA;        // RGBA颜色格式
    cColorBits      := PixelDepth;           // OpenGL颜色深度
    cDepthBits      := 16;                   // 指定深度缓冲区的深度
    iLayerType      := PFD_MAIN_PLANE;
  end;
  PixelFormat := ChoosePixelFormat(h_DC, @pfd);   //设置刚才设置的象素格式
  if (PixelFormat = 0) then
  begin
    glKillWnd(Fullscreen);
    MessageBox(0, '不能找到一个合适的象素格式!', '错误', MB_OK or MB_ICONERROR);
    Result := False;
    Exit;
  end;
  // 设置象素格式
  if (not SetPixelFormat(h_DC, PixelFormat, @pfd)) then
  begin
    glKillWnd(Fullscreen);
    MessageBox(0, '不能设置象素格式', '错误', MB_OK or MB_ICONERROR);
    Result := False;
    Exit;
  end;
  // 创建一个OpenGL 渲染环境
  h_RC := wglCreateContext(h_DC);
  if (h_RC = 0) then
  begin
    glKillWnd(Fullscreen);
    MessageBox(0, '不能创建一个OpenGL 渲染环境', '错误', MB_OK or MB_ICONERROR);
    Result := False;
    Exit;
  end;
  //设置当前的设备环境
  if (not wglMakeCurrent(h_DC, h_RC)) then
  begin
    glKillWnd(Fullscreen);
    MessageBox(0, '不能激活OpenGL渲染设备', '错误', MB_OK or MB_ICONERROR);
    Result := False;
    Exit;
  end;
  SetTimer(h_Wnd, FPS_TIMER, FPS_INTERVAL, nil);  //初始化计算帧数的定时器
  ResHandle := FindResource(hInstance, 'Electric', 'WAVE');   //初始化声音设置，加载声音资源
  SndHandle := LoadResource(hInstance, ResHandle);
  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;
  ResPtr : PChar;
begin
  finished := False;
  //执行程序初始化设置
  if not glCreateWnd(800, 600, FALSE, 32) then
  begin
    Result := 0;
    Exit;
  end;
  ResPtr := LockResource(SndHandle);
  sndPlaySound(ResPtr, SND_MEMORY OR SND_ASYNC OR SND_LOOP OR SND_NODEFAULT);  //播放声音
  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           //按ESC退出程序
        finished := True
      else
        ProcessKeys;                      //检测键盘消息
        end;
  end;
  glKillWnd(FALSE);
  Result := msg.wParam;
end;

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