unit IOGraphics; {nacita 8 a 16 bitove formaty}

interface

uses Graphics;

{podporovane pripony - velkymi pismeny}
const SupportedExtensions = '*.BIF;*.FIT;*.FTS;*.FITS;*.TIF;*.TIFF;*.PNG;*.BMP;*.JPG;*.JPEG;*.ACT';
      MaxImgSize=6000*4000; 

type  TImgRec = record
             // Obecne vlastnosti  obrazu nutne pro praci s obrazem -------------------------------------------
             FileName      : string;   // 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     : string;   // nemusi byt totozny s DataType, pokud byl obraz pri nacteni convertovan
             OK            : boolean;  // zda se podarilo korektne nacist obraz
             Error         : string;   // 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      : string;   // 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          : string;   // parametr pouzivany pouze formatem FITS
             Telescope     : string;   // parametr pouzivany pouze formatem FITS
             Instrument    : string;   // parametr pouzivany pouze formatem FITS
             R_Sun         : 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;
      TWColor   = record
                    R,G,B : word;
                  end;{record}
      TWColorArr    = array[0..MaxImgSize] of TWColor;
      PWColorArr    = ^TWColorArr;
      

procedure LoadImageFromFile(FileName : string; var Info :TImgRec; var Img : pointer;
              ConvertToBits : integer; AlocMem : boolean; DisplayWarnings : boolean);
// FileName        : nazev souboru
// 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
//                   (pokud jeste nebyl alokovan, musi byt Img=nil)
// 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 : string; var Info: TImgRec; DisplayWarnings : boolean);
procedure GetBifInfo(FileName : string; var Info: TImgRec; DisplayWarnings : boolean);
procedure GetImgInfo(FileName : string; var Info :TImgRec; DisplayWarnings : boolean);
procedure ComputeMaxMinWordByte(var Info :TImgRec; Img : pointer);
procedure ComputeMaxMinWordByteRoi(RoiL, RoiT, RoiW, RoiH : integer; var Info :TImgRec; Img : pointer);
procedure ComputeMaxMinWordByteCircle(var Info :TImgRec; Img : pointer);
procedure GetInteger(s, Keyword : string; var value : integer);
procedure GetDouble(s, Keyword : string; var value : double);
procedure GetSingle(s, Keyword : string; var value : single);
procedure GetString(s, Keyword : string; var txt : string);
procedure SaveFits(FileName : string; Img : PWordArr);


implementation

uses SysUtils, Dialogs, TIFformat, PNGformat, BMP_JPEGformat, Global;


var ImgError : string;

procedure GetImgInfo(FileName : string; var Info : TImgRec; DisplayWarnings : boolean);
var ext : string;
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,DisplayWarnings);
  if (ext='.BIF')                                  then GetBifInfo(FileName,Info,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);
end;

procedure LoadImageFromFile(FileName : string; var Info :TImgRec; var Img : pointer;
          ConvertToBits : integer;  AlocMem : boolean; DisplayWarnings : boolean);
