unit IOGraphics; {nacita 8 a 16 bitove formaty}

interface

uses Graphics, stdctrls, classes;

      {podporovane pripony - velkymi pismeny}
const SupportedExtensions = '*.BIF;*.FIT;*.FTS;*.FITS;*.PNG;*.BMP;*.JPG;*.JPEG;*.ACT;*.PNH;*.UMF';
      MaxImgSize=4096*4096*4; // max velikost obrazu (mozno zmenit)

type  TImgRec = record
             // Obecne vlastnosti  obrazu nutne pro praci s obrazem -------------------------------------------
             FileName      : Ansistring;   // nazev souboru s obrazem
             ImgWidth      : integer;  // sirka obrazu v pixelech
             ImgHeight     : integer;  // vyska obrazu v pixelech
             Channels      : integer;  // 1 ... BW obraz, 3 ... barevny obraz
             PixelType     : Ansistring;   // nemusi byt totozny s DataType, pokud byl obraz pri nacteni convertovan
             OK            : boolean;  // zda se podarilo korektne nacist obraz
             Error         : Ansistring;   // pokud neni OK=true, je zde chybove hlaseni
             Min           : integer;  // nejmensi hodnota pixelu v obraze
             Min_20Q0      : integer;  // 20% pixelu podtecenych
             Min_10Q0      : integer;  // 10% pixelu podtecenych
             Min_1Q0       : integer;  // 1% pixelu podtecenych
             Min_0Q1       : integer;  // 0.1% pixelu podtecenych
             Min_0Q01      : integer;  // 0.01% pixelu podtecenych
             Min_0Q001     : integer;  // 0.001% pixelu podtecenych
             Min_0Q0001     : integer; // 0.0001% pixelu podtecenych
             Max           : integer;  // nejvetsi hodnota pixelu v obraze
             Max_20Q0      : integer;  // 20% pixelu pretecenych
             Max_10Q0      : integer;  // 10% pixelu pretecenych
             Max_1Q0       : integer;  // 1% pixelu pretecenych
             Max_0Q1       : integer;  // 0.1% pixelu pretecenych
             Max_0Q01      : integer;  // 0.01% pixelu pretecenych
             Max_0Q001     : integer;  // 0.001% pixelu pretecenych
             Max_0Q0001    : integer;  // 0.0001% pixelu pretecenych
             Zero          : integer;  // hodnota pixelu reprezentujici 0 (0 fotonu)
             // Informace nutne jen pro nacteni obrazu ze souboru (vsechny nemusi byt vyuzity)- po nacteni obrazu nemaji smysl
             ImgSize       : integer;  // velikost obrazove matice v bytech vstupniho obrazu (nekomprim. obr.)
             HeaderSize    : integer;  // velikost hlavicky v bytech (-1 ... neni urcena)
             RGBsepatated  : boolean;  // zda jsou obrazy R,G,B zvlast (za sebou)
             BytesPerPixel : integer;  // pocet bytu na pixel vstupniho obrazu FileName
             DataType      : Ansistring;   // datovy typ vstupniho obrazu
             SwapBytes     : boolean;  // zda ma vstupni obraz swapovane byty
             VertFlip      : boolean;  // zda je nutne vstupni obraz vystove prevratit
             //----- Pouziva pouze format FITS----------------------------------------------------------------
             FITS          : boolean;  // zda je obraz FITS
             BZero         : double;   // parametr pouzivany pouze formatem FITS
             BScale        : double;   // parametr pouzivany pouze formatem FITS
             DataMin       : double;   // parametr pouzivany pouze formatem FITS
             DataMax       : double;   // parametr pouzivany pouze formatem FITS
             CenterX       : double;   // parametr pouzivany pouze formatem FITS
             CenterY       : double;   // parametr pouzivany pouze formatem FITS
             Rotation      : double;   // parametr pouzivany pouze formatem FITS
             PixelSizeX    : double;   // parametr pouzivany pouze formatem FITS
             PixelSizeY    : double;   // parametr pouzivany pouze formatem FITS
             Wavelength    : integer;  // parametr pouzivany pouze formatem FITS
             Time          : Ansistring;   // parametr pouzivany pouze formatem FITS
             TimeObs       : Ansistring;   // nestandartne pro SOHO
             Exposure      : double;   // parametr pouzivany pouze formatem FITS
             ExpTotal      : double;   // pro sumarni expozice vice obrazku
             Telescope     : Ansistring;   // parametr pouzivany pouze formatem FITS
             Instrument    : Ansistring;   // parametr pouzivany pouze formatem FITS
             Probe         : Ansistring;
             Detector      : Ansistring;   // pro SOHO
             Filter        : Ansistring;   // pro SOHO
             Polar         : Ansistring;   // pro SOHO
             OccoulterX    : double;   // pro SOHO
             OccoulterY    : double;   // pro SOHO
             OccoulterR    : double;   // pro SOHO
             Content       : Ansistring;   //
             R_Sun         : double;   // parametr pouzivany pouze formatem FITS
             Compress      : Ansistring;
             //----- Pouziva pouze pro geometricke sesazeni SDO -----------------------------------------------
             AlignRot      : double;
             AlignMagn     : double;
             //-------- Pouziva pouze format BMP a JPEG -------------------------------------------------------
             BitMap        : Graphics.TBitmap; // musi byt nil pokut neni vytvorena
           end{record};

      TWordArr      = array[0..MaxImgSize] of word;
      PWordArr      = ^TWordArr;
      TByteArr      = array[0..MaxImgSize] of byte;
      PByteArr      = ^TByteArr;
      TSmallintArr  = array[0..MaxImgSize] of smallint;
      PSmallintArr  = ^TSmallintArr;
      TSingleArr  = array[0..MaxImgSize] of Single;
      PSingleArr  = ^TSingleArr;
      TIntegerArr  = array[0..MaxImgSize] of integer;
      PIntegerArr  = ^TIntegerArr;
      TCardinalArr  = array[0..MaxImgSize] of Cardinal;
      PCardinalArr  = ^TCardinalArr;


      TWColor   = record
                    R,G,B : word;
                  end;{record}
      TWColorArr    = array[0..MaxImgSize] of TWColor;
      PWColorArr    = ^TWColorArr;

