MultipleTexture Loader

[EWeiss]

Hallo Leute lange nichts mehr von euch gehört..
So sei es denn.

Stelle euch meinen MultipleTexture Loader zur verfügung.
Was tut das Ding?

Na ja Texture laden halt.
Es Unterstützt BMP, DIB, GIF, ICO, JPG, JPEG, PNG, TIF, TIFF
und das alles ohne zusätzliche Komponente.

Initialisieren!
Variable deklarieren
MultibleTex : array [0..3] of TMmtTex; //für 4 Texturen Format siehe oben Zu ladende Dateien übergeben.

Delphi-Quellcode:

  //Load textures
  MultibleTex[0].FullName := TextureDir + '\Test\' + 'tunnel.png';
  MultibleTex[0].ID     := 1;
  MultibleTex[0].Square := false; // Tunnel

  MultibleTex[1].FullName := TextureDir + '\Test\' +'background.png';
  MultibleTex[1].ID     := 2;
  MultibleTex[1].Square := false; // Bacgkround

  MultibleTex[2].FullName := TextureDir + '\Test\' +'particle.png';
  MultibleTex[2].ID     := 3;
  MultibleTex[2].Square := false; // Particle

  MultibleTex[3].FullName := TextureDir + '\Test\' +'good.jpg';
  MultibleTex[3].ID     := 4;
  MultibleTex[3].Square := false; // Good

Ausführen!
MakeMultipleTexture(high(MultibleTex) - low(MultibleTex)); Das war's schon.
Die Texturen werden nun in ein OpenGl fähiges Format geschrieben.
Somit ist es möglich Hochtransparente PNG Dateien mit OpenGL zu kombinieren.

Weiterhin kann man zur Laufzeit einfach mal eine Texture mit einer anderen vertauschen.

Delphi-Quellcode:

// Aktualisiere das GDIImg MultibleTex(1).texture, und ersetze es mit der Erde.
MultibleTex[1].FullName := TextureDir + '\Test\' +'earth.png';
UpdateNamedGLTextureFromFileEx(MultibleTex[1].FullName, MultibleTex[1].Square, 1);
// Aktualisiere das GDIImg MultibleTex(3).texture, und ersetze es mit dem Flare.
MultibleTex[3].FullName := TextureDir + '\Test\' +'flare0.png';
UpdateNamedGLTextureFromFileEx(MultibleTex[3].FullName, MultibleTex[3].Square, 3);

Das wars soweit im groben wenn jemand Fehler findet dann her damit.

Delphi-Quellcode:

unit uMultibleTextures;

interface

uses Windows,
     Graphics,
     Classes,
     dglOpenGL,
     uGDIUnit,
     Math,
     SysUtils;

type
  PMmtTex = ^TMmtTex;
  TMmtTex = record
    FullName: string;
    Texture: GLuint;
    ID:     integer;
    Square: Bool;
  end;

  TMyBitmapInfo = record
    bmiHeader: TBitmapInfoHeader;
    bmiColors: array [0..255] of RGBQUAD;
  end;

procedure MakeMultipleTexture(N: integer);

function CreateGLTextureFromFile(FullPath: string; Xin: integer;
  Yin: integer; SquareTexture: Bool; Index: Integer): boolean;

procedure UpdateNamedGLTextureFromFileEx(FullPath: string;
  SquareTexture: Bool; Index: Integer);

function CreateTexture(Width, Height, Format: word; pData: Pointer): integer;

function MyCreateDIBSection(DC: HDC; const pbmi: TMyBitmapInfo;
  dwUsage: UINT; var ppvBits: Pointer; hSection: THandle;
  dwOffset: DWORD): HBITMAP; stdcall;
  external 'GDI32.DLL' Name 'CreateDIBSection';


var
  MultibleTex : array [0..8] of TMmtTex;
  P           : array[1..12] of integer;
  imgW, imgH  : cardinal;
  xSize, ySize: integer;
  Texture     : array of TGLuint;
  mPixelArray : array of byte;