var ext : string;
begin
  Info.OK:=false;
  Info.FileName:=' -';
  if not FileExists(FileName) then Exit;
  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,DisplayWarnings);
  if (ext='.BIF')                                  then GetBifInfo(FileName,Info,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 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-1;
      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;

procedure ComputeMaxMinWordByteRoi(RoiL, RoiT, RoiW, RoiH : integer; var Info :TImgRec; Img : pointer);
var Hist      : array[0..65535] of integer;
    i, j      : integer;
    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;
    ww        : 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;
  ww:=Info.ImgWidth;
  for i:=0 to 65535 do Hist[i]:=0;
  if Info.PixelType='BYTE' then
    for i:=RoiL to RoiL+RoiW-1 do
      for j:=RoiT to RoiT+RoiH-1 do inc(Hist[PB^[i+j*ww]]);
  if Info.PixelType='WORD' then
    for i:=RoiL to RoiL+RoiW-1 do
      for j:=RoiT to RoiT+RoiH-1 do inc(Hist[PW^[i+j*ww]]);
  if RoiW*RoiH=Hist[InvalidVal] then
    begin // kdyz cele ROI je neplatne 
      ComputeMaxMinWordByte(Info,Img);
      Exit;
    end;
  Q_20Q0  :=round((RoiW*RoiH-Hist[InvalidVal])/5);
  Q_10Q0  :=round((RoiW*RoiH-Hist[InvalidVal])/10);
  Q_1Q0   :=round((RoiW*RoiH-Hist[InvalidVal])/100);
  Q_0Q1   :=round((RoiW*RoiH-Hist[InvalidVal])/1000);
  Q_0Q01  :=round((RoiW*RoiH-Hist[InvalidVal])/10000);
  Q_0Q001 :=round((RoiW*RoiH-Hist[InvalidVal])/100000);
  Q_0Q0001:=round((RoiW*RoiH-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;
  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;
  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;
  sum:=0;
  for i:=65535 downto InvalidVal+1 do
    begin
      sum:=sum+Hist[i];
      if sum=0        then Info.Max       :=i-1;
      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;


procedure ComputeMaxMinWordByteCircle(var Info :TImgRec; Img : pointer);
var Hist     : array[0..65535] of integer;
    x, y     : integer;
    r, r_ROI : double;
    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;
  r_ROI:=1.15*Info.R_Sun;
  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
      begin
        x:=i mod Info.ImgWidth;
        y:=i div Info.ImgWidth;
        r:=sqrt(sqr(x-Info.CenterX)+sqr(y-Info.CenterY));
        if r>r_ROI 
          then inc(Hist[InvalidVal])
          else inc(Hist[PW^[i]]);
      end;
  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-1;
      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;


procedure LoadAndTransformImage(var Info :TImgRec; var Img : pointer; ConvertToBits : integer; AlocMem : boolean);
var f            : file;
    PB           : PByteArr;
    PW           : PWordArr;
    PS           : PSmallIntArr;
    i, j, siz, Q : integer;
    P1, P2, Buff : pointer;
    ext          : string;
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 Img<>nil then FreeMem(Img);
      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
    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;
  {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;
  {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];
    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;
end;


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

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

procedure GetInteger(s, Keyword : string; var value : integer);
var p1, p2, code : integer;
    cislo        : string;
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 GetDouble(s, Keyword : string; var value : double);
var p1, p2, code : integer;
    cislo        : string;
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 : string; var value : single);
var p1, p2, code : integer;
    cislo        : string;
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 : string; var txt : string);
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 GetFitsInfo(FileName : string; var Info: TImgRec; DisplayWarnings : boolean);
var f          : file;
    s          : AnsiString;
    i, n       : integer;
    space      : boolean;
    BitPix     : integer;
    NAxis      : integer;
    NAaxis3    : integer;
    FSize      : integer;
    FilterName : string;
    OrdType    : boolean;
    SgnType    : boolean; 

begin
  System.Assign(f,FileName);
  System.Reset(f,1);
  FSize:=System.FileSize(f);
  s:='                                                                                            ';  //nesahat
  n:=0;
  NAaxis3:=0;
  Info.BZero:=0;
  Info.BScale:=1;
  Info.DataMax:=-1;   // zvoleno aby Info.DataMax<Info.DataMin
  Info.DataMin:=1;
  FilterName:='';
  Info.CenterX:=0;
  Info.CenterY:=0;
  Info.CenterX:=-1;
  Info.CenterY:=-1;
  Info.Rotation:=0;
  Info.R_Sun:=-1;
  Info.Wavelength:=0;
  Info.Time:='';
  Info.Telescope:='';
  Info.Instrument:='';
  repeat
    System.BlockRead(f,s[1],80);
    s[9]:=' ';
    space:=false;
    for i:=11 to 80 do
      begin
        if s[i]='/' then space:=true;
        if (s[i]='''') or space then s[i]:=' ';
      end;
    GetInteger(s,'NAXIS',NAxis);
    GetInteger(s,'NAXIS1',Info.ImgWidth);
    GetInteger(s,'NAXIS2',Info.ImgHeight);
    GetInteger(s,'NAXIS3',NAaxis3);
    GetInteger(s,'BITPIX',BitPix);
    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);
    GetString(s,'DATE-OBS',Info.Time);
    GetString(s,'TELESCOP',Info.Telescope);
    GetString(s,'INSTRUME',Info.Instrument);
    inc(n);
  until eof(f) or (Pos('END',s)=1);
  System.Close(f);
  Info.OK:=true;
  Info.FileName:=FileName;
  Info.FITS:=true;
  {Oprava pro SDO AIA}
  if POS('SDO',Info.Telescope)>0 then
    begin
      Info.BScale:=1;
      Info.BZero:=100;
      Info.Zero:=100;
    end;
  {Oprava pro Proba2 SWAP}
  if POS('PROBA2',Info.Telescope)>0 then    
    begin
      Info.BScale:=1;
      Info.BZero:=32768;
      Info.Zero:=0;
    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 : string; var Info: TImgRec; DisplayWarnings : boolean);
var t                 : TextFile;
    f                 : file;
    i, j, ImgFileSize : integer;
    s, ByteOrder      : string;
    SizX, SizY : integer;
begin
  System.Assign(t,FileName);
  System.Reset(t);
  ImgError          :='';
  Info.FileName     :='';
  Info.ImgWidth     :=0;
  Info.ImgHeight    :=0;
  Info.HeaderSize   :=-1;
  Info.Channels     :=-1;
  Info.DataType     :='';
  ByteOrder         :='PC';
  Info.VertFlip     :=false;
  Info.RGBsepatated :=false;
  Info.BZero        :=0;
  Info.BScale       :=1;
  Info.OK           :=true;
  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);
     GetString(s,'FILENAME',Info.FileName);
     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);
     GetString (s,'BYTEORDER',ByteOrder);
   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;


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


procedure SaveFits(FileName : string; Img : PWordArr);
var HLine, Spaces    : string[80];
    Line             : PSmallintArr;
    l                : Smallint;
    s                : string;
    i, j, n, k, app  : integer;
    f                : file;
begin
  app:=(Info.ImgWidth*Info.ImgHeight*2) mod 2880;
  k:=Info.ImgWidth*2;
  if app>k then k:=app;
  GetMem(Line,k);
  n:=0;
  Spaces[0]:=chr(80);
  for i:=1 to 80 do Spaces[i]:=' ';
  System.Assign(f,FileName);
  System.Rewrite(f,1);
  HLine:=Spaces;
  Insert('SIMPLE  =                    T',HLine,1);
  System.BlockWrite(f,HLine[1],80);
  inc(n);
  HLine:=Spaces;
  Insert('BITPIX  =                   16',HLine,1);
  System.BlockWrite(f,HLine[1],80);
  inc(n);
  HLine:=Spaces;
  Insert('NAXIS   =                    2',HLine,1);
  System.BlockWrite(f,HLine[1],80);
  inc(n);
  HLine:=Spaces;
  str(Info.ImgWidth:4,s);
  Insert('NAXIS1  =                 '+s,HLine,1);
  System.BlockWrite(f,HLine[1],80);
  inc(n);
  HLine:=Spaces;
  str(Info.ImgHeight:4,s);
  Insert('NAXIS2  =                 '+s,HLine,1);
  System.BlockWrite(f,HLine[1],80);
  inc(n);
  HLine:=Spaces;
  Insert('BZERO   =              32768.0',HLine,1);
  System.BlockWrite(f,HLine[1],80);
  inc(n);
  HLine:=Spaces;
  Insert('BSCALE  =                  1.0',HLine,1);
  System.BlockWrite(f,HLine[1],80);
  inc(n);
  HLine:=Spaces;
  Insert('DATAMIN =                  0.0',HLine,1);
  System.BlockWrite(f,HLine[1],80);
  inc(n);
  HLine:=Spaces;
  Insert('DATAMAX =              65535.0',HLine,1);
  System.BlockWrite(f,HLine[1],80);
  inc(n);

  HLine:=Spaces;
  Insert('COMMENT =''NAFE 1.1 processed image, for detasils see:''',HLine,1);
  System.BlockWrite(f,HLine[1],80);
  inc(n);

  HLine:=Spaces;
  Insert('COMMENT =''M. Druckmuller 2013 ApJS 207 25 doi:10.1088/0067-0049/207/2/25''',HLine,1);
  System.BlockWrite(f,HLine[1],80);
  inc(n);

  HLine:=Spaces;
  Insert('DATE-OBS= '''+Info.Time+'''',HLine,1);
  System.BlockWrite(f,HLine[1],80);
  inc(n);
    HLine:=Spaces;
  Insert('TELESCOP= '''+Info.Telescope+'''',HLine,1);
  System.BlockWrite(f,HLine[1],80);
  inc(n);
  HLine:=Spaces;
  Insert('INSTRUME= '''+Info.Instrument+'''',HLine,1);
  System.BlockWrite(f,HLine[1],80);
  inc(n);
  HLine:=Spaces;
  Insert('WAVELNTH=                  '+IntToStr(Info.Wavelength),HLine,1);
  System.BlockWrite(f,HLine[1],80);
  inc(n);
  HLine:=Spaces;
  Insert('CRPIX1  =                  '+DoubleToStr6(Info.CenterX),HLine,1);
  System.BlockWrite(f,HLine[1],80);
  inc(n);
  HLine:=Spaces;
  Insert('CRPIX2  =                  '+DoubleToStr6(Info.CenterY),HLine,1);
  System.BlockWrite(f,HLine[1],80);
  inc(n);
  HLine:=Spaces;
  Insert('CROTA2  =                  '+DoubleToStr6(Info.Rotation),HLine,1);
  System.BlockWrite(f,HLine[1],80);
  inc(n);
  HLine:=Spaces;
  Insert('CDELT1  =                  '+DoubleToStr6(Info.PixelSizeX),HLine,1);
  System.BlockWrite(f,HLine[1],80);
  inc(n);
  HLine:=Spaces;
  Insert('CDELT2  =                  '+DoubleToStr6(Info.PixelSizeY),HLine,1);
  System.BlockWrite(f,HLine[1],80);
  inc(n);
  HLine:=Spaces;
  Insert('R_SUN   =                  '+DoubleToStr6(Info.R_Sun),HLine,1);
  System.BlockWrite(f,HLine[1],80);
  inc(n);
  HLine:=Spaces;
  Insert('END',HLine,1);
  System.BlockWrite(f,HLine[1],80);
  inc(n);
  n:=36-n;
  for i:=1 to n do System.BlockWrite(f,Spaces[1],80);
  for j:=Info.ImgHeight-1 downto 0 do
    begin
      for i:=0 to Info.ImgWidth-1 do
        begin
          n:=i+j*Info.ImgWidth;
          k:=Img^[n];
          k:=k-32768;
          l:=k;
          l:=swap(l);
          Line^[i]:=l;
        end;
      System.BlockWrite(f,Line^,Info.ImgWidth*2);
    end;
  FillChar(Line^,app,0);
  System.BlockWrite(f,Line^,app);
  System.Close(f);
  FreeMem(Line);
end;

end.
-------------------------------------------------------------------------------------------------------------


procedure LoadFits16ToWord(FileName : string; var BufferSize : integer; var ImgP  : PWordArr; Ovr : boolean);
var f             : file;
    i, n          : integer;
    x, y, range   : double;
    Info          : TImgRec;
    P1, P2, Buff  : pointer;
begin
  GetFitsInfo(FileName,Info,true);
  if not Info.OK then
    begin
      ShowMessage('Incorrect FITS file '+Info.FileName+'.');
      Exit;
    end;
  if (Info.BytesPerPixel<>2) or (Info.Chanels<>1) then
    begin
      ShowMessage('This FITS file is not 16 bit/pixel image!');
      Exit;
    end;
  if Ovr and ((ImgWidth<>Info.ImgWidth) or (ImgHeight<>Info.ImgHeight)) then
    begin
      OverlayLoaded:=false;
      ShowMessage('This image has different size than the current image!');
      Exit;
    end;
  ImgWidth:=Info.ImgWidth;
  ImgHeight:=Info.ImgHeight;
  System.Assign(f,Info.FileName);
  System.Reset(f,1);
  System.Seek(f,Info.HeaderSize);
  if (BufferSize<Info.ImgSize) then
    begin
      if Img<>nil then FreeMem(Img);
      if Dark<>nil then FreeMem(Dark);
      if Overlay<>nil then FreeMem(Overlay);
      GetMem(Img,Info.ImgSize);      // alokace pameti pro obraz
      GetMem(Dark,Info.ImgSize);     // alokace pameti pro dark frame pro flat
      GetMem(Overlay,Info.ImgSize);  // alokace pameti pro overlay
      BufferSize:=Info.ImgSize;
    end;
  System.BlockRead(f,ImgP^,Info.ImgSize);
  if Info.DataMax<Info.DataMin then // kdyz chybi v hlavicce DATAMAX a DATAMIN
    begin
      x:=swap(PSmallintArr(ImgP)^[0]);
      y:=Info.BScale*x + Info.BZero;
      Info.DataMax:=y;
      Info.DataMin:=y;
      for i:=1 to Info.ImgWidth*Info.ImgHeight-1 do
        begin
          x:=swap(PSmallintArr(ImgP)^[i]);
          y:=Info.BScale*x + Info.BZero;
          if y>Info.DataMax then Info.DataMax:=y;
          if y<Info.DataMin then Info.DataMin:=y;
        end;
      if Info.DataMax=Info.DataMin then Info.DataMax:=Info.DataMin+1;
    end;
  Range:=Info.DataMax-Info.DataMin;
  for i:=0 to Info.ImgWidth*Info.ImgHeight-1 do
    begin
      //ImgP^[i]:=Swap(ImgP^[i]) xor $8000;
      x:=swap(PSmallintArr(ImgP)^[i]);// + 32768;
      y:=Info.BScale*x + Info.BZero;
      if y<Info.DataMin then y:=Info.DataMin;
      if y>Info.DataMax then y:=Info.DataMax;
      ImgP^[i]:=round(65535*(y-Info.DataMin)/Range);
    end;
  System.Close(f);
  GetMem(Buff,ImgWidth*2);
  for i:=1 to ImgHeight div 2 do
    begin
      P1:=Addr(ImgP^[(i-1)*ImgWidth]);
      P2:=Addr(ImgP^[(ImgHeight-i)*ImgWidth]);
      Move(P1^,Buff^,ImgWidth*2);
      Move(P2^,P1^,ImgWidth*2);
      Move(Buff^,P2^,ImgWidth*2);
    end;
  FreeMem(Buff);
  if Ovr then OverlayLoaded:=true;



 // ImgWidth:=Info.ImgWidth;
 // ImgHeight:=Info.ImgHeight;
end;


end.