//******** Procedura nacteni obrazu ve vsech formatech SupportedExtensions *************************************
procedure LoadImageFromFile(FileName : Ansistring; var Info :TImgRec; var Img : pointer;
              ConvertToBits : integer; AlocMem : boolean; HeaderMemo : TMemo; DisplayWarnings : boolean);
// FileName        : nazev souboru s obrazem
// Info            : record obsahujici informace o souboru i obraze
// Img             : pointer na obraz
// ConvertToBits   : 0 .. jen nacist, 8 .. transformovat vse na BYTE, 16 .. transformovat vse na WORD
// AlocMem         : zda procedura ma alokovat pamet - pokud ano, tak procedura pointer Img odalokuje i alokuje
//                   (dulezite: pokud Img jeste nebyl alokovan, musi byt Img=nil)
// HeaderMemo      : Memo, kam se ma napsat hlavicka souboru (HeaderMemo=nil, pokud hlavicku nechci)
// DisplayWarnings : zda se ma vypsat automaticky chyba pri nacitani soubory (MessageDlg)
// *************************************************************************************************************




procedure LoadAndTransformImage(var Info :TImgRec; var Img : pointer; ConvertToBits : integer; AlocMem : boolean);
procedure GetFitsInfo(FileName : Ansistring; var Info: TImgRec; var HeaderMemo : TMemo; DisplayWarnings : boolean);
procedure GetPnhInfo(FileName : Ansistring; var Info: TImgRec; var HeaderMemo : TMemo);
procedure GetBifInfo(FileName : Ansistring; var Info: TImgRec; var HeaderMemo : TMemo; DisplayWarnings : boolean);
procedure GetImgInfo(FileName : Ansistring; var Info :TImgRec; DisplayWarnings : boolean);
procedure ComputeMaxMinWordByte(var Info :TImgRec; Img : pointer);
procedure GetInteger(s, Keyword : Ansistring; var value : integer);
procedure GetDouble(s, Keyword : Ansistring; var value : double);
procedure GetSingle(s, Keyword : Ansistring; var value : single);
procedure GetString(s, Keyword : Ansistring; var txt : Ansistring);
procedure GetMemoInfo(var HeaderMemo : TMemo; var Info: TImgRec);
function InvLogLimFce(x,LinLimit : Cardinal) : cardinal;

implementation

uses SysUtils, Dialogs, PNGformat, BMP_JPEGformat, SDO_param;

const InvalidVal = 0; // jakou hodnotu ma neplatny pixel (neznama hodnota)
      LogLimit : integer = 65535;

var ImgError   : Ansistring;
    HeaderMemo : TMemo;

procedure GetPnhInfo(FileName : Ansistring; var Info: TImgRec; var HeaderMemo : TMemo);
var f          : file;
    fs, i, j   : integer;
    id         : array [1..6] of ansichar ;
    BitPix     : byte;
    HeaderSize : integer;
    CrLf       : word;
    Buff       : PByteArr;
    s          : array [1..100] of ansichar;
begin
  Info.FileName:=FileName;
  System.Assign(f,FileName);
  System.Reset(f,1);
  fs:=System.FileSize(f);
  System.Seek(f,fs-13);
  System.BlockRead(f,id[1],6);        // EndBIF
  System.BlockRead(f,CrLf,2);         // konec radku ve Win. textu
  System.BlockRead(f,HeaderSize,4);   // velikost hlavicky
  System.BlockRead(f,BitPix,1);       // pocet bitu na pixel
  if id<>'EndBIF' then
    begin
      ShowMessage('Incorrect PGH file feader');
      Exit;
    end;
  if BitPix=16 then
    begin
      Info.DataType:='WORD';
      Info.BytesPerPixel:=2;
    end else
    begin
      Info.DataType:='CARDINAL';
      Info.BytesPerPixel:=4;
    end;
  GetMem(Buff,HeaderSize);
  System.Seek(f,fs-HeaderSize-5);
  System.BlockRead(f,Buff^,HeaderSize);
  j:=0;
  for i:=0 to HeaderSize-1 do
    if Buff^[i]=13 then
      begin
        Move(Buff^[j],s[1],i-j);
        HeaderMemo.Lines.Add(s);
        j:=i+2;
      end;
  FreeMem(Buff);
  GetMemoInfo(HeaderMemo,Info);
end;

function SwapInteger(i : integer) : integer;
begin
  SwapInteger:=(i and $FF000000) shr 24 or
               (i and $00FF0000) shr  8 or
               (i and $0000FF00) shl  8 or
               (i and $000000FF) shl 24;
end;


function SwapCardinal(i : cardinal) : cardinal;
begin
  SwapCardinal:= (i and $FF000000) shr 24 or
                 (i and $00FF0000) shr  8 or
                 (i and $0000FF00) shl  8 or
                 (i and $000000FF) shl 24;
end;

procedure GetUmfInfo (FileName : Ansistring; var Info:TimgRec);
var ID,FileHandle : Integer;
    W,H,BpP : Integer;
begin
  FileHandle:=FileOpen(FileName,fmOpenRead);
  FileRead(FileHandle,ID,4);
  FileRead(FileHandle,W,4);
  FileRead(FileHandle,H,4);
  FileRead(FileHandle,BpP,4);
  FileClose(FileHandle);
  if ID=2727 then
    begin
     Info.ImgWidth:=W;
     Info.ImgHeight:=H;
     Info.BytesPerPixel:=BpP;
     Info.OK:=true;
     Info.HeaderSize:=16;
     Info.Channels:=1;
     Info.FileName:=Filename;
     Info.PixelType:='WORD';
     Info.Zero:=0;
     Info.ImgSize:=W*H*BpP;
     Info.DataType:='WORD';
     Info.SwapBytes:=false;
     Info.VertFlip:=false;
    end
  else
  ShowMessage('Invalid UMF format');
