qdcmimage.pas

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

            lSameFormat := true;
            lNameStr := gFilePath+gStringList.Strings[0];
            read_dicom_data(false,false,true,false,true,true,false,lDicomData,lHdrOK,LImgOK,lDynStr,lNameStr);
            lX := lDicomdata.xyzdim[1];
            lY := lDicomData.xyzdim[2];
            lSamples := lDicomData.SamplesPerPixel;
            lBits := lDICOMdata.Allocbits_per_pixel;
            lBitsStore := lDICOMdata.Storedbits_per_pixel;
            gOffsetList[1,kOffset] := lDicomData.ImageStart;
            gOffsetList[1,kWinCen] := lDicomData.WindowCenter;
            gOffsetList[1,kWinWid] := lDicomData.WindowWidth;
            lIndexRAz[1] := lDICOMdata.ImageNum;
            if (lDICOMdata.CompressSz <> 0) or(lDicomData.JPEGlosslessCpt) or (lDicomData.JPEGlossyCpt) or (lDicomData.RunLengthEncoding) then
              lSameFormat := false;
            for lCount := 2 to gFileListSz do begin
                lNameStr := gFilePath+gStringList.Strings[lCount-1];
                read_dicom_data(false,false,true,false,true,true,false,lDicomData,lHdrOK,LImgOK,lDynStr,lNameStr);
                if (lX <> lDicomdata.xyzdim[1]) or (lSamples <> lDicomData.SamplesPerPixel) or (lY <> lDicomdata.xyzdim[2])
                or (lBits <> lDICOMdata.Allocbits_per_pixel) or (lBitsStore <> lDICOMdata.Storedbits_per_pixel) then
                   lSameFormat := false;
                gOffsetList[lCount,kOffset] := lDicomData.ImageStart;
                gOffsetList[lCount,kWinCen] := lDicomData.WindowCenter;
                gOffsetList[lCount,kWinWid] := lDicomData.WindowWidth;
                lIndexRAz[lCount] := lDICOMdata.ImageNum;
                if (lDICOMdata.CompressSz <> 0) or(lDicomData.JPEGlosslessCpt) or (lDicomData.JPEGlossyCpt) or (lDicomData.RunLengthEncoding) then
                   lSameFormat := false;
            end; //check that all images are the same format

            if lSameFormat then
               gOffsetListSize := gFileListSz;
            lIndexRepeat := false;
            for lI := (lIndexRASz-1) downto 1 do begin
                for lI2 := (lI+1) to lIndexRAsz do
                        if lIndexRAz[lI2] = lIndexRAz[lI] then lIndexRepeat := true;
            end;
            if (lSameFormat) and (not lIndexRepeat) then begin
                //find smallest image number
                lTempList := TStringList.Create;
                //NEXT: find the smallest index available: this will be the first image in the sequence
                lPrevSmallest := lIndexRAz[1];
                for lI := lIndexRASz downto 1 do
                  if lIndexRAz[lI] < lPrevSmallest then
                        lPrevSmallest := lIndexRAz[lI];
                lPrevSmallest := lPrevSmallest -1;
                //NEXT: find the best order based on the image index
                //before sorting: PrevIndex is the smallest -1
                for lI := 1 to lIndexRASz do begin
                   lNextSmallest := {lIndexRAz[1]}MaxInt;//crucial
                   lNextSmallestPos := 1;
                   for lI2 := 1 to lIndexRASz do begin
                     if (lIndexRAz[lI2] > lPrevSmallest) and (lIndexRAz[lI2] < lNextSmallest) then begin
                        lNextSmallest := lIndexRAz[lI2];
                        lNextSmallestPos := lI2;
                     end; //new smallest value
                   end; //find smallest value
                   lTempList.Add ( gStringList.Strings[lNextSmallestPos-1]);
                   lImageStartTempRAz[lI,kOffset] := gOffsetList[lNextSmallestPos,kOffset];
                   lImageStartTempRAz[lI,kWinCen] := gOffsetList[lNextSmallestPos,kWinCen];
                   lImageStartTempRAz[lI,kWinWid] := gOffsetList[lNextSmallestPos,kWinWId];
                   lPrevSmallest := lNextSmallest;
                end; //sort all strings
                //NEXT: make order of filenames, image offsets, brightness and contrast settings match the order
                for lI := 1 to lIndexRASz do begin
                    gStringList.Strings[lI-1] := lTempList.Strings[lI-1];
                    gOffsetList[lI,kOffset] := lImageStartTempRAz[lI,kOffset];
                    gOffsetList[lI,kWinCen] := lImageStartTempRAz[lI,kWinCen];
                    gOffsetList[lI,kWinWid] := lImageStartTempRAz[lI,kWinWid];
                end;
                lTempList.Free;
            end;
            FreeMem( lIndexRAz);
        end;
