15Bit RGB in TBitmap32 konvertieren

[SittingDuck]

Moin zusammen ...

Ich versuche 16Bit RGB(555) Raw-Daten in ein TBitmap32 zu bekommen, aber irgendwas stimmt hier nicht ... Bit-Schieben ist nicht so meine Stärke. Wer kann helfen? Dieses Format wird hier ganz gut beschrieben.

Delphi-Quellcode:

 

var i: Integer; Ptr: Pointer; RawMS: TMemoryStream;

  RawMS.CopyFrom(SourceMS, 50560); // RawDaten holen (158 * 158 * 2)
   
  bmp     := TBitmap.Create;
  TempMap := TBitmap32.Create;

  bmp.Width := 158; bmp.Height := 158;
  bmp.PixelFormat := pf15bit; // so stimmen zumindestens die Farben

  for i := 0 to 157 do begin
    Ptr := bmp.ScanLine[i];
    RawMS.Read(Ptr^, bmp.Width * 2);
  end;

  TempMap.Assign(bmp);
  TempMap.DrawTo(FotosImage.Bitmap, 4, 4); // Ausgeben auf einem TImageView32

Das Ergebnis ist irgendwie verschoben. (siehe Bild im Anhang ... soll ein grinsender Smiley sein)
Auch gefällt mir der Umweg über das TBitmap nicht. Kann man das nicht direkt in ein TBitmap32 einlesen?

[jfheins]

TBitmap32 müsste doch eine setpixel Methode oder so haben.
Dann einfach immer 2 byte aus dem Stream lesen, umwandeln und die Farbe zuweisen.
Das umwandeln kannst du gut in eine kleine Funktion auslagern die die Bits shiftet und einen TColor32 zurückgibt.
Ungefähr so:

Delphi-Quellcode:

function Convert15bitToColor32(x: Word): TColor32;
begin
  Result.B := (x or $1F) shl 3;
  Result.G := (x or $3E0) shr 2;
  Result.R := (x or $7C00) shr 7;
end;

[SittingDuck]

Super Idee ... Danke schonmal für Deine Hilfe. Trotzdem, irgenwas mache ich noch falsch.

Delphi-Quellcode:

var i: Integer; Buf: Word; col32: TColor32; RawMS: TMemoryStream; 

begin
  RawMS.CopyFrom(SourceMS, 50560); // RawDaten holen (158 * 158 * 2)
   
  TempMap := TBitmap32.Create; TempMap.SetSize(158, 158);

  for j := 0 to 157 do
    for i := 0 to 157 do begin
      RawMS.ReadBuffer(Buf, 2);
      
      TColor32Entry(col32).A := 255;
      TColor32Entry(col32).R := Byte(Buf or $7C00);
      TColor32Entry(col32).G := Byte(Buf or $3E0 );
      TColor32Entry(col32).B := Byte(Buf or $1F  );
      
      TempMap.SetPixelT(i, j, col32);
    end;
  end;
  
  TempMap.DrawTo(FotosImage.Bitmap, 4, 4); // Ausgabe auf einem TImageView32
end;

Das Bitmap ist danach einfach nur weiss ... :(

[Namenloser]

Du musst schon bitshiften...

[SittingDuck]

Stimmt, habe ich vergessen hinzuschreiben ... (Copy/Paste-Fehler von mir)

Delphi-Quellcode:

    TColor32Entry(col32).A := 255;
    TColor32Entry(col32).R := Byte(Buf or $7C00) shr 7;
    TColor32Entry(col32).G := Byte(Buf or $3E0 ) shr 2;
    TColor32Entry(col32).B := Byte(Buf or $1F  ) shl 3;

So hatte ich es auch gemacht ... der Effekt (weißes Bild) bleibt aber.

[Namenloser]

Auf den zweiten Blick: Müsste es nicht AND sein statt OR?

[jfheins]

Zitat:

Zitat von NamenLozer (Beitrag 1099498)

Auf den zweiten Blick: Müsste es nicht AND sein statt OR?

Ja, müsste es. Tut mir Leid ^^

[SittingDuck]

Ja, das wars ... Danke für Eure Hilfe. Hier nochmal die bereinigte Routine, falls ein anderer mal vor einem ähnlichen Problem steht.

Delphi-Quellcode:

var i: Integer; b: Word; TempMap: TBitmap32; ms: TMemoryStream; P: PColor32; 
begin
  ms := TMemoryStream.Create; ms.LoadFromFile('Pic.raw'); ms.Position := 0;
  
  with TempMap do begin SetSize(150, 150); P := PixelPtr[0, 0];
   
    for i := 0 to Width * Height - 1 do begin ms.ReadBuffer(b, 2);
      P^ := Color32(b and $7C00 shr 7, b and $3E0 shr 2, b and $1F shl 3);
      Inc(P);
    end;

    DrawTo(FotosImage.Bitmap, 4, 4, Rect(0, 0, 150, 150));   
  end;
end;

Dies dürfte wohl auch die schnellste Lösung sein. Im Anhang das korrigierte Bild.

[Aphton]

Zitat:

Zitat von SittingDuck (Beitrag 1099508)

Dies dürfte wohl auch die schnellste Lösung sein. Im Anhang das korrigierte Bild.

Will zwar nicht kleinlich sein, aber wenn du die Funktion Color32() als Inline deklarierst, sparst du einen Call Befehl und somit dürfte das dann um einen Tick schneller sein :P

[turboPASCAL]

Delphi-Quellcode:

procedure Load15BitPicFromRawFile(Filename: String; W, H: integer;
  DestBitmap32: TBitmap32; PosX, PosY: integer);
var
  i: Integer;
  b: Word;
  P: PColor32;
begin
  with TMemoryStream.Create do
  try
    LoadFromFile(Filename);
    Position := 0;

    with TBitmap32.Create do
    try
      SetSize(W, H);
      P := PixelPtr[0, 0];

      for i := 0 to Width * Height - 1 do
      begin
        ReadBuffer(b, 2);
        P^ := $FF000000 or (b and $7C00 shr 7) or (b and $3E0 shr 2) or (b and $1F shl 3);
        Inc(P);
      end;

      DrawTo(DestBitmap32, PosX, PosY);
    finally
      Free;
    end;
  finally
    Free;
  end;
end;

Oder so ?