end;

procedure GetImgInfo(FileName : Ansistring; var Info : TImgRec; DisplayWarnings : boolean);
var ext : Ansistring;
begin
  if not FileExists(FileName) then Exit;
  ext:=UpperCase(ExtractFileExt(FileName));
  Info.FITS:=false;
  Info.Zero:=0;
  if (ext='.FIT') or (ext='.FTS') or (ext='.FITS') then GetFitsInfo(FileName,Info,HeaderMemo,DisplayWarnings);
  if (ext='.BIF')                                  then GetBifInfo(FileName,Info,HeaderMemo,DisplayWarnings);
  //if (ext='.TIF') or (ext='.TIFF') or (ext='.ACT') then GetTiffInfo(FileName,Info,DisplayWarnings);
  if (ext='.PNG')                                  then GetPngInfo(FileName,Info,DisplayWarnings);
  if (ext='.BMP') or (ext='.JPG') or (ext='.JPEG') then GetBmpJpegInfo(FileName,Info,DisplayWarnings);
  if (ext='.PNH')                                  then GetPnhInfo(FileName,Info,HeaderMemo);
end;

procedure LoadImageFromFile(FileName : Ansistring; var Info :TImgRec; var Img : pointer;
          ConvertToBits : integer;  AlocMem : boolean; HeaderMemo : TMemo; DisplayWarnings : boolean);
var ext : Ansistring;
begin
  Info.OK:=false;
  HeaderMemo.Clear;
  ext:=UpperCase(ExtractFileExt(FileName));
  if (Pos(ext,SupportedExtensions)=0) then
    begin
      ShowMessage('Files *'+ext+' are not supported.');
      Exit;
    end;
  if (ext='.FIT') or (ext='.FTS') or (ext='.FITS') then GetFitsInfo(FileName,Info,HeaderMemo,DisplayWarnings);
  if (ext='.BIF')                                  then GetBifInfo(FileName,Info,HeaderMemo,DisplayWarnings);
  //if (ext='.TIF') or (ext='.TIFF') or (ext='.ACT') then GetTiffInfo(FileName,Info,DisplayWarnings);
  if (ext='.PNG')                                  then GetPngInfo(FileName,Info,DisplayWarnings);
  if (ext='.BMP') or (ext='.JPG') or (ext='.JPEG') then GetBmpJpegInfo(FileName,Info,DisplayWarnings);
  if (ext='.PNH')                                  then GetPnhInfo(FileName,Info,HeaderMemo);
  if (ext='.UMF')                                  then GetUMFInfo (FileName,Info);
  if Info.OK then
    begin
      LoadAndTransformImage(Info,Img,ConvertToBits,AlocMem);
      ComputeMaxMinWordByte(Info,Img);
    end;
end;

procedure ComputeMaxMinWordByte(var Info :TImgRec; Img : pointer);
var Hist     : array[0..65535] of integer;
    i, sum   : integer;
    PW       : PWordArr;
    PB       : PByteArr;
    Q_20Q0   : integer;
    Q_10Q0   : integer;
    Q_1Q0    : integer;
    Q_0Q1    : integer;
    Q_0Q01   : integer;
    Q_0Q001  : integer;
    Q_0Q0001 : integer;
begin
  if (Info.PixelType<>'BYTE') and (Info.PixelType<>'WORD') then with Info do
    begin
      Min        :=0;
      Min_20Q0   :=0;
      Min_10Q0   :=0;
      Min_1Q0    :=0;
      Min_0Q1    :=0;
      Min_0Q01   :=0;
      Min_0Q001  :=0;
      Min_0Q0001 :=0;
      Max        :=0;
      Max_20Q0   :=0;
      Max_10Q0   :=0;
      Max_1Q0    :=0;
      Max_0Q1    :=0;
      Max_0Q01   :=0;
      Max_0Q001  :=0;
      Max_0Q0001 :=0;
      Exit;
    end;
  PW:=Img;
  PB:=Img;
  for i:=0 to 65535 do Hist[i]:=0;
  if Info.PixelType='BYTE'
    then for i:=0 to Info.ImgWidth*Info.ImgHeight-1 do inc(Hist[PB^[i]]);
  if Info.PixelType='WORD'
    then for i:=0 to Info.ImgWidth*Info.ImgHeight*Info.Channels-1 do inc(Hist[PW^[i]]);
  Q_20Q0  :=round((Info.ImgWidth*Info.ImgHeight-Hist[InvalidVal])/5);
  Q_10Q0  :=round((Info.ImgWidth*Info.ImgHeight-Hist[InvalidVal])/10);
  Q_1Q0   :=round((Info.ImgWidth*Info.ImgHeight-Hist[InvalidVal])/100);
  Q_0Q1   :=round((Info.ImgWidth*Info.ImgHeight-Hist[InvalidVal])/1000);
  Q_0Q01  :=round((Info.ImgWidth*Info.ImgHeight-Hist[InvalidVal])/10000);
  Q_0Q001 :=round((Info.ImgWidth*Info.ImgHeight-Hist[InvalidVal])/100000);
  Q_0Q0001:=round((Info.ImgWidth*Info.ImgHeight-Hist[InvalidVal])/1000000);
  Info.Min        :=0;
  Info.Min_20Q0   :=0;
  Info.Min_10Q0   :=0;
  Info.Min_1Q0    :=0;
  Info.Min_0Q1    :=0;
  Info.Min_0Q01   :=0;
  Info.Min_0Q001  :=0;
  Info.Min_0Q0001 :=0;
  Info.Max        :=65535;
  Info.Max_20Q0   :=65535;
  Info.Max_10Q0   :=65535;
  Info.Max_1Q0    :=65535;
  Info.Max_0Q1    :=65535;
  Info.Max_0Q01   :=65535;
  Info.Max_0Q001  :=65535;
  Info.Max_0Q0001 :=65535;
  if (Info.ImgWidth*Info.ImgHeight=Hist[InvalidVal]) then Exit;
  sum:=0;
  for i:=InvalidVal+1 to 65535 do  // InvalidVal jsou chybejici data
    begin
      sum:=sum+Hist[i];
      if sum=0        then Info.Min       :=i+1;
      if sum<Q_20Q0   then Info.Min_20Q0  :=i;
      if sum<Q_10Q0   then Info.Min_10Q0  :=i;
      if sum<Q_1Q0    then Info.Min_1Q0   :=i;
      if sum<Q_0Q1    then Info.Min_0Q1   :=i;
      if sum<Q_0Q01   then Info.Min_0Q01  :=i;
      if sum<Q_0Q001  then Info.Min_0Q001 :=i;
      if sum<Q_0Q0001 then Info.Min_0Q0001:=i;
    end;

  sum:=0;
  for i:=65535 downto InvalidVal+1 do
    begin
      sum:=sum+Hist[i];
      if sum=0        then Info.Max        :=i;
      if sum<=Q_20Q0   then Info.Max_20Q0  :=i;
      if sum<=Q_10Q0   then Info.Max_10Q0  :=i;
      if sum<=Q_1Q0    then Info.Max_1Q0   :=i;
      if sum<=Q_0Q1    then Info.Max_0Q1   :=i;
      if sum<=Q_0Q01   then Info.Max_0Q01  :=i;
      if sum<=Q_0Q001  then Info.Max_0Q001 :=i;
      if sum<=Q_0Q0001 then Info.Max_0Q0001:=i;
    end;
