childwin.pas

在delphi7 下开发医学图象浏览器,对医学图象进行编辑,分析的

    gBuff16sz := 0;
  end;
  if (gBuff8sz > 0) then
  begin
    freemem(gBuff8);
    gBuff8sz := 0;
  end;
  if red_table_size > 0 then
  begin
    freemem(red_table);
    red_table_size := 0;
  end;
  if green_table_size > 0 then
  begin
    freemem(green_table);
    green_table_size := 0;
  end;
  if blue_table_size > 0 then
  begin
    freemem(blue_table);
    blue_table_size := 0;
  end;
  gCustomPalette := 0;
  gECATslices := 0;
end;

procedure ShellSort(first, last: integer; var lPositionRA {,lIndexRA}: longintP; lIndexRA: DWordP; var lRepeatedValues:
  boolean);
{Shell sort chuck uses this- see 'Numerical Recipes in C' for similar sorts.}
{less memory intensive than recursive quicksort}
label
  555;
const
  tiny = 1.0E-5;
  aln2i = 1.442695022;
var
  n, t, nn, m, lognb2, l, k, j, i, s: INTEGER;
begin
  lRepeatedValues := false;
  n := abs(last - first + 1);
  lognb2 := trunc(ln(n) * aln2i + tiny);
  m := last;
  for nn := 1 to lognb2 do
  begin
    m := m div 2;
    k := last - m;
    for j := 1 to k do
    begin
      i := j;
      555: {<- LABEL}
      l := i + m;
      if lIndexRA[lPositionRA[l]] = lIndexRA[lPositionRA[i]] then
      begin

        //showmessage(inttostr(lIndexRA[lPositionRA[l]] shr 24 and 255 )+'-'+inttostr(lIndexRA[lPositionRA[l]] shr 16 and 255 )+'-'+inttostr(lIndexRA[lPositionRA[l]] and 65535 ) );
        lRepeatedValues := true;
        exit;
      end;
      if lIndexRA[lPositionRA[l]] < lIndexRA[lPositionRA[i]] then
      begin
        //swap values for i and l
        t := lPositionRA[i];
        lPositionRA[i] := lPositionRA[l];
        lPositionRA[l] := t;
        i := i - m;
        if (i >= 1) then
          goto 555;
      end
    end
  end
end; (**)

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;
  lIndex: DWord;
  lInc, lItems: longint; //vixen
  lDicomData: DicomData; //vixen
  lRepeatedValues, lHdrOK, lImgOK: boolean; //vixen
  lFilename, lDynStr, lFoldername: string; //vixen
  lStringList: TStringList; //vixen
  lTimeD: DWord;
  lIndexRA: DWordP;
  lPositionRA {,lIndexRA}: longintP; //vixen
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);
            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
  value, i, lScaleShl10, lSz, min16, max16, lCen, lWid: integer;
  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;
  value := (max16 - min16);
  //MainForm.StatusBar.Panels[0].text := inttostr(value)+'tx'+inttostr(random(888));

  //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!
      //  	    lbuff[i] := (Trunc(255*((gBuff16[i])-min16) / (value)));
    end;
  end;
  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