DirectX Textur aus TBitmap laden

[igel457]

Also ich habe es geschafft. Ist zwar nicht so einfach, wie ich mir es vorgestellt habe, aber so geht es:

Delphi-Quellcode:

function LoadTextureFromBitmap(Appl:TAndorraApplication;ABitmap:Pointer;AColorDepth:byte):TAndorraTexture;
var Texture:IDirect3DTexture9;
    Format:cardinal;
    d3dlr: TD3DLocked_Rect;
    Cursor32: pLongWord;
    Cursor16: pWord;
    BitCur: PRGBRec;
    x,y:integer;

    //Convert a 8 Bit Color to a 4 Bit Color
    function R8ToR4(r:byte):byte;
    begin
      result := (r div 16);
    end;

    //Converts a R8G8B8 Value to a A4R4G4B4
    function RGBTo16Bit(r,g,b:byte):Word;
    begin
      Result := (R8ToR4(255) shl 12) or (R8ToR4(r) shl 8)
                            or (R8ToR4(g) shl 4)
                            or R8ToR4(b);
    end;
begin
  //Set Result to nil
  result := nil;

  with TAndorraApplicationItem(Appl) do
  begin
    with TBitmap(ABitmap) do
    begin

      //Set the Textures Pixel Format
      case AColorDepth of
        16: Format := D3DFMT_A4R4G4B4;
        24: Format := D3DFMT_A8R8G8B8;
        32: Format := D3DFMT_A8R8G8B8;
      else
        Format := D3DFMT_A8R8G8B8;
      end;

      //Set the Pixel Format of the Bitmap to 24 Bit
      PixelFormat := pf24Bit;

      //Create the Texture
      if D3DXCreateTexture(Direct3D9Device, Width, Height, 0, 0, Format, D3DPOOL_MANAGED, Texture) = D3D_OK then
      begin
        Texture.LockRect(0, d3dlr, nil, 0);

        if Format = D3DFMT_A8R8G8B8 then
        begin
          Cursor32 := d3dlr.Bits;

          for y := 0 to Height-1 do
          begin
            BitCur := Scanline[y];
            for x := 0 to Width-1 do
            begin
              Cursor32^ := D3DColor_ARGB(255,BitCur^.b,BitCur^.g,BitCur^.r);
              inc(BitCur);
              inc(Cursor32);
            end;
          end;
        end;
        if Format = D3DFMT_A4R4G4B4 then
        begin
          Cursor16 := d3dlr.Bits;
          for y := 0 to Height-1 do
          begin
            BitCur := Scanline[y];
            for x := 0 to Width-1 do
            begin
              Cursor16^ := RGBTo16Bit(BitCur^.b,BitCur^.g,BitCur^.r);
              inc(BitCur);
              inc(Cursor16);
            end;
          end;
        end;
      end;

      Texture.UnlockRect(0);
      IDirect3DTexture9(Result) := Texture;
    end;
  end;
end;

Einige werden jetzt vielleicht fragen, warum ich AColorDepth als Parameter übergebe, wenn ich es doch aus dem PixelFormat auslesen kann.
Die Antwort ist einfach: Bei mir hat das interne Konvertieren von 24 zu 16 Bit Bildern nicht richtig geklappt (Die Farben waren total verfälscht...), deshalb kann man die Farbtiefe übergeben um dennoch 16 Bit nutzen zu können...

Ich hoffe, dass noch andere den Code vielleicht nützlich finden könnten.

Wenn jemand eine kürzere Lösung hat, neheme ich diese auch gerne entgegen...

[Edit]Ein paar Schlechtschreibfehler entfernt...[/Edit]