end;


function LogLimFce(x,LinLimit,Limit : Cardinal) : word;
var y : double;
begin
  if x<=LinLimit then LogLimFce:=x else
    begin
      y:=LinLimit*(ln(x/LinLimit) + 1);
      if y<Limit
        then LogLimFce:=round(y)
        else LogLimFce:=Limit;
    end;
end;

function InvLogLimFce(x,LinLimit : Cardinal) : cardinal;
var y : double;
begin
  if x<=LinLimit then InvLogLimFce:=x else
    begin
      y:=exp((x/LinLimit)-1+ln(LinLimit));
      InvLogLimFce:=round(y);
    end;
end;


procedure LoadAndTransformPnh(var Info :TImgRec; var Img : pointer;
          ConvertToBits : integer);
var Name      : Pointer;
    ImageDx   : integer;
    ImageDy   : integer;
    i, n      : integer;
    P         : PWordArray;
    l, h, Pix : Cardinal;
begin
  P:=Img;
  GetMem(Name,Length(Info.FileName)+1);
  StrPCopy(Name,Info.FileName);
  n:=Info.ImgWidth*Info.ImgHeight;
  if Info.DataType='WORD' then
    begin
      ImageDx:=Info.ImgWidth;
      ImageDy:=Info.ImgHeight;
      load_png_gray16(Name,@Img,@ImageDx,@ImageDy,nil);
    end else
    begin
      ImageDx:=Info.ImgWidth;
      ImageDy:=2*Info.ImgHeight;
      load_png_gray16(Name,@Img,@ImageDx,@ImageDy,nil);
      for i:=0 to n-1 do
        begin
           l:=P^[i];
           h:=P^[i+n];
           Pix:=l or (h shl 16);
           Pix:=LogLimFce(Pix,LogLimit,65535);
           P^[i]:= Pix;
        end;
    end;
  Info.SwapBytes:=false;  
  FreeMem(Name);
end;

procedure LoadAndTransformImage(var Info :TImgRec; var Img : pointer; ConvertToBits : integer; AlocMem : boolean);
var f            : file;
    PB           : PByteArr;
    PW           : PWordArr;
    PS           : PSmallIntArr;
    PI           : PIntegerArr;
    PC           : PCardinalArr;
    i, j, siz, Q : integer;
    P1, P2, Buff : pointer;
    ext          : Ansistring;
    max, Min     : integer;
