home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 October / Chip_2001-10_cd1.bin / zkuste / delphi / navody / DICOMSRC.ZIP / analyze.pas < prev    next >
Pascal/Delphi Source File  |  2001-04-07  |  20KB  |  516 lines

  1. unit Analyze;
  2. {$A-} {turn off byte alignment!!!}
  3. interface
  4. uses
  5.   Windows, Messages,SysUtils,Dicom,Dialogs;
  6.          
  7.  
  8. type
  9.  AHdr = packed record
  10.    HdrSz : longint;
  11.    Data_Type: array [1..10] of char;
  12.    db_name: array [1..18] of char;
  13.    extents: longint;                            (* 32 + 4    *)
  14.    session_error: smallint;                (* 36 + 2    *)
  15.    regular: char;                           (* 38 + 1    *)
  16.    hkey_un0: char;                          (* 39 + 1    *)
  17.    dim: array[0..7] of smallint;                       (* 0 + 16    *)
  18.    vox_units: array[1..4] of char;                      (* 16 + 4    *)
  19.    (*   up to 3 characters for the voxels units label; i.e. mm., um., cm.*)
  20.    cal_units: array [1..8] of char;                      (* 20 + 4    *)
  21.    (*   up to 7 characters for the calibration units label; i.e. HU *)
  22.    unused1: smallint;                      (* 24 + 2    *)
  23.    datatype: smallint ;                     (* 30 + 2    *)
  24.    bitpix: smallint;                       (* 32 + 2    *)
  25.    dim_un0: smallint ;                      (* 34 + 2    *)
  26.    pixdim: array[1..8]of single;                        (* 36 + 32   *)
  27.                         (*
  28.                                 pixdim[] specifies the voxel dimensions:
  29.                                 pixdim[1] - voxel width  {in SPM [2]}
  30.                                 pixdim[2] - voxel height  {in SPM [3]}
  31.                                 pixdim[3] - interslice distance {in SPM [4]}
  32.                                         ..etc
  33.                         *)
  34.    vox_offset: single;                       (* 68 + 4    *)
  35.    roi_scale: single;                        (* 72 + 4    *)
  36.    funused1: single;                         (* 76 + 4    *)
  37.    funused2: single;                         (* 80 + 4    *)
  38.    cal_max: single;                          (* 84 + 4    *)
  39.    cal_min: single;                          (* 88 + 4    *)
  40.    compressed: longint;                         (* 92 + 4    *)
  41.    verified: longint;                           (* 96 + 4    *)
  42.    glmax, glmin: longint;                       (* 100 + 8   *)
  43.    descrip: array[1..80] of char;                       (* 0 + 80    *)
  44.    aux_file: array[1..24] of char;                      (* 80 + 24   *)
  45.    orient: char;                            (* 104 + 1   *)
  46.    (*originator: array [1..10] of char;                   (* 105 + 10  *)
  47.    originator: array [1..5] of smallint;                    (* 105 + 10  *)
  48.    generated: array[1..10]of char;                     (* 115 + 10  *)
  49.    scannum: array[1..10]of char;{array [1..10] of char {extended??}                       (* 125 + 10  *)
  50.    patient_id: array [1..10] of char;                    (* 135 + 10  *)
  51.    exp_date: array [1..10] of char;                      (* 145 + 10  *)
  52.    exp_time: array[1..10] of char;                      (* 155 + 10  *)
  53.    hist_un0: array [1..3] of char;                       (* 165 + 3   *)
  54.    views: longint;                              (* 168 + 4   *)
  55.    vols_added: longint;                         (* 172 + 4   *)
  56.    start_field: longint;                        (* 176 + 4   *)
  57.    field_skip: longint;                         (* 180 + 4   *)
  58.    omax,omin: longint;                          (* 184 + 8   *)
  59.    smax,smin:longint;                          (* 192 + 8   *)
  60. {} end;
  61. function OpenAnalyze (var lHdrOK,lImgOK : boolean; var lDynStr, lFileName: string; var lDicomData: DicomData): boolean;
  62. function SaveAnalyzeHdr (lHdrName: string; lDicomData: DicomData): boolean;
  63.  
  64. implementation
  65. procedure Swap2 (var lInt: SmallInt);
  66. begin
  67.  lInt := swap(lInt);
  68. end;
  69.  
  70. function swap64r(s : double):double;
  71. type
  72.   swaptype = packed record
  73.     case byte of
  74.       0:(Word1,Word2,Word3,Word4 : word); //word is 16 bit
  75.       1:(float:double);
  76.   end;
  77.   swaptypep = ^swaptype;
  78. var
  79.   inguy:swaptypep;
  80.   outguy:swaptype;
  81. begin
  82.   inguy := @s; //assign address of s to inguy
  83.   outguy.Word1 := swap(inguy^.Word4);
  84.   outguy.Word2 := swap(inguy^.Word3);
  85.   outguy.Word3 := swap(inguy^.Word2);
  86.   outguy.Word4 := swap(inguy^.Word1);
  87.   try
  88.     swap64r:=outguy.float;
  89.   except
  90.         swap64r := 0;
  91.         exit;
  92.   end;{}
  93. end;
  94.  
  95. function swap32i(var s : LongInt): Longint;
  96. type
  97.   swaptype = packed record
  98.     case byte of
  99.       0:(Word1,Word2 : word); //word is 16 bit
  100.       1:(Long:LongInt);
  101.   end;
  102.   swaptypep = ^swaptype;
  103. var
  104.   inguy:swaptypep;
  105.   outguy:swaptype;
  106. begin
  107.   inguy := @s; //assign address of s to inguy
  108.   outguy.Word1 := swap(inguy^.Word2);
  109.   outguy.Word2 := swap(inguy^.Word1);
  110.   swap32i:=outguy.Long;
  111. end;
  112. procedure swap4r(var s : single);
  113. type
  114.   swaptype = packed record
  115.     case byte of
  116.       0:(Word1,Word2 : word); //word is 16 bit
  117.       1:(sing:single);
  118.   end;
  119.   swaptypep = ^swaptype;
  120. var
  121.   inguy:swaptypep;
  122.   outguy:swaptype;
  123. begin
  124.   inguy := @s; //assign address of s to inguy
  125.   outguy.Word1 := swap(inguy^.Word2);
  126.   outguy.Word2 := swap(inguy^.Word1);
  127.   s:=outguy.sing;
  128. end;
  129.  
  130. function fswap4r (s:single): single;
  131. type
  132.   swaptype = packed record
  133.     case byte of
  134.       0:(Word1,Word2 : word); //word is 16 bit
  135.       1:(float:single);
  136.   end;
  137.   swaptypep = ^swaptype;
  138. var
  139.   inguy:swaptypep;
  140.   outguy:swaptype;
  141. begin
  142.   inguy := @s; //assign address of s to inguy
  143.   outguy.Word1 := swap(inguy^.Word2);
  144.   outguy.Word2 := swap(inguy^.Word1);
  145.   fswap4r:=outguy.float;
  146. end;
  147. {procedure Swap4r (var lR: single);
  148. begin
  149.      lR := fswap4r(lR)
  150. end;      }
  151. procedure swap4(var s : LongInt);
  152. type
  153.   swaptype = packed record
  154.     case byte of
  155.       0:(Word1,Word2 : word); //word is 16 bit
  156.       1:(Long:LongInt);
  157.   end;
  158.   swaptypep = ^swaptype;
  159. var
  160.   inguy:swaptypep;
  161.   outguy:swaptype;
  162. begin
  163.   inguy := @s; //assign address of s to inguy
  164.   outguy.Word1 := swap(inguy^.Word2);
  165.   outguy.Word2 := swap(inguy^.Word1);
  166.   s:=outguy.Long;
  167. end;
  168. function fswap4 (s:longint): longint;
  169. var l: longint;
  170. begin
  171.      l := s;
  172.      swap4(l);
  173.      fswap4 := l;
  174. end;
  175.  
  176. function fswap8 (s:double): double;
  177. type
  178.   swaptype8 = packed record
  179.     case byte of
  180.       0:(Word1,Word2,Word3,Word4 : word); //word is 16 bit
  181.       1:(Dbl:Double);
  182.   end;
  183.   swaptype8p = ^swaptype8;
  184. var
  185.   inguy:swaptype8p;
  186.   outguy:swaptype8;
  187. begin
  188.   inguy := @s; //assign address of s to inguy
  189.   outguy.Word1 := swap(inguy^.Word4);
  190.   outguy.Word2 := swap(inguy^.Word3);
  191.   outguy.Word3 := swap(inguy^.Word2);
  192.   outguy.Word4 := swap(inguy^.Word1);
  193.   fswap8:=outguy.Dbl;
  194. end;
  195.  
  196. procedure SwapBytes (var lAHdr: AHdr);
  197. var
  198. //   l10 : array [1..10] of byte;
  199.    lInc: integer;
  200. begin
  201.     with lAHdr do begin
  202.          swap4(hdrsz);
  203.          {for lInc := 1 to 10 do
  204.              Data_Type[lInc] := chr(0);  for chars: no need to swap 1 byte
  205.          for lInc := 1 to 18 do
  206.              db_name[lInc] := chr(0);}
  207.          swap4(extents);                            (* 32 + 4    *)
  208.          swap2(session_error);                (* 36 + 2    *)
  209.          {regular:=chr(0);                           (* 38 + 1    *)
  210.          hkey_un0:=chr(0);}                          (* 39 + 1    *)
  211.          for lInc := 0 to 7 do
  212.              swap2(dim[lInc]);                       (* 0 + 16    *)
  213.          {for lInc := 1 to 4 do
  214.              vox_units[lInc] := chr(0);                      (* 16 + 4    *)
  215.          for lInc := 1 to 4 do
  216.              cal_units[lInc] := chr(0);}                      (* 20 + 4    *)
  217.          swap2(unused1);                      (* 24 + 2    *)
  218.          swap2(datatype);                     (* 30 + 2    *)
  219.          swap2(bitpix);                       (* 32 + 2    *)
  220.          swap2(dim_un0);                      (* 34 + 2    *)
  221.          for lInc := 1 to 4 do
  222.              swap4r(pixdim[linc]);                        (* 36 + 32   *)
  223.          swap4r(vox_offset);
  224. {roi scale = 1}
  225.          swap4r(roi_scale);
  226.          swap4r(funused1);                         (* 76 + 4    *)
  227.          swap4r(funused2);                         (* 80 + 4    *)
  228.          swap4r(cal_max);                          (* 84 + 4    *)
  229.          swap4r(cal_min);                          (* 88 + 4    *)
  230.          swap4(compressed);                         (* 92 + 4    *)
  231.          swap4(verified);                           (* 96 + 4    *)
  232.          swap4(glmax);
  233.          swap4(glmin);                       (* 100 + 8   *)
  234.          {for lInc := 1 to 80 do
  235.              gAHdr.descrip[lInc] := chr(0);{80 spaces}
  236.          {for lInc := 1 to 24 do
  237.              gAHdr.aux_file[lInc] := chr(0);{24 spaces}
  238.          orient:= chr(0);                            (* 104 + 1   *)
  239.          (*originator: array [1..10] of char;                   (* 105 + 10  *)
  240.          for lInc := 1 to 5 do
  241.              swap2(originator[lInc]);                    (* 105 + 10  *)
  242.          {for lInc := 1 to 10 do
  243.              generated[lInc] := chr(0);                     (* 115 + 10  *)
  244.          for lInc := 1 to 10 do
  245.              scannum[lInc] := chr(0);{}
  246.         // scannum := 0{fswap10(scannum)};
  247.                                     (* 125 + 10  *)
  248.          {for lInc := 1 to 10 do
  249.              patient_id[lInc] := chr(0);                    (* 135 + 10  *)
  250.          for lInc := 1 to 10 do
  251.              exp_date[lInc] := chr(0);                    (* 135 + 10  *)
  252.          for lInc := 1 to 10 do
  253.              exp_time[lInc] := chr(0);                    (* 135 + 10  *)
  254.          for lInc := 1 to 3 do
  255.              hist_un0[lInc] := chr(0);                    (* 135 + 10  *)
  256.          {}
  257.          swap4(views);                              (* 168 + 4   *)
  258.          swap4(vols_added);                         (* 172 + 4   *)
  259.          swap4(start_field);                        (* 176 + 4   *)
  260.          swap4(field_skip);                         (* 180 + 4   *)
  261.          swap4(omax);
  262.          swap4(omin);                          (* 184 + 8   *)
  263.          swap4(smax);
  264.          swap4(smin);                          (* 192 + 8   *)
  265.     end; {with}
  266. end;
  267.  
  268.  
  269.  
  270. function ParseFileName (lFilewExt:String): string;
  271. var
  272.    lLen,lInc: integer;
  273.    lName: String;
  274. begin
  275.     lName := '';
  276.      lLen := length(lFilewExt);
  277.     lInc := lLen+1;
  278.      if  lLen > 0 then
  279.        repeat
  280.               dec(lInc);
  281.         until (lFileWExt[lInc] = '.') or (lInc = 1);
  282.      if lInc > 1 then
  283.         for lLen := 1 to (lInc - 1) do
  284.             lName := lName + lFileWExt[lLen]
  285.      else
  286.          lName := lFilewExt; //no extension
  287.         ParseFileName := lName;
  288. end;
  289. function FSize (lFName: String): longint;
  290. var SearchRec: TSearchRec;
  291. begin
  292.   FSize := 0;
  293.   if not FileExists(lFName) then exit;
  294.   FindFirst(lFName, faAnyFile, SearchRec);
  295.   FSize := SearchRec.size;
  296.   FindClose(SearchRec);
  297. end;
  298.  
  299. function OpenAnalyze (var lHdrOK,lImgOK  : boolean; var lDynStr,lFileName: string; var lDicomData: DicomData): boolean;
  300. var
  301.   F: file;
  302.   lFSz: LongInt;
  303.   lHdrSz : Longint;
  304.   gAHdr : AHdr;
  305. begin
  306.      result := false;
  307.      lImgOK := false;
  308.      lHdrOK:= false;
  309.      lDynStr := '';
  310.      lDICOMdata.PlanarConfig:= 1; //only used in RGB values
  311.      lDICOMdata.GenesisCpt := false;
  312.      lDICOMdata.GenesisPackHdr := 0;
  313.      lDICOMdata.SamplesPerPixel := 1;
  314.      lDICOMdata.WindowCenter := 0;
  315.      lDICOMdata.WindowWidth := 0;
  316.      lDICOMdata.monochrome := 2; {most common}
  317.      lDICOMdata.XYZmm[1] := 1;
  318.      lDICOMdata.XYZmm[2] := 1;
  319.      lDICOMdata.XYZmm[3] := 1;
  320.      lDICOMdata.XYZdim[1] := 1;
  321.      lDICOMdata.XYZdim[2] := 1;
  322.      lDICOMdata.XYZdim[3] := 1;
  323.      lDICOMdata.ImageStart := 0;
  324.      lDICOMdata.Little_Endian := 1;
  325.      if not FileExists(lFileName) then exit;
  326.      lFSz := FSize(lFileName);
  327.      if (lFSz) <> sizeof(gAHdr) then begin
  328.         {CloseFile(F);}
  329.         ShowMessage('This header file is the wrong size to be in Analyze format.'+
  330.         ' Required: '+inttostr(sizeof(gAHdr))+'  Selected:'+inttostr(lFSz));
  331.         exit;
  332.      end;
  333.      AssignFile(F, lFileName);
  334.      FileMode := 0;  { Set file access to read only }
  335.      Reset(F, 1);
  336.      {$I+}
  337.      if ioresult <> 0 then
  338.         ShowMessage('Potential error in reading Analyze header.'+inttostr(IOResult));
  339.      BlockRead(F, gAHdr{Buffer^}, lFSz);
  340.      CloseFile(F);
  341.      if (IOResult <> 0) then exit;
  342.      FileMode := 2;
  343.       lHdrSz := gAHdr.HdrSz;
  344.       Swap4(lHdrSz);
  345.       if gAHdr.HdrSz = sizeof(gAHdr) then begin
  346.          lDicomData.little_endian := 1;
  347.       end else if SizeOf(gAHdr) = lHdrSz then begin
  348.          lDicomData.little_endian := 0;
  349.              SwapBytes (gAHdr);
  350.       end else begin
  351.               ShowMessage('This software can not read this header file.'+
  352.                'The header file is not in Analyze format.');
  353.               CloseFile(F);
  354.               exit;
  355.       end;
  356.       result := true;
  357.       lImgOK := true;
  358.       lHdrOK := true;
  359.       lDICOMdata.XYZdim[1]  :=gAHdr.Dim[1];
  360.       lDICOMdata.XYZdim[2] := gAHdr.Dim[2];
  361.       lDICOMdata.XYZdim[3] := gAHdr.Dim[3];
  362.       lDicomData.IntenScale := gAHdr.roi_scale;
  363.       lDICOMdata.XYZmm[1] := gAHdr.pixdim[2];
  364.       lDICOMdata.XYZmm[2] := gAHdr.pixdim[3];
  365.       lDICOMdata.XYZmm[3] := gAHdr.pixdim[4];{}
  366.       lDynStr := 'Analyze format'+kCR+'XYZ dim:' +inttostr(lDicomData.XYZdim[1])+'/'
  367.       +inttostr(lDicomData.XYZdim[2])+'/'+inttostr(lDicomData.XYZdim[3])
  368.       +kCR+'XYZ mm:'+floattostrf(lDicomData.XYZmm[1],ffFixed,8,2)+'/'
  369.        +floattostrf(lDicomData.XYZmm[2],ffFixed,8,2)+'/'+floattostrf(lDicomData.XYZmm[3],ffFixed,8,2)+
  370.        kCR+'Bits per pixel: '+ inttostr(gAHdr.bitpix);
  371.       lDicomData.Allocbits_per_pixel := gAHdr.bitpix;
  372.       lDicomData.Storedbits_per_pixel := gAHdr.bitpix;
  373.       if gAHdr.bitpix > 16 then begin
  374.          lImgOK := false;
  375.          showmessage('This software can only read 8/16-bit Analyze images.');
  376.       end;
  377.       lDICOMdata.ImageStart := round(gAHdr.vox_offset);
  378.       lFileName :=ExtractFilePath(lFileName)+ParseFileName(ExtractFileName(lFileName))+'.img';
  379. end;
  380.  
  381. procedure ClearHdr (var lHdr: AHdr);
  382. var lInc: byte;
  383. begin
  384.     with lHdr do begin
  385.          {set to 0}
  386.          HdrSz := sizeof(AHdr);
  387.          for lInc := 1 to 10 do
  388.              Data_Type[lInc] := chr(0);
  389.          for lInc := 1 to 18 do
  390.              db_name[lInc] := chr(0);
  391.          extents:=0;                            (* 32 + 4    *)
  392.          session_error:= 0;                (* 36 + 2    *)
  393.          regular:='r'{chr(0)};                           (* 38 + 1    *)
  394.          hkey_un0:=chr(0);
  395.          dim[0] := 4;                          (* 39 + 1    *)
  396.          for lInc := 1 to 7 do
  397.              dim[lInc] := 0;                       (* 0 + 16    *)
  398.          for lInc := 1 to 4 do
  399.              vox_units[lInc] := chr(0);                      (* 16 + 4    *)
  400.          for lInc := 1 to 4 do
  401.              cal_units[lInc] := chr(0);                      (* 20 + 4    *)
  402.          unused1:=0;                      (* 24 + 2    *)
  403.          datatype:=0 ;                     (* 30 + 2    *)
  404.          bitpix:=0;                       (* 32 + 2    *)
  405.          dim_un0:=0;                      (* 34 + 2    *)
  406.          for lInc := 1 to 4 do
  407.              pixdim[linc]:= 2.0;                        (* 36 + 32   *)
  408.          vox_offset:= 0.0;
  409.          roi_scale:= 0.00392157{1.1};
  410.          funused1:= 0.0;                         (* 76 + 4    *)
  411.          funused2:= 0.0;                         (* 80 + 4    *)
  412.          cal_max:= 0.0;                          (* 84 + 4    *)
  413.          cal_min:= 0.0;                          (* 88 + 4    *)
  414.          compressed:=0;                         (* 92 + 4    *)
  415.          verified:= 0;                           (* 96 + 4    *)
  416.          glmax:= 0;
  417.          glmin:= 0;                       (* 100 + 8   *)
  418.          for lInc := 1 to 80 do
  419.              lHdr.descrip[lInc] := chr(0);{80 spaces}
  420.          for lInc := 1 to 24 do
  421.              lHdr.aux_file[lInc] := chr(0);{80 spaces}
  422.          orient:= chr(0);                            (* 104 + 1   *)
  423.          (*originator: array [1..10] of char;                   (* 105 + 10  *)
  424.          for lInc := 1 to 5 do
  425.              originator[lInc] := 0;                    (* 105 + 10  *)
  426.          for lInc := 1 to 10 do
  427.              generated[lInc] := chr(0);                     (* 115 + 10  *)
  428.          for lInc := 1 to 10 do
  429.              scannum[lInc] := chr(0);
  430.          for lInc := 1 to 10 do
  431.              patient_id[lInc] := chr(0);                    (* 135 + 10  *)
  432.          for lInc := 1 to 10 do
  433.              exp_date[lInc] := chr(0);                    (* 135 + 10  *)
  434.          for lInc := 1 to 10 do
  435.              exp_time[lInc] := chr(0);                    (* 135 + 10  *)
  436.          for lInc := 1 to 3 do
  437.              hist_un0[lInc] := chr(0);                    (* 135 + 10  *)
  438.          views:=0;                              (* 168 + 4   *)
  439.          vols_added:=0;                         (* 172 + 4   *)
  440.          start_field:=0;                        (* 176 + 4   *)
  441.          field_skip:=0;                         (* 180 + 4   *)
  442.          omax:= 0;
  443.          omin:= 0;                          (* 184 + 8   *)
  444.          smax:= 0;
  445.          smin:=0;                          (* 192 + 8   *)
  446. {below are standard settings which are not 0}
  447.          bitpix := 8; {8bits per pixel, e.g. unsigned char}
  448.          DataType := 2;{unsigned char}
  449.          vox_offset := 0;
  450.          Originator[1] := 0;
  451.          Originator[2] := 0;
  452.          Originator[3] := 0;
  453.          Dim[1] := 91;
  454.          Dim[2] := 109;
  455.          Dim[3] := 91;
  456.          Dim[4] := 1; {n vols}
  457.          glMin := 0;
  458.          glMax := 255; {critical!}
  459.          roi_scale := 0.00392157{1.1};
  460.     end;
  461. end;
  462. function SaveAnalyzeHdr (lHdrName: string; lDicomData: DicomData): boolean;
  463. var
  464. lF: file;
  465. lStr : string;
  466. lHdr: AHdr;
  467.  lSwapBytes: boolean;
  468. begin
  469.  lStr := ExtractFilePath(lHdrName)+ParseFileName(ExtractFileName(lHdrName))+'.hdr';
  470.      {if (sizeof(AHdr)> DiskFree(lStr)) then begin
  471.         ShowMessage('There is not enough free space on the destination disk to save the header. '+lStr);
  472.         result := false;
  473.         exit;
  474.      end;  }
  475.      Result := true;
  476.      ClearHdr (lHdr);
  477.      if lDicomData.little_endian = 1 then
  478.         lSwapBytes := false
  479.      else
  480.          lSwapBytes := true;
  481.      lHdr.Dim[1] := lDICOMdata.XYZdim[1];
  482.      lHdr.Dim[2] := lDICOMdata.XYZdim[2];
  483.      lHdr.Dim[3] := lDICOMdata.XYZdim[3];
  484.      lHdr.pixdim[2] := lDICOMdata.XYZmm[1];
  485.      lHdr.pixdim[3] := lDICOMdata.XYZmm[2];
  486.      lHdr.pixdim[4] := lDICOMdata.XYZmm[3];{}
  487.      lHdr.bitpix := lDicomData.Allocbits_per_pixel;
  488.      lHdr.bitpix := lDicomData.Storedbits_per_pixel;
  489.      lHdr.vox_offset := lDICOMdata.ImageStart;
  490.      lHdr.roi_scale := lDicomData.IntenScale;
  491.      case lHdr.bitpix of
  492.          1: lHdr.datatype := 1; {binary}
  493.          8: lHdr.datatype := 2; {8bit int}
  494.          16: lHdr.datatype := 4; {16bit int}
  495.          32: lHdr.datatype := 8; {32 bit long}
  496.          else begin
  497.              showmessage('Unable to save Analyze header '+lHdrName+chr(13)+
  498.                'Use MRIcro to convert this image (ezDICOM can only convert files with 8/16/32 bits per voxel.');
  499.              result := false;
  500.              exit;
  501.          end;
  502.          //4: gAHdr.datatype := 16;{float=32bits}
  503.          //5: gAHdr.datatype := 64; {float=64bits}
  504.      end;
  505.  
  506.      if lSwapBytes then
  507.         SwapBytes (lHdr);{swap to sun format}
  508.      FileMode := 2; //read/write
  509.      AssignFile(lF,lStr); {WIN}
  510.      Rewrite(lF,sizeof(AHdr));
  511.      BlockWrite(lF,lHdr, 1  {, NumWritten});
  512.      CloseFile(lF);
  513. end;
  514.  
  515. end.
  516.