console.pas

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

  BIH     : TBitmapInfoHeader;
  Bmp     : TBitmap;
  ImagoDC : hDC;
  pixmap  : Pointer;
  PPal: PLogPalette;
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
            if not gSilent then
               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;
//     if lTmpPos > lMaxo then lMaxo := lTmpPos;
     inc(lTMpPos);
end;

begin //procdure DisplayImage
lWinWid := lInWinWid;
lWinCen := lInWinCen;
if (lWinWid < 0) and ((gCustomPalette>0) or (gDICOMdata.RLERedOffset <>0) or ((gDICOMdata.Allocbits_per_pixel = 8) and(gDICOMdata.SamplesPerPixel = 3)) ) then begin
        lWinCen := 127;
        lWinWid := 255;
end else if (lWInWid < 0) and (gUseRecommendedContrast) and (gDICOMdata.WindowWidth <> 0) then begin //autocontrast
    lWinWId := gDICOMdata.WindowWidth;
    lWinCen := gDICOMdata.WindowCenter;
end;
if lUpdateCon then begin
     gFastSlope := 128;
     gFastCen := 128;
     if gDICOMdata.Allocbits_per_pixel > 8 then begin
         gFastSlope := 512{256};  {CONTRAST change here}
         gFastCen := 512{256}; {CONTRAST change here}
     end;
end;
lFileName := lInFilename;
Size := 0;
//nothere if (not lUpdateCon) and (gSlice = lSlice) {and (gScheme = lScheme)} and (lWinCen = gWinCen) and (lWinWid = gWinWid) then
//nothere    exit; {no change: delphi sends two on change commands each time a slider changes: this wastes a lot of display time}
gImgMin :=0;
gImgMax := 0;
gImgCen := 0;
gImgWid := 0;
gWinMin := gImgMin;
gWinMax := gImgMax;
gWinCen := lWinCen;
gWinWid := lWinWid;
//dsa gPalUpdated := false;
//nothere if (not gImgOK) or (gAbort) then exit;
if lSlice < 1 then {exit}lSlice := 1;
g100pctImageWid := gDICOMdata.XYZdim[1];
g100pctImageHt :=  gDICOMdata.XYZdim[2];
gSlice := lSlice;
lnMultiRow := gMultiRow;
if lnMultiRow < 1 then lnMultiRow := 1;
lnMultiCol := gMultiCol;
if lnMultiCol < 1 then lnMultiCol := 1;
lnMultiSlice := lnMultiRow*lnMultiCol;
//lMultiMultiFile := false;
lMultiMaxSlice :=  gDicomData.XYZdim[3];
if lnMultiSlice > 1 then begin //compute if single multiframe file or multiple files
   if gDicomData.XYZdim[3] > 1 then  begin
      if (lnMultiSLice > gDicomData.XYZdim[3]) then begin
         lnMultiSLice := gDicomData.XYZdim[3];
         gMultiFirst := 1;
         gMultiLast := lnMultiSlice;

      end;
   end {else if (gOffsetListSize>1) then begin
       if lnMultiSLice > gOffsetListSize then
          lnMultiSLice := gOffsetListSize;
       if  lnMultiSlice > 1 then
           lMultiMultiFile := true;
       lMultiMaxSlice := gOffsetListSize;

   end} else lnMultiSlice := 1;
end;
if lnMultiSlice > 1 then begin
   //nothere Self.caption := 'Multislice';
   g100pctImageWid := g100pctImageWid * lnMultiCol;
   g100pctImageHt := g100pctImageHt * lnMultiRow;
   if gDICOMdata.SamplesPerPixel > 1 then
      lMultiColSz := gDICOMdata.XYZdim[1]* gDICOMdata.SamplesPerPixel
   else
      lMultiColSz := gDICOMdata.XYZdim[1];
  lMultiLineSz := lMultiColSz * lnMultiCol;
  lMultiFullRowSz := lMultiLineSz * gDICOMdata.XYZdim[2];
  lMultiSliceSz := lMultiLineSz * gDICOMdata.XYZdim[2]*lnMultiRow;
  If (gDICOMdata.Allocbits_per_pixel > 8) then
    getmem(lMultiBuff{lMultiBuff16},lMultiSliceSz*2)
  else
      getmem(lMultiBuff,lMultiSliceSz);
  if gMultiFirst > lMultiMaxSlice then
     gMultiFirst := 1;
  lSlice := gMultiFirst;
  if (gMultiLast > lMultiMaxSlice) or (gMultiLast < gMultiFirst) then
     gMultiLast := lMultiMaxSlice;
  lMultiSliceInc := (gMultiLast -gMultiFirst) / (lnMultiSlice-1);
  if lMultiSliceInc < 1 then lMultiSliceInc := 1;
end {nothere else begin
         Self.caption := extractfilename(FFilename);
end};
lMultiSlice := 1; //1stSlice
123: //return here for multislice view              xx
lMultiCol := lMultiSlice mod lnMultiCol;
{if (lMultiMultiFile)  then begin
    lSlice := 1;
    lFilename := gFilePath+gStringList.Strings[lMultiSlice-1];//-1: indexed from 0
    lImageStart := gOffsetList[lMultislice];
end;}
if lMultiCol = 0 then lMultiCol := lnMultiCol;
lMultiCol := lMultiCol - 1; //index from 0
lMultiRow := (lMultiSlice-1) div lnMultiCol;
  lAllocSLiceSz := (gDICOMdata.XYZdim[1]*gDICOMdata.XYZdim[2] * gDICOMdata.Allocbits_per_pixel+7) div 8 ;
  if (lAllocSLiceSz) < 1 then exit;
  AssignFile(infp, lFilename);
  FileMode := 0; //Read only
  Reset(infp, 1);
  //if not lMultiMultiFile then
  lImageStart := gDicomData.ImageStart + ((lSlice-1) * (lAllocSliceSz*gDICOMdata.SamplesPerPixel));
  if (not gDicomData.GenesisCpt) and (gDicomData.CompressSz=0) and (not gDicomData.RunLengthEncoding)and ((lImageStart + (lAllocSliceSz*gDICOMdata.SamplesPerPixel)) > (FileSize(infp))) then begin
        if not gSilent then
           showmessage('This file does not have enough data for the image size:'+lFilename+kCR+'Image start: '+inttostr(lImageStart)+kCR+'Image size: '+inttostr(lAllocSliceSz*gDICOMdata.SamplesPerPixel));
        closefile(infp);
        FileMode := 2; //read/write
        exit;
  end;
  Seek(infp, lImageStart);
  if (gDICOMdata.RLERedOffset <>0) or ((gDICOMdata.Allocbits_per_pixel = 8) and(gDICOMdata.SamplesPerPixel = 3)) then begin
     //showmessage(inttostr(gWinCen)+'rgbx'+inttostr(gWinWid));
     lAllocSLiceSz := (gDICOMdata.XYZdim[1]*gDICOMdata.XYZdim[2]); //24bits per pixel: number of voxels in each colour plane
     size := lAllocSliceSz-1;
//'     AssignFile(infp, lFilename);
//'     FileMode := 0; //Read only
//'     Reset(infp, 1);
     lImageStart := gDicomData.ImageStart + ((lSlice-1) * (lAllocSliceSz*gDICOMdata.SamplesPerPixel));
