Приналожении текстуры не рисует сферу

[Rin]

Хай, всем, кто сюда заглянул.
не рисует сферу, гад.

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    procedure FormPaint(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
     DC:HDC;
     hrc:HGLRC;
     var  quadObj:GLUquadricObj;
     procedure PixelFormat;
     procedure PrepareImage(bmap: string);
     procedure Init;
    { Private declarations }
  public
    { Public declarations }
  end;
  {типы данных и переменные под картинку}

  {конец описания типов данных и переменных под картинку}

  type PointXYZ=record
  x,y,z:real;
  end;

var
  Form1: TForm1;
  zzz:INTEGER;
  n:real; // отвечает за высоту насосной трости и переноса координат ручки
  radius:real;// сферы
  spusk:real;
  vverx:boolean;
  B3PbIB: array [0..200] of PointXYZ;

implementation

{$R *.dfm}
{=============================================================================}
procedure TForm1.PrepareImage(bmap: string);
type
  PPixelArray = ^TPixelArray;
  TPixelArray = array [0..0] of Byte;
var
  Bitmap : TBitmap;
  Data, DataA : PPixelArray;
  BMInfo : TBitmapInfo;
  I, ImageSize : Integer;
  Temp : Byte;
  MemDC : HDC;
begin
  Bitmap := TBitmap.Create;
  Bitmap.LoadFromFile (bmap);
  with BMinfo.bmiHeader do begin
    FillChar (BMInfo, SizeOf(BMInfo), 0);
    biSize := sizeof (TBitmapInfoHeader);
    biBitCount := 24;
    biWidth := Bitmap.Width;
    biHeight := Bitmap.Height;
    ImageSize := biWidth * biHeight;
    biPlanes := 1;
    biCompression := BI_RGB;
    MemDC := CreateCompatibleDC (0);
    GetMem (Data, ImageSize * 3);
    GetMem (DataA, ImageSize * 4);
    try
      GetDIBits (MemDC, Bitmap.Handle, 0, biHeight, Data, BMInfo, DIB_RGB_COLORS);
      For I := 0 to ImageSize - 1 do begin
          Temp := Data [I * 3];
          Data [I * 3] := Data [I * 3 + 2];
          Data [I * 3 + 2] := Temp;
      end;

      For I := 0 to ImageSize - 1 do begin
          DataA [I * 4] := Data [I * 3];
          DataA [I * 4 + 1] := Data [I * 3 + 1];
          DataA [I * 4 + 2] := Data [I * 3 + 2];
          If (Data [I * 3 + 2] > 50) and
             (Data [I * 3 + 1] < 200) and
             (Data [I * 3] < 200)
             then DataA [I * 4 + 3] := 27
             else DataA [I * 4 + 3] := 255;
      end;

      glTexImage2d(GL_TEXTURE_2D, 0, 3, biWidth,
                   biHeight, 0, GL_RGBA, GL_UNSIGNED_BYTE, DataA);
     finally
      FreeMem (Data);
      FreeMem (DataA);
      DeleteDC (MemDC);
      Bitmap.Free;
   end;
  end;
end;
{=============================================================================}
procedure TForm1.Init;
var
 Quadric : GLUquadricObj;
begin

 glNewList (1, GL_COMPILE);
   Quadric := gluNewQuadric;
   gluQuadricTexture (Quadric, TRUE);

   glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
   glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST);

   glEnable(GL_TEXTURE_2D);

   prepareImage ('..\насос\4.bmp');
   gluSphere (Quadric, 1, 10, 100);

   gluDeleteQuadric (Quadric);

 glEndList;
 glEnable(GL_DEPTH_TEST);
end;
{=============================================================================}
procedure TForm1.PixelFormat;
var
nPixelFormat:Integer;
pfd:TPixelFormatDescriptor;
begin
fillChar(pfd,sizeof(pfd),0);//заполняем структуру нулями
pfd.nSize:=sizeof(pfd);//определяем размер структуры
pfd.nVersion:=1;//версия
{используем: двойную буферизацию с поддержкой OpenGl в проекте
и вырисовкой объектов OpenGl в этом окне}
pfd.dwFlags:=PFD_DOUBLEBUFFER+PFD_SUPPORT_OPENGL+PFD_DRAW_TO_WINDOW;
pfd.iPixelType:=PFD_TYPE_RGBA;//тип цвета
pfd.cColorBits:=24;//количество цветов
pfd.cAlphaBits:=128;
pfd.cAccumBits:=128;
pfd.cDepthBits:=128;
pfd.cStencilBits:=128;                                                                                                                                                                                                           pfd.iLayerType:=PFD_MAIN_PLANE;
nPixelFormat:=ChoosePixelFormat(DC,@pfd);//берем индекс пикселя из текущего
//окна
if nPixelFormat<>0 then //если индекс найден, то
SetPixelFormat(DC,nPixelFormat,@pfd);//устанавливаем в текущем окне нашу
//структуру пикселя по индексу, указанному в nPixelFormat
end;
{=============================================================================}
procedure TForm1.Timer1Timer(Sender: TObject);
begin
FormPaint(nil);
end;

