console.pas

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

                 I12 := I12 + 3;
           until I >= lStoreSliceVox;
        end else begin
           repeat
                 gbuff16[I] := tmpbuff[I12] shl 4 + (tmpbuff[I12+1] and 15);
                 inc(I);
                 if I < lStoreSliceVox then
                    gbuff16[i] :=  (((tmpbuff[I12+2]) and 15) shl 8) +((((tmpbuff[I12+1]) shr 4 ) shl 4)+((tmpbuff[I12+2]) shr 4)  );
                 inc(I);
                 I12 := I12 + 3;
           until I >= lStoreSliceVox;
         end;
           FreeMem( tmpbuff);
           end;
       else exit;
  end;
  size := gDicomData.XYZdim[1]*gDicomData.XYZdim[2] {2*width*height};
  if (gDicomdata.little_endian <> 1) and (not gDicomData.GenesisCpt) then  //convert big-endian data to Intel friendly little endian
     for i := (Size-1) downto 0 do
         gbuff16[i] := swap(gbuff16[i]);

  if gDicomData.Maxintensity >32767 then begin
    //if  then there will be wrap around if read as signed value
    i:=0;
    while I < (Size) do begin
          if gbuff16[i] >= 0 then gbuff16[i] := gbuff16[i] - 32768
          else
            gbuff16[i] := 32768+gbuff16[i];
          i := i+1;
    end;
  end; //prevent image wrapping > 32767
  value := gbuff16[0];
  max16 := value;
  min16 := value;
  i:=0;
  while I < (Size) do begin
    value := gbuff16[i];
    if value < min16 then min16 := value;
    if value > max16 then max16 := value;
    i := i+1;
  end;
  gImgMin := RescaleFromBuffer(min16);
  gImgMax := RescaleFromBuffer(max16);
  gImgWid := gImgMax-gImgMin;
  gImgCen := gImgMin + ((gImgWid)shr 1);
  if lWinWid < 0 then begin //autocontrast
    gWinMin := gImgMin;
    gWinMax := gImgMax;
    gWinCen := gImgCen;
    gWinWid := gImgWid;
    gFastCen := gImgCen;
  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(gBuff16[i],lMultiBuff[(lMultiStart+ (J*lMultiLineSz)) shl 1],lMultiColSz shl 1);
      end;
      lSlice := gMultiFirst+round (lMultiSliceInc*lMultiSlice);
      inc(lMultiSlice);
      if (lMultiSlice <= lnMultiSlice) and (lSlice <= {lMultiMaxSlice}gMultiLast) then goto 123;
      freemem(gBuff16);
      getmem(gBuff16,lMultiSliceSz shl 1);
      gBuff16sz := (lMultiSliceSz);
      move(lMultiBuff[0],gBuff16[0],lMultiSliceSz shl 1);
      freemem(lMultiBuff);
  end;
  Scale16to8bit(gWinCen,gWinWid,lFilename);
  exit;
  {x$P-,S+,W+,R+}
end;

function LoadData(lInFileName : string) : Boolean;
var
     lHdrOK: boolean;
     lS,lX: integer;
     gImgOK{,lDICOM}: boolean;
     lDynStr,lFilename: string;
begin
     RescaleClear;
     result := false;
     gImgOK := false;
     lFilename:= lInFilename;
  if (not fileexists(lFilename)) and (not gSilent) then begin
     result := false;
     if not gSilent then
        showmessage('Unable to find the file: '+lFilename);
     exit;
  end;
        read_dicom_data(true,true,true,true,true,true,true, gDICOMdata, lHdrOK, gImgOK, lDynStr,lFileName );
     if (lHdrOK) and (gImgOK) and (not fileexists(lFileName)) then begin
        if not gSilent then
           Showmessage('Unable to find the image data file: '+lFilename);
     end; //1.33
      if gECATJPEG_table_entries > 0 then begin
         if (gECATJPEG_table_entries > kMaxECAT) then begin
            gImgOK := false;
            if not gSilent then
               Showmessage('This ECAT file has too many slices ('+inttostr(gECATJPEG_table_entries)+').');
         end else begin
             gECATslices:= gECATJPEG_table_entries;
             for lS := 1 to gECATslices do begin
                 gECATposra[lS] := gECATJPEG_pos_table[lS];
                 gECATszra[lS]:= gECATJPEG_size_table[lS];
             end;
         end;
         freemem(gECATJPEG_pos_table);
         freemem(gECATJPEG_size_table);
         gECATJPEG_table_entries := 0;
      end;
      rescaleInit;

  if (gDICOMdata.XYZdim[2] < 1) or (gDICOMdata.XYZdim[1] < 1) or (not lHdrOK) or (not gImgOK) then begin
     if not gSilent then
        showmessage('Error reading image.');
     exit;
  end;
  result := true;
  if gOutputFormat = kTxt then begin
   SaveTxt (lFilename,lDynStr);
  end else
   if (gDICOMdata.XYZdim[3] > 0) then
     for lS := 1 to gDICOMdata.XYZdim[3] do
         DisplayImage(True,True,lS,gWinWid,gWInCen,lFilename);
