⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 view.pas

📁 CT DCOM源代码
💻 PAS
字号:
Unit
View;
// Wolfgang Krug and Chris Rorden - www.mrc-cbu.cam.ac.uk/~chris.rorden
{If compiling for Pascal compilers other than Delphi 2+, gDynStr must be changed!}
 {Limitations:
  1.) Does not load custom colour palette  s
  2.) Does not extract compressed images
  3.) big endian and 12-bit features have not been heavily tested}
interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls,DICOM, ExtCtrls, ComCtrls, Buttons;
{$H+} //use long, dynamic strings
type

  TezDICOMform = class(TForm)
    OpenDialog1: TOpenDialog;
    Button1: TButton;
    Image: TImage;
    TrackBar1: TTrackBar;
    SpeedButton1: TSpeedButton;
    Memo1: TMemo;
    SaveBtn: TSpeedButton;
    SaveDialog: TSaveDialog;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    procedure Button1Click(Sender: TObject);
    procedure TrackBar1Change(Sender: TObject);
    procedure SaveBtnClick(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);

  private
    { Private declarations }
  public
procedure DisplayImage (lSlice: integer; lForceRedraw: boolean);
  end;
type
  ByteRA = array [0..0] of byte;
  Bytep0 = ^ByteRA;
  SmallIntRA = array [0..0] of SmallInt;
  SMallIntp0 = ^SmallIntRA;
const gImgOK: boolean = false;
      gHdrOK: boolean = false;
//	scale_flag      : Integer = 0;  //scale 16 bits to 8
//	flip_flag       : Integer = 0;  //flip 16 bit data values
//	no_flip_flag    : Integer = 0;  //no flip no matter what!
//	invert_flag     : Integer = 0;	//invert data values
var
  ezDICOMform: TezDICOMform;
  gDICOMData: DiCOMDATA;
  gViewSlice: integer;

implementation

{$R *.DFM}

procedure TezDICOMform.DisplayImage (lSlice: integer; lForceRedraw: boolean);
var
  lBuff,TmpBuff   : bYTEp0;
  lBuff16: SmallIntP0;
  infp: file;
  lX: char;
  max16 : LongInt;
  min16 : LongInt;
  j,size   : Integer;
  value : LongInt;
  lStoreSliceVox,lCol,lXdim,lMax,lMax2,lImageStart,lAllocSLiceSz,lStoreSliceSz,I,I12       : Integer;
	hBmp    : HBITMAP;
  BI      : PBitmapInfo;
  BIH     : TBitmapInfoHeader;
  Bmp     : TBitmap;
  TmpDC   : hDC;
  ImagoDC : hDC;
begin
     if not gImgOK then exit;
     if (lSlice = gViewSlice) and (not lForceRedraw) then exit;
     gViewSlice := lSlice;
  lAllocSLiceSz := (gDICOMdata.XYZdim[1]*gDICOMdata.XYZdim[2]{height * width} * gDICOMdata.Allocbits_per_pixel+7) div 8 ;
  if (lAllocSLiceSz) < 1 then exit;
     AssignFile(infp, OpenDialog1.FileName);
     FileMode := 0; //Read only
	  Reset(infp, 1);

   lImageStart := gDicomData.ImageStart + ((lSlice-1) * lAllocSliceSz);
  if (lImageStart + lAllocSliceSz) > (FileSize(infp)) then begin
        showmessage('This file does not have enough data for the image size.');
        closefile(infp);
        FileMode := 2; //read/write
        exit;
  end;
  Seek(infp, lImageStart);
  case gDICOMdata.Allocbits_per_pixel of
       8: begin
                   GetMem( lbuff, lAllocSliceSz);
                   BlockRead(infp, lbuff^, lAllocSliceSz{, n});
                   CloseFile(infp);
                   FileMode := 2; //read/write
                   end;
       16: begin
                   GetMem( lbuff16, lAllocSliceSz);
                   BlockRead(infp, lbuff16^, lAllocSliceSz{, n});
                   CloseFile(infp);
                   FileMode := 2; //read/write

       end;
       12: begin
           GetMem( tmpbuff, lAllocSliceSz);
           BlockRead(infp, tmpbuff^, lAllocSliceSz{, n});
           CloseFile(infp);
           FileMode := 2; //read/write
           lStoreSliceVox := gDICOMdata.XYZdim[1]*gDICOMdata.XYZdim[2];
           lStoreSLiceSz := lStoreSliceVox * 2;
           GetMem( lbuff16, lStoreSLiceSz);
           I12 := 0;
           I := 0;
           lMax := 0;
           lMax2 := 0;
           repeat
                 lbuff16[I] := (((tmpbuff[I12]) shr 4) shl 8) + (((tmpbuff[I12+1]) and 15) + (((tmpbuff[I12]) and 15) shl 4) );
                 inc(I);
                 if I < lStoreSliceVox then
                    lbuff16[i] :=  (((tmpbuff[I12+2]) and 15) shl 8) +((((tmpbuff[I12+1]) shr 4 ) shl 4)+((tmpbuff[I12+2]) shr 4)  );//char (((integer(tmpbuff[I12+2]) and 16) shl 4)+ (integer(tmpbuff[I12+1]) shr 4));
                 inc(I);
                 I12 := I12 + 3;
           until I >= lStoreSliceVox;
           FreeMem( tmpbuff);
           end;
       else exit;
  end;
  if  (gDICOMdata.Storedbits_per_pixel)  > 8 then begin
  value := lbuff16[0];
  max16 := value;
  min16 := value;
  size := gDicomData.XYZdim[1]*gDicomData.XYZdim[2] {2*width*height};
  if gDicomdata.little_endian <> 1 then  //convert big-endian data to Intel friendly little endian
     for i := (Size-1) downto 0 do
         lbuff16[i] := swap(lbuff16[i]);
  i:=0;
  while I < Size do begin
    value := lbuff16[i];
    if value < min16 then min16 := value;
    if value > max16 then max16 := value;
    i := i+1;
  end;