implementation

// Splite eine 32-Bit-ARGB Farbe in seine vier Komponente.
procedure SplitColorARGB(const ARGB: COLORREF; out A, R, G, B: byte);
begin
  R := TRGBQuad(ARGB).rgbRed;
  G := TRGBQuad(ARGB).rgbGreen;
  B := TRGBQuad(ARGB).rgbBlue;
  A := TRGBQuad(ARGB).rgbReserved;
end;

// Erstelle DIB Sektion
function hbCreateDIBSection(hDC: longword; Width, Height: integer;
  BitCount: integer): HBITMAP;
var
  bi: TMyBitmapInfo;
  p:  Pointer;
begin
  bi.bmiHeader.biSize := SIZEOF(bi.bmiHeader);
  bi.bmiHeader.biWidth := Width;
  bi.bmiHeader.biHeight := Height;
  bi.bmiHeader.biPlanes := 1;
  bi.bmiHeader.biBitCount := BitCount;
  bi.bmiHeader.biCompression := BI_RGB;
  Result := MyCreateDIBSection(hDC, bi, DIB_RGB_COLORS, p, 0, 0);
end;


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}

  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);

  Result := Texture;
end;


function CreateImageFromFile(FileName: WideString): cardinal;
var
  Img: cardinal;
begin
  Result := 0;

  if not FileExists(FileName) then
  begin
    Result := 0;
    Exit;
  end;

  //Lade das Image
  if GdipLoadImageFromFile(PWideChar(FileName), Img) = 0 then
    Result := Img;

end;


function CreateGLTextureFromFile(FullPath: string; Xin: integer;
  Yin: integer; SquareTexture: Bool; Index: Integer): boolean;
var
  bi        : TMyBitmapInfo;
  bi2       : BitmapInfo;
  lBM       : BITMAP;
  scale     : single;
  hDIB      : HBITMAP;
  Img       : cardinal;
  mhDC      : HDC;
  xP, yP, xS, yS: integer;
  K         : integer;
  So        : boolean;
  hIC       : cardinal;
  sImgName  : WideString;
  ARGBcolor : COLORREF;
  A         : byte;
  R         : byte;
  G         : byte;
  B         : byte;
  lPixel    : PRGBQuad;
  ImageType : string;
  ImgType   : string;
  gGraphics : cardinal;
  Value     : integer;
  pp        : Pointer;