end;

//to-do
// -b,-c
// create folders

procedure ShowHelp;
begin
     Writeln('0 DCM2JPG vers 15/7/2004 by Chris Rorden');
     Writeln('  DICOM-to-bitmap converter');
     Writeln('    Simply drag and drop DICOM images to convert them');
     Writeln('ADVANCED OPTIONS');
     Writeln('  Usage <options> <sourcenames>');
     Writeln('OPTIONS:');
     Writeln('-b Brightness [window center]: a,h,-9999..9999 for auto, header, custom');
     Writeln('    default: header');
     Writeln('-c Contrast [window width]: a,h,0..9999 for auto, header, custom');
     Writeln('    default: header');
     {$IFDEF PNG}
     Writeln('-f Format of Output: b,p,j,t for bmp, png, jpg, txt');
     {$ELSE}
     Writeln('-f Format of Output: b,j,t for bmp, jpg, txt');
     {$ENDIF}
     Writeln('    default: jpg');
     Writeln('-o Output Directory, e.g. ''C:\TEMP''');
     Writeln('    default: source directory');
     Writeln('-q Quality of JPEG, 5..95, low values produce small files of poor quality');
     Writeln('    default: 80');
     Writeln('-s Silent [errors not reported, auto overwrites]: y,n for yes or no');
     Writeln('    default: no');
     Writeln('-z Zoom of Output, e.g. ''1.5'' for 150% zoom');
     Writeln('    default: 1.0');
     Writeln('EXAMPLE:');
     Writeln('  dcm2jpg -f p -o C:\TEMP -z 1.5 C:\DICOM\input1.dcm C:\input2.dcm');
     Writeln('TRICK:');
     {$IFDEF PNG}
     Writeln('  To change default format, change name to ''dcm2bmp.exe'', ''dcm2txt.exe'' or ''dcm2png.exe''');
     {$ELSE}
     Writeln('  To change default format, change name to ''dcm2bmp.exe'', ''dcm2txt.exe'' ');
     {$ENDIF}
     Writeln('');
     Writeln('Hit <Enter> to exit.');
     Readln;
end; //proc ShowHelp

procedure ResetDCMvalues;
var i: integer;
begin
  gBuff16sz := 0;
  gVideoSpeed := 0;
  gBuff8sz := 0;
  gDICOMdata.Allocbits_per_pixel := 0;
  gDICOMdata.WindowWidth := 0;
  gDICOMdata.WindowCenter := 0;
  g100PctImageWid := 0;
  g100PctImageHt := 0;
  for I:=0 to 255 do begin
         gRra[i] := i;
         gGra[i] := i;
         gBra[i] := i;
  end;
end;

Function GetLongFileName(Const FileName : String) : String; //convert short name into full windows name
var
  aInfo: TSHFileInfo;
begin
  if SHGetFileInfo(PChar(FileName),0,aInfo,Sizeof(aInfo),SHGFI_DISPLAYNAME)<>0 then
     Result:= extractfilepath(Filename)+String(aInfo.szDisplayName)
  else
     Result:= FileName;
end;

procedure MainLoop;
var
   lStr: String;
   lResult,lHelpShown : boolean;
   lCommandChar: Char;
   I,lError: integer;
   lSingle: single;
   lOrigWinWid,lOrigWinCen: Integer;
