home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 October / Chip_2001-10_cd1.bin / zkuste / delphi / navody / DICOMSRC.ZIP / ebasic.pas < prev    next >
Pascal/Delphi Source File  |  2001-03-06  |  13KB  |  392 lines
  1. Unit
  2. eBasic;
  3. // Wolfgang Krug and Chris Rorden - www.psychology.nottingham.ac.uk/staff/Chris.Rorden/
  4. {If compiling for Pascal compilers other than Delphi 2+, gDynStr must be changed!}
  5.  {Limitations:
  6.   1.) Does not load custom colour palette  s
  7.   2.) Does not extract compressed images
  8.   3.) big endian and 12-bit features have not been heavily tested}
  9. interface
  10.  
  11. uses
  12.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  13.   StdCtrls,DICOM, Analyze,ExtCtrls, ComCtrls, Buttons, ToolWin,
  14.   Dialogs, Spin;
  15. {$H+} //use long, dynamic strings
  16. type
  17.     TInteger8 = Comp;  // 8-byte integer, since disk sizes may be > 2 GB
  18.     Int64 = ^TInteger8;
  19.  
  20.   TeDICOMform = class(TForm)
  21.     OpenDialog1: TOpenDialog;
  22.     SaveDialog: TSaveDialog;
  23.     ToolBar1: TToolBar;
  24.     SpeedButton4: TSpeedButton;
  25.     SpeedButton1: TSpeedButton;
  26.     SaveBtn: TSpeedButton;
  27.     SpeedButton2: TSpeedButton;
  28.     SpeedButton3: TSpeedButton;
  29.     SpeedButton5: TSpeedButton;
  30.     TrackBar1: TTrackBar;
  31.     Image: TImage;
  32.     SumPanel: TPanel;
  33.     Memo1: TMemo;
  34.     SpeedButton6: TSpeedButton;
  35.     procedure Button1Click(Sender: TObject);
  36.     procedure TrackBar1Change(Sender: TObject);
  37.     procedure SaveBtnClick(Sender: TObject);
  38.     procedure SpeedButton1Click(Sender: TObject);
  39.     procedure SpeedButton2Click(Sender: TObject);
  40.     procedure SpeedButton3Click(Sender: TObject);
  41.     procedure SpeedButton5Click(Sender: TObject);
  42.     procedure FormCreate(Sender: TObject);
  43.   private
  44.     { Private declarations }
  45.   public
  46. procedure DisplayImage (lSlice: integer; lForceRedraw: boolean);
  47.   end;
  48. type
  49.   ByteRA = array [0..0] of byte;
  50.   Bytep0 = ^ByteRA;  
  51.   SmallIntRA = array [0..0] of SmallInt;
  52.   SMallIntp0 = ^SmallIntRA;
  53. const gImgOK: boolean = false;
  54.       gHdrOK: boolean = false;
  55. var
  56.   eDICOMform: TeDICOMform;
  57.   gDICOMData: DiCOMDATA;
  58.   gViewSlice: integer;
  59.  
  60. implementation
  61.  
  62. {$R *.DFM}
  63.  
  64. procedure TeDICOMform.DisplayImage (lSlice: integer; lForceRedraw: boolean);
  65. var
  66.   lBuff,TmpBuff   : bYTEp0;
  67.   lBuff16: SmallIntP0;
  68.   infp: file;
  69.   max16 : LongInt;
  70.   min16 : LongInt;
  71.   size   : Integer;
  72.   value : LongInt;
  73.   lScanLineSz,lStoreSliceVox,lCol,lXdim,lImageStart,lAllocSLiceSz,lStoreSliceSz,I,I12       : Integer;
  74.     hBmp    : HBITMAP;
  75.   BI      : PBitmapInfo;
  76.   BIH     : TBitmapInfoHeader;
  77.   Bmp     : TBitmap;
  78.   pixmap  : Pointer;
  79.   PPal: PLogPalette;
  80. //  TmpDC   : hDC;
  81.   ImagoDC : hDC;
  82. begin
  83.      if not gImgOK then exit;
  84.      if (lSlice = gViewSlice) and (not lForceRedraw) then exit;
  85.   if (gDicomData.GenesisCpt) or (gDicomdata.GenesisPackHdr <> 0) then begin
  86.         showmessage('This file is compressed or packed. You will require a more advanced viewer.');
  87.         exit;
  88.   end;
  89.      gViewSlice := lSlice;
  90.   lAllocSLiceSz := (gDICOMdata.XYZdim[1]*gDICOMdata.XYZdim[2]{height * width} * gDICOMdata.Allocbits_per_pixel+7) div 8 ;
  91.   if (lAllocSLiceSz) < 1 then exit;
  92.      AssignFile(infp, OpenDialog1.FileName);
  93.      FileMode := 0; //Read only
  94.       Reset(infp, 1);
  95.    lImageStart := gDicomData.ImageStart + ((lSlice-1) * lAllocSliceSz);
  96.   if (lImageStart + lAllocSliceSz) > (FileSize(infp)) then begin
  97.         showmessage('This file does not have enough data for the image size.');
  98.         closefile(infp);
  99.         FileMode := 2; //read/write
  100.         exit;
  101.   end;
  102.   Seek(infp, lImageStart);
  103.   case gDICOMdata.Allocbits_per_pixel of
  104.        8: begin
  105.                    GetMem( lbuff, lAllocSliceSz);
  106.                    BlockRead(infp, lbuff^, lAllocSliceSz{, n});
  107.                    CloseFile(infp);
  108.                    FileMode := 2; //read/write
  109.                    end;
  110.        16: begin
  111.                    GetMem( lbuff16, lAllocSliceSz);
  112.                    BlockRead(infp, lbuff16^, lAllocSliceSz{, n});
  113.                    CloseFile(infp);
  114.                    FileMode := 2; //read/write
  115.  
  116.        end;
  117.        12: begin
  118.            GetMem( tmpbuff, lAllocSliceSz);
  119.            BlockRead(infp, tmpbuff^, lAllocSliceSz{, n});
  120.            CloseFile(infp);
  121.            FileMode := 2; //read/write
  122.            lStoreSliceVox := gDICOMdata.XYZdim[1]*gDICOMdata.XYZdim[2];
  123.            lStoreSLiceSz := lStoreSliceVox * 2;
  124.            GetMem( lbuff16, lStoreSLiceSz);
  125.            I12 := 0;
  126.            I := 0;
  127.            repeat
  128.                  lbuff16[I] := (((tmpbuff[I12]) shr 4) shl 8) + (((tmpbuff[I12+1]) and 15) + (((tmpbuff[I12]) and 15) shl 4) );
  129.                  inc(I);
  130.                  if I < lStoreSliceVox then
  131.                     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));
  132.                  inc(I);
  133.                  I12 := I12 + 3;
  134.            until I >= lStoreSliceVox;
  135.            FreeMem( tmpbuff);
  136.            end;
  137.        else exit;
  138.   end;
  139.   if  (gDICOMdata.Storedbits_per_pixel)  > 8 then begin
  140.   size := gDicomData.XYZdim[1]*gDicomData.XYZdim[2] {2*width*height};
  141.   if gDicomdata.little_endian <> 1 then  //convert big-endian data to Intel friendly little endian
  142.      for i := (Size-1) downto 0 do
  143.          lbuff16[i] := swap(lbuff16[i]);
  144.   value := lbuff16[0];
  145.   max16 := value;
  146.   min16 := value;
  147.   i:=0;
  148.   while I < Size do begin
  149.     value := lbuff16[i];
  150.     if value < min16 then min16 := value;
  151.     if value > max16 then max16 := value;
  152.     i := i+1;
  153.   end;
  154.   size := (gDicomData.XYZdim[1]*gDicomData.XYZdim[2])-1 {width*height-1 };
  155.   GetMem( lbuff,size+1 {width * height});
  156.   value := (max16-min16);
  157.   if value = 0 then value := 1;
  158.   for i := 0 to size do begin
  159.       lbuff[i] := (Trunc(255*((lBuff16[i])-min16) / value));
  160.   end;
  161.   FreeMem( lbuff16 );
  162. end;
  163. if (gDICOMdata.XYZdim[1] mod 8) <> 0 then begin
  164.    lXdim :=  ((gDICOMdata.XYZdim[1]+7) div 8) * 8;
  165.    lAllocSLiceSz := lXdim*gDICOMdata.XYZdim[2] ;
  166.        GetMem( tmpbuff, lAllocSliceSz);
  167.        I := 0;
  168.        lCol := 1;
  169.        I12 := 0;
  170.        repeat
  171.              if lCol <= gDICOMdata.XYZdim[1] then begin
  172.                 tmpbuff[I] := lbuff[I12];
  173.                 inc(I12);
  174.              end else
  175.                  tmpbuff[I] := (0);
  176.              inc(lCol);
  177.              if lCol > lXdim then lCol := 1;
  178.              Inc(I);
  179.        until I >= (lAllocSliceSz);
  180.        freemem(lBuff);
  181.        lbuff := tmpbuff;
  182. end else
  183.          lXdim := gDICOMdata.XYZdim[1];
  184.     BIH.biSize                     := Sizeof(BIH);
  185.     BIH.biWidth                    := lXdim;//gDICOMdata.XYZdim[1]{width};
  186.   BIH.biHeight                   := gDICOMdata.XYZdim[2]{-height};
  187.     BIH.biPlanes                   := 1;
  188.   BIH.biBitCount               := 8;
  189.     BIH.biCompression     := BI_RGB;
  190.   BIH.biSizeImage              := 0;
  191.     BIH.biXPelsPerMeter := 0;
  192.   BIH.biYPelsPerMeter := 0;
  193.     BIH.biClrUsed       := 0;
  194.   BIH.biClrImportant  := 0;
  195. {$P+,S-,W-,R-}
  196.  
  197.          // Create DIB Bitmap Info with actual color table
  198.     BI := AllocMem(SizeOf(TBitmapInfoHeader) + 256*Sizeof(TRGBQuad));
  199.     try
  200.       BI^.bmiHeader := BIH;
  201.        for I:=0 to 255 do begin
  202.                BI^.bmiColors[I].rgbBlue     := Byte( I );
  203.                 BI^.bmiColors[I].rgbGreen    := Byte( I );
  204.                BI^.bmiColors[I].rgbRed      := Byte( I );
  205.              BI^.bmiColors[I].rgbReserved := 0;
  206.        end;
  207.       Bmp        := TBitmap.Create;
  208.          Bmp.Height := gDICOMdata.XYZdim[2]{width};
  209.       Bmp.Width  := lXdim{gDICOMdata.XYZdim[2]{height};
  210.  
  211.        ImagoDC := GetDC(Self.Handle);
  212.           Pixmap:=nil;
  213.           hBmp:= CreateDIBSection(imagodc,bi^,DIB_RGB_COLORS,pixmap,0,0);
  214.           lScanLineSz := {BMp.width}lXdim;
  215.            if (hBmp = 0) or (pixmap = nil) then
  216.              if GetLastError = 0 then ShowMessage('Error!') else RaiseLastWin32Error;
  217.           try
  218.         For i:= (Bmp.Height-1)  downto 0 do
  219.          begin
  220.           CopyMemory(Pointer(Integer(pixmap)+lScanLineSz*(i)),
  221.                      Pointer(Integer(lBuff)+(Bmp.Height-(i+1))*lScanLineSz),
  222.                      lScanLineSz);
  223.         end;
  224.           except
  225.            DeleteObject(hBmp);
  226.           end;
  227.           ReleaseDC(0,ImagoDC);
  228.       Bmp.Handle := hBmp;
  229.  
  230.       Bmp.Handle := hBmp;
  231.           Bmp.ReleasePalette;
  232. GetMem (PPal,SizeOf(TLogPalette)+255*SizeOf(TPaletteEntry));
  233.   with PPal^ do
  234.    begin
  235.       PalVersion := $300;
  236.       PalNumEntries := 256;
  237.    {$R-}
  238.     for i := 0 to 255 do
  239.      begin
  240.       PalPalEntry[i].peRed   := BI^.bmiColors[I].rgbRed;
  241.       PalPalEntry[i].peGreen := BI^.bmiColors[I].rgbGreen;
  242.       PalPalEntry[i].peBlue  := BI^.bmiColors[I].rgbBlue;
  243.       PalPalEntry[i].peFlags := BI^.bmiColors[I].rgbReserved;
  244.      end;
  245.  
  246.    end;
  247.  Bmp.Palette:= CreatePalette(PPal^);
  248. FreeMem (PPal,SizeOf(TLogPalette)+255*SizeOf(TPaletteEntry));
  249. Image.Picture.Assign( Bmp );
  250.   Image.Refresh;
  251.   Bmp.Free;
  252.   except
  253.       exit;
  254.   end;
  255.   FreeMem( BI, SizeOf(TBitmapInfoHeader) + 256*Sizeof(TRGBQuad));
  256.   freemem(lBuff);
  257. {$P-,S+,W+,R+}
  258. end;
  259.  
  260.  
  261.  
  262. (***********************************************************)
  263. procedure TeDICOMform.Button1Click(Sender: TObject);
  264. var
  265. lLen,lI: integer;
  266. lStr,lDynStr: string;
  267. lf: file of byte;
  268. begin
  269.   if (Sender as TSpeedbutton).tag = 1 then
  270.      OpenDialog1.Filter := 'Analyze Header (*.hdr)|*.hdr' {*.jpg;*.bmp;*.gif}
  271.   else
  272.      OpenDialog1.Filter := 'Medical Image (*.*)|*.*'; {*.jpg;*.bmp;*.gif}
  273.   if OpenDialog1.Execute then begin
  274.      lStr := OpenDialog1.FileName;
  275.      if not fileexists(lStr) then exit;
  276.      filemode := 0;
  277.      AssignFile(lf, lStr);
  278.      Reset(lf);
  279.      lLen := filesize(lf);
  280.      closefile(lf);
  281.      filemode := 2;
  282.      if ((Sender as TSpeedbutton).tag = 1) or ((lLen = 348) and (ExtractFileExt(lStr)='.hdr')) then begin
  283.         OpenAnalyze (gHdrOK,gImgOK,lDynStr,lStr, gDicomData);
  284.      end else
  285.          read_dicom_data(false,true,false,false,true,true,false,gDICOMdata,gHdrOK,gImgOK,lDynStr,lStr {infp});
  286. //procedure read_dicom_data(lVerboseRead,lAutoDECAT7,lReadECAToffsetTables,lAutodetectInterfile,lAutoDetectGenesis,lReadColorTables: boolean; var lDICOMdata: DICOMdata; var lHdrOK, lImageFormatOK: boolean; var lDynStr: string;var lFileName: string);
  287.      OpenDialog1.FileName := lStr;
  288.      if (gImgOK) and ((gDicomData.CompressSz > 0) or (gDICOMdata.SamplesPerPixel > 1)) then begin
  289.          showmessage('This software can not read compressed or 24-bit color files.');
  290.          gImgOK := false;
  291.      end;
  292.      if gDICOMdata.XYZdim[3] < 2 then
  293.           TrackBar1.visible := false
  294.        else begin
  295.             TrackBar1.position := 1;
  296.             TrackBar1.Min := 1;
  297.             TrackBar1.Max := gDICOMdata.XYZdim[3];
  298.             TrackBar1.visible := true;
  299.        end;
  300.     if not gHdrOK then begin
  301.        showmessage('Unable to load DICOM header segment. Is this really a DICOM compliant file?');
  302.        lDynStr := '';
  303.        //exit;
  304.     end;
  305.     lLen := Length (lDynStr);
  306.     Memo1.Lines.Clear;
  307.     if lLen > 0 then begin
  308.        lStr := '';
  309.        for lI := 1 to lLen do begin
  310.            if lDynStr[lI] <> kCR then
  311.               lStr := lStr + lDynStr[lI]
  312.            else begin
  313.                 Memo1.Lines.add(lStr);
  314.                 lStr := '';
  315.            end;
  316.        end;
  317.        Memo1.Lines.Add(lStr);
  318.     end;
  319. lDynStr := '';
  320.  if gImgOK then
  321.     DisplayImage(1, true);//force redraw: new image
  322.   end;
  323. end;
  324.  
  325. procedure TeDICOMform.TrackBar1Change(Sender: TObject);
  326. var lSlice: integer;
  327. begin
  328.      lSlice := TrackBar1.Position;
  329.      If (not gImgOK) or (lSlice > gDicomData.XYZdim[3]) then exit;
  330.      DisplayImage(lSlice,false); //don't force redraw: Delphi calls TrackBarChange BEFORE and after each change
  331. end;
  332.  
  333. procedure TeDICOMform.SaveBtnClick(Sender: TObject);
  334. var lF: textfile;
  335.     lInc: integer;
  336. begin
  337.     if Memo1.Lines.Count < 1 then begin
  338.         ShowMessage('DICOM summary is empty.');
  339.         exit;
  340.      end;
  341.     SaveDialog.DefaultExt := '.TXT';
  342.       SaveDialog.Filter := 'Text files (*.TXT)|*.TXT';
  343.       SaveDialog.Options := [ofOVerWritePrompt];
  344.       if SaveDialog.Execute then begin
  345.         AssignFile(lF, SaveDialog.FileName); {WIN}
  346.         {$I-}
  347.         Rewrite(lF);
  348.         {$I+}
  349.         if IoResult = 0 then begin
  350.            for lInc  := 0 to Memo1.Lines.Count do begin
  351.             Writeln(lF, Memo1.Lines[lInc]);
  352.               end;
  353.               CloseFile(lF);
  354.         end; {i/o error}
  355.        end; {save dlg execute}
  356. end;
  357. procedure TeDICOMform.SpeedButton1Click(Sender: TObject);
  358. begin
  359.     if Memo1.Lines.Count < 1 then begin
  360.         ShowMessage('DICOM summary is empty.');
  361.         exit;
  362.      end;
  363.      Memo1.SelectAll;
  364.      Memo1.CopyToClipBoard
  365. end;
  366.  
  367. procedure TeDICOMform.SpeedButton2Click(Sender: TObject);
  368. begin
  369.       SaveDialog.Filter := 'Bitmap Files (*.BMP)|*.BMP';
  370.       SaveDialog.Options := [ofOVerWritePrompt];
  371.       SaveDialog.DefaultExt := 'bmp';
  372.       if SaveDialog.Execute then
  373.           Image.Picture.SaveToFile(SaveDialog.Filename);
  374. end;
  375.  
  376. procedure TeDICOMform.SpeedButton3Click(Sender: TObject);
  377. begin
  378.     Showmessage('eDICOM is a basic DICOM medical image viewer. The program was written by Wolfgang Krug and Chris Rorden.'+kCR+'version 1.2 rev 10'+kCR+' www.psychology.nottingham.ac.uk/staff/cr1/');
  379. end;
  380.  
  381. procedure TeDICOMform.SpeedButton5Click(Sender: TObject);
  382. begin
  383.  SumPanel.visible := not sumpanel.visible;
  384. end;
  385.  
  386. procedure TeDICOMform.FormCreate(Sender: TObject);
  387. begin
  388. DecimalSeparator := '.';
  389. end;
  390.  
  391. end.
  392.