begin

  Result := True;

  imgW  := 0;
  imgH  := 0;
  Xin   := 0;
  Yin   := 0;

  scale := 0;
  So    := False;

  sImgName := FullPath;
  if FileExists(AnsiUpperCase(sImgName)) then
    So := True;

  if So then
  begin
    // Unterstützte Bildformate
    ImgType := ExtractFileExt(AnsiUpperCase(sImgName));

    if ImgType <> '' then
    begin
      if copy(Uppercase(sImgName), length(sImgName) - 3, 4) = '.BMP' then
        ImageType := '.BMP';
      if copy(Uppercase(sImgName), length(sImgName) - 3, 4) = '.DIB' then
        ImageType := '.DIB';
      if copy(Uppercase(sImgName), length(sImgName) - 3, 4) = '.GIF' then
        ImageType := '.GIF';
      if copy(Uppercase(sImgName), length(sImgName) - 3, 4) = '.ICO' then
        ImageType := '.ICO';
      if copy(Uppercase(sImgName), length(sImgName) - 4, 5) = '.JPEG' then
        ImageType := '.JPEG';
      if copy(Uppercase(sImgName), length(sImgName) - 3, 4) = '.JPG' then
        ImageType := '.JPG';
      if copy(Uppercase(sImgName), length(sImgName) - 3, 4) = '.PNG' then
        ImageType := '.PNG';
      if copy(Uppercase(sImgName), length(sImgName) - 3, 4) = '.TIF' then
        ImageType := '.TIF';
      if copy(Uppercase(sImgName), length(sImgName) - 4, 5) = '.TIFF' then
        ImageType := '.TIFF';
    end
    else
      ImageType := '';

    if ImageType <> '' then
    begin
      // Lade GDI Image
      img := CreateImageFromFile(PWideChar(sImgName));
      if img <> 0 then
      begin
        // Hole die Image Höhe und Weite
        GdipGetImageWidth(Img, imgW);
        GdipGetImageHeight(Img, imgH);

        P[1]  := 2;
        P[2]  := 4;
        P[3]  := 8;
        P[4]  := 16;
        P[5]  := 32;
        P[6]  := 64;
        P[7]  := 128;
        P[8]  := 256;
        P[9]  := 512;
        P[10] := 1024;
        P[11] := 2048;
        P[12] := 4096;

        for K := 12 downto 1 do
        begin
          if (Xin = 0) and (ImgW > cardinal(P[K]) - 1) then
            Xin := P[K];
          if (Yin = 0) and (ImgH > cardinal(P[K]) - 1) then
            Yin := P[K];
        end;

        if SquareTexture and (Xin <> Yin) then
        begin
          Xin := Max(Xin, Yin);
          Yin := Xin;
        end
        else
          SquareTexture := False;


        // Adjustiere Scale
        // ------------------------------------------------------------------------
        if imgW <> 0 then
          scale := Xin div round(imgW);
        if scale > 1 then
          scale := 1;

        xS := imgW * round(scale);
        yS := imgH * round(scale);

        // Höhe mehr wie > Yin erstelle neuen scale factor
        if yS > Yin then
        begin
          if imgH <> 0 then
            scale := Yin div round(imgH);
          xS := imgW * round(scale);
          yS := imgH * round(scale);
        end;

        xP := (Xin - xS) div 2;
        yP := (Yin - yS) div 2;
        // ------------------------------------------------------------------------


        hIC  := CreateIC('DISPLAY', nil, nil, nil);
        mhDC := CreateCompatibleDC(hIC);

        hDIB := hbCreateDIBSection(mhDC, Xin, Yin, 32);
        SelectObject(mhDC, hDIB);

        // Zeichne das Image
        if GdipCreateFromHDC(mhDC, gGraphics) = 0 then
        begin
          // Setze Stretch Qualitäts Modus
          GdipSetInterpolationMode(gGraphics, 2);

          // Fülle den Hintergrund mit der Farbe der pixel(0,0)
          if SquareTexture then
          begin
            GdipBitmapGetPixel(img, 0, 0, ARGBcolor);
            SplitColorARGB(ARGBcolor, A, R, G, B);

            GetObject(hDIB, sizeof(lBM), @lBM);
            lPixel := lBM.bmBits;

            for K := (Xin * Yin)  downto 0 do
            begin
              lPixel.rgbReserved := A;
              lPixel.rgbRed      := R;
              lPixel.rgbGreen    := G;
              lPixel.rgbBlue     := B;

              Inc(lPixel);
            end;
          end;

          // Zeichne das Image
          if GdipDrawImageRectRectI(gGraphics, Img, xP, yP, xS,
            yS, 0, 0, ImgW, ImgH, 2, nil, False, nil) = 0 then
          begin
            bi2.bmiHeader.biSize        := SIZEOF(bi.bmiHeader);
            bi2.bmiHeader.biWidth       := Xin;
            bi2.bmiHeader.biHeight      := Yin;
            bi2.bmiHeader.biPlanes      := 1;
            bi2.bmiHeader.biBitCount    := 32;
            bi2.bmiHeader.biCompression := 0;

            Value := (Xin * Yin * 4 - 1);
            SetLength(mPixelArray, Value);

            if GetDIBits(mhDC, hDIB, 0, Yin, @mPixelArray[0], bi2, 0) > 0 then
            begin
              // 2.Vertausche Rot und Grün
              lPixel := @mPixelArray[0];
              for K := (Xin * Yin)  downto 0 do
              begin
                R := lPixel.rgbRed;
                lPixel.rgbRed := lPixel.rgbBlue;
                lPixel.rgbBlue := R;

                Inc(lPixel);
              end;
              Texture[Index] := CreateTexture(Xin, Yin, GL_RGBA, addr(mPixelArray[0]));
              xSize := Xin;
              ySize := Yin;
            end
            else
              Result := False;
          end;

          // Alles Freigeben
          GdipDeleteGraphics(gGraphics);
        end;
        DeleteObject(hDIB);
        if mhDC <> 0 then
          DeleteDC(mhDC);
        if hIC <> 0 then
          DeleteDC(hIC);
      end;

      GdipDisposeImage(Img);
    end;
  end;
end;


procedure MakeMultipleTexture(N: integer);
var
  mtCount  : integer;
  K        : integer;
  nRet     : TGLenum;
  OkDelete : Bool;

begin
  mtCount  := high(MultibleTex) - low(MultibleTex) + 1;
  OkDelete := False;

  // Array Redimensionieren
  SetLength(Texture, mtCount);
  if mtCount > 0 then
  begin
    for K := 0 to (mtCount - 1) do
    begin
      Texture[K] := MultibleTex[k].Texture;
      if Texture[K] <> 0 then
        OkDelete := True;
    end;

    // befinden sich Texturen im Array dann löschen
    if OkDelete then
    begin
      glDeleteTextures(mtCount, @Texture[1]);
      glGenTextures(mtCount, @Texture[1]);
    end;

    nRet := glGetError;
    // Überprüfung ob ein OpenGL Fehler aufgetreten ist
    if nRet = 0 then
    begin
      // alles OK Aktuelle Texture laden
      // und ins OpenGl Format konvertieren
      for K := 0 to (mtCount - 1) do
      begin
        SetLength(mPixelArray, 0);

        if CreateGLTextureFromFile(MultibleTex[K].FullName,
          xSize, ySize, MultibleTex[K].Square, K) then
        begin
          MultibleTex[k].Texture := Texture[K];
          glBindTexture(GL_TEXTURE_2D, Texture[K]);
          nRet := glGetError;
          if nRet = 0 then
          begin
            glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
            glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
            glTexImage2D(GL_TEXTURE_2D, 0, 4, xSize, ySize,
              0, GL_RGBA, GL_UNSIGNED_BYTE, @mPixelArray[0]);
          end;
        end;
      end;
    end;
  end;
end;


procedure UpdateNamedGLTextureFromFileEx(FullPath: string; SquareTexture: Bool; Index: Integer);
var
  nRet: TGLenum;

begin
  // Übergebenen Index im Array prüfen
  // und Texture mit neuer ersetzen
  Texture[Index] := MultibleTex[Index].Texture;

    nRet := glGetError;
    // Überprüfung ob ein OpenGL Fehler aufgetreten ist
    if nRet = 0 then
    begin
        // Array Redimensionieren
        SetLength(mPixelArray, 0);
        // alles OK Aktuelle Texture laden
        // und ins OpenGl Format konvertieren
        if CreateGLTextureFromFile(MultibleTex[Index].FullName,
          xSize, ySize, MultibleTex[Index].Square, Index) then
        begin
          MultibleTex[Index].Texture := Texture[Index];
          glBindTexture(GL_TEXTURE_2D, Texture[Index]);
          nRet := glGetError;
          if nRet = 0 then
          begin
            glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
            glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
            glTexImage2D(GL_TEXTURE_2D, 0, 4, xSize, ySize,
              0, GL_RGBA, GL_UNSIGNED_BYTE, mPixelArray);
          end;
        end;
    end;
end;

end.

gruss

Das ganze sieht dann in etwa so aus ...