begin
  ext:=UpperCase(ExtractFileExt(Info.FileName));
  if (ConvertToBits=0)  then Info.PixelType:=Info.DataType else // zadna konverze
  if (ConvertToBits=8)  then Info.PixelType:='BYTE' else
  if (ConvertToBits=16) then Info.PixelType:='WORD' else
    begin
      Info.ok:=false;
      ShowMessage('Inavalid parameter ConvertToBits in procedure LoadAndTransformImage');
      Exit;
    end;
  if AlocMem then
    begin
      siz:=Info.ImgSize;
      if (Info.DataType='BYTE') and (ConvertToBits=16)
        then siz:=siz*2;
      if (Info.DataType='CARDINAL') or (Info.DataType='INTEGER')
        then siz:=siz*4;
      if (Img<>nil)  then
        begin
          FreeMem(Img);
          Img:=nil;
        end;
      if Img=nil then GetMem(Img,siz);
    end;
  if ext='.PNG' then LoadPNGImage(Info,Img)  else
  if (ext='.BMP') or (ext='.JPG') or (ext='.JPEG') then LoadBmpJpegImage(Info,Img) else
  if (ext='.PNH') then  LoadAndTransformPnh(Info,Img,ConvertToBits) else 
    begin
      System.Assign(f,Info.FileName);
      System.Reset(f,1);
      System.Seek(f,Info.HeaderSize);
      System.BlockRead(f,Img^,Info.ImgSize);
      System.Close(f);
    end;  
  {swapovani 16-bit datovych typu}
  if ((Info.DataType='WORD') or (Info.DataType='SMALLINT')) and Info.SwapBytes then
    begin
      PW:=Img;
      for i:=0 to Info.ImgWidth*Info.ImgHeight*Info.Channels-1 do PW^[i]:=swap(PW^[i]);
    end;
  {swapovani 32-bit typu Integer}
  if (Info.DataType='INTEGER') and Info.SwapBytes then
    begin
      PI:=Img;
      PW:=Img;
      Max:=round(Info.DataMax);
      Min:=round(Info.DataMin);
      for i:=0 to Info.ImgWidth*Info.ImgHeight*Info.Channels-1
        do PI^[i]:=round(Info.BScale*SwapInteger(PI^[i])-Info.BZero);

      for i:=0 to Info.ImgWidth*Info.ImgHeight*Info.Channels-1 do
        begin
          if PI^[i]>Max then PI^[i]:=Max;
          if PI^[i]<Min then PI^[i]:=Min;
        end;
      for i:=0 to Info.ImgWidth*Info.ImgHeight*Info.Channels-1
        do PW^[i]:=round(65534*(PI^[i]-Min)/(Max-Min))+1;
      Info.DataType:='WORD';
    end;
  {prevod smallint na word}
  if Info.FITS then Q:=round(Info.BZero) else Q:=32768;
  if (ConvertToBits<>0) and (Info.DataType='SMALLINT') then
    begin
      PS:=Img;
      PW:=Img;
      for i:=0 to Info.ImgWidth*Info.ImgHeight*Info.Channels-1 do
        begin
         j:=PS^[i];
         j:=j+Q;
         if j<0 then j:=0;
         if j>65535 then j:=65535;
         PW^[i]:=j;
        end;
    end;
  {oprava saturace pro HINODE SOT}
   if (Pos('HINODE',Info.Telescope)>0) and (Pos('SOT',Info.Instrument)>0) then
     begin
      PW:=Img;
      for i:=0 to Info.ImgWidth*Info.ImgHeight-1 do
        if PW^[i]=0 then PW^[i]:=4096;
     end;
  {prevod byte na word}
  if (ConvertToBits=16) and (Info.DataType='BYTE') then
    begin
      Info.BytesPerPixel:=Info.BytesPerPixel*2;
      PB:=Img;
      PW:=Img;
     // for i:=Info.ImgWidth*Info.ImgHeight*Info.Channels-1 downto 0 do PW^[i]:=PB^[i]*256;
      for i:=Info.ImgWidth*Info.ImgHeight*Info.Channels-1 downto 0 do PW^[i]:=PB^[i] shl 8 ;
    end;
   {prevod word na byte}
  if (ConvertToBits=8) and (Info.PixelType='WORD') then
    begin
      Info.BytesPerPixel:=Info.BytesPerPixel div 2;
      PB:=Img;
      PW:=Img;
      for i:=Info.ImgWidth*Info.ImgHeight*Info.Channels-1 downto 0 do PB^[i]:=PW^[i] div 256;
    end;
  {vert. prevraceni obrazu 8 bitoveho obrazu}
  if Info.VertFlip and (Info.PixelType='BYTE') then
    begin
      PB:=Img;
      GetMem(Buff,Info.ImgWidth*Info.Channels);
      for i:=1 to Info.ImgHeight div 2 do
        begin
          P1:=Addr(PB^[(i-1)*Info.ImgWidth*Info.Channels]);
          P2:=Addr(PB^[(Info.ImgHeight-i)*Info.ImgWidth*Info.Channels]);
          Move(P1^,Buff^,Info.ImgWidth*Info.Channels);
          Move(P2^,P1^,  Info.ImgWidth*Info.Channels);
          Move(Buff^,P2^,Info.ImgWidth*Info.Channels);
        end;
      FreeMem(Buff);
    end;
  {vert. prevraceni obrazu 16 bitoveho obrazu}
  if Info.VertFlip and ((Info.PixelType='WORD') or (Info.PixelType='SMALLINT')) then
    begin
      PW:=Img;
      GetMem(Buff,Info.ImgWidth*Info.Channels*2);
      for i:=1 to Info.ImgHeight div 2 do
        begin
          P1:=Addr(PW^[(i-1)*Info.ImgWidth*Info.Channels]);
          P2:=Addr(PW^[(Info.ImgHeight-i)*Info.ImgWidth*Info.Channels]);
          Move(P1^,Buff^,Info.ImgWidth*Info.Channels*2);
          Move(P2^,P1^,  Info.ImgWidth*Info.Channels*2);
          Move(Buff^,P2^,Info.ImgWidth*Info.Channels*2);
        end;
      FreeMem(Buff);
    end;
  {Logaritmovani}
  if (Info.Max>LogLimit) and (Info.DataType<>'CARDINAL') then
    begin
      PW:=Img;
       for i:=0 to Info.ImgWidth*Info.ImgHeight-1
         do PW^[i]:= LogLimFce(PW^[i],LogLimit,65535);
    end;
end;


function BooleanToStr(x : boolean) : Ansistring;
begin
  if x then BooleanToStr:='true' else BooleanToStr:='false';
end;

function RemoveComment(s : string) : Ansistring;
var n : integer;
begin
  n:=Pos('//',s);
  if n>0 then delete(s,n,256);
  RemoveComment:=s;
end;

