childwin.pas

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

              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);
                    try
                       Filemode := 0; //read only - might be CD
                       Reset(fp, 1);
                       Seek(FP,128);
                       BlockRead(fp, lDICMcode, 4);
                       if lDICMcode = 1296255300 then lDICM := true;
                    finally
                       CloseFile(fp);
                    end; //try..finally open file
                    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
        {start vixen}
        lItems := gStringlist.Count;
        getmem(lIndexRA,lItems*sizeof({longint}DWord));
        getmem(lPositionRA,lItems*sizeof(longint));
        lFolderName := extractfiledir(FFilename);
        lTimeD := GetTickCount;
        for lInc := 1 to lItems do begin
            lFilename := lFolderName+pathdelim+gStringList.Strings[lInc-1];
            //showmessage(lFilename);
            read_dicom_data({true}false,false{not verbose},true,true,true,true,false, lDICOMdata, lHdrOK, lImgOK, lDynStr,lFileName );
            //if lDicomData.SiemensMosaicX <> 1 then showmessage(lFilename+' '+inttostr(lDicomData.SiemensMosaicX));
            application.ProcessMessages;

            lIndex := ((lDicomData.PatientIDInt and 65535) shl 32)+((lDicomData.SeriesNum and 255) shl 24)+((lDicomData.AcquNum and 255) shl 16) +lDicomData.ImageNum;
            lIndexRA[lInc] := lIndex;
            lPositionRA[lInc] := lInc;
        end;
        lTimeD := GetTickCount-lTimeD; //70 ms
       // Showmessage(inttostr(lItems)+'  '+inttostr(lTimeD)+'x');


        ShellSort (1, lItems,lPositionRA,lIndexRA, lRepeatedValues);
        //for lInc := 1 to lItems do
        //showmessage(inttostr(lPositionRA[lInc])+' = ' +  inttostr(lIndexRA[lPositionRA[lInc]]));

        if not lRepeatedValues then begin
           lStringList := TStringList.Create;
           for lInc := 1 to lItems do
            lStringList.Add(gStringList[lPositionRA[lInc]-1]);
            //[lInc-1] := gStringList[lPositionRA[lInc]-1]; //place items in correct order
           for lInc := 1 to lItems do
               gStringList[lInc-1] := lStringList[lInc-1]; //put sorted items into correct list
           lStringList.Free;
        end else
            gStringlist.Sort; //repeated index - sort name by filename instead
        //sort stringlist based on indexRA
        freemem(lPositionRA);
        freemem(lIndexRA);
        {end vixen}
        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    *)
  if (gStringlist.Count > 1) then begin
      StudyMenu.enabled := true;
  end;
end;(**)


(*old primitive->
procedure TMDIChild.LoadFileList;
//Searches for other DICOM images in the same folder (so user can cycle through images
var
  lSearchRec: TSearchRec;
  lName,lFilenameWOPath,lExt : string;
  lSz,lDICMcode: integer;
  lDICM: boolean;
     FP: file;
begin
     lFilenameWOPath := extractfilename(FFilename);
     lExt := ExtractFileExt(FFileName);
     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);
     gStringlist.Sort;
     if gStringlist.Count > 0 then begin
        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    *)