begin
  DecimalSeparator := '.';
  gJPEGQuality := 80;
  gUseRecommendedContrast := true;
  gAbort := false;
  gOverwriteAlertShown := false;
  gOutDir := '';
  gSmooth := true;
  gSilent := false;
  lHelpShown := false;
  gMultiRow := 1;
  gMultiCol := 1;
  gWinCen := 0;
  gWinWid := -1;
  gZoomPct := 100;
  lStr := paramstr(0);
  lStr := extractfilename(lStr);
  lStr := string(StrUpper(PChar(lStr))) ;
  {$IFDEF PNG}
  if (lStr = 'DCM2PNG.EXE') then
     gOutputFormat := kPNG;
  {$ENDIF}
  if (lStr = 'DCM2BMP.EXE') then
     gOutputFormat := kBMP;
  if (lStr = 'DCM2TXT.EXE') then
     gOutputFormat := kTXT;
  if (ParamCount > 0) then begin
    I := 0;
    repeat
     lStr := '';
     repeat
        inc(I);
        if I = 1 then
            lStr := ParamStr(I)
        else begin
            if lStr <> '' then
               lStr := lStr +' '+ ParamStr(I)
            else
                lStr := ParamStr(I);
        end;
        if (length(lStr)>1) and (lStr[1] = '-') and (ParamCount > I) then begin //special command
           //-z= zoom, -f= format [png,jpeg,bmp], -o= output directory
           lCommandChar := UpCase(lStr[2]);
           inc(I);
           lStr := ParamStr(I);
           lStr := string(StrUpper(PChar(lStr))) ;
           case lCommandChar of
                'B': begin //Brightness
                          if lStr[1] = 'A' then begin
                             gWinWid := -1;
                             gUseRecommendedContrast := false
                          end else if lStr[1] = 'H' then begin
                             gWinWid := -1;
                             gUseRecommendedContrast := true
                          end else begin //not 'A' or 'H'
                            Val(lStr,lSingle,lError);
                            if lError = 0 then
                                 gWinCen := round(lSingle);
                          end; //not 'A' or 'H'
                     end;
                'C': begin //Contrast
                          gWinWid := -1;
                          if lStr[1] = 'A' then begin
                             gUseRecommendedContrast := false
                          end else if lStr[1] = 'H' then begin
                             gUseRecommendedContrast := true
                          end else begin //not 'A' or 'H'
                            Val(lStr,lSingle,lError);
                            if lError = 0 then
                                 gWinWid := round(lSingle);
                          end; //not 'A' or 'H'
                     end; //Contrast

                'F': begin //output format
                      gOutputFormat := kJPEG;
                      {$IFDEF PNG}
                      if lStr[1] = 'P' then
                         gOutputFormat := kPNG
                      else {$ENDIF} if lStr[1] = 'B' then
                           gOutputFormat := kBMP
                      else if lStr[1] = 'T' then
                           gOutputFormat := kTXT;
                     end;
                'O': begin //output directory
                      gOutDir := '';
                      if directoryexists(lStr) then begin
                         gOutDir := lStr;
                         if gOutDir[length(gOutDir)] <> '\' then
                            gOutDir := gOutDir + '\';
                      end;
                     end;
                'S': begin //output format
                      gSilent := false;
                      if lStr[1] = 'Y' then
                         gSilent := true;
                    end;
                'Q': begin
                            Val(lStr,lSingle,lError);
                            if lError = 0 then
                                 gJPEGQuality := round(lSingle);
                end;
                'Z': begin //zoom scale
                          Val(lStr,lSingle,lError);
                          if lError = 0 then begin
                              if lSingle < 10 then
                                 gZoomPct := round(100*lSingle)
                              else
                                  gZoomPct := round(lSingle);
                          end;

                     end; //Zoom scale
           end; //case lStr[2]
           lStr := '';
        end; //special command
     until (I=ParamCount) or (fileexists(lStr)) or (gAbort);
     if fileexists(lStr) then begin
        lStr :=  GetLongFileName(lStr);
        ResetDCMvalues;
        lOrigWinWid := gWinWid;
        lOrigWinCen := gWinCen;
        lResult := LoadData(lStr);
        if lResult then
           Writeln('1') //report success
        else
            Writeln('0'); //report failure
        gWinWid := lOrigWinWid;
        gWinCen := lOrigWinCen;
     end else if  not (gSilent) then begin
        Writeln('0 dcm2jpg ERROR: unable to find '+lStr);
        if lHelpShown then
          Readln
        else
            Showhelp;
        lHelpShown := true;
     end;
    until I >= ParamCount;
  end else begin
    //begin test routines....
    (*
      lStr := 'D:\yuv2.dcm';
        ResetDCMvalues;
        lOrigWinWid := gWinWid;
        lOrigWinCen := gWinCen;
        LoadData(lStr);
        gWinWid := lOrigWinWid;
        gWinCen := lOrigWinCen;
    //...end test routines(**)
   ShowHelp;
  end;{param count > 0}
end;


end.