function RemoveApostrophe(s : Ansistring) : Ansistring;
var i : integer;
begin
  for i:=1 to length(s) do
    if s[i]='''' then s[i]:=' ';
  RemoveApostrophe:=s;
end;

procedure GetInteger(s, Keyword : Ansistring; var value : integer);
var p1, p2, code : integer;
    cislo        : Ansistring;
begin
  s:=RemoveComment(s);
  s:=RemoveApostrophe(s); // kvuli TRACE
  if (Uppercase(Copy(s,1,Length(Keyword)+1))<>Uppercase(Keyword+' ')) then Exit;
  p1:=Length(Keyword)+1;
  p2:=Length(s);
  while s[p1]=' ' do inc(p1);
  while s[p2]=' ' do dec(p2);
  cislo:=Copy(s,p1,p2-p1+1);
  val(cislo,value,code);
  if code <> 0 then ImgError:=ImgError + chr(13) + Keyword + ' error';
end;

procedure GetDouble(s, Keyword : Ansistring; var value : double);
var p1, p2, code : integer;
    cislo        : Ansistring;
begin
  s:=RemoveComment(s);
  if (Uppercase(Copy(s,1,Length(Keyword)+1))<>Uppercase(Keyword+' ')) then Exit;
  p1:=Length(Keyword)+1;
  p2:=Length(s);
  while s[p1]=' ' do inc(p1);
  while s[p2]=' ' do dec(p2);
  cislo:=Copy(s,p1,p2-p1+1);
  val(cislo,value,code);
  if code <> 0 then ImgError:=ImgError + chr(13) + Keyword + 'error';
end;

procedure GetSingle(s, Keyword : Ansistring; var value : single);
var p1, p2, code : integer;
    cislo        : Ansistring;
begin
  s:=RemoveComment(s);
  if (Uppercase(Copy(s,1,Length(Keyword)+1))<>Uppercase(Keyword+' ')) then Exit;
  p1:=Length(Keyword)+1;
  p2:=Length(s);
  while s[p1]=' ' do inc(p1);
  while s[p2]=' ' do dec(p2);
  cislo:=Copy(s,p1,p2-p1+1);
  val(cislo,value,code);
  if code <> 0 then ImgError:=ImgError + chr(13) + Keyword + 'error';
end;

procedure GetString(s, Keyword : Ansistring; var txt : Ansistring);
var p1, p2 : integer;
begin
  s:=RemoveComment(s);
  if (Uppercase(Copy(s,1,Length(Keyword)+1))<>Uppercase(Keyword+' ')) then Exit;
  p1:=Length(Keyword)+1;
  p2:=Length(s);
  while (s[p1]=' ') and (Length(s)>p1) do inc(p1);
  while (s[p2]=' ') and (p2>1)         do dec(p2);
  if p1>=p2
    then
      begin
        txt:='';
        ImgError:=ImgError + chr(13) + Keyword + ' error';
      end
    else txt:=Copy(s,p1,p2-p1+1);
end;

procedure InitHeaderParam(var Info : TImgRec);
begin
  Info.ImgWidth   := 0;
  Info.ImgHeight  := 0;
  // pro FITS
  Info.BZero        := 0;
  Info.BScale       := 1;
  Info.DataMin      := 1;  // zvoleno aby Info.DataMax<Info.DataMin
  Info.DataMax      :=-1;  // zvoleno aby Info.DataMax<Info.DataMin
  Info.CenterX      :=-1;
  Info.CenterY      :=-1;
  Info.Rotation     := 0;
  Info.PixelSizeX   := 0;
  Info.PixelSizeY   := 0;
  Info.R_Sun        :=-1;
  Info.Wavelength   := 0;
  Info.Time         :='';
  Info.TimeObs      :='';
  Info.Telescope    :='';
  Info.Instrument   :='';
  Info.Detector     :='';
  Info.Filter       :='';
  Info.Polar        :='';
  Info.OccoulterX   := 0;
  Info.OccoulterY   := 0;
  Info.OccoulterR   :=-1;
  Info.Probe        :='';
  Info.Content      :='';
  Info.Exposure     :=-1;
  Info.ExpTotal     :=-1;
  Info.Zero         := 0;
  Info.Compress     :='';
  Info.VertFlip     :=false;
  Info.RGBsepatated :=false;
  // pro BIF
  ImgError          :='';
  Info.HeaderSize   :=-1;
  Info.Channels     :=-1;
  Info.DataType     :='';
 // Info.ByteOrder    :='PC';
  Info.OK           :=true;
end;

procedure GetHeaderParam(s : Ansistring; var Info : TImgRec);
begin
  // pro FITS
  GetInteger(s,'NAXIS1',Info.ImgWidth);
  GetInteger(s,'NAXIS2',Info.ImgHeight);
  GetDouble(s,'BZERO',Info.BZero);       // v SDO AIA chybi
  GetDouble(s,'BSCALE',Info.BScale);     // v SDO AIA chybi
  GetDouble(s,'DATAMIN',Info.DataMin);
  GetDouble(s,'DATAMAX',Info.DataMax);
  GetDouble(s,'CRPIX1',Info.CenterX);    // Levy pixel ma souradnici 1
  GetDouble(s,'CRPIX2',Info.CenterY);    // Dolni pixel ma souradnici 1
  GetDouble(s,'CROTA2',Info.Rotation);   // ve stupnich
  GetDouble(s,'CDELT1',Info.PixelSizeX);
  GetDouble(s,'CDELT2',Info.PixelSizeY);
  GetDouble(s,'R_SUN',Info.R_Sun);
  GetInteger(s,'WAVELNTH',Info.Wavelength);
  GetInteger(s,'WAVE_LEN',Info.Wavelength);
  GetString(s,'DATE-OBS',Info.Time);     // pro SDO
  GetString(s,'DATE_OBS',Info.Time);     // pro TRACE
  GetString(s,'TIME-OBS',Info.TimeObs);  // pro SOHO
  GetString(s,'TELESCOP',Info.Telescope);
  GetString(s,'INSTRUME',Info.Instrument);
  GetString(s,'DETECTOR',Info.Detector); // pro SOHO
  GetString(s,'FILTER',Info.Filter);     // pro SOHO
  GetString(s,'POLAR',Info.Polar);       // pro SOHO
  GetDouble(s,'OCC_X',Info.OccoulterX);  // pro SOHO
  GetDouble(s,'OCC_Y',Info.OccoulterY);  // pro SOHO
  GetDouble(s,'OCC_R',Info.OccoulterR);  // pro SOHO
  GetString(s,'OBSRVTRY',Info.Probe);
  GetString(s,'WAVE',Info.Content);      // pro Hinode
  GetString(s,'CONTENT',Info.Content);
  GetDouble(s,'SHT_MDUR',Info.Exposure); // pro TRACE
  GetDouble(s,'EXPTIME',Info.Exposure);  // pro SDO
  GetDouble(s,'EXP-TOT',Info.ExpTotal);  //pro sumu vice snimku
  GetInteger(s,'ZERO-VAL',Info.Zero);
  GetString(s,'COMPRESS',Info.Compress); // spececraft onboard compression
  // pro BIF
  GetInteger(s,'WIDTH',Info.ImgWidth);
  GetInteger(s,'HEIGHT',Info.ImgHeight);
  GetInteger(s,'HEADER',Info.HeaderSize);
  GetInteger(s,'CHANNELS',Info.Channels);
  GetString (s,'DATATYPE',Info.DataType);
end;


procedure GetFitsInfo(FileName : Ansistring; var Info: TImgRec; var HeaderMemo : TMemo; DisplayWarnings : boolean);
var f          : file;
    s          : AnsiString;
    i, n       : integer;
    space      : boolean;
    BitPix     : integer;
    NAxis      : integer;
    NAaxis3    : integer;
    FSize      : integer;
    FilterName : Ansistring;
    OrdType    : boolean;
    SgnType    : boolean;

begin
  HeaderMemo.Clear;
  System.Assign(f,FileName);
  System.Reset(f,1);
  FSize:=System.FileSize(f);
  s:='                                                                                            ';  //nesahat
  n:=0;
  NAxis:=0;
  NAaxis3:=0;
  BitPix:=0;
  InitHeaderParam(Info);
  repeat
    System.BlockRead(f,s[1],80);
    HeaderMemo.Lines.Add(s);
    s[9]:=' ';
    space:=false;
    for i:=11 to 80 do
      begin
        if (s[i]='/') and (s[i-1]=' ') then space:=true;
        if (s[i]='''') or space then s[i]:=' ';
      end;
    GetInteger(s,'NAXIS',NAxis);
    GetInteger(s,'NAXIS3',NAaxis3);
    GetInteger(s,'BITPIX',BitPix);
    GetHeaderParam(s,Info);
    inc(n);
  until eof(f) or (Pos('END',s)=1);
  System.Close(f);
  Info.OK:=true;
  Info.FileName:=FileName;
  Info.FITS:=true;
  {oprava pro SOHO}
  if (Pos('SOHO',Info.Telescope)>0) and (Pos('/',Info.Time)>0) then
    begin
      Info.Time[5]:='-';
      Info.Time[8]:='-';
      Info.Time:=Info.Time+'T'+Info.TimeObs;
    end;
  {pro STEREO}
  if Pos('STEREO',Info.Telescope)>0 then Info.Telescope:=Info.Probe;  
  {Parametry pro sesazeni}
  if (POS('SDO',Info.Telescope)>0) and (Info.PixelSizeX>0.00001) then
    begin
      Info.AlignRot:=RefRotation - Info.Rotation;
      Info.AlignMagn:=RefPixelSize/Info.PixelSizeX;
    end else
    begin
      Info.AlignRot:=0;
      Info.AlignMagn:=-1;
    end;
  {Oprava pro SDO AIA a vypocet geom. param. sesazeni}
  if (POS('SDO',Info.Telescope)>0) and (POS('AIA',Info.Instrument)>0)
      and (Pos('COMPOSED IMAGE',Info.Content)=0)  then
    begin
      Info.BScale:=1;
      Info.BZero:=100;
      Info.Zero:=100;
      Info.Telescope:='SDO';
    end;
   {Oprava pro SDO HMI - WL}
  if (POS('SDO',Info.Telescope)>0) and (POS('HMI_FRONT2',Info.Instrument)>0)
      and (Pos('CONTINUUM INTENSITY',Info.Content)>0) then
    begin
      Info.BScale:=1;
      Info.BZero:=32768;
      Info.Zero:=0;
      Info.Telescope:='SDO';
    end;
  {Oprava pro Proba2 SWAP}
  if POS('PROBA2',Info.Telescope)>0 then
    begin
      Info.BScale:=1;
      Info.BZero:=32768;
      Info.Zero:=0;
    end;
  {Oprava pro HINODE SOT}
  if (POS('HINODE',Info.Telescope)>0) and (POS('SOT',Info.Instrument)>0) then
    begin
      if (POS('WB',Info.Instrument)>0) then
        begin
          Info.BScale:=1;
          Info.BZero:=0;
          Info.Zero:=0;
        end;
      if (POS('NB',Info.Instrument)>0) then
        begin
          Info.BScale:=1;
          Info.BZero:=4096;
          Info.Zero:=0;
        end;
    end;
  {urceni zda je obraz barevny nebo BW, pokud je barevny, pak jak je ulozeny}
  if NAxis=2 then Info.Channels:=1 else
    if (NAxis=3) and (NAaxis3=3) then Info.Channels:=3 else
      begin
         Info.OK:=false;
         if DisplayWarnings then
           ShowMessage('FITS file '+ExtractFileName(FileName)+' is not a correct image file!');
      end;
  if (NAaxis3=3) then Info.RGBsepatated:=true else Info.RGBsepatated:=false;
  {urceni poctu bytu na pixel}
  Info.BytesPerPixel:=abs(BitPix) div 8;
  if (Info.BytesPerPixel<>1) and (Info.BytesPerPixel<>2) and (Info.BytesPerPixel<>4) then
    begin
      Info.OK:=false;
      if DisplayWarnings then
        ShowMessage('FITS file '+ExtractFileName(FileName)+' has unsupported pixel format!');
    end;
  {urceni datoveho typu}
  case BitPix of
     8 : Info.DataType:='Byte';     // Byte	     0..255                   Unsigned 8-bit
    16 : Info.DataType:='SmallInt'; // Smallint	-32768..32767	              Signed 16-bit
    32 : Info.DataType:='Integer';  // Integer	-2147483648..2147483647	      Signed 32-bit
    64 : Info.DataType:='Comp';     // Comp (64-bit integer)                  Signed 64-bit;
   -32 : Info.DataType:='Single';   // Single	1.5 x 10E-45 .. 3.4 x 10E38   Signed 32-bit
   -64 : Info.DataType:='Double';   // Double	5.0 x 10E-324 .. 1.7 x 10E308 Signed 64-bit
  end {case};
  Info.DataType:=UpperCase(Info.DataType);
  {urceni zda datovy typ je to ordinalni typ}
  if BitPix>0 then OrdType:=true else OrdType:=false;
  {urceni zda datovy typ ma znamenko}
  SgnType:=true;
  {urceni velikosti obrazu v bytech}
  Info.ImgSize:=Info.ImgWidth*Info.ImgHeight*Info.Channels*Info.BytesPerPixel;
  {u FITSu se musi swapovat byty}
  Info.SwapBytes:=true;
  {u FITSu se musi vert. prevratit obraz}
  Info.VertFlip:=true;
  {urceni velikosti hlavicky + kontrola velikosti souboru}
  if n mod 36 = 0
    then Info.HeaderSize:= 2880*(n div 36)
    else Info.HeaderSize:= 2880*(n div 36 + 1);
  if FSize-Info.HeaderSize-Info.ImgSize<0 then
    begin
      Info.OK:=false;
      if DisplayWarnings then
        ShowMessage('FITS file '+ExtractFileName(FileName)+' has incorrect file size!');
    end;
