decompress.pas

在delphi7 下开发医学图象浏览器,对医学图象进行编辑,分析的

unit decompress;
//This unit decompresses images encoded by RunLengthEncoding (RLE), lossyJPEG or GE's proprietary compression algorithm
//Note: lossless JPEG are decoded by the separate unit 'lsjpeg.pas'

interface
{$ifdef Linux}
uses sysUtils,define_types,Qdialogs;
{$else}
uses clipbrd,dialogs,sysutils,windows,classes,jpeg,Graphics,define_types,extctrls;
(*uses SysUtils, Windows, Classes, Graphics, Forms,
     Controls, ExtCtrls, StdCtrls, Buttons,define_types,
     ComCtrls, Menus, Dialogs,DICOM,JPEG,analyze,lsJPEG,Clipbrd, ToolWin,uMultislice;
  *)
{$endif}
//declarations
procedure DecompressRLE8(var infp: file; var lOutputBuff: ByteP0;lSamplesPerPixel,lAllocSliceSz,lCompressOffset,lCompressSz: integer);
procedure DecompressRLE16(var infp: file; var lOutputBuff: SmallIntP0;lImageVoxels,lCompressOffset,lCompressSz: integer);
procedure DecompressRLE16toRGB(var infp: file; var lOutputBuffRGB: ByteP0;lImageVoxels,lCompressOffset,lCompressSz,lRedLUTOffset,lGreenLUTOffset,lBlueLUTOffset,lRedLUTSz,lGreenLUTSz,lBlueLUTSz: integer);
procedure DecompressGE(var infp: file; var lOutputBuff: SmallIntP0;lImageStart,lImgWid,lImgHt,lGenesisPackHdr: integer);
procedure decompressJPEG8 (lFilename: string; var lOutputBuff{gBuff8}: ByteP0; lAllocSliceSz,lImageStart{gECATposra[lSlice]}: integer);
procedure decompressJPEG24noImage (lFilename: string; var lOutputBuff: ByteP0; lImageVoxels,lImageStart{gECATposra[lSlice]}: integer);//for console applications
procedure decompressJPEG24 (lFilename: string; var lOutputBuff: ByteP0; lImageVoxels,lImageStart{gECATposra[lSlice]}: integer; var lImage: TImage);


implementation

procedure decompressJPEG24 (lFilename: string; var lOutputBuff: ByteP0; lImageVoxels,lImageStart{gECATposra[lSlice]}: integer; var lImage: TImage);
var
   Stream: Tmemorystream;
   Jpg: TJPEGImage;

//   TmpBmp: TPicture;
//   lImage: Timage;
   lRow:  pRGBTripleArray;
   lHt0,lWid0,lInc,i,j: integer;
begin
  try
      Stream := TMemoryStream.Create;
      Stream.LoadFromFile(lFilename);
      Stream.Seek(lImageStart, soFromBeginning);
      try
        Jpg := TJPEGImage.Create;
        Jpg.LoadFromStream(Stream);
        lImage.Height := JPG.Height;
        lImage.Width := JPG.Width;
        lImage.Picture.Bitmap.Assign(jpg);
        if lImageVoxels = (JPG.Height*JPG.Width) then begin
           lWid0 := JPG.Width-1;
           lHt0 := JPG.Height-1;
           lInc := (3*lImageVoxels)-1; //*3 because 24-bit, -1 since index is from 0
           FOR j := lHt0-1 DOWNTO 0 DO BEGIN
                          lRow := lImage.Picture.Bitmap.ScanLine[j];
                          FOR i := lWid0 downto 0 DO BEGIN
                              lOutputBuff[lInc] := (lRow[i].rgbtBlue) and 255;//lRow[i].rgbtRed;
                              lOutputBuff[lInc-1] := (lRow[i].rgbtGreen) and 255;//lRow[i].rgbtRed;
                              lOutputBuff[lInc-2] := (lRow[i].rgbtRed) and 255;//lRow[i].rgbtRed;
                              dec(lInc,3);
                          END; //for i.. each column
           END; //for j...each row
        end; //correct image size
      finally //try..finally
        Jpg.Free;
      end;
    finally
      Stream.Free;
    end; //try..finally
end;


procedure decompressJPEG24noImage (lFilename: string; var lOutputBuff: ByteP0; lImageVoxels,lImageStart{gECATposra[lSlice]}: integer);
{$ifdef linux}
begin
end;
{$else}
var
   lStream: TMemoryStream;
   lWid0,i,J,lInc: integer;
   Jpg: TJPEGImage;
   lRow:  pRGBTripleArray;
   lStr: string;
   Bmp     : TBitmap;
