AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Multimedia Delphi [OpenGL] Transparenz
Thema durchsuchen
Ansicht
Themen-Optionen

[OpenGL] Transparenz

Ein Thema von Flips · begonnen am 30. Aug 2007 · letzter Beitrag vom 5. Sep 2007
Antwort Antwort
Benutzerbild von turboPASCAL
turboPASCAL

Registriert seit: 8. Mai 2005
Ort: Sondershausen
4.274 Beiträge
 
Delphi 6 Personal
 
#1

Re: [OpenGL] Transparenz

  Alt 4. Sep 2007, 08:22
*Einmisch*

Uwaäh, glBmp und glBitmaps.... nehmt die Textures.pas. Die hat das PNG-Format,
dieses ist eigentlich alles was man braucht.

Hier die kleinste Version:

Delphi-Quellcode:
//----------------------------------------------------------------------------
//
// Autor : MatthiasG. (turboPASCAL)
// Website : [url]http://www.mgsdh.de.vu[/url]
// Version : 2.00 lite
// Date : Jun 2006
// Changes : * Ver 1.9 -> Ver 2.0 Debugzeugs eingebaut
// * Ver 1.8 -> Unterstützung von RGB-Dateien
//
// Hint : * in der Datei "pngimage.pas" den Compilerschalter
// {$DEFINE UseDelphi} durch {.$DEFINE UseDelphi} ersetzen
// * nicht 100% Optimiert für nonVCL
//----------------------------------------------------------------------------

unit PNGLoader;

{$WARNINGS OFF}

// For Debug only: --------------------
{.$DEFINE ViewLoadedFilesOnConsole}
// ------------------------------------

interface

uses
  Windows,
  OpenGL,
  pngimage,
  sysutils; // für Uppercase und solch einen Käse...

  function LoadTexture(const Filename: String; var Texture: GLuint;
    const LoadFromRes: Boolean = FALSE): Boolean;

  function gluBuild2DMipmaps(Target: GLenum; Components, Width, Height: GLint;
    Format, atype: GLenum; Data: Pointer): GLint; stdcall; external 'glu32.dll';
  procedure glGenTextures(n: GLsizei; var textures: GLuint); stdcall; external OpenGL32;
  procedure glBindTexture(target: GLenum; texture: GLuint); stdcall; external OpenGL32;
  procedure glDeleteTextures(n: Integer; textures: PGLuint); stdcall; external OpenGL32;


implementation

{------------------------------------------------------------------}
{  Create the Texture                                              }
{------------------------------------------------------------------}
function CreateTexture(Width, Height, Format: Word; pData: Pointer): Integer;
var
  Texture: GLuint;
begin
  glGenTextures(1, Texture);
  glBindTexture(GL_TEXTURE_2D, Texture);
  glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE); {Texture blends with object background}
// glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_DECAL); {Texture does NOT blend with object background}

  { Select a filtering type. BiLinear filtering produces very good results with little performance impact
    GL_NEAREST              - Basic texture (grainy looking texture)
    GL_LINEAR                - BiLinear filtering
    GL_LINEAR_MIPMAP_NEAREST - Basic mipmapped texture
    GL_LINEAR_MIPMAP_LINEAR  - BiLinear Mipmapped texture
  }
  

  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR); { only first two can be used }
  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); { all of the above can be used }

  if Format = GL_RGBA then
    gluBuild2DMipmaps(GL_TEXTURE_2D, GL_RGBA, Width, Height, GL_RGBA, GL_UNSIGNED_BYTE, pData)
  else
    gluBuild2DMipmaps(GL_TEXTURE_2D, 3, Width, Height, GL_RGB, GL_UNSIGNED_BYTE, pData);
