home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 October / Chip_2001-10_cd1.bin / zkuste / delphi / navody / DICOMSRC.ZIP / ImgInfo.pas < prev    next >
Pascal/Delphi Source File  |  1999-10-27  |  2KB  |  78 lines
  1. (*
  2.  *  ImgInfo.pas - ezDICOM: Image Information
  3.  *  Project: ezDICOM
  4.  *  Purpose: Display's DICOM information
  5.  *  Rev:
  6.  *    01-Jul-97, wk: first implementation coded
  7.  *   30-Oct-99, cr: updated for pixelgraphic
  8.  *)
  9.  unit ImgInfo;
  10.  
  11. interface
  12.  
  13. uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
  14.   Buttons, ExtCtrls, ChildWin,Dialogs, ToolWin, ComCtrls;
  15.  
  16. type
  17.   TImgInfoDlg = class(TForm)
  18.     Memo1: TMemo;
  19.     SaveDialog: TSaveDialog;
  20.     ToolBar1: TToolBar;
  21.     SaveBtn: TSpeedButton;
  22.     SpeedButton1: TSpeedButton;
  23.     procedure SpeedButton1Click(Sender: TObject);
  24.     procedure SaveBtnClick(Sender: TObject);
  25.   private
  26.     { Private declarations }
  27.   public
  28.     { Public declarations }
  29.   end;
  30.  
  31. var
  32.   ImgInfoDlg: TImgInfoDlg;
  33.  
  34. implementation
  35.  
  36. uses Main;
  37.  
  38. {$R *.DFM}
  39.  
  40. (*========================================================================*)
  41. procedure TImgInfoDlg.SpeedButton1Click(Sender: TObject);
  42. begin
  43.     if Memo1.Lines.Count < 1 then begin
  44.         ShowMessage('DICOM summary is empty.');
  45.         exit;
  46.      end;
  47.      Memo1.SelectAll;
  48.      Memo1.CopyToClipBoard
  49.  
  50. end;
  51.  
  52. procedure TImgInfoDlg.SaveBtnClick(Sender: TObject);
  53. var lF: textfile;
  54.     lInc: integer;
  55. begin
  56.     if Memo1.Lines.Count < 1 then begin
  57.         ShowMessage('DICOM summary is empty.');
  58.         exit;
  59.      end;
  60.     SaveDialog.DefaultExt := '.TXT';
  61.       SaveDialog.Filter := 'Text files (*.TXT)|*.TXT';
  62.       SaveDialog.Options := [ofOVerWritePrompt];
  63.       if SaveDialog.Execute then begin
  64.         AssignFile(lF, SaveDialog.FileName); {WIN}
  65.         {$I-}
  66.         Rewrite(lF);
  67.         {$I+}
  68.         if IoResult = 0 then begin
  69.            for lInc  := 0 to Memo1.Lines.Count do begin
  70.             Writeln(lF, Memo1.Lines[lInc]);
  71.               end;
  72.               CloseFile(lF);
  73.         end; {i/o error}
  74.        end; {save dlg execute}
  75. end;
  76.  
  77. end.
  78.