begin
    try
    lStream := TMemoryStream.Create;
    //showmessage(inttostr(lImageStart));
       // lStr := 'D:\jpeg24.dic';
      //lStream.LoadFromFile(lStr);
      lStream.LoadFromFile(lFilename);
      lStream.Seek(lImageStart, soFromBeginning);
      Jpg := TJPEGImage.Create;
      try
         Jpg.LoadFromStream(lStream);
         BMP := TBitmap.create;
         try
            BMP.Height := JPG.Height;
            BMP.Width := JPG.Width;
            lWid0 := BMP.Width-1;
            BMP.PixelFormat := pf24bit;
            BMP.Canvas.Draw(0,0, JPG);
            if lImageVoxels = (BMP.Height*BMP.Width) then begin
                        lInc := (3*lImageVoxels)-1; //*3 because 24-bit, -1 since index is from 0
                        FOR j := BMP.Height-1 DOWNTO 0 DO BEGIN
                          lRow := BMP.Scanline[j];
                          FOR i := lWid0 downto 0 DO BEGIN
                              lOutputBuff[lInc] := (lRow[i].rgbtBlue) and 255;//lRow[i].rgbtRed;
                              lOutputBuff[lInc-1] := (lRow[i].rgbtGreen) and 255;//lRow[i].rgbtRed;
                              lOutputBuff[lInc-2] := (lRow[i].rgbtRed) and 255;//lRow[i].rgbtRed;
                              dec(lInc,3);
                          END; //for i.. each column
                        END; //for j...each row
            end; //if ImageSize matches buffer size
            //Image.Picture.Graphic := BMP;
         finally
                BMP.Free;
         end;
      finally
             JPG.Free;
      end; //JPEG try..finally
    finally
                  lStream.Free;
    end; //Stream try..finally
  FileMode := 0; //Read only
end; //decompressJPEG24
{$endif}

procedure decompressJPEG8 (lFilename: string; var lOutputBuff: ByteP0; lAllocSliceSz,lImageStart{gECATposra[lSlice]}: integer);
{$ifdef Linux}
begin
end;
{$else}
var
   Stream: TMemoryStream;
   i,J,lInc: integer;
   Jpg: TJPEGImage;
   lRow:  pRGBTripleArray;
   Bmp     : TBitmap;
begin
Stream := TMemoryStream.Create;
             try
                Stream.LoadFromFile(lFilename);
                Stream.Seek(lImageStart, soFromBeginning);
                Jpg := TJPEGImage.Create;
                try
                   Jpg.LoadFromStream(Stream);
                   BMP := TBitmap.create;
                   try
                      BMP.Height := JPG.Height;
                      BMP.Width := JPG.Width;
                      BMP.PixelFormat := pf24bit;
                      BMP.Canvas.Draw(0,0, JPG);
                      if lAllocSliceSz = (BMP.Height*BMP.Width) then begin
                        lInc := lAllocSliceSz-1;
                        FOR j := BMP.Height-1 DOWNTO 0 DO BEGIN
                          lRow := BMP.Scanline[j];
                          FOR i := (BMP.Width - 1) downto 0 DO BEGIN
                              lOutputBuff[lInc] := (lRow[i].rgbtRed) and 255;//lRow[i].rgbtRed;
                              dec(lInc);
                          END; //for i.. each column
                        END; //for j...each row
                      end; //if ImageSize matches buffer size
                   finally
                           BMP.Free;
                   end; //BMP try..finally
                finally
                        Jpg.Free;
                end; //JPG try..finally
             finally
                    Stream.Free;
             end; //Stream try..finally
end; //decompressJPEG8
{$endif}

procedure DecompressGE(var infp: file; var lOutputBuff: SmallIntP0;lImageStart,lImgWid,lImgHt,lGenesisPackHdr: integer);
label 444;
var J,I,lPos,lTmpSz,lTmpPos,lImgPos,lLine,lLastPixel,lBufEntries,lAllocSliceSz,lLineStart,lLineEnd: integer;
    TmpBuff   : bYTEp0;
    lByte,lByte2: byte;
function swap16i(lPos: longint): smallint;
var
   s : SmallInt;
begin
     seek(infp,lPos);
  BlockRead(infp, s, 2{, n});
  swap16i:=swap(s);
end;
function GetByte: byte;
begin
     if lTmpPos >= lTmpSz then begin //whoops GE "compression" has made the file BIGGER!
 {Worst case scenario filesize = 150% uncompressed, so this can only happen once}
        lTmpSz := FileSize(inFp)-lImageStart;
        if (lAllocSliceSz < lTmpSz) then
           lTmpSz := lAllocSliceSz; {idea: for multi slice images, limit compression}
        if lTmpSz < 1 then begin
            Showmessage('Error with GE Genesis compression.');
            GetByte := 0;
            exit;
        end;
        FreeMem(TmpBuff);
        GetMem( TmpBuff, lTmpSz);
        BlockRead(inFp, TmpBuff^, lTmpSz);
        lTmpPos := 0;
     end;
     if lTmpPos > 0 then GetByte := TmpBuff[lTmpPos]
     else GetByte := 0;
     inc(lTMpPos);