// glTexImage2D(GL_TEXTURE_2D, 0, 3, Width, Height, 0, GL_RGB, GL_UNSIGNED_BYTE, pData); // Use when not wanting mipmaps to be built by openGL

  {$IFDEF ViewLoadedFilesOnConsole}
    if Format = GL_RGBA
      then Write(' -> CreateTexture (RGBA): ')
      else Write(' -> CreateTexture (RGB): ');
    WriteLn(Width, 'x', Height);
  {$ENDIF ViewLoadedFilesOnConsole}

  result := Texture;
end;

{------------------------------------------------------------------}
{  Load PNG textures                                               }
{------------------------------------------------------------------}
function LoadPNGTexture(Filename: String; var Texture: GLuint; LoadFromResource: Boolean): Boolean;
var
  Data : Array of DWORD;
  W, Width : Integer;
  H, Height : Integer;
  AlphaPtr: PByte;
  PNG : TPngObject;
begin
  {$IFDEF ViewLoadedFilesOnConsole}
    Writeln('LoadTexture "Type PNG": ', Filename);
  {$ENDIF ViewLoadedFilesOnConsole}

  PNG := TPngObject.Create;

  if LoadFromResource then // Load from resource
  begin
    PNG.LoadFromResourceName(hInstance, copy(Filename, 1, Pos('.', Filename)-1));
    // to do: on Error exit
    // Result := FALSE;
  end else
  begin
    PNG.LoadFromFile(Filename);
    // to do: on Error exit
    // Result := FALSE;
  end;

  //
  // Nö, Palettenzeugs will ich nicht.
  /////////////////////////////////////////////////////////////////////////
  if PNG.Header.ColorType = COLOR_PALETTE then
  begin
    MessageBox(0,
      PChar('Dieser PNG-Typ in der Datei:'#13#10'"' + Filename +
            '"'#13#10'wird nicht unterstützt.'),
      PChar('Information:' + IntToStr(PNG.Header.ColorType)),
      MB_APPLMODAL or MB_SYSTEMMODAL or MB_ICONINFORMATION or MB_OK);
    Result := FALSE;
    exit;
  end;

  Width := PNG.Width;
  Height := PNG.Height;
  SetLength(Data, Width * Height);

  if (PNG.Header.ColorType = COLOR_RGB) or
     (PNG.Header.ColorType = COLOR_GRAYSCALE) then
  begin
    For H := 0 to Height - 1 do
      For W := 0 to Width - 1 do
        Data[W + (H * Width)] := $FF000000 or PNG.Pixels[W, (Height-1)-H];
  end else
  if (PNG.Header.ColorType = COLOR_RGBALPHA) or
     (PNG.Header.ColorType = COLOR_GRAYSCALEALPHA) then
  begin
    for H := 0 to Height - 1 do
    begin
      AlphaPtr := PByte(PNG.AlphaScanline[(Height-1)-H]);
      for W := 0 to Width - 1 do
      begin
        Data[W + (H * Width)] := (($FF000000 and (AlphaPtr^ shl 24)) or PNG.Pixels[W, (Height-1)-H]);
        Inc(AlphaPtr);
      end;
    end;
  end;

  PNG.free;

  Texture := CreateTexture(Width, Height, GL_RGBA, @Data[0]);

  Result := TRUE;
end;

{------------------------------------------------------------------}
{  Determines file type and sends to correct function              }
{------------------------------------------------------------------}
function LoadTexture(const Filename: String; var Texture: GLuint; const LoadFromRes: Boolean = FALSE): Boolean;
begin
  result := False;
  if copy(Uppercase(filename), length(filename)-3, 4) = '.PNGthen
    LoadPNGTexture(Filename, Texture, LoadFromRes);
end;

{$IFDEF ViewLoadedFilesOnConsole}
initialization
  AllocConsole;
  SetConsoleTitle('Unit PNGLoader:');

finalization
  FreeConsole;
{$ENDIF ViewLoadedFilesOnConsole}

end.
Matti
Meine Software-Projekte - Homepage - Grüße vom Rüsselmops -Mops Mopser
  Mit Zitat antworten Zitat
Antwort Antwort


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 08:27 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz