IPB
ЛогинПароль:

> ВНИМАНИЕ!

Прежде чем задать вопрос, смотрите FAQ.
Рекомендуем загрузить DRKB.

> Оpengl Why?, Почему не работает?
XaMMaX
сообщение 8.12.2005 14:50
Сообщение #1


Пионер
**

Группа: Пользователи
Сообщений: 85
Пол: Мужской
Реальное имя: max

Репутация: -  0  +


Почему ечсли компилировать этот код на форме не чего не появляется исправьте кто может плиз.

unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs,opengl, ExtCtrls;

type
 TForm1 = class(TForm)
   Timer1: TTimer;
   procedure FormCreate(Sender: TObject);
   procedure FormResize(Sender: TObject);
   procedure FormClose(Sender: TObject; var Action: TCloseAction);

 private
   { Private declarations }
           ghRC:HGLRC;
           ghDC:HDC;
           procedure Draw;
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

function bSetupPixelFormat(DC:HDC):boolean;
 var
  pfd:PIXELFORMATDESCRIPTOR;
  ppfd:PPIXELFORMATDESCRIPTOR;
  pixelformat:integer;
 begin
  ppfd := @pfd;

  ppfd.nSize := sizeof(PIXELFORMATDESCRIPTOR);
  ppfd.nVersion := 1;
  ppfd.dwFlags :=  PFD_DRAW_TO_WINDOW xor
                PFD_SUPPORT_OPENGL xor
                PFD_DOUBLEBUFFER;
  ppfd.dwLayerMask := PFD_MAIN_PLANE;
  ppfd.iPixelType := PFD_TYPE_RGBA;
  ppfd.cColorBits := 16;
  ppfd.cDepthBits := 16;

  ppfd.cAccumBits := 0;
  ppfd.cStencilBits := 0;

  pixelformat := ChoosePixelFormat(dc, ppfd);
  if pixelformat=0 then
     begin
      MessageBox(0, 'ChoosePixelFormat failed', 'Error', MB_OK);
      bSetupPixelFormat:=FALSE;
      exit;
     end;

  if SetPixelFormat(dc, pixelformat, ppfd)=false then
     begin
      MessageBox(0, 'SetPixelFormat failed', 'Error', MB_OK);
      bSetupPixelFormat:=FALSE;
      exit;
     end;

      bSetupPixelFormat:=TRUE;
     end;

procedure TForm1.FormCreate(Sender: TObject);
           var
              p: TGLArrayf4;
              d: TGLArrayf3;
           begin
              ghDC := GetDC(Handle);
              if bSetupPixelFormat(ghDC)=false then
                Close();
              ghRC := wglCreateContext(ghDC);
              wglMakeCurrent(ghDC, ghRC);
           
              glClearColor(0.0, 0.0, 0.0, 0.0);

              FormResize(Sender);
           
              glEnable(GL_COLOR_MATERIAL);
              glEnable(GL_DEPTH_TEST);
           
              glEnable(GL_LIGHTING);
              glEnable(GL_LIGHT0);
                p[0]:=3;
                p[1]:=3;
                p[2]:=3;
                p[3]:=1;
                d[0]:=-1;
                d[1]:=-1;
                d[2]:=-3;
              glLightfv(GL_LIGHT0,GL_POSITION,@p);
              glLightfv(GL_LIGHT0,GL_SPOT_DIRECTION,@d);
           end;

procedure TForm1.FormResize(Sender: TObject);
begin
              glViewport( 0, 0, Width, Height );
              glMatrixMode( GL_PROJECTION );
              glLoadIdentity();
              glOrtho(-5,5, -5,5, 2,12);
              gluLookAt(0,0,5, 0,0,0, 0,1,0);
              glMatrixMode( GL_MODELVIEW );
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
           begin
             if ghRC<>0 then
             begin
               wglMakeCurrent(ghDC,0);
               wglDeleteContext(ghRC);
             end;
             if ghDC<>0 then
               ReleaseDC(Handle, ghDC);
           end;

           procedure TForm1.Draw;
           var
             quadObj :GLUquadricObj;
           begin
             glClear(GL_DEPTH_BUFFER_BIT xor GL_COLOR_BUFFER_BIT);
           
             quadObj:=gluNewQuadric;
             gluQuadricDrawStyle(quadObj, GLU_FILL);
             glColor3f(1,0,0);
             gluSphere(quadObj, 2,10,10);
               glRotatef(3, 0,1,0);
             gluDeleteQuadric(quadObj);
           
             SwapBuffers(ghDC);
           end;

end.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

Сообщений в этой теме


 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 



- Текстовая версия 20.07.2025 13:45
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"