end;

begin
                lAllocSliceSz := lImgHt*lImgWid * 2;
                lLastPixel := 0;
                lBufEntries := lAllocSliceSz div 2;
                lTmpSz := FileSize(infp)-lImageStart;
                if (lAllocSliceSz < lTmpSz) then
                lTmpSz := FileSize(infp)-lImageStart;
                if (lAllocSliceSz < lTmpSz) then
                   lTmpSz := lAllocSliceSz; {idea: for multi slice images, limit compression}
                lTmpSz := lTmpSz - 2;
                GetMem( TmpBuff, lTmpSz);
                BlockRead(inFp, TmpBuff^, lTmpSz);
                {$R-}
                   lTmpPos := 0;
                   lImgPos := 0;
                   lLineStart := 1;
                   lLineEnd := lImgWid;
                   for lLine := 1 to lImgHt do begin
                       if lGenesisPackHdr <> 0 then begin
                              lLineStart :=swap16i(lGenesisPackHdr+((lLine-1)*4));
                              lLineEnd := -1+lLineStart+ swap16i(2+lGenesisPackHdr+((lLine-1)*4));
                              //if lLine < 10 then showmessage(inttostr(lLineStart));
                              if lLinestart >0 then
                                 for lPos := 1 to (lLineStart) do begin
                                  lOutputBuff[lImgPos] := 0;
                                  inc(lImgPos);
                              end;
                          end;
                          for lPos := lLineStart to lLineEnd do begin
                             lByte := GetByte;
                             if (lByte > 127) then begin
                                if ((lByte and 64)=64) then begin {new 16 bits}
                                   I := GetByte;//lByte2;
                                   lByte := GetByte;
                                   lLastPixel := ((I shl 8)+lByte);
                                end else begin {not lbyte and 64: 14 byte delta}
                                 lByte2 := getbyte;
                                 J := lByte2;
                                 if ((lByte and 32)=32) then {subtract delta}  //shl1=2,shl2=4,shl3=8,shl4=16,shl5=32
                                    I := (lByte or $E0)
                                 else
                                     I := lByte and $1F;
                                 lLastPixel := lLastPixel + smallint(((I)shl 8)+ (J {shl 5}))
                                end; {14 byte delta}
                             end else begin {not lbyte and 128: 7 byte delta}
                                 if (lByte > 63) then {subtract delta}
                                    lByte := lByte or $C0;
                                 lLastPixel := lLastPixel + shortInt(lByte);
                         end; //lbyte values
                             if lImgPos <= lBufEntries then
                                lOutputBuff[lImgPos] := lLastPixel
                             else //imgpos >= lAlloc
                                 goto 444;
                             inc(lImgPos);
                       end; //lPos
                       if (lLineEnd+1) < lImgWid then begin
                              for lPos := lImgWid downto (lLineEnd+2) do begin
                                  //if lLine < (512) then
                                  lOutputBuff[lImgPos] := 0;
                                  inc(lImgPos);
                              end;
                       end;
                   end; //for lines
                   444:
                   Freemem(TmpBuff);
end; //DecompressGE

procedure DecompressRLE8(var infp: file; var lOutputBuff: ByteP0;lSamplesPerPixel,lAllocSliceSz,lCompressOffset,lCompressSz: integer);
var
  lRGBsegmentOffset: array [1..3] of longint;
  lShort: ShortInt;
  lSamples,lUncompressedSegmentSz0,lUncompressedSegmentEnd,lSegment,J,i,lCompSz,lCptPos,lCptVal,lRunVal: integer;
  lTmpBuff,lCptBuff: bYTEp0;
begin
     lSamples := lSamplesPerPixel;
     if lSamples = 3 then begin
        //lFullSz := lAllocSliceSz*3;
        GetMem( lTmpBuff, lAllocSliceSz*3);
     end else begin
         lTmpBuff := @lOutputBuff^;
         lSamples := 1;
     end;
     Seek(infp,lCompressOffset+4);
     BlockRead(infp, lRGBsegmentOffset[1], 4); //1st Offset: RED
     BlockRead(infp, lRGBsegmentOffset[2], 4); //2nd Offset: GREEN, unused for monochrome
     BlockRead(infp, lRGBsegmentOffset[3], 4); //3rd Offset: BLUE, unused for monochrome
     lCompSz := FileSize(infp) - (lCompressOffset);
     if lCompSz >lCompressSz then
        lCompSz := lCompressSz;
     Seek(infp, lCompressOffset);
     GetMem( lCptBuff, lCompSz);
     BlockRead(infp, lCptBuff^, lCompSz{, n});
     lUncompressedSegmentSz0 :=lAllocSliceSz-1;
     J := 0;
     for lSegment := 1 to lSamples do begin
             lUncompressedSegmentEnd := (lUncompressedSegmentSz0 * lSegment)-1;
             lCptPos := lRGBsegmentOffset[lSegment];