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

📄 define_types.pas

📁 在delphi7 下开发医学图象浏览器,对医学图象进行编辑,分析的
💻 PAS
📖 第 1 页 / 共 2 页
字号:
unit define_types;

interface
{$IFDEF LINUX}
uses
  SysUtils,QDialogs,QControls;
{$ELSE}
uses
  Windows,SysUtils,Dialogs,Controls,classes {tstrings};
{$ENDIF}

const
     PixelCountMax = 32768;
     kTab = chr(9);
     kEsc = chr(27);
     kCR = chr (13);
{$IFDEF LINUX}
{$ELSE}
       PathDelim = '\';
{$ENDIF}

type
{$IFDEF Linux}
  TRGBtriple = PACKED RECORD
        rgbtBlue,rgbtGreen,rgbtRed,trgbreserved: byte;
  end;
{$ENDIF}
  TRGBquad = PACKED RECORD
        rgbBlue,rgbGreen,rgbRed,rgbreserved: byte;
  end;
DICOMdata = record
   XYZdim: array [1..4] of integer;   //4=volume, eg time: some EC*T7 images
   XYZori: array [1..3] of integer;
   XYZmm: array [1..3] of double;
   Rotate180deg,Float,RunLengthEncoding,GenesisCpt,JPEGlosslessCpt,
   JPEGlossyCpt,ElscintCompress,MinIntensitySet: boolean;
   IntenScale,IntenIntercept,kV,mA,TR,TE,spacing,location: single;
   SiemensInterleaved {0=no,1=yes,2=not defined},SiemensSlices,SiemensMosaicX,SiemensMosaicY,CompressSz,CompressOffset,SeriesNum,AcquNum,ImageNum,Monochrome,SamplesPerPixel,PlanarConfig,ImageStart,little_endian,
   Allocbits_per_pixel,Storedbits_per_pixel,ImageSz,accession,
   PatientIDint,VolumeNumber,WindowWidth,WindowCenter,GenesisPackHdr, NamePos,StudyDatePos,MinIntensity,MaxIntensity,
   RLEredOffset,RLEgreenOffset,RLEblueOffset,RLEredSz,RLEgreenSz,RLEblueSz: integer; {must be 32-bit integer aka longint}
   AcqTime,ImgTime,PatientName,PatientID,StudyDate,modality,serietag: string;
  end;
   AHdr = packed record //Next: analyze Format Header structure
   HdrSz : longint;
   Data_Type: array [1..10] of char;
   db_name: array [1..18] of char;
   extents: longint;                            (* 32 + 4    *)
   session_error: smallint;                (* 36 + 2    *)
   regular: char;                           (* 38 + 1    *)
   hkey_un0: char;                          (* 39 + 1    *)
   dim: array[0..7] of smallint;                       (* 0 + 16    *)
   vox_units: array[1..4] of char;                      (* 16 + 4    *)
   (*   up to 3 characters for the voxels units label; i.e. mm., um., cm.*)
   cal_units: array [1..8] of char;                      (* 20 + 4    *)
   (*   up to 7 characters for the calibration units label; i.e. HU *)
   unused1: smallint;                      (* 24 + 2    *)
   datatype: smallint ;                     (* 30 + 2    *)
   bitpix: smallint;                       (* 32 + 2    *)
   dim_un0: smallint ;                      (* 34 + 2    *)
   pixdim: array[1..8]of single;                        (* 36 + 32   *)
                        (*
                                pixdim[] specifies the voxel dimensions:
                                pixdim[1] - voxel width  //in SPM [2]
                                pixdim[2] - voxel height  //in SPM [3]
                                pixdim[3] - interslice distance //in SPM [4]
                                        ..etc
                        *)
   vox_offset: single;                       (* 68 + 4    *)
   roi_scale: single;                        (* 72 + 4    *)
   zero_intercept: single;//funused1: single;                         (* 76 + 4    *)
   funused2: single;                         (* 80 + 4    *)
   cal_max: single;                          (* 84 + 4    *)
   cal_min: single;                          (* 88 + 4    *)
   compressed: longint;                         (* 92 + 4    *)
   verified: longint;                           (* 96 + 4    *)
   glmax, glmin: longint;                       (* 100 + 8   *)
   descrip: array[1..80] of char;                       (* 0 + 80    *)
   aux_file: array[1..24] of char;                      (* 80 + 24   *)
   orient: char;                            (* 104 + 1   *)
   (*originator: array [1..10] of char;                   (* 105 + 10  *)
   originator: array [1..5] of smallint;                    (* 105 + 10  *)
   generated: array[1..10]of char;                     (* 115 + 10  *)
   scannum: array[1..10]of char;//array [1..10] of char ..extended??                       (* 125 + 10  *)
   patient_id: array [1..10] of char;                    (* 135 + 10  *)
   exp_date: array [1..10] of char;                      (* 145 + 10  *)
   exp_time: array[1..10] of char;                      (* 155 + 10  *)
   hist_un0: array [1..3] of char;                       (* 165 + 3   *)
   views: longint;                              (* 168 + 4   *)
   vols_added: longint;                         (* 172 + 4   *)
   start_field: longint;                        (* 176 + 4   *)
   field_skip: longint;                         (* 180 + 4   *)
   omax,omin: longint;                          (* 184 + 8   *)
   smax,smin:longint;                          (* 192 + 8   *)
 end; //Analyze Header Structure

	int32  = LongInt;
	uint32 = Cardinal;
	int16  = SmallInt;
	uint16 = Word;
	int8   = ShortInt;
	uint8  = Byte;
    SingleRA0 = array [0..0] of Single;
    Singlep0 = ^SingleRA0;
    ByteRA0 = array [0..0] of byte;
    Bytep0 = ^ByteRA0;
    WordRA0 = array [0..0] of Word;
    Wordp0 = ^WordRA0;
    SmallIntRA0 = array [0..0] of SmallInt;
    SMallIntp0 = ^SmallIntRA0;
    LongIntRA0 = array [0..0] of LongInt;
    LongIntp0 = ^LongIntRA0;
    DWordRA = array [1..1] of DWord;
    DWordp = ^DWordRA;

    ByteRA = array [1..1] of byte;
    Bytep = ^ByteRA;
    WordRA = array [1..1] of Word;
    Wordp = ^WordRA;
    SmallIntRA = array [1..1] of SmallInt;
    SMallIntp = ^SmallIntRA;
    LongIntRA = array [1..1] of LongInt;
    LongIntp = ^LongIntRA;
    SingleRA = array [1..1] of Single;
    Singlep = ^SingleRA;
    DoubleRA = array [1..1] of Double;
    Doublep = ^DoubleRA;

    HistoRA = array [0..256] of longint;
    pRGBTripleArray = ^TRGBTripleArray;
    TRGBTripleArray = ARRAY[0..PixelCountMax-1] OF TRGBTriple;
procedure SwapBytes (var lAHdr: AHdr); //Swap Byte order for the Analyze type
procedure swap4(var s : LongInt); //swap 32-bit integer between long/little endian
procedure ClearHdr (var lHdr: AHdr);
procedure DICOM2AnzHdr (var lBHdr: AHdr; lAnonymize: boolean; var lFilename: string; var lDICOMdata: DicomData);
FUNCTION specialsingle (var s:single): boolean; //check if 32-bit float is Not-A-Number, infinity, etc
procedure Xswap4r ( var s:single);
procedure Xswap8r(var s : double);
function FSize (lFName: String): longint;
function {TMainForm.}FileExistsEX(Name: String): Boolean;
function ParseFileName (lFilewExt:String): string;
function ParseFileFinalDir (lFileName:String): string;
function ExtractFileDirWithPathDelim(lInFilename: string): string;
function PadStr (lValIn, lPadLenIn: integer): string;

 implementation

function PadStr (lValIn, lPadLenIn: integer): string;
var lOrigLen,lPad : integer;
begin
 lOrigLen := length(inttostr(lValIn));
 result := inttostr(lValIn);
 if lOrigLen < lPadLenIn then begin
    lOrigLen := lPadLenIn-lOrigLen;
    for lPad := 1 to lOrigLen do
        result := '0'+result;
 end;
end;

function ExtractFileDirWithPathDelim(lInFilename: string): string;
//F:\filename.ext -> 'F:\' and F:\dir\filename.ext -> 'F:\dir\'
//Despite documentation, Delphi3's ExtractFileDir does not always retain final pathdelim
var lFilePath: string;
begin
     result := '';
     lFilePath := ExtractFileDir(lInFilename);
     if length(lFilepath) < 1 then exit;
     if lFilePath[length(lFilepath)] <> pathdelim then
        lFilepath := lFilepath + pathdelim; //Delphi3 bug: sometimes forgets pathdelim
     result := lFilepath;
end;

function ParseFileFinalDir (lFileName:String): string;
var
   lLen,lInc,lPos: integer;
   lInName,lName: String;
begin
     lInName := extractfiledir(lFilename);
     lName := '';
     lLen := length(lInName);
     if  lLen < 1 then exit;
     lInc := lLen;
     repeat
              dec(lInc);
     until (lInName[lInc] = pathdelim) or (lInc = 1);
     if lInName[lInc] = pathdelim then inc(lInc); //if '\folder' then return 'folder'
     for lPos := lInc to lLen do
            lName := lName + lInName[lPos];
     ParseFileFinalDir := lName;
end;

function ParseFileName (lFilewExt:String): string;
var
   lLen,lInc: integer;
   lName: String;
begin
	lName := '';
     lLen := length(lFilewExt);
	lInc := lLen+1;
     if  lLen > 0 then
	   repeat
              dec(lInc);
        until (lFileWExt[lInc] = '.') or (lInc = 1);
     if lInc > 1 then
        for lLen := 1 to (lInc - 1) do
            lName := lName + lFileWExt[lLen]
     else
         lName := lFilewExt; //no extension
        ParseFileName := lName;
end;

 Function {TMainForm.}FileExistsEX(Name: String): Boolean;
 var
   F: File;
 begin
  result := FileExists(Name);
   if result then exit;
   //the next bit attempts to check for a file to avoid WinNT bug
   AssignFile(F, Name);
   {$I-}
   Reset(F);
   {$I+}
   Result:=IOresult = 0;
   if Result then
     CloseFile(F);
 end;


function FSize (lFName: String): longint;
var SearchRec: TSearchRec;
begin
  FSize := 0;
  if not fileexistsex(lFName) then exit;
  FindFirst(lFName, faAnyFile, SearchRec);
  FSize := SearchRec.size;
  FindClose(SearchRec);
end;
procedure Xswap8r(var s : double);
type
  swaptype = packed record
    case byte of
      0:(Word1,Word2,Word3,Word4 : word); //word is 16 bit
      //1:(float:double);
  end;
  swaptypep = ^swaptype;
var
  inguy:swaptypep;
  outguy:swaptype;
begin
  inguy := @s; //assign address of s to inguy
  outguy.Word1 := swap(inguy^.Word4);
  outguy.Word2 := swap(inguy^.Word3);
  outguy.Word3 := swap(inguy^.Word2);
  outguy.Word4 := swap(inguy^.Word1);
  inguy.Word1 := outguy.Word1;
  inguy.Word2 := outguy.Word2;
  inguy.Word3 := outguy.Word3;
  inguy.Word4 := outguy.Word4;
end;

FUNCTION specialsingle (var s:single): boolean;
//returns true if s is Infinity, NAN or Indeterminate
//4byte IEEE: msb[31] = signbit, bits[23-30] exponent, bits[0..22] mantissa
//exponent of all 1s =   Infinity, NAN or Indeterminate
CONST kSpecialExponent = 255 shl 23;
VAR Overlay: LongInt ABSOLUTE s;
BEGIN
  IF ((Overlay AND kSpecialExponent) = kSpecialExponent) THEN
     RESULT := true
  ELSE
      RESULT := false;

⌨️ 快捷键说明

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