(*  if (gStringlist.Count > 1) then begin
      StudyMenu.enabled := true;
  end;
end;(**)

procedure TMDIChild.RescaleClear;
//resets slope/intercept for image brightness/contrast (e.g. to convert stored image intensity to Hounsfield units)
begin
     gIntenScaleInt := 1;
     gIntenInterceptInt := 0;
     gIntRescale := true;
end;

procedure TMDIChild.RescaleInit;
//updates slope/intercept for image brightness/contrast (e.g. to convert stored image intensity to Hounsfield units)
var lS,lI: single;
 lSi, lIi: integer;
begin
     RescaleClear;
     if gDICOMdata.IntenScale = 0 then
        gDICOMdata.IntenScale := 1;
     lS := gDICOMdata.IntenScale;
     lI := gDICOMdata.IntenIntercept;
     lSi := round(lS);
     lIi := round(lI);
     if (lS=lSi) and (lI=lIi) then begin
        gIntenScaleInt := lSi;
        gIntenInterceptInt := lIi;
        gIntRescale := true;
     end else
         gIntRescale := false;
end;

function TMDIChild.RescaleFromBuffer(lIn:integer):integer;
//converts image brightness to Hounsfield units using Slope and Intercept
// Output := (StoredImageIntensity*Slope)+zero_intercpet
begin
     if gIntRescale then
        result := round((lIn*gIntenScaleInt)+ gIntenInterceptInt)
     else
          result := round((lIn*gDICOMdata.IntenScale)+ gDICOMdata.intenIntercept);

end;

function TMDIChild.RescaleToBuffer(lIn:integer):integer;
//converts Hounsfield units to Stored image intensity using Slope and Intercept
// Output := (HounsfieldUnit / Slope)-zero_intercpet
begin
     result := round((lIn- gDICOMdata.intenIntercept)/gDICOMdata.IntenScale);//ChayMarch2003
//     result := round((lIn/gDICOMdata.IntenScale)- gDICOMdata.intenIntercept);
end;

procedure TMDIChild.Scale16to8bit(lWinCen,lWinWid: integer);
//Given a 16-bit input, this generates an 8-bit output, based on user's contrast/brightness settings
//Uses integer multiplication for fast computations on old CPUs
var
  lStartTime, lEndTime: DWord;
   lRngi,lMinVal,lMaxVal,lInt,lInc,lRange,i,lScaleShl10,lSz,min16,max16,lCen,lWid  :integer;
    lBuff: bytep0;
   lBuffx: ByteP0;
begin
     //MainForm.StatusBar.Panels[3].text := 'ax'+inttostr(random(888));

  if gBuff16 = nil then exit;
  gWinCen := lWinCen;
  gWinWid := lWinWid;
  if Self.Active then begin
     gContrastStr := 'Window Center/Width: '+inttostr(lWinCen)+'/'+inttostr(lWinWid){+':'+inttostr(round(lSlopeReal))};
     MainForm.StatusBar.Panels[4].text := gContrastStr;

     //gContrastStr := 'ABBA: '+floattostr(gDICOMdata.IntenIntercept)+'/'+floattostr(gDICOMdata.IntenScale){+':'+inttostr(round(lSlopeReal))};
     //MainForm.StatusBar.Panels[3].text := gContrastStr;

  end;
  //showmessage(floattostr(gDICOMdata.Intenscale));
  //gDICOMdata.Intenscale := 1;

  lCen := RescaleToBuffer(lWinCen);
  //showmessage(inttostr(lWinCen));
  lWid := abs(trunc((lWinWid/ gDICOMdata.IntenScale) /2));
  min16 := lCen - lWid;
  max16 := lCen + lWid;
  gWinMin := min16;
  gWinMax := max16;
  lSz:= (g100pctImageWid*g100pctImageHt);
  GetMem( lbuffx,lSz {width * height});
  lSz := lSz -1;
  lRange := (max16-min16);
  //MainForm.StatusBar.Panels[0].text := inttostr(value)+'tx'+inttostr(random(888));
  lStartTime := GetTickCount;
  //value = range
  if (lRange = 0) or (trunc((1024/lRange) * 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
      lScaleShl10 := trunc((1024/lRange) * 255); //value = range,Scale = 255/range
    (*
    if lSz > 131070  then begin //large image: make a look up table  x2 speedup
    //Using this code speeds up rescaling slightly, but not well tested...
               lMinVal := RescaleToBuffer(gImgMin)-1; //gRaw16Min;//
               lMaxVal := RescaleToBuffer(gImgMax)+1; //gRaw16Max;//
               lRngi := ROund(lMaxVal-lMinVal);
               getmem(lBuff, lRngi+1);  //+1 if the only values are 0,1,2 the range is 2, but there are 3 values!
               //max16 := max16-2;
               for lInc := (lRngi) downto 0 do begin
                   lInt := lInc+lMinVal; //32 bit math fastest
                    if lInt < min16 then
                        lBuff[lInc] := 0 //0
                   else if lInt > max16 then
                        lBuff[lInc] := 255
                   else
                       lBuff[lInc] :=  (((lInt)-min16) * lScaleShl10)  shr 10;
               end;
               lInc := 1;
               for i := 0 to lSz do
                   lbuffx[i] := lBuff[gBuff16[i]-lMinVal] ;
               freemem(lBuff);
    end else*) begin //if lSz -> use look up table for large images
      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!
            //  	    lbuff[i] := (Trunc(255*((gBuff16[i])-min16) / (value)));
      end;
    end; //if lSz ,,large image  .. else ...
  end; //lRange > 0
  //self.caption :=('update(ms): '+inttostr(GetTickCount-lStartTime)); //70 ms
  SetDimension(g100pctImageHt,g100pctImageWid,8,lBuffx,false);
  DICOMImageRefreshAndSize;
  FreeMem( lbuffx );
end;



function TMDIChild.VxlVal (X,Y: integer; lRGB_greenOnly: boolean): integer;
//Reports the intensity of a voxel at location X/Y
//If lRGB_greenOnly = TRUE, then the RRGGBB value #112233 will be #22 (useful for estimating approximate brightness at a voxel
//If lRGB_greenOnly = TRUE, then the RRGGBB value #112233 will be #112233 (actual RGB value)
var
   lVxl,lVxl24: integer;
begin
  RESULT := 0;
  lVxl := (Y* g100PctImageWid) +X; //rel20 Wid not Ht
  lVxl24 := (Y* g100PctImageWid*3) +(X * 3);
  if (gBuff16Sz > 0) and (lVxl >= 0) and (lVxl < gBuff16Sz) then
     result := RescaleFromBuffer(gBuff16[lVxl])
  else if (gBuff8sz > 0) and (lVxl >= 0) and (lVxl < gBuff8Sz) then
     result := gbuff8[lVxl]
  else if (gBuff24Sz > 0) and (lVxl24 >= 0) and (lVxl24 < gBuff24Sz) then begin
     if lRGB_greenOnly then
         result := (gbuff24[lVxl24+1]){green}
     else
         result := gbuff24[lVxl24+2]{blue}+(gbuff24[lVxl24+1] shl 8){green}+(gbuff24[lVxl24] shl 16){red};
  end;
end;

procedure TMDIChild.Vxl (X,Y: integer);
//Reports Brightness of voxel under the cursor
begin
  if (gBuff8sz > 0) or (gBuff16sz > 0) then
     MainForm.StatusBar.Panels[0].text := inttostr(VxlVal(X,Y,false))
  else if (gBuff24sz > 0) then
     MainForm.StatusBar.Panels[0].text :='#'+ Format('%*.*x', [6, 6, VxlVal(X,Y,false)])
  else
      MainForm.StatusBar.Panels[0].text := '';
end;
     
procedure TMDIChild.SetDimension(lInPGHt,lInPGWid ,lInBits:integer; lInBuff: ByteP0; lUseWinCenWid: boolean);
//Draws a graphic using the values in lInBuff
//Contains the nested procedure ScaleStretch, that resizes the image using linear interpolation (minimizing jaggies)
var
  lBuff: ByteP0;
  lPGwid,lPGHt,lBits: integer;
procedure ScaleStretch(lSrcHt,lSrcWid: integer; lInXYRatio: single);
var
lKScale: byte;
lrRA,lbRA,lgRA: array [0..255] of byte;
  //lBuff: ByteP0;
  lPos,xP,yP,yP2,xP2,t,z, z2,iz2,w1,w2,w3,w4,lTopPos,lBotPos,
  lINSz,  lDstWidM,{lDstWid,lDstHt,}x,y,lLT,lLB,lRT,lRB: integer;
    lXRatio,lYRatio: single;
  begin
  yP:=0;
  lXRatio := lInXYRatio;
  lYRatio := lInXYRatio;
  lInSz := lSrcWid *lSrcHt;
  lPGwid := {round}round(lSrcWid*lXRatio);//*lZoom;
  lPGHt := {round}round(lSrcHt*lYRatio);//*lZoom;
  lkScale := 1;
  xP2:=((lSrcWid-1)shl 15)div (lPGWid -1 );
  yP2:=((lSrcHt-1)shl 15)div (lPGHt -1);
  lPos := 0;
  lDstWidM := lPGWid - 1;
if lBIts = 24 then begin
  getmem(lBuff, lPGHt*lPGWid*3);
  lInSz := lInSz * 3; //24bytesperpixel
  for y:=0 to lPGHt-1 do begin
      xP:= 0;
      lTopPos:=lSrcWid *(yP shr 15) *3; //top row
      if yP shr 16<lSrcHt-1 then
         lBotPos:=lSrcWid *(yP shr 15+1) *3 //bottom column
      else
          lBotPos:=lTopPos;
      z2:=yP and $7FFF;
      iz2:=$8000-z2;
      x := 0;
      while x < lPGWid do begin
        t:=(xP shr 15) * 3;
        if ((lBotPos+t+6) > lInSz) or ((lTopPos+t) < 0) then begin
           lBuff[lPos] :=0; inc(lPos); //reds
           lBuff[lPos] :=0; inc(lPos); //greens
           lBuff[lPos] :=0; inc(lPos); //blues
        end else begin
            z:=xP and $7FFF;
            w2:=(z*iz2)shr 15;
            w1:=iz2-w2;
            w4:=(z*z2)shr 15;
            w3:=z2-w4;
            lBuff[lPos] :=(lInBuff[lTopPos+t]*w1+lInBuff[lTopPos+t+3]*w2