ezdicomimpl1.pas

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

     For i:= (lHt)  downto 0 do //copy each row/scanline of data
       CopyMemory(Pointer(lPixmapInt+lScanLineSz8*(i)),Pointer(lBuffInt+((lHt-i))*lScanLineSz),lScanLineSz);
  end; //if lBuff full
  ReleaseDC(0,ImagoDC);
  Bmp.Handle := hBmp;
  Bmp.ReleasePalette;
  Image.Picture.Assign(Bmp);
  Bmp.Free;
  FreeMem( BI);
  //if (lScale <> 1) and (gSmooth) then //unload temporary buffers
  if lBufferUsed then
     freemem(lBuff);
  {x$P-,S+,W+,R-}
end; //procedure SetDimensions

procedure TezDICOMX.OverlayData;
//shows text details on top of images
//Useful for showing patient name, patient ID, contrast settings, etc.
var lMaxSlices,lZOomPct,lMultiSlice,lRowPos,lColPos,lDiv,lFOntSpacing,lSpace,lRow,lSlice,lCol: integer;
lMultiSliceInc : single;
begin
     if gDicomData.XYZdim[3] > 1 then
        lMaxSlices := gDicomData.XYZdim[3]
     else if gFileListSz > 1 then
           lMaxSlices := gFileListSz
     else
        lMaxSlices := 1;
     if not gOverlay then exit;
     if gSmooth then
        lZoomPct := gZoomPct
     else
         lZoomPct := 100;
     if gMultiCol > 0 then
        lDiv := gMultiCol
     else
         lDiv := 1;
     case (image.Picture.Width div lDiv) of //use smaller fonts on smaller images
          0..63: lFontSpacing := 8;
          64..127: lFontSpacing := 8;//9;
          128..255: lFontSpacing := 9;//10;
          256..511: lFontSpacing := 10;//12;
          512..767: lFontSpacing := 12;//14;
          else lFontSpacing := 14;//26;
     end; //case.. set font size
     Image.Canvas.Font.Name := 'MS Sans Serif';
     Image.Canvas.Brush.Style := bsClear;
     Image.Canvas.Font.Size := lFontSpacing;
     if gOverlayColor = 1 then //black
        Image.Canvas.Font.Color := 0//$FFFFFF;//gMaxRGB
     else
        Image.Canvas.Font.Color := $FFFFFF;
     if ((gMultiRow > 1) or (gMultiCol > 1)) and (gMultiROw > 0) and (gMultiCol > 0) then begin
               lMultiSliceInc := (gMultiLast -gMultiFirst) / ((gMultiRow * gMultiCol)-1);
               if lMultiSliceInc < 1 then
                  lMultiSliceInc := 1;
               lMultiSlice := 0;
               for lRow := 0 to (gMultiRow-1)  do begin
                   lRowPos := 6+(lROw * (((gDICOMdata.XYZdim[2]+kBorderSz )* lZoomPct) div 100 ));
                   for lCol := 0 to (gMultiCOl-1)  do begin
                       lColPos :=6+ (lCol * (((gDICOMdata.XYZdim[1]+kBorderSz )* lZoomPct) div 100 ));
                       lSlice := gMultiFirst+round (lMultiSliceInc*(lMultiSlice))-1;
                       Image.Canvas.TextOut(lColPos,lRowPos,inttostr(lSlice+1)+':'+inttostr(lMaxSlices));
                       inc(lMultiSlice);
                   end;//for lROw
               end; //for lCol.
     end else //not multislice mosaic
     Image.Canvas.TextOut(6,6,inttostr(gSlice)+':'+inttostr(lMaxSlices));
     lSpace := 6+2+lFontSpacing;
     Image.Canvas.TextOut(6,lSpace,'C/W: '+floattostrf(gWinCen,ffFixed,8,0)+'/'+floattostrf(gWinWid,ffFixed,8,0));
     lSpace :=lSpace+ 2+lFontSpacing;
     Image.Canvas.TextOut(6,lSpace,'Ht*Wid*Thk mm: '+floattostrf(gDicomData.XYZmm[1],ffFixed,8,2)+'*'
              +floattostrf(gDicomData.XYZmm[2],ffFixed,8,2)+'*'+floattostrf(gDicomData.XYZmm[3],ffFixed,8,2));
     lSpace :=lSpace+ 2+lFontSpacing;
     Image.Canvas.TextOut(6,lSpace,'Name: '+gDicomData.PatientName);
     lSpace :=lSpace+ 2+lFontSpacing;
     Image.Canvas.TextOut(6,lSpace,'ID: '+gDicomData.PatientID);
     lSpace :=lSpace+ 2+lFontSpacing;
     Image.Canvas.TextOut(6,lSpace,'Date: '+gDicomData.StudyDate);
     lSpace :=lSpace+ 2+lFontSpacing;
     if (gDICOMdata.TR <> 0) then //show Time to Repeat and Time to Echo for MRI scan
        Image.Canvas.TextOut(6,lSpace,'TR/TE: '+floattostrf(gDicomData.TR,ffFixed,8,1)+'/'+floattostrf(gDICOMdata.TE,ffFixed,8,1))
     else if (gDICOMdata.kV <> 0) then  //show peak kV/mA for CT scans
        Image.Canvas.TextOut(6,lSpace,'kV/mA: '+floattostrf(gDicomData.kV,ffFixed,8,1)+'/'+floattostrf(gDICOMdata.mA,ffFixed,8,1));
