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

Код

procedure TForm1.Init;
begin

  DC := GetDC(Handle);
  SetDCPixelFormat(DC);
  hrc := wglCreateContext(Canvas.Handle);
  wglMakeCurrent(DC, hrc);

  glClearColor (0.5, 0.5, 0.75, 1.0); // цвет фона
  glNewList (ListName, GL_COMPILE);
    glBegin(GL_QUADS) ;
     glTexCoord2d (0.0, 0.0);
      glVertex2f (-1.0, -1.0);
      glTexCoord2d (640 / 1024, 0.0);
      glVertex2f (1.0 , -1.0);
      glTexCoord2d (640 / 1024, 480 / 1024);
      glVertex2f (1.0, 1.0);
      glTexCoord2d (0.0, 480 / 1024);
      glVertex2f (-1.0, 1.0);
    glEnd;
  glEndList;

  glGenTextures(2, @TexName);
  glBindTexture(GL_TEXTURE_2D, TexName);
  glPixelStorei(GL_UNPACK_ALIGNMENT, 1);

  glTexImage2D(GL_TEXTURE_2D, 0, 3, 1024, 1024, 0, {GL_RGB}BGR_EXT, GL_UNSIGNED_BYTE, FTexImage);
  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST);
  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
  glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_DECAL);

  glEnable(GL_TEXTURE_2D);

  CreateShader;
end;


procedure TForm1.CreateShader;
begin
  FFragmentProgram := glCreateShaderObjectARB(GL_FRAGMENT_SHADER_ARB);
  if FFragmentProgram <> 0 then
  begin
    LoadShader(FFragmentProgram, 'shader.fsh');
    FProgram := glCreateProgramObjectARB;
    if FProgram <> 0 then
    begin
      glAttachObjectARB(FProgram, FFragmentProgram);

      glLinkProgramARB(FProgram);

      glValidateProgramARB(FProgram);
      CheckGLSLError(FProgram, GL_OBJECT_VALIDATE_STATUS_ARB);
//до этого момента функция CheckGLSLError возвращает, что у меня все хорошо сбилдилось 
и скомпилилось

      texture := glGetUniformLocationARB(FProgram, PChar('texFrame'));
      glUseProgramObjectARB(FProgram);

      glUniform1fARB(texture, @TexName);
      CheckGLSLError(FProgram, GL_OBJECT_ACTIVE_UNIFORMS_ARB); //возвращает ошибку, пишет,
что текстура не была задана
    end;
  end;
end;