lsjpeg.pas

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

                    showmessage('Huffman size array corrupted.');
                    goto 666;
                  end; {}
                end;
              end; //Length of size lInc > 0
            end;
            //showmessage('Max bits:'+inttostr(lMaxHufSi)+' SSSS:'+inttostr(lMaxHufVal));
            K := 1;
            Code := 0;
            Si := lHufRA[lFrameCount, K].HufSz; //HuffSizeRA[1];
            repeat
              while (Si = lHufRA[lFrameCount, K].HufSz) do
              begin
                lHufRA[lFrameCount, K].HufCode := Code;
                //showmessage('bits: '+inttostr(Si)+' NthEntry:'+inttostr(K)+' Code:'+inttostr(Code));
                Code := Code + 1;
                Inc(K);
              end;
              if K <= DHTnLi then
              begin
                while lHufRA[lFrameCount, K].HufSz > Si do
                begin
                  Code := Code shl 1;
                  Si := Si + 1;
                end; //while Si
              end; //K <= 17
            until K > DHTnLi; // JGS added rev13
            inc(lFrameCount);
          until (lSegmentEnd - lRawPos) < 18;
          lnHufTables := lFrameCount - 1;
          //showmessage(inttostr(lnHufTables));
          lRawPos := (lSegmentEnd);
        end; //$C4: DHT Huffman
      $DD:
        begin //Define Restart
          lRestartSegmentSz := Readword;
          lRawPos := (lSegmentEnd);
        end;
      $DA:
        begin //read SOS Scan Header
          if SOSns > 0 then
            goto 666; //multiple SOS!
          ReadByte(SOSns);
          //if Ns = 1 then NOT interleaved, else interleaved: see B.2.3
          SOSarrayPos := lRawPos;
          if SOSns > 0 then
          begin
            for lInc := 1 to SOSns do
            begin
              ReadByte(btS1); //component identifier 1=Y,2=Cb,3=Cr,4=I,5=Q
              ReadByte(btS2); //horizontal and vertical sampling factors
            end;
          end;
          ReadByte(SOSss); //predictor selection B.3
          ReadByte(SOSse);
          ReadByte(SOSahal); //lower 4bits= pointtransform
          SOSpttrans := SOSahal and 16;
          if lverbose then
            Showmessage('[Predictor: ' + inttostr(SOSss) + ' PointTransform:' + inttostr(SOSahal) + '] ');
          lRawPos := (lSegmentEnd);
        end; //$DA SOS - Scan Header
    else
      begin //skip marker segment;
        lRawPos := (lSegmentEnd);
      end;
    end; //case markertype
  until (lRawPos >= lRawSz) or (btMarkerType = $DA); {hexDA=Start of scan}
  lHdrOK := true; //errors goto label 666, so are NOT OK
  lImgStart := lRawPos;
  666:
  if not lHdrOK then
  begin
    showmessage('Unable to read this file - is this really a JPEG image?');
    exit;
  end;
  if (not lImgTypeC3) then
    exit; //lossless compressed huffman tables
  //NEXT: unpad data - delete byte that follows $FF
  lINc := lRawPos;
  lIncX := lRawPos;
  repeat
    lRawRA[lIncX] := lRawRA[lInc];
    if lRawRA[lInc] = 255 then
    begin
      if (lRawRA[lInc + 1] = $00) then
        lInc := lInc + 1
      else
      begin
        //showmessage(inttostr(lRawRA[lInc+1]));
        if (lRawRA[lInc + 1] = $D9) then //end of image
          lIncX := -666; //end of padding
      end;
    end;
    inc(lInc);
    inc(lIncX);
  until lIncX < 0;
  //End: Data unpadding
  //NEXT: Create Huffman LookupTable.
  //We will compute all possible outcomes for an 8-bit value, while less intuitive than
  //reading Huffman 1 bit at a time, it doubles the decompression speed
  lBitMask[1] := 1;
  lBitMask[2] := 3;
  lBitMask[3] := 7;
  lBitMask[4] := 15;
  lBitMask[5] := 31;
  lBitMask[6] := 63;
  lBitMask[7] := 127;
  lBitMask[8] := 255;
  lBitMask[9] := 511;
  lBitMask[10] := 1023;
  lBitMask[11] := 2047;
  lBitMask[12] := 4095;
  lBitMask[13] := 8191;
  lBitMask[14] := 16383;
  lBitMask[15] := 32767;
  lBitMask[16] := 65535;
  lBitMask[17] := 131071; //ONLY required for Osiris corrupted images, see DecodePixelDifference for details
  //NEXT: some RGB images use only a single Huffman table for all 3 colour planes. In this case, replicate the correct values
  if (lnHufTables < SOFnf) then
  begin //use single Hufman table for each frame
    //showmessage('generating tables'+inttostr(SOFnf));
    if lnHufTables < 1 then
    begin
      showmessage('Lossless JPEG decoding error: no Huffman tables.');
      exit;
    end;

    for lFrameCount := 2 to SOFnf do
    begin
      for lInc := 1 to 16 do
        DHTstartRA[lFrameCount, lInc] := DHTstartRA[1, lInc];

      for lInc := 0 to 31 do
      begin
        lHufRA[lFrameCount, lInc].HufCode := lHufRA[1, lInc].HufCode;
        lHufRA[lFrameCount, lInc].HufVal := lHufRA[1, lInc].HufVal;
        lHufRA[lFrameCount, lInc].HufSz := lHufRA[1, lInc].HufSz;
        DHTliRA[lFrameCount, lInc] := DHTliRA[1, lInc];
      end; //for each table entry
    end; //for each frame                                           xx
  end; // if lnHufTables < SOFnf
  for lFrameCount := 1 to kMaxFrames do
    for lInc := 0 to 17 do
      lSSSSszRA[lFrameCount, lInc] := 123; //Impossible value for SSSS, suggests 8-bits can not describe answer
  for lFrameCount := 1 to kMaxFrames do
    for lInc := 0 to 255 do
      lLookUpRA[lFrameCount, lInc] := 255; //Impossible value for SSSS, suggests 8-bits can not describe answer
  //NEXT fill lookuptable
  for lFrameCount := 1 to SOFnf do
  begin
    lIncY := 0;
    for lSz := 1 to 8 do
    begin //set the huffman lookup table for keys with lengths <=8
      if DHTliRA[lFrameCount, lSz] > 0 then
      begin
        for lIncX := 1 to DHTliRA[lFrameCount, lSz] do
        begin
          inc(lIncY);
          lHufVal := lHufRA[lFrameCount, lIncY].HufVal; //SSSS
          {if (lHufVal < 0) or (lHufVal > 17) then begin
              showmessage('Unknown SSSS =' +inttostr(lHufVal));
              lHufVal := 16;
          end; }
          lSSSSszRA[lFrameCount, lHufVal] := lSz;
          k := (lHufRA[lFrameCount, lIncY].HufCode shl (8 - lSz)) and 255; //K= most sig bits for hufman table
          if lSz < 8 then
          begin //fill in all possible bits that exceed the huffman table
            lInc := lBitMask[8 - lSz];
            for lCurrentBitPos := 0 to lInc do
            begin
              lLookUpRA[lFrameCount, k + lCurrentBitPos] := lHufVal;
            end;
          end
          else
            lLookUpRA[lFrameCount, k] := lHufVal; //SSSS

          {Showmessage('Frame ' + inttostr(lFrameCount) + ' SSSS= '+inttostr(lHufRA[lFrameCount,lIncY].HufVal)+
             '  Size= '+inttostr(lHufRA[1,lIncY].HufSz)+
             '  Code= '+inttostr(lHufRA[1,lIncY].HufCode)+
             '  SHL Code= '+inttostr(k)+
             '  EmptyBits= '+inttostr(lInc)); {}
        end; //Set SSSS
      end; //Length of size lInc > 0
    end; //for lInc := 1 to 8
  end; //For each frame, e.g. once each for Red/Green/Blue
  //Next: uncompress data: different loops for different predictors
  SOFxdim := SOFnf * SOFxdim;
  lItems := SOFxdim * SOFydim;
  //if lVerbose then showmessage('precision'+inttostr(SOFprecision));
  //for timing, multiple decoding loops lRawAbba := lRawPos;for lLoopsAbba := 1 to 100 do begin lRawPos := lRawAbba;
     //if (lRestartSegmentSz > 0) and ((SOFPrecision<> 8) or (SOSss = 7)) then //add restart support if we ever find any samples to test
     //   showmessage('This image uses restart markers. Please contact the author. Predictor:Precision '+inttostr(SOSss)+':'+inttostr(SOFPrecision));
  inc(lRawPos); //abbax
  lCurrentBitPos := 0; //read in a new byte
  //lCurrentBitPos := 1; //read in a new byte
  lItems := SOFxdim * SOFydim;
  lPredicted := 1 shl (SOFPrecision - 1 - SOSpttrans);
  lInc := 0;
  if (SOFPrecision <> 8) then
  begin //start - 16 bit data
    lImgRA := @lOutSmallRA[0]; {set to 1 for MRIcro, else 0}
    FillChar(lImgRA^, lItems * sizeof(word), 0); //zero array
    lPredB := 0;
    lPredC := 0;
    case SOSss of //predictors 1,2,3 examine single previous pixel, here we set the relative location
      2: lPredA := SOFxDim - 1; //Rb directly above
      3: lPredA := SOFxDim; //Rc UpperLeft:above and to the left
      4, 5:
        begin
          lPredA := 0;
          lPredB := SOFxDim - 1; //Rb directly above
          lPredC := SOFxDim; //Rc UpperLeft:above and to the left
        end;
      6:
        begin
          lPredB := 0;
          lPredA := SOFxDim - 1; //Rb directly above
          lPredC := SOFxDim; //Rc UpperLeft:above and to the left
        end;
    else
      lPredA := 0; //Ra: directly to left
    end; //case SOSss: predictor offset
    for lIncX := 1 to SOFxdim do
    begin
      inc(lInc); //writenext voxel
      if lInc > 1 then
        lPredicted := lImgRA[lInc - 1];
      lImgRA[lInc] := lPredicted + DecodePixelDifference(1);
    end; //first line: use prev voxel prediction;

    (*          if SOFyDim > 1 then
                 for lIncY := 2 to SOFyDim do begin
                     inc(lInc); //write next voxel
                     lPredicted := lImgRA[lInc-SOFxdim];
                     lImgRA[lInc] := lPredicted+DecodePixelDifference(1);
                     if SOSss = 4 then begin
                        for lIncX := 2 to SOFxdim do begin
                             lPredicted := lImgRA[lInc-lPredA]+lImgRA[lInc-lPredB]-lImgRA[lInc-lPredC];
                             inc(lInc); //writenext voxel
                             lImgRA[lInc] := lPredicted+DecodePixelDifference(1);
                        end; //for lIncX
                     end else if (SOSss = 5) or (SOSss = 6) then begin
                        for lIncX := 2 to SOFxdim do begin
                             lPredicted := lImgRA[lInc-lPredA]+ ((lImgRA[lInc-lPredB]-lImgRA[lInc-lPredC]) shr 1);
                             inc(lInc); //writenext voxel
                             lImgRA[lInc] := lPredicted+DecodePixelDifference(1);
                        end; //for lIncX
                     end else if SOSss = 7 then begin
                        for lIncX := 2 to SOFxdim do begin
                            inc(lInc); //writenext voxel
                            lPredicted := (lImgRA[lInc-1]+lImgRA[lInc-SOFxdim]) shr 1;
                            lImgRA[lInc] := lPredicted+DecodePixelDifference(1);
                        end; //for lIncX
                     end else begin //SOSss 1,2,3 read single values
                         for lIncX := 2 to SOFxdim do begin
                             lPredicted := lImgRA[lInc-lPredA];
                             inc(lInc); //writenext voxel
                             lImgRA[lInc] := lPredicted+DecodePixelDifference(1);
                         end; //for lIncX
                     end;  //SOSss predictor
                 end; //for lIncY
    (**)

    if lRestartSegmentSz = 0 then
    begin
      for lIncY := 2 to SOFyDim do
      begin
        inc(lInc); //write next voxel
        lPredicted := lImgRA[lInc - SOFxdim];
        lImgRA[lInc] := lPredicted + DecodePixelDifference(1);
        if SOSss = 4 then
        begin
          for lIncX := 2 to SOFxdim do
          begin
            lPredicted := lImgRA[lInc - lPredA] + lImgRA[lInc - lPredB] - lImgRA[lInc - lPredC];
            inc(lInc); //writenext voxel
            lImgRA[lInc] := lPredicted + DecodePixelDifference(1);
          end; //for lIncX
        end
        else if (SOSss = 5) or (SOSss = 6) then
        begin
          for lIncX := 2 to SOFxdim do
          begin
            lPredicted := lImgRA[lInc - lPredA] + ((lImgRA[lInc - lPredB] - lImgRA[lInc - lPredC]) shr 1);
            inc(lInc); //writenext voxel
            lImgRA[lInc] := lPredicted + DecodePixelDifference(1);
          end; //for lIncX
        end
        else if SOSss = 7 then
        begin
          for lIncX := 2 to SOFxdim do
          begin
            inc(lInc); //writenext voxel
            lPredicted := (lImgRA[lInc - 1] + lImgRA[lInc - SOFxdim]) shr 1;
            lImgRA[lInc] := lPredicted + DecodePixelDifference(1);
          end; //for lIncX
        end
        else
        begin //SOSss 1,2,3 read single values
          for lIncX := 2 to SOFxdim do
          begin
            lPredicted := lImgRA[lInc - lPredA];
            inc(lInc); //writenext voxel
            lImgRA[lInc] := lPredicted + DecodePixelDifference(1);
          end; //for lIncX
        end; //SOSss predictor

      end; //for lIncY
    end {RestartSegmentSz = 0}
    else
    begin {restartsegment}
      if SOSss > 3 then
        showmessage('Unusual 16-bit lossless JPEG with restart segments. Please contact the author:' +
          inttostr(SOSss));
      lSegmentEnd := lRestartSegmentSz;
      repeat
        if lSegmentEnd > lItems then
          lSegmentEnd := lItems;
        lLineStart := (((lInc div SOFxDim) + 1) * SOFxDim) {-1};
        if lInc > (SOFxDim + 1) then
          lPredicted := 1 shl (SOFPrecision - 1 - SOSpttrans)
        else
          lPredicted := lImgRA[lInc - SOFxdim];

        for lInc := lInc to (lSegmentEnd - 1) do
        begin