OpenGL v Delphi4



Alpha Blending


Příklad a zdroják ke stažení (445k)


Příklad je stejný jako předchozí, akorát jsem použil jinou blend funkci 'glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA)' která aktivujeme alpha blending. Černá barva je průhledná, ostatní barvy jsou normální.




procedure DrawButterfly;
var
  i: integer;                                           //číslo textury
begin
  i := 2;                                               //textura 2
  glEnable(GL_BLEND);                                   //zapne se průhlednost     
  glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);    //zapne se Alpha Blending
  glBindTexture(GL_TEXTURE_2D, TextureBin[i]);          //načti texturu
  glEnable(GL_TEXTURE_2D);                              //zapni texturování     
  glBegin(GL_TRIANGLES);                                //vytvoř trojúhelníky    
                                                        //první trojúhelník
      glTexCoord2f(Coord1[i].x,Coord1[i].y);            //texturová koordinace prvního bodu
      glVertex3f(Point1[i].x,Point1[i].y,Point1[i].z);  //pozice prvního bodu
      glTexCoord2f(Coord2[i].x,Coord2[i].y);            //texturová koordinace druhého bodu
      glVertex3f(Point2[i].x,Point2[i].y,Point2[i].z);  //pozice druhého bodu
      glTexCoord2f(Coord3[i].x,Coord3[i].y);            //texturová koordinace třetího bodu
      glVertex3f(Point3[i].x,Point3[i].y,Point3[i].z);  //pozice třetího bodu
                                                        //druhý trojúhelník        
      glTexCoord2f(Coord2[i].x,Coord2[i].y);            //texturová koordinace druhého bodu
      glVertex3f(Point2[i].x,Point2[i].y,Point2[i].z);  //pozice druhého bodu
      glTexCoord2f(Coord3[i].x,Coord3[i].y);            //texturová koordinace třetího bodu
      glVertex3f(Point3[i].x,Point3[i].y,Point3[i].z);  //pozice třetího bodu
      glTexCoord2f(Coord4[i].x,Coord4[i].y);            //texturová koordinace čtvrtého bodu
      glVertex3f(Point4[i].x,Point4[i].y,Point4[i].z);  //pozice čtvrtého bodu
  glEnd;                                                //konec vytváření trojúhelníků
  glDisable(GL_BLEND);                                  //vypni průhlednost
  glPopMatrix;
end;

Aby 'Alpha Blending' fungoval musí se načíst alpha textura 'LoadTexture(2,Path + 'bab.bmp',gl_rgba8);'

procedure InitTriangleTexture;
var
  Path: string;
begin
  Path := ExtractFilePath(Application.ExeName);
  InitTexture;
  LoadTexture(1,Path + 'back.jpg',gl_rgb8);        //načte se obyčejná textura (pozadí)
  LoadTexture(2,Path + 'bab.bmp',gl_rgba8);        //načte se alpha textura
end;

procedure LoadTexture(Num:LongInt;FileName:string;Typ:word);
begin
  //jestliže je 'gl_rgba8' tak zapni 'color system' textury 'gl_rgba' 
  if (Typ=gl_rgba2) or (Typ=gl_rgba4) or (Typ=gl_rgba8) or (Typ=gl_rgba16) then texture[num].colorsystem:=gl_rgba        
  else texture[num].colorsystem:=gl_rgb;
    LoadPicture(FileName,UniPicture);
    texture[num].filename:=ExtractFileName(FileName);
    StoreTexture(Num,UniPicture);
    SetTexture(Num,Typ);
end;

procedure LoadPicture(FileName:String;var Pic:TPicture);
var Y:TPicture;
    temp:boolean;
    searchrec:tsearchrec;
begin
  filename:=uppercase(filename);
  if findfirst(filename,$3f,searchrec)<>0 then begin
     MessageDlg('Picture '+filename+' not found !!!', mtError, [mbOK], 0);
     halt;
  end;
  if ExtractFileExt(FileName)='.JPG' then begin
     Y:=TPicture.Create;
     Y.LoadFromFile(FileName);
     temp:=y.Graphic is TJPEGImage;
     if temp then begin
        Pic.Bitmap.Width:=y.Graphic.Width;
        Pic.Bitmap.Height:=y.Graphic.Height;
        Pic.Bitmap.Canvas.draw(0,0,Y.Graphic);
     end;
     Y.Free;
  end;
  if ExtractFileExt(FileName)='.BMP' then begin
     Pic.LoadFromFile(FileName);
  end;
end;

procedure StoreTexture(Num:LongInt;Pic:TPicture);
var bih : TBitmapInfoHeader;
    bi : TBitmapInfo;
    poz,poz2:longint;
    i,j : longint;
begin
  with Texture[Num] do begin
      Width:=Pic.Bitmap.Width;Height:=Pic.Bitmap.Height;
      TextureH.rgbcolor:=AllocMem(Width*Height*sizeof(TRGBByte));
  end;
  with bih do begin
      biSize:=SizeOf(bih);
      biWidth:=Pic.width;biHeight:=Pic.height;
      biPlanes:=1;biBitCount:=24;biCompression:=BI_RGB;
      biSizeImage:=Pic.width;
      biXPelsPerMeter:=0;biYPelsPerMeter:=0;biClrImportant:=0;
      biClrUsed := 0;
  end;
  bi.bmiHeader := bih;
  GetDIBits(Pic.Bitmap.Canvas.Handle,Pic.Bitmap.Handle,0,Pic.width,textureH.rgbcolor,bi,dib_rgb_colors);
  with Texture[Num] do begin
    if ColorSystem=GL_RGB then begin
       rgbcolor:=AllocMem(Width*Height*sizeof(TRGBByte));
       for i := 0 to Pic.height-1 do begin
         for j := 1 to Pic.width do begin
           poz:=j+i*texture[num].width;
           poz2:=j+((pic.height-1)-i)*texture[num].width;
           with texture[num].rgbcolor^[poz2] do begin
             r:=textureH.rgbcolor^[poz].b;
             g:=textureH.rgbcolor^[poz].g;
             b:=textureH.rgbcolor^[poz].r;
           end;
         end;
       end;
    end else begin                                               //alpha textura
       rgbacolor:=AllocMem(Width*Height*sizeof(TRGBAByte));
       for i := 0 to Pic.height-1 do begin
         for j := 1 to Pic.width do begin
           poz:=j+i*texture[num].width;
           poz2:=j+((pic.height-1)-i)*texture[num].width;
           with texture[num].rgbacolor^[poz2] do begin
             r:=textureH.rgbcolor^[poz].b;
             g:=textureH.rgbcolor^[poz].g;
             b:=textureH.rgbcolor^[poz].r;
             if r+g+b=0 then a:=0 else a:=255;
           end;
         end;
       end;
    end;
  end;
  FreeMem(TextureH.rgbcolor);
end;

procedure SetTexture(Num:Longint;Typ:word);
begin
  with Texture[Num] do begin
    Mip:=false;
    glBindTexture(GL_TEXTURE_2D,TextureBin[num]);
    if ColorSystem=GL_RGB then begin
       glTexImage2d(GL_Texture_2D,0,TYP,width,height,0,GL_RGB,GL_Unsigned_byte,rgbcolor);
    end else begin
       //alpha textura
       glTexImage2d(GL_Texture_2D,0,TYP,width,height,0,GL_RGBA,GL_Unsigned_byte,rgbacolor);
    end;
  end;
end;

Celej zdroják je tady
Transp_f.pas;


Průhledný okraj textury Emboss Bumpmapping
Home