end; //procedure OverlayData

procedure TezDICOMX.LoadFileList;
//loads multiple sequential DICOM files from a directory
//In future, it would be nice to make this a bit more object oriented.
var
  lSearchRec: TSearchRec;
  lName,lFilenameWOPath,lExt : string;
  lSz,lDICMcode: integer;
  lDICM: boolean;
     FP: file;
begin
  gFilelistSz := 0;
  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 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 (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;
  end; //NamePos > 0    *)
end; //procedure LoadFileList

Procedure TezDICOMX.LoadFiles;
//loads multiple sequential DICOM files from a directory
//note: inefficient bubble sort to compute order
var
  lNameStr,lDynStr: string;
  lI,lI2,lCount,lX,lY,lBits,lBitsStore,lSamples: integer;
  lHdrOK,lImgOK,lSameFormat,lIndexRepeat: boolean;
  lDicomData: DICOMdata;
  lTempList: TStringList;
  lImageStartTempRAz: array [1..kMaxEcat,kOffset..kWinWid] of longint;
  lindexRAz: LongIntp ;
  lPrevSmallest,lNextSmallest,lNextSmallestPos,lindexRAsz: integer;
begin
     gStringList.Clear;
     LoadFileList;
     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,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;// else lSameFormat := false;
end;





procedure TezDICOMX.DICOMImageRefreshAndSize;
//redraws the image: called when the window size or zoom values change
begin
  if gSmooth then begin
     image.Height:= image.Picture.Height;
     image.Width := image.Picture.Width ;
  end else begin
       image.Height:= round((image.Picture.Height * gZoomPct) div 100);
       image.Width := round((image.Picture.Width* gZoomPct) div 100) ;
  end;
  if gOverlay then OverlayData;
  Image.refresh;
end;


procedure TezDICOMX.Scale16to8bit(lWinCen,lWinWid: double);
//scales a 16bit image to an 8bit image, using the brightness/contrast of WinCen/WinWid
//this procedure then writes the 8bit image to the screen
var
   value,i,lScaleShl10,lSz,min16,max16,lwid,lcen  :integer;
   lBuffx: ByteP0;
begin
  if gBuff16 = nil then exit;
  gWinCen := lWinCen;
  gWinWid := lWinWid;
  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);
  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 Scale16to8bit



procedure TezDICOMX.RefreshZoom;
begin
  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
       image.Height:= round((image.Picture.Height * gZoomPct) div 100);
       image.Width := round((image.Picture.Width* gZoomPct) div 100) ;
       IMage.refresh;
       LockWindowUpdate(0);
       exit;
  end;
  DICOMImageRefreshAndSize;
  LockWindowUpdate(0);
end;

procedure TezDICOMX.UpdatePalette (lApply: boolean;lWid0ForSlope:integer);
//updates the colour scheme.
//For 8bit images, we manipulate the palette when the brightness/contrast change
//Apply refreshed the screen
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;