//  memo1.lines.add(inttostr(min16)+'/'+inttostr(max16));
  size := (gDicomData.XYZdim[1]*gDicomData.XYZdim[2])-1 {width*height-1 };
  GetMem( lbuff,size+1 {width * height});
  for i := 0 to size do begin
  	lbuff[i] := (Trunc(255*((lBuff16[i])-min16) / (max16-min16)));
  end;
  FreeMem( lbuff16 );
end;
if (gDICOMdata.XYZdim[1] mod 8) <> 0 then begin
   lXdim :=  ((gDICOMdata.XYZdim[1]+7) div 8) * 8;
   lAllocSLiceSz := lXdim*gDICOMdata.XYZdim[2] ;
       GetMem( tmpbuff, lAllocSliceSz);
       I := 0;
       lCol := 1;
       I12 := 0;
       repeat
             if lCol <= gDICOMdata.XYZdim[1] then begin
                tmpbuff[I] := lbuff[I12];
                inc(I12);
             end else
                 tmpbuff[I] := (0);
             inc(lCol);
             if lCol > lXdim then lCol := 1;
             Inc(I);
       until I >= (lAllocSliceSz);
       freemem(lBuff);
       lbuff := tmpbuff;
end else
         lXdim := gDICOMdata.XYZdim[1];

	BIH.biSize   		 	 	:= Sizeof(BIH);
	BIH.biWidth  		 	 	:= lXdim;//gDICOMdata.XYZdim[1]{width};
  BIH.biHeight 		 	 	:= -gDICOMdata.XYZdim[2]{-height};
	BIH.biPlanes 		 	 	:= 1;
  BIH.biBitCount 	 	 	:= 8;
	BIH.biCompression 	:= BI_RGB;
  BIH.biSizeImage	 	 	:= 0;
	BIH.biXPelsPerMeter := 0;
  BIH.biYPelsPerMeter := 0;
	BIH.biClrUsed       := 0;
  BIH.biClrImportant  := 0;

{$P+,S-,W-,R-}

 		// Create DIB Bitmap Info with actual color table
	BI := AllocMem(SizeOf(TBitmapInfoHeader) + 256*Sizeof(TRGBQuad));
	try
	  BI^.bmiHeader := BIH;
	  for I:=0 to 255 do begin
  		BI^.bmiColors[I].rgbBlue     := Byte( I );
    	BI^.bmiColors[I].rgbGreen    := Byte( I );
	    BI^.bmiColors[I].rgbRed      := Byte( I );
		  BI^.bmiColors[I].rgbReserved := 0;
    end;

	  Bmp        := TBitmap.Create;
  	Bmp.Height := gDICOMdata.XYZdim[1]{width};
	  Bmp.Width  := gDICOMdata.XYZdim[2]{height};

	  ImagoDC := GetDC(ezDICOMform.Handle);
	  hBmp :=  CreateDIBitmap(
    				ImagoDC,		// handle of device context
    				BIH,									// address of bitmap size and format data
    				CBM_INIT,							// initialization flag
	    			pCHar(lbuff),									// address of initialization data
  	  			BI^,									// address of bitmap color-format data
    				DIB_RGB_COLORS ); 		// color-data usage
	  Bmp.Handle := hBmp;
