Forum > Graphics

[SOLVED] RLE help

(1/3) > >>

Espectr0:
Hola,

In my project I need to load/save a compressed image using RLE.


--- Code: Pascal  [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---// The Run-length encoding method is defined in the US 7912305 B1 patent.// Here’s a quick and dirty definition to this method://// Code                                   Meaning// CCCCCCCC                               One pixel in color C// 00000000 00LLLLLL                      L pixels in color 0 (L between 1 and 63)// 00000000 01LLLLLL LLLLLLLL             L pixels in color 0 (L between 64 and 16383)// 00000000 10LLLLLL CCCCCCCC             L pixels in color C (L between 3 and 63)// 00000000 11LLLLLL LLLLLLLL CCCCCCCC    L pixels in color C (L between 64 and 16383)// 00000000 00000000                      End of line 
To Encode:


--- Code: Pascal  [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---function EncodeImage(const AImage: TBGRABitmap; out ABuffer: TBytes; out APalette: TFPPalette): Integer;var  bmp : TBGRABitmap;  quant : TBGRAColorQuantizer;  x, y, i, len : Integer;  p, r : PBGRAPixel;  bytes : TBytesStream;  clr : Integer;begin  // Reduce image  bmp := TBGRABitmap.Create(AImage);  quant := TBGRAColorQuantizer.Create(bmp, acFullChannelInPalette, 256); // reduce colors  try    quant.ApplyDitheringInplace(daNearestNeighbor, bmp);    bmp.UsePalette := True;    APalette := TFPPalette.Create(quant.ReducedPalette.Count);    bmp.Palette.Count := APalette.Count;    for i := 0 to quant.ReducedPalette.Count-1 do // copy reduced colors to palette    begin      bmp.Palette[i] := (quant.ReducedPalette.Color[i].ToFPColor);      APalette.Color[i] := bmp.Palette[i];    end;     // RLE compress image    bytes := TBytesStream.Create;    try      for y := 0 to bmp.Height-1 do      begin        p := bmp.Scanline[y];        x := 0;        while x < bmp.Width do        begin          i := quant.ReducedPalette.IndexOfColor(p[x]);          if i >= 0 then            clr := i          else            clr := quant.ReducedPalette.FindNearestColorIndex(p[x]);           r := bmp.Scanline[y];          len := 1;          while (x + len < bmp.Width) and (len < $3FFF) do          begin            if r[x + len] <> p[x] then Break;            Inc(len);          end;           if (len <= 2) and (clr <> 0) then // One pixel in color C          begin            bytes.WriteByte(clr);            if len = 2 then bytes.WriteByte(clr);          end          else          begin            // rle id            bytes.WriteByte(0);             if (clr = 0) and (len < $40) then // L pixels in color 0 (L between 1 and 63)              bytes.WriteByte(len)            else if (clr = 0) then  // L pixels in color 0 (L between 64 and 16383)            begin              bytes.WriteByte($40 or (len shr 8));              bytes.WriteByte(len);            end            else if len < $40 then // L pixels in color C (L between 3 and 63)            begin              bytes.WriteByte($80 or len);              bytes.WriteByte(clr);            end            else // L pixels in color C (L between 64 and 16383)            begin              bytes.WriteByte($C0 or (len shr 8));              bytes.WriteByte(len);              bytes.WriteByte(clr);            end;          end;          Inc(x, len);        end;        // end rle id        bytes.WriteByte(0);        bytes.WriteByte(0);      end;    finally      Result := bytes.Size;      SetLength(ABuffer, Result);      Move(bytes.Bytes[0], ABuffer[0], Result);      bytes.Free;    end;  finally    quant.Free;    bmp.Free;  end;end; 
To Decode:


--- Code: Pascal  [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---function DecodeImage(const ABuffer: TBytes; const APalette: TFPPalette; const AWidth, AHeight: Integer): TBGRABitmap;var  bmp : TBGRABitmap;  x, y, idx, i : Integer;  b, len : Byte;  clr : TBGRAPixel;begin  bmp := TBGRABitmap.Create(AWidth, AHeight);  idx := 0;  for y := 0 to bmp.Height-1 do  begin    x := 0;    while x < bmp.Width do    begin      b := ABuffer[idx] and $FF;      Inc(idx);       if (b = 0) and (idx < Length(ABuffer)) then // rle id      begin        b := ABuffer[idx] and $FF;        Inc(idx);         if b = 0 then // next line        begin          Inc(idx);          Break;        end        else if (b and $C0) = $40 then // L pixels in color 0 (L between 1 and 63)        begin          if (idx < Length(ABuffer)) then          begin            len := ((b - $40) shl 8) or (ABuffer[idx] and $FF);            Inc(idx);            clr := FPColorToBGRA(APalette.Color[0]);            for i := 1 to len do            begin              bmp.Scanline[y][x] := clr;              Inc(x);            end;          end;        end        else if (b and $C0) = $80 then // L pixels in color C (L between 64 and 16383)        begin          if (idx < Length(ABuffer)) then          begin            len := (b - $80);            b := ABuffer[idx] and $FF;            Inc(idx);            clr := FPColorToBGRA(APalette.Color[b]);            for i := 1 to len do            begin              bmp.Scanline[y][x] := clr;              Inc(x);            end;          end;        end        else if (b and $C0) <> 0 then // L pixels in color C (L between 3 and 63)        begin          if (idx < Length(ABuffer)) then          begin            len := ((b - $C0) shl 8) or (ABuffer[idx] and $FF);            Inc(idx);            b := ABuffer[idx] and $FF;            Inc(idx);            clr := FPColorToBGRA(APalette.Color[b]);            for i := 1 to len do            begin              bmp.Scanline[y][x] := clr;              Inc(x);            end;          end;        end        else // L pixels in color 0 (L between 64 and 16383)        begin          clr := FPColorToBGRA(APalette.Color[0]);          for i := 1 to b do          begin            bmp.Scanline[y][x] := clr;            Inc(x);          end;        end;      end      else // One pixel in color C      begin        bmp.Scanline[y][x] := FPColorToBGRA(APalette.Color[b]);        Inc(x);      end;    end;  end;   Result := bmp;end; 
But I have problems loading the compressed image, I am attaching the original and the restored one.
Can you guide me what is the fault?

Gracias!!

speter:
I have a program which reads Utah RLE images.

I am attaching a Zipped RLE image (the forum doesn't allow .RLE files) and a PNG version.

Is this the same format as you are using?

cheers
S.

Leledumbo:
Since you're too lazy to write a MRE, I'll be too lazy to properly test, too.

From what I can read, since the decoded image looks similar, it's not the (de)compression problem (if it's wrong, it would be garbage instead of looking similar). You intentionally reduce the colors by using a TBGRAColorQuantizer.

You have two ways to verify:

* Instead of using your decoder, use an existing image viewer capable of reading RLE compressed bitmaps
* Remove the quantization part and solely compress the image

circular:
I don't see any obvious problem with the code.

The output seems to have only 2 colors. I suggest to write the details to the console when a non black pixel is written, to see where this may happen.

Espectr0:
I made some changes and uploaded a demo to decode the image, one of the problems I have is the transparency of the image, the black background should be transparent.
Any help is welcome :)


https://github.com/URUWorks/UW_BlurayPGSParser

Navigation

[0] Message Index

[#] Next page

Go to full version