//'     Seek(infp, lImageStart);
     if gBuff24Sz <>(lAllocSliceSz*3) then begin //gDICOMdata.SamplesPerPixel
        if gBuff24Sz <> 0 then
           Freemem(gBuff24);
        gBuff24Sz := lAllocSliceSz*3;
        GetMem( gBuff24, lAllocSliceSz*3);
     end;
     if (gDICOMdata.JPEGLossyCpt) then begin
        //Note: does not correctly convert YUV JPEG images...
        CloseFile(infp); //we will read this file directly
        FileMode := 2; //Read only
        decompressJPEG24noImage (lFilename,gBuff24,lAllocSliceSz,gECATposra[lSlice]);
        Reset(infp, 1); //other routines expect this to be left open
     end else if (gDICOMdata.JPEGLosslessCpt) then
        DecodeJPEG(infp,gBuff16,gBuff24, gBuff24Sz,gECATposra[lSlice],gECATszra[lSlice],false)
     else if (gDICOMdata.planarconfig = 0) and (gDICOMdata.RunLengthEncoding = false) then begin
         BlockRead(infp, gBuff24^, lAllocSliceSz*gDICOMdata.SamplesPerPixel);
     end else if (gDICOMdata.RLERedOffset <>0)  then begin
                DecompressRLE16toRGB(infp,gBuff24,lAllocSLiceSz,gDICOMdata.CompressOffset,gDICOMdata.CompressSz,gDICOMdata.RLERedOffset,gDICOMdata.RLEGreenOffset,gDICOMdata.RLEBlueOffset,gDICOMdata.RLERedSz ,gDICOMdata.RLEGreenSz,gDICOMdata.RLEBlueSz);
     end else if gDICOMdata.CompressSz > 0 then begin
         DecompressRLE8(infp, gBuff24,3{gDICOMdata.SamplesPerPixel},lAllocSliceSz,gDICOMdata.CompressOffset,gDICOMdata.CompressSz);
     end else begin //not compressed
            GetMem( TmpBuff, lAllocSliceSz);
            BlockRead(infp, TmpBuff^, lAllocSliceSz{, n});
            size := lAllocSliceSz-1;
            j := 0;
            for i := 0 to size do begin
                gBuff24[j] := TmpBuff[i];
                j := j + 3;
            end;
            BlockRead(infp, TmpBuff^, lAllocSliceSz{, n});
            size := lAllocSliceSz-1;
            j := 1;
            for i := 0 to size do begin
             gBuff24[j] := TmpBuff[i];
             j := j + 3;
            end;
            BlockRead(infp, TmpBuff^, lAllocSliceSz{, n});
            size := lAllocSliceSz-1;
            j := 2;
            for i := 0 to size do begin
             gBuff24[j] := TmpBuff[i];
             j := j + 3;
            end;
            FreeMem( TmpBuff);
     end; //no compression, swap planar compression
     CloseFile(infp);
     FileMode := 2; //read/write
     if gDICOMdata.monochrome = 4 then begin  //xappa
              j:= 0;
           for i := 0 to size do begin  //convert YcBcR to RGB
             lY := gBuff24[j];
             lCb := gBuff24[j+1]-128;
             lCr := gBuff24[j+2]-128;
             lR := round(lY+1.4022*lCr);
             lG := lY+round(-0.3456*lCb -0.7145*lCr);
             lB := round(lY+1.771 *lCb );
             if lR < 0 then lR := 0;
             if lR > 255 then lR := 255;
             if lG < 0 then lG := 0;
             if lG > 255 then lG := 255;
             if lB < 0 then lB := 0;
             if lB > 255 then lB := 255;
             gBuff24[j] := lR;
             gBuff24[j+1] := lG;
             gBuff24[j+2] := lB;  //red
             j := j + 3;
           end; //for loop
         end; //convert YcBcR to RGB
         //DetermineZoom;
  SetDimension(g100pctImageHt,g100pctImageWid,24,gBuff24,true,lFilename);
   exit;
  end; //24-bit RGB

  case gDICOMdata.Allocbits_per_pixel of
       8: begin

          if lAllocSliceSz <> gBuff8Sz then begin
             if gBuff8Sz <> 0 then freemem(gBuff8);
             GetMem( gbuff8, lAllocSliceSz);
          end;
          gBuff8Sz := lAllocSliceSz;
          if gDICOMdata.JPEGlossyCpt then begin
                          CloseFile(infp);
                          decompressJPEG8 (lFilename,gBuff8,lAllocSliceSz,gECATposra[lSlice]);
          end else  if gDicomData.JPEGlosslessCpt then
             DecodeJPEG(infp,gBuff16,gBuff8, lAllocSliceSz,gECATposra[lSlice],gECATszra[lSlice],false)
          else if gDICOMdata.CompressSz > 0 then begin
                  DecompressRLE8(infp, gBuff8,1,lAllocSliceSz,gECATposra[lSlice],gECATszra[lSlice]);
          end else begin
                  BlockRead(infp, gBuff8^, lAllocSliceSz{, n});
          end;
          if not gDICOMdata.JPEGlossyCpt then
             CloseFile(infp);
          FileMode := 2; //read/write
  size := gDicomData.XYZdim[1]*gDicomData.XYZdim[2] {2*width*height};
  value := gBuff8[0];
  max16 := value;
  min16 := value;
  i:=0;
  while I < (Size) do begin
    value := gBuff8[i];
    if value < min16 then min16 := value;
    if value > max16 then max16 := value;
    i := i+1;
  end;
  gImgMin := min16;
  gImgMax := max16;
  gWinMin := min16;
  gWinMax := max16;
  gImgWid := gImgMax-gImgMin;
  gImgCen := gImgMin + ((gImgWid)shr 1);
  if lWinWid < 0 then begin //autocontrast
    gWinMin := gImgMin;
    gWinMax := gImgMax;
    gWinWid := gImgWid;
    gWinCen := gImgCen;
  end;

  if (gCustomPalette>0) or ((red_table_size > 0) and (red_table_size <= 256) and (red_table_size=green_table_size) and (red_table_size=blue_table_size)) then begin
     if  gCustomPalette = 0 then begin
             gCustomPalette := red_table_size-1;
             for lInc := (gCustomPalette-1) downto 0 do begin
                 gRra[gCustomPalette-lInc] := red_table[lInc+1];//red_table[lInc+1];
                 gGra[gCustomPalette-lInc] := green_table[lInc+1];
                 gBra[gCustomPalette-lInc] := blue_table[lInc+1];//blue_table[lInc+1];
             end;
             freemem(red_table);
             red_table_size := 0;
             freemem(green_table);
             green_table_size := 0;
             freemem(blue_table);
             blue_table_size := 0;
     end; //red_size > 0
  end;
  if lnMultiSlice > 1 then begin
      lMultiStart := ((lMultiCol) * lMultiColSz)+(lMultiRow * lMultiFullRowSz);//both indexed from 0
      for j := (gDICOMdata.XYZdim[2]-1) downto 0 do begin
        i := j * lMultiColSz;
        move(gBuff8[i],lMultiBuff[lMultiStart+ (J*lMultiLineSz)],lMultiColSz);
      end;
      lSlice := gMultiFirst+round (lMultiSliceInc*lMultiSlice);
      inc(lMultiSlice);
      if (lMultiSlice <= lnMultiSlice) and (lSlice <= {lMultiMaxSlice}gMultiLast) then goto 123;
      freemem(gBuff8);
      getmem(gBuff8,lMultiSliceSz);
      move(lMultiBuff[0],gBuff8[0],lMultiSliceSz);
      freemem(lMultiBuff);
      gBuff8Sz := lMultiSliceSz;
  end;
  SetDimension(g100pctImageHt,g100pctImageWid,8,gBuff8,true,lFilename);
  exit;
          end;
       16: begin
           if gECATslices >= lSlice then
              seek(infp, gECATposra[lSlice])
           else
               Seek(infp, lImageStart);
           if (gBuff16Sz <> (lAllocSliceSz shr 1)) then begin
              if gBuff16sz <> 0 then
                 Freemem(gBuff16);
              gBuff16Sz := 0;
           end;
           if gBuff16sz = 0 then
           GetMem( gbuff16, lAllocSliceSz);
           gBuff16sz := (lAllocSliceSz shr 1);
           if gDicomData.RunLengthEncoding then begin
              gDicomData.Maxintensity :=32767; //convert 16 bit to 15bit
              DecompressRLE16(infp,gBuff16,gBuff16sz,gDICOMdata.CompressOffset,gDICOMdata.CompressSz);
           end else if gDicomData.JPEGlosslessCpt then begin
              DecodeJPEG(infp,gBuff16,lBuff, lAllocSliceSz,gECATposra[lSlice],gECATszra[lSlice],false);
           end else if gDicomData.GenesisCpt then begin
                DecompressGE(infp,gBuff16,lImageStart,gDicomData.XYZdim[1],gDicomData.XYZdim[2],gDicomData.GenesisPackHdr);
           end else begin //not genesis
                   BlockRead(infp, gbuff16^, lAllocSliceSz{, n});
                end;
                CloseFile(infp);
                FileMode := 2; //read/write
       end;
       12: begin
           GetMem( tmpbuff, lAllocSliceSz);
           BlockRead(infp, tmpbuff^, lAllocSliceSz{, n});
           CloseFile(infp);
           FileMode := 2; //read/write
           lStoreSliceVox := gDICOMdata.XYZdim[1]*gDICOMdata.XYZdim[2];
           lStoreSLiceSz := lStoreSliceVox * 2;
           if (gBuff16Sz <> (lStoreSLiceSz shr 1)) then begin
              if gBuff16sz <> 0 then
                 Freemem(gBuff16); //asdf
              gBuff16Sz := 0;
           end;
           if gBuff16sz = 0 then
           GetMem( gbuff16, lStoreSLiceSz);
           gBuff16sz := lStoreSLiceSz shr 1;
           I12 := 0;
           I := 0;
         if gDicomData.little_endian = 1 then begin
          repeat
                 gbuff16[I] := tmpbuff[I12] + ((tmpbuff[I12+1] and 15) shl 8);
                 inc(I);
                 if I < lStoreSliceVox then
                    gbuff16[i] :=  (tmpbuff[I12+2] shl 4) +((tmpbuff[I12+1] and 240) shr 4 );
                 inc(I);