Image.Picture.Bitmap.Assign( Bmp );
Image.Refresh;
	  Bmp.Free;
	except
	  exit;
  end;
  FreeMem( BI, SizeOf(TBitmapInfoHeader) + 256*Sizeof(TRGBQuad));
  freemem(lBuff);
{$P-,S+,W+,R+}
end;



(***********************************************************)
procedure TezDICOMform.Button1Click(Sender: TObject);
var
lLen,lI: integer;
lStr,lDynStr: string;
begin
  if OpenDialog1.Execute then
  begin
  read_dicom_data(gDICOMdata,gHdrOK,gImgOK,lDynStr,OpenDialog1.FileName {infp});
       if gDICOMdata.XYZdim[3] < 2 then
          TrackBar1.visible := false
       else begin
            TrackBar1.position := 1;
            TrackBar1.Min := 1;
            TrackBar1.Max := gDICOMdata.XYZdim[3];
            TrackBar1.visible := true;
       end;
    if not gHdrOK then begin
       showmessage('Unable to load DICOM header segment. Is this really a DICOM compliant file?');
       lDynStr := '';
       //exit;
    end;
    lLen := Length (lDynStr);
    Memo1.Lines.Clear;
    if lLen > 0 then begin
       lStr := '';
       for lI := 1 to lLen do begin
           if lDynStr[lI] <> kCR then
              lStr := lStr + lDynStr[lI]
           else begin
                Memo1.Lines.add(lStr);
                lStr := '';
           end;
       end;
       Memo1.Lines.Add(lStr);
    end;
lDynStr := '';
 if gImgOK then
    DisplayImage(1, true);//force redraw: new image
  end;
end;

procedure TezDICOMform.TrackBar1Change(Sender: TObject);
var lSlice: integer;
begin
     lSlice := TrackBar1.Position;
     If (not gImgOK) or (lSlice > gDicomData.XYZdim[3]) then exit;
     DisplayImage(lSlice,false); //don't force redraw: Delphi calls TrackBarChange BEFORE and after each change
end;

procedure TezDICOMform.SaveBtnClick(Sender: TObject);
var lF: textfile;
    lInc: integer;
begin
	if Memo1.Lines.Count < 1 then begin
        ShowMessage('DICOM summary is empty.');
        exit;
     end;
	SaveDialog.DefaultExt := '.TXT';
	  SaveDialog.Filter := 'Text files (*.TXT)|*.TXT';
	  SaveDialog.Options := [ofOVerWritePrompt];
	  if SaveDialog.Execute then begin
		AssignFile(lF, SaveDialog.FileName); {WIN}
		{$I-}
		Rewrite(lF);
		{$I+}
		if IoResult = 0 then begin
		   for lInc  := 0 to Memo1.Lines.Count do begin
			Writeln(lF, Memo1.Lines[lInc]);
              end;
              CloseFile(lF);
		end; {i/o error}
       end; {save dlg execute}
end;
procedure TezDICOMform.SpeedButton1Click(Sender: TObject);
begin
	if Memo1.Lines.Count < 1 then begin
        ShowMessage('DICOM summary is empty.');
        exit;
     end;
     Memo1.SelectAll;
     Memo1.CopyToClipBoard
end;

procedure TezDICOMform.SpeedButton2Click(Sender: TObject);
begin
	  SaveDialog.Filter := 'Bitmap Files (*.BMP)|*.BMP';
	  SaveDialog.Options := [ofOVerWritePrompt];
	  SaveDialog.DefaultExt := 'bmp';
	  if SaveDialog.Execute then
          Image.Picture.SaveToFile(SaveDialog.Filename);
end;

procedure TezDICOMform.SpeedButton3Click(Sender: TObject);
begin
     Showmessage('ezDICOM is a basic DICOM medical image viewer. The program was written by Wolfgang Krug and Chris Rorden.'+kCR+' www.mrc-cbu.cam.ac.uk/~chris.rorden');
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -