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

Delphi-Quellcode:

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!

Delphi-Quellcode:

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

[lbccaleb]

Hallo,

ja lang nichts mehr von einander gehört :P

Danke dafür :)
Hast du vllt. noch nen Anwendungs Bsp. parat?

[EWeiss]

Zitat:

Zitat von lbccaleb (Beitrag 1056169)

Hallo,

ja lang nichts mehr von einander gehört :P

Danke dafür :)
Hast du vllt. noch nen Anwendungs Bsp. parat?

Welches Beispiel möchtest du denn gerne
Du erstellst ein Array so groß wie du an Bildern einladen willst
Dann liest du sie so ein wie angegeben.

Danach befindet sich im Record von MultibleTex[Index].Texture die Texture welche für OpenGl generiert wurde
Diese decrementiert sich von selbst abhängig davon wie du die Bilderreihenfolge übergibst.

Danach kannst du sie mit
glBindTexture(GL_TEXTURE_2D, MultibleTex[Index].Texture);

verwenden..

gruss

[newbe]

@Eweiss

Du beschäftigst dich nicht zufällig auch mit Demoprogrammierung? Was mich interessieren würde
wie machst du den Bluer Effekt um den unteren Text (Georg Michael...

Der Equalizer sieht auch "ganz nett" aus :)

mfG newbe

[EWeiss]

Zitat:

Zitat von newbe (Beitrag 1056393)

@Eweiss

Du beschäftigst dich nicht zufällig auch mit Demoprogrammierung? Was mich interessieren würde
wie machst du den Bluer Effekt um den unteren Text (Georg Michael...

Der Equalizer sieht auch "ganz nett" aus :)

mfG newbe

Demo ?
Wie soll ich das verstehen ;)

Den Text macht man ganz einfach Suche mal nach TextSuite hhier im Forum
Damit kannst du so etwas erstellen.

nen EQ kann ich auf dem Bild nicht erkennen.
gruss

[Aurelius]

http://de.wikipedia.org/wiki/Demoszene

Da muss ich auch immer wieder stauen was mit doch begrenzten technischen Mitteln möglich ist :shock:

Sieht auf jeden Fall interssant aus :)

[EWeiss]

Zitat:

Zitat von Aurelius (Beitrag 1056436)

http://de.wikipedia.org/wiki/Demoszene

Da muss ich auch immer wieder stauen was mit doch begrenzten technischen Mitteln möglich ist :shock:

Sieht auf jeden Fall interssant aus :)

Ahh das ist was er meint .. nö kannte ich bisher nicht ;)
Na ja wenn es euch weiter bringt
Viel spass damit

gruss

[newbe]

@EWeis,

Mit EQ meinte den Rainbow Spectrum Analyzer am unteren Bildrand.

mfG newbe

[EWeiss]

Zitat:

Zitat von newbe (Beitrag 1056831)

@EWeis,

Mit EQ meinte den Rainbow Spectrum Analyzer am unteren Bildrand.

mfG newbe

Ah so ;)
Hab mich schon gewundert

[idefix2]

Eine Kleinigkeit:

Delphi-Quellcode:

if copy(Uppercase(sImgName), length(sImgName) - 3, 4) = '.JPEG' then
        ImageType := '.JPEG';

ist vielleicht nicht so gut? Detto für .tiff