lsjpeg.pas

用Delphi做的读取医学图片的控件及代码

                 if DHTliRA[lFrameCount,lInc]> 0 then begin
                     DHTstartRA[lFrameCount,lInc] := lIncY+1;
                     for lIncX := 1 to DHTliRA[lFrameCount,lInc] do begin
                         inc(lIncY);
                         ReadByte(btS1);
                         lHufRA[lFrameCount,lIncY].HufVal := btS1;
                         lMaxHufVal[lFrameCount] := btS1;
                         if (btS1 >= 0) and (btS1 <= 16) then
                           lHufRA[lFrameCount,lIncY].HufSz := lInc
                         else begin
                            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