[Rin]

{=============================================================================}
procedure TForm1.FormCreate(Sender: TObject);
var i:byte;
begin
randomize;
for i := 0 to 200 do
begin
if i<100 then B3PbIB[i].x:= ((random(1000)-random(1000)+random(1000)-random(1000))*(i/40))/1000
else B3PbIB[i].x:= ((random(1000)-random(1000)-random(1000)-random(1000))*(i/40))/1000;
  B3PbIB[i].y:= (random(1000)+random(1000)+random(1000))/1000;
if i<100 then  B3PbIB[i].z:= ((random(1000)-random(1000)+random(1000)+random(1000))*(i/50))/1000
else B3PbIB[i].z:= ((random(1000)-random(1000)-random(1000)+random(1000))*(i/50))/1000;
end;
radius:=0.3;
form1.Width:=screen.Height;
form1.Height:=screen.Height;
DC:=GetDC (Handle) ;
PixelFormat;
hrc:=wglCreateContext(DC);
wglMakeCurrent(DC,hrc);
//Init;
quadObj:=gluNewQuadric();
zzz:=0;
n:=1;
vverx:=false;
spusk:=0.01;
end;
{=============================================================================}
procedure TForm1.FormDestroy(Sender: TObject);
begin
DeleteDC(DC);
wglDeleteContext(hrc);
end;
{=============================================================================}
procedure TForm1.FormPaint(Sender : TObject) ;
var
j:byte;
ps : TPaintStruct ;
begin
BeginPaint (Handle,ps) ;
if zzz=0 then glScale(0.3,0.3,0.3);
if zzz=360 then zzz:=1;
glClearColor(1, 1, 1,1) ;

glClear (GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT) ;
if zzz=0 then glRotated (30, 1,1,0) ;

glLineWidth(1);
glColor3f(0,1,0);
glBegin(GL_QUADS);
glVertex3f(10,-0.01,10);
glVertex3f(10,-0.01,-10);
glVertex3f(-10,-0.01,-10);
glVertex3f(-10,-0.01,10);
glEnd;

glLineWidth(3);
glColor3f(0,0,0);
glBegin(GL_LINE_STRIP);
glVertex3f(1.3,0,0);
glVertex3f(1.2,0,0.32);
glVertex3f(1.05,0,0.46);
glVertex3f(1,0,0.46);
glVertex3f(0.89,0,0.5);
glVertex3f(0.85,0,0.54);
glVertex3f(0.75,0,0.5);
glVertex3f(0.6,0,0.46);
glVertex3f(0.58,0,0.4);
glVertex3f(0.57,0,0.34);
glVertex3f(0.55,0,0.28);
glVertex3f(0.54,0,0.14);
glVertex3f(0.54,0,-0.04);
glVertex3f(0.52,0,-0.12);
glVertex3f(0.45,0,-0.15);
glVertex3f(0.4,0,-0.12);
glVertex3f(0.35,0,-0.08);
glVertex3f(0.3,0,0);
glEnd;

glLineWidth(1);

//if not vverx then radius:=radius+0.01;
glColor3f (1,0,0) ;
if radius<1 then
begin
 glCallList(1);
// quadObj:=GlunewQuadric;
 //gluSphere(QuadObj,radius,100,100);
end
else
begin
glEnable(GL_POINT_SMOOTH);
glpointSize(4);
glBegin(GL_POINTS);
for j := 0 to 100 do
begin
  if B3PbIB[j].y>0 then B3PbIB[j].y:=B3PbIB[j].y-spusk;
  glColor3f(random(1),random(1),random(1));
  glVertex3f(B3PbIB[j].x,B3PbIB[j].y,B3PbIB[j].z);
end;
glEnd;
end;

glPushMatrix;
glRotated (-90, 1,0,0);
glColor3f(0.65,0.65,0.65);
glTranslate(1.5,0,0);
gluCylinder (quadObj,0.2, 0.2, 1, 50, 50);// основание насоса
glTranslate(0,0,1);
glColor3f(0.4,0.4,0.4);
gluCylinder (quadObj,0.02, 0.02, n, 50, 50);// насосная трость
glRotated (90,1,0,0);
glTranslate(0,n,-0.15);
glColor3f(0.65,0.65,0.65);
gluCylinder (quadObj,0.02, 0.02, 0.3, 50, 50);//ручка
glPopMatrix;

glFlush() ;
swapBuffers(dc);
EndPaint(Handle,ps);
inc(zzz);
if radius<1 then
begin
  if (n>0.4)and (not vverx) then n:=n-0.05
  else vverx:=true;
  if (n<1)and(vverx) then n:=n+0.05
  else vverx:=false;
end;
end;


end.

[Rin]

если надо, то могу скинуть проект.

в общем рисуется насос и постепенно накачивает мяч, без текстуры всё норм работает.
НАРОД, СОРРИ, Я НАВРАЛ.

Текстуру оказывается рисует, НО:

-лишь половину мяча
- выдаёт не тот цвет текстуры
-стирая половину нарисованного на форме.

[Rin]

Вопрос снимается =) спасибо 21 человеку за просмотр. =)