end;


procedure GetBifInfo(FileName : Ansistring; var Info: TImgRec; var HeaderMemo : TMemo; DisplayWarnings : boolean);
var t                 : TextFile;
    f                 : file;
    i, j, ImgFileSize : integer;
    s, ByteOrder      : Ansistring;
    SizX, SizY : integer;
begin
  InitHeaderParam(Info);
  System.Assign(t,FileName);
  System.Reset(t);
  ReadLn(t,s);
  if UpperCase(Copy(s,1,3))<>'BIF'
    then
      begin
        Info.OK:=false;
        if DisplayWarnings then ShowMessage('File '+ExtractFileName(FileName)+' is not a correct BIF image file!');
        System.Close(t);
        Exit;
      end;
   repeat
     ReadLn(t,s);
     GetHeaderParam(s,Info); // kompatibilita s FITS tagy

   until Eof(t) or (Pos('ENDBIF',UpperCase(s))<>0);
  System.Close(t);
  Info.FileName:=ExtractFileDir(FileName)+'\'+Info.FileName;
  if not FileExists(Info.FileName) then Info.FileName:=FileName;
  System.Assign(f,Info.FileName);
  System.Reset(f,1);
  ImgFileSize:=FileSize(f);
  System.Close(f);
  {test velikosti obrazu}
  if (Info.ImgWidth<=0) or (Info.ImgHeight<=0) then
    begin
      Info.OK:=false;
      if DisplayWarnings then ShowMessage('Incorrect image '+ExtractFileName(FileName)+' width or height!');
    end;
  {test Channels}
  if (Info.Channels<>1) and (Info.Channels<>3) then
    begin
      Info.OK:=false;
      if DisplayWarnings then ShowMessage('Image '+ExtractFileName(FileName)+': has unsupported number of channels');
    end;
  {test datoveho formatu}
  Info.DataType:=UpperCase(Info.DataType);
  if (Info.DataType<>'BYTE') and (Info.DataType<>'WORD') and (Info.DataType<>'SMALLINT') and (Info.DataType<>'SINGLE') then
    begin
      Info.OK:=false;
      if DisplayWarnings then ShowMessage('Image '+ExtractFileName(FileName)+': has unsupported data type');
    end;
  {urceni poctu bytu na pixel a velikosti obr. matice v bytech}
  Info.DataType:=UpperCase(Info.DataType);
  if Info.DataType='BYTE'     then Info.BytesPerPixel:=Info.Channels   else
  if Info.DataType='WORD'     then Info.BytesPerPixel:=Info.Channels*2 else
  if Info.DataType='SMALLINT' then Info.BytesPerPixel:=Info.Channels*2 else
  if Info.DataType='SINGLE'   then Info.BytesPerPixel:=Info.Channels*4;
  Info.ImgSize:=Info.ImgWidth*Info.ImgHeight*Info.BytesPerPixel;
  {urceni velikosti hlavicky - seek}
  if Info.HeaderSize<0 then Info.HeaderSize:=ImgFileSize-Info.ImgSize;
  if Info.HeaderSize<0 then
     begin
       Info.OK:=false;
       if DisplayWarnings then ShowMessage('Image '+ExtractFileName(FileName)+' has incorrect file size.');
     end;
  {zda se ma swapovat}
   ByteOrder:=UpperCase(ByteOrder);
   if ByteOrder='PC' then Info.SwapBytes:=false else Info.SwapBytes:=true;
   if (ByteOrder<>'PC') and (ByteOrder<>'MAC') then
     begin
       Info.OK:=false;
       if DisplayWarnings then ShowMessage('Image '+ExtractFileName(FileName)+' has ivalid information about byte order.');
     end;