end;

(*procedure TDCMimage.LoadFileList;
var
  lSearchRec: TSearchRec;
  lName,lFilenameWOPath,lExt : string;
  lSz,lDICMcode: integer;
  lDICM: boolean;
     FP: file;
begin
     gFilelistSz := 0;//abz
     if not gloadmultiplefiles then exit;
     lFilenameWOPath := extractfilename(gFilename);
     lExt := ExtractFileExt(gFileName);
     if length(lExt) > 0 then
        for lSz := 1 to length(lExt) do
            lExt[lSz] := upcase(lExt[lSz]);
 if (gDicomData.NamePos > 0) then begin //real DICOM file
     if {SysUtils.}FindFirst(gFilePath+'*.*', faAnyFile-faSysFile-faDirectory, lSearchRec) = 0 then begin
        repeat
              lExt := AnsiUpperCase(extractfileext(lSearchRec.Name));
              lName := AnsiUpperCase(lSearchRec.name);
              if (lSearchRec.Size > 1024)and (lName <> 'DICOMDIR') then begin
                 lDICM := false;
                 if ('.DCM' = lExt) then lDICM := true;
                 if ('.DCM'<>  lExt) then begin
                    Filemode := 0;
                    AssignFile(fp, gFilePath+lSearchRec.Name);
                    Filemode := 0; //read only - might be CD
                    Reset(fp, 1);
                    Seek(FP,128);
                    BlockRead(fp, lDICMcode, 4);
                    if lDICMcode = 1296255300 then lDICM := true;
                    CloseFile(fp);
                    Filemode := 2; //read/write
                 end; //Ext <> DCM
                 if lDICM then
                    gStringList.Add(lSearchRec.Name);{}
              end; //FileSize > 512

        until ({SysUtils.}FindNext(lSearchRec) <> 0);
        Filemode := 2;
     end; //some files found
     SysUtils.FindClose(lSearchRec);
     if gStringlist.Count > 0 then begin
        gStringlist.Sort;
        for lSz := (gStringList.count-1) downto 0 do begin
            if gStringList.Strings[lSz] = lFilenameWOPath then gCurrentPosInFileList := lSz;
        end;
     end;
     gFileListSz := gStringList.count;
     //lStringList.Free;
  end; //NamePos > 0
end;

Procedure TDCMimage.LoadFiles;
var lNameStr,lDynStr: string;
lI,lI2,lCount,lX,lY,lBits,lBitsStore,lSamples: integer;
lHdrOK,lImgOK,lSameFormat,lIndexRepeat: boolean;
lDicomData: DICOMdata;
lTempList: TStringList;
lindexRAz,lImageStartTempRAz: Longintp ;
lPrevSmallest,lIndexInc,lNextSmallest,lNextSmallestPos,lindexRAsz: integer;

begin
     gStringList.Clear;
     LoadFileList;//(gStringList,FFilename, gCurrentPosInFileList,gFileListSz);
     gOffsetListSize := 0;
     if (gFileListSz > 1) and (gFileListSz <= kMaxEcat) then begin
            lIndexRASz := gFileListSz;
            GetMem( lIndexRAz, gFileListSz*sizeof(longint));
            lSameFormat := true;
            lNameStr := gFilePath+gStringList.Strings[0];
            read_dicom_data(false,false,true,false,true,true,false,lDicomData,lHdrOK,LImgOK,lDynStr,lNameStr);
            lX := lDicomdata.xyzdim[1];
            lY := lDicomData.xyzdim[2];
            lSamples := lDicomData.SamplesPerPixel;
            lBits := lDICOMdata.Allocbits_per_pixel;
            lBitsStore := lDICOMdata.Storedbits_per_pixel;
            gOffsetList[1] := lDicomData.ImageStart;
            lIndexRAz[1] := lDICOMdata.ImageNum;
            if (lDICOMdata.CompressSz <> 0) or(lDicomData.JPEGlosslessCpt) or (lDicomData.JPEGlossyCpt) or (lDicomData.RunLengthEncoding) then
              lSameFormat := false;
            for lCount := 2 to gFileListSz do begin
                lNameStr := gFilePath+gStringList.Strings[lCount-1];
                read_dicom_data(false,false,true,false,true,true,false,lDicomData,lHdrOK,LImgOK,lDynStr,lNameStr);
                if (lX <> lDicomdata.xyzdim[1]) or (lSamples <> lDicomData.SamplesPerPixel) or (lY <> lDicomdata.xyzdim[2])
                or (lBits <> lDICOMdata.Allocbits_per_pixel) or (lBitsStore <> lDICOMdata.Storedbits_per_pixel) then
                   lSameFormat := false;
                gOffsetList[lCount] := lDicomData.ImageStart;
                lIndexRAz[lCount] := lDICOMdata.ImageNum;
                if (lDICOMdata.CompressSz <> 0) or(lDicomData.JPEGlosslessCpt) or (lDicomData.JPEGlossyCpt) or (lDicomData.RunLengthEncoding) then
                   lSameFormat := false;
            end; //check that all images are the same format

            if lSameFormat then
               gOffsetListSize := gFileListSz;

            lIndexRepeat := false;
            for lI := (lIndexRASz-1) downto 1 do begin
                for lI2 := (lI+1) to lIndexRAsz do
                        if lIndexRAz[lI2] = lIndexRAz[lI] then lIndexRepeat := true;
            end;
            if (lSameFormat) and (not lIndexRepeat) then begin
                //find smallest image number
                GetMem( lImageStartTempRAz, gFileListSz*sizeof(longint));
                lTempList := TStringList.Create;
                lPrevSmallest := lIndexRAz[1];
                for lI := lIndexRASz downto 1 do
                  if lIndexRAz[lI] < lPrevSmallest then
                        lPrevSmallest := lIndexRAz[lI];
                lPrevSmallest := lPrevSmallest -1;

       // for lI := 0 to (lIndexRASz-1) do
     // showmessage(gStringList.Strings[lI]+'x'+inttostr(lIndexRAz[lI+1]));
      // showmessage(inttostr(lPrevSmallest));
                //before sorting: PrevIndex is the smallest -1
                for lI := 1 to lIndexRASz do begin
                   lNextSmallest := {lIndexRAz[1]}MaxInt;//crucial
                   lNextSmallestPos := 1;
                   for lI2 := 1 to lIndexRASz do begin
                     if (lIndexRAz[lI2] > lPrevSmallest) and (lIndexRAz[lI2] < lNextSmallest) then begin
                        lNextSmallest := lIndexRAz[lI2];
                        lNextSmallestPos := lI2;
                     end; //new smallest value
                   end; //find smallest value
                   lTempList.Add ( gStringList.Strings[lNextSmallestPos-1]);
                   lImageStartTempRAz[lI] := gOffsetList[lNextSmallestPos];
                   //showmessage(inttostr(lNextSmallest)+'/'+inttostr(lNextSmallestPos));
                   lPrevSmallest := lNextSmallest;
                end; //sort all strings

                for lI := 1 to lIndexRASz do begin
                    gStringList.Strings[lI-1] := lTempList.Strings[lI-1];
                    gOffsetList[lI] := lImageStartTempRAz[lI];
                end;
                lTempList.Free;
                Freemem(lImageStartTempRAz);
            end;
            FreeMem( lIndexRAz);

        end else lSameFormat := false;
end; (*  *)

procedure TDCMimage.DICOMImageRefreshAndSize;
var lHt, lWid: integer;
begin
  IF gFilename = '' THEN exit;
  if (gSmooth)  then begin
     lHt:= Self.Picture.Height;
     lWid := Self.Picture.Width ;
  end else begin
       lHt:= round((Self.Picture.Height * gZoomPct) div 100);
       lWid := round((Self.Picture.Width* gZoomPct) div 100) ;
  end;
  if (lHt <> Self.Height) or (lWid <> Self.Width) then begin
     Self.Height := lHt;
     Self.Width := lWid;
  end;
  if gOverlay then OverlayData;
  Self.refresh;
end;


procedure TDCMimage.Scale16to8bit(lWinCen,lWinWid: double);
var
   lCen,lWid,value,i,lScaleShl10,lSz,min16,max16  :integer;
   //value,i,lScaleShl10,lSz,min16,max16  :integer;
   lBuffx: ByteP0;
begin
  if gBuff16 = nil then exit;
  gWinCen := lWinCen;
  gWinWid := lWinWid;
  //min16 := round(lWinCen - (abs(trunc(lWinWid{Edit.value}/2))));
  //max16 := round(lWinCen + (abs(trunc(lWinWid{Edit.value}/2))));
  lCen := RescaleToBuffer(lWinCen);
  lWid := abs(trunc((lWinWid/ gDICOMdata.IntenScale) /2));
  min16 := lCen - lWid;//15za
  max16 := lCen + lWid;//15za
  gWinMin := min16;
  gWinMax := max16;
  lSz:= (g100pctImageWid*g100pctImageHt);
  GetMem( lbuffx,lSz );
  lSz := lSz -1;
  value := (max16-min16);
  //value = range
  if (value = 0) or (trunc((1024/value) * 255) = 0) then begin
      if lWinWid > 1024 then begin
         for i := 0 to lSz do
          lbuffx[i] := 128;

      end else begin
      for i := 0 to lSz do
          if gBuff16[i] < lWinCen then
             lbuffx[i] := 0
          else
               lbuffx[i] := 255;
      end;
  end else begin
      if value = 0 then value := 1;
      lScaleShl10 := trunc((1024/value) * 255); //value = range,Scale = 255/range
      for i := 0 to lSz do begin
          if gBuff16[i] < min16 then
             lbuffx[i] := 0
          else if gBuff16[i] > max16 then
               lbuffx[i] := 255
          else
              lbuffx[i] := (((gBuff16[i])-min16) * lScaleShl10)  shr 10;
            //NOTE: integer maths increases speed x7!
      end;
  end;
  SetDimension(g100pctImageHt,g100pctImageWid,8,lBuffx,false);
  DICOMImageRefreshAndSize;
  FreeMem( lbuffx );
end;



procedure TDCMimage.RefreshZoom;
begin
  //abba LockWindowUpdate(Self.Handle);
  if gBuff24sz > 0 then
        SetDimension(g100pctImageHt,g100pctImageWid,24,gBuff24,false)
  else if gBuff16sz > 0 then
         Scale16to8bit(gWinCen,gWinWid)
  else if  (gBuff8sz > 0) {and (gCustomPalette = 0)} then begin
       SetDimension(g100pctImageHt,g100pctImageWid,8,gBuff8,true);
  end else begin
        IF gFilename = '' THEN exit;
       Self.Height:= round((Self.Picture.Height * gZoomPct) div 100);
       Self.Width := round((Self.Picture.Width* gZoomPct) div 100) ;
       Self.refresh;
       //LockWindowUpdate(0);
       exit;
  end;
  DICOMImageRefreshAndSize;
  //LockWindowUpdate(0);
end;

procedure TDCMimage.UpdatePalette (lApply: boolean;lWid0ForSlope:integer);
var
   lMin,lMax: integer;
   lSlopeReal: single;
begin
   if (gDICOMdata.Allocbits_per_pixel > 8) and (gBuff24Sz = 0){16-BITPALETTE} then begin
        if not lApply then exit;
        refreshzoom;
        exit;
   end;
   if lWid0ForSlope = 0 then begin
      lSlopeReal := gFastSlope * 0.352059;
      lSlopeReal := sin(lSlopeReal*kRadCon)/cos(lSlopeReal*kRadCon);
      if lSlopeReal <> 0 then begin
           lMax := round(128 / lSlopeReal);
           lMin := gFastCen-lMax;
           lMax := gFastCen+lMax;
      end else begin
            lMin := 0;
            lMax := 0;
      end;
   end else begin //lWid0ForSlope
       lMin := gFastCen - (lWid0ForSlope shr 1);
       lMax := lMin + lWid0ForSlope;
       lSlopeReal := 255 / lWid0ForSlope;
       gFastSlope := round(( arctan(lSlopeReal)/kRadCon)/0.352059);

   end;
        if  (gDicomData.Allocbits_per_pixel < 9) or (gDICOMdata.RLERedSz > 0) then begin
            gWinCen := (gFastCen);
            if ((lMax - lMin) > maxint) or ((lMin=0) and (lMax=0)) then begin
                gWInWid := maxint;
            end else begin
                gWInWid := (lMax - lMin);
            end;
        end;
        if gBuff8Sz > 0 then begin
           SetDimension(g100pctImageHt,g100pctImageWid,8,gBuff8,true);
           DICOMImageRefreshAndSize;
         end else if gBuff24Sz > 0 then begin
           //fargo
           SetDimension(g100pctIma