end;


procedure GetMemoInfo(var HeaderMemo : TMemo; var Info: TImgRec);
var
    f                 : file;
    i, j, ImgFileSize : integer;
    s, ByteOrder      : Ansistring;
    SizX, SizY : integer;
begin
  InitHeaderParam(Info);
  s:=HeaderMemo.Lines[0];
  for i:=0 to HeaderMemo.Lines.Count-1 do
    begin
      s:=HeaderMemo.Lines[i];
      while Pos('''',s)>0 do delete(s,Pos('''',s),1); 
      GetHeaderParam(s,Info);
    end;
   if Info.DataType='WORD'
     then Info.ImgSize:=Info.ImgWidth*Info.ImgHeight*2;
   if Info.DataType='CARDINAL'
     then Info.ImgSize:=Info.ImgWidth*Info.ImgHeight*4;
   if (POS('SDO',Info.Telescope)>0) and (Info.PixelSizeX>0.00001) then
    begin
      Info.AlignRot:=RefRotation - Info.Rotation;
      Info.AlignMagn:=RefPixelSize/Info.PixelSizeX;
    end else
    begin
      Info.AlignRot:=0;
      Info.AlignMagn:=-1;
    end;
 end;

function DoubleToStr6(x : double) : Ansistring;
var s : Ansistring;
begin
  str(x:0:6,s);
  DoubleToStr6:=s;
end;


end.




