{                            MGF v1.7 by F.Cheveau                           }

{Algorithme de transformation d'une image BMP en MGF par supression
des 16 premires couleurs de la palette sur une palette 256 couleurs.

(C)1996 F.Cheveau as Zuul as BouFFtou.

Lecture des donnes de l'image:
 - Stockage de la table des couleurs dans un tableau du nom de "TC".
 - Stockage des points du gfx dans un tableau en XMS du nom de "TP".

Description des variables locales utilises:

  A,B,C     : Boucles
  QttUsedCol: Nombre de couleurs utilises par l'image parmis les 16 premires
  QttFreeCol: Nombre de couleurs libres (non utilises) parmis les 255-16 de l'image
  QttC      : Nombre de couleurs de l'image BMP
  QttP      : Nombre de pixels de l'image BMP
  R1,G1,B1  : Valeurs RGB de la couleur 1
  R2,G2,B2  : Valeurs RGB de la couleur 2
  Coul1     : Variable de stockage du numro de couleur
  Coul2     : Variable de stockage du numro de couleur

Description des variables globales utilises:

  TC      : Array[0..QttC,0..2] of Integer;  : Tableau des couleurs : QttC = 255
  TCBusy  : Array[0..15] of Integer;    : Tableau des couleurs utilises par l'image parmis les 16 premires
  TCBusy2 : Array[16..QttC] of Integer; : Tableau des couleurs utilises par l'image parmis les 255-16 de l'image
  TP      : Array[0..QttP] of Integer;  : Tableau des couleurs : QttP = n
}

{****************************************************************************}
{***                                                                      ***}
{***                         A L G O R I T H M E                          ***}
{***                                                                      ***}
{****************************************************************************}

Program BMP_To_MGF;

Uses MOS_XMS,MOS_Crt,Dos;

{ΙΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ»
 Ί                       VARIABLES DECLAREES PAR ZUUL                        Ί
 ΘΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΌ}

Const  QttC = 255;                       {*Taille de la palette*}

Var
  Error    :Byte;                        {*Gestion des Erreur*}
  Par      :String;                      {*Gestion des Paramtres*}
  Source   :String;                      {*Nom du fichier Source*}
  Target   :String;                      {*Nom du fichier destination*}
  New_Target:String;                     {*Source Target pour RLE*}
  Rapport  :String;                      {*Nom du fichier de Rapport*}
  Fr       :Text;                        {*Fichier Rapport*}
  Fil1     :Text;                        {*Pour Travail RLE*}
  Path     :DirStr;
  Name     :NameStr;
  Ext      :ExtStr;
  Mode     :Byte;                        {*Mode de Modification de l'Image*}
  SDiff    :Longint;                     {*Somme des Min_Diff*}
  Force    :Byte;                        {*Forage du format de Sauvegarde*}
  NoMess   :Boolean;                     {*Pas d'affichage  l'cran*}
  Save_Info:Boolean;                     {*Save les Infos sur la Compression*}
{F}  Alias    :Boolean;                     {*Le nom Fichier Comporte des "*"*}
{F}  DirI     :SearchRec;                   {*Struct Dir Infos*}
{F}  Mask     :String;                      {*Masque Gnral pour Alias*}
  DoneOne  :Boolean;                     {*Trouve au Moins au Fichier avec Alias*}
  DN       :Boolean;                     {*Display Only Files Names*}
  FTag     :Boolean;                     {*Force la Tag de l'Image...*}
  TagOnly  :Boolean;                     {*Tag image Only*}
  A        :Integer;                     {*Loop*}
  Oui      :Boolean;                     {*Rponds OUI  toutes les quetions Poses*}
  CSuc     :Integer;                     {*Nombre de couleurs  Supprimer*}
  DejaConv :Boolean;                     {*Image dja au format MGF ???*}

  TC       :Array[0..QttC,0..3] of Byte; {*Couleurs RGB ???*}
  TCTag    :Array[0..QttC] of Integer;   {*Tableau des couleurs tagges*}

  QttP     :Longint;                     {*Taille de l'image*}

{ΙΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ»
 Ί                     VARIABLES DECLAREES PAR SYBARIS                       Ί
 ΘΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΌ}

Type bmpHeader=Record
       ID    : Array[1..2] of char;     { 'BM' for a Windows BitMaP }
       FSize : LongInt;  { Size of file }
       Ver   : LongInt;  { BMP version (?), currently 0 }
       Image : LongInt;  { Offset of image into file }
       Misc  : LongInt;  { Unknown, appears to be 40 for all files }
       Width : LongInt;  { Width of image }
       Height: LongInt;  { Height of image }
       Num   : Word;     { Not sure, possibly number of images or planes (1) }
       Bits  : Word;     { Number of bits per pixel }
       Comp  : LongInt;  { Type of compression, 0 for uncompressed, 1,2 for RLE }
       ISize : LongInt;  { Size of image in bytes }
       XRes  : LongInt;  { X dots per metre (not inches! for US, unbelievable!) }
       YRes  : LongInt;  { Y dots per metre }
       PSize : LongInt;  { Palette size (number of colors) if not zero }
       Res   : LongInt;  { Probably reserved, currently 0 }
     End;                { 54 bytes }

Type TPalette = Record
       b,g,r,x : Byte;   { BMP uses a fourth byte for the palette, not used }
     End;

Type Typ_buffer=array[1..1284] of byte;

Var F               : file;
    header          : BMPHeader;
    E               : Word;      {Erreur lors de la lecture }
    ScreenX,ScreenY : word;
    Colors          : longint;
    Compression     : Boolean;
    TAB_XMS         : TXMSArray;
    Buff            : ^typ_buffer;
    L,i,j           : Word;
    TQP             : Array[0..Qttc] of longint;{*Tableau des Quantits de Points*}
    Errorsyb        : Boolean;

{****************************************************************************}


{****************************************************************************}
{****************************************************************************}
{****************************************************************************}
{****************************************************************************}
{****************************************************************************}

Var BMPErreur:Byte;
{ 1 Erreur de lecture de la BMP   }
{ 2 BMP non RLE comprss         }
{ 3 BMP non 256 Couleurs          }
{ 4 Erreur durant la lecture et la convertion     }
{ 5 Erreur durant l'ecriture et la convertion     }
{ 6 Il est impossible au convertisseur RLE -> Non RLE de convertir cette bmp}
Procedure Rle_to_BMP(Source,Target:String);
VAR FS,FT:file;
    header : BMPHeader;
    Palette :Array[0..255] of TPalette;
    b1,b2,b3,i : Byte;
    fn:Array[0..63]Of Char;
    flg:boolean;
    s:string;
    ls:byte;
    s2:string;
    ls2:byte;

Procedure flush_add;
Var e:word;
begin
If bmperreur=0 then
  begin
  BlockWrite(FT,s,length(s),e);
  If e<>length(s) then bmperreur:=5;
  end;
end;

Procedure add(b:byte);
Var e:word;
begin
If bmperreur=0 then
  begin
  if ls=254 then
   begin
    BlockWrite(FT,s,254,e);
    If e<>254 then bmperreur:=5;
    ls:=0;
   end;
  s[ls]:=chr(b);
  inc(ls);
  end;
end;

Procedure get(var b:byte);
var er:integer;
begin
If bmperreur=0 then
  begin
  if ls2=254 then
    begin
    BlockRead(Fs,s2,254,er);
    ls2:=0;
    If (er<>254) and (ls2>=er) then bmperreur:=4;
    end;
  b:=ord(s2[ls2]);
  inc(ls2);
  end;
end;

Var e:word;

Begin
 flg:=false;ls:=0;ls2:=254;
 BMPErreur:=0;
 Assign(fS,Source);
 Assign(fT,Target);
 {$I-}
 Reset(fS,1);
 {$I+}
 If IOResult<>0 Then Begin BMPErreur:=1; Exit; End;
 {$I-}
 ReWrite(FT,1);
 {$I+}
 If IOResult<>0 Then BMPErreur:=1 Else
   Begin
   BlockRead(fS,header,54,e);
   If e<>54 then Bmperreur:=1;
   If header.comp=0 Then BMPErreur:=2 Else
   If (header.Bits<>8) and (header.Psize<>256) Then BMPErreur:=3 Else
     Begin
     if header.width mod 4 <>0 then
       begin
       Bmperreur:=6;
       Exit;
       end;
     header.comp:=0;
     BlockWrite(FT,header,54,e);
     If e<>54 then Bmperreur:=5;
     BlockRead(FS,Palette,Sizeof(Palette),e);
     If e<>Sizeof(Palette) then Bmperreur:=1;
     BlockWrite(FT,Palette,Sizeof(Palette),e);
     If e<>Sizeof(Palette) then Bmperreur:=5;

     While not( flg or (bmperreur<>0)) do
       Begin
       get(b1);
       If b1=0 then
         begin
         get(b1);
         If b1=1 then flg:=true else
           begin
           For i:=1 to b1 do
             begin
             get(b2);
             add(b2);
             end;
           if b1 mod 2=1 then get(b1);
           end;
         end else
         begin
         get(b2);
         For i:=1 to b1 do add(b2);
         end;
       End;
     End;
     flush_add;
   Close(FT)
   End;
 Close(FS);
End;

{****************************************************************************}
{****************** TEST SI L'IMAGE EST CRUNCHEE EN RLE *********************}
{****************************************************************************}

Function TEST_RLE(s:String):Byte;
Var header : BMPHeader;
    F:file;
{ 0 : Non Rle Compress }
{ 1 : Rle Compress }
{ 2 : Erreur de lecture }
Begin
 Assign(f,S);
 {$i-}
 Reset(f,1);
 If ioresult<>0 then
   begin
   Test_rle:=2;
   Exit;
   End;
 {$i+}
 Blockread(f,header,54);
 If ioresult<>0 then
   begin
   Test_rle:=2;
   Close(f);
   Exit;
   End;
 Close(f);
 If header.Comp=0 Then Test_RLE:=0 Else
 If header.Comp<>0 Then Test_RLE:=1;

End;

{****************************************************************************}
{****************************************************************************}
{****************************************************************************}
{****************************************************************************}
{****************************************************************************}

{ΙΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ»
 Ί                     LE CODE QUI SUIT EST DE SYBARIS                       Ί
 ΘΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΌ}

Procedure Load_Palette;
Var palette : TPalette;
    i,nBits : Word;
Begin
 If header.PSize=0 Then
  Case header.Bits Of
   1 : nbits:=2;  { These are the only valid bits in a BMP }
   4 : nbits:=16;
   8 : nbits:=256;
   24: nbits:=0;  { A 24 bit image does not have a palette }
  End else nbits:=header.PSize;
 For i:=0 To nbits-1 Do
  Begin
   BlockRead(f,palette,4);
   With Palette do If (I=0) And (R=70) And (G=71) And (B=77)
      Then DejaConv:=True;             {*Image dja au format MGF...*}
   TC[i,0]:=palette.r Shr 2;
   TC[i,1]:=palette.g Shr 2;
   TC[i,2]:=palette.b Shr 2;
  End;
End;

{ΙΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ»
 Ί                       LE CODE QUI SUIT EST DE ZUUL                        Ί
 ΘΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΌ}

{ΙΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ»
 Ί                           FONCTIONS DE SERVICES                           Ί
 ΜΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΉ
 Ί Gestion des strings, paramtres...                                        Ί
 ΘΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΌ}

Function UPPER(SUP:String):String;      {*Passe en Majuscules*}
Var I:Integer;
    ST1:String;
Begin
St1:=SUP;
For I:=1 to Length(ST1) do
ST1[I]:=Upcase(ST1[I]);
UPPER:=ST1;
End;

Function Parameter(Var St:String):Byte; {*Renvois le Paramtre Demand*}
Var A,PP:Integer;
    P:String;
Begin
Parameter:=0;                           {*De Base*}
For A:=1 to ParamCount do
   Begin
   P:=Upper(ParamStr(A)); St:=Upper(St);{*Passe tout en Majuscule*}
   If Pos(St,P)>0 Then Begin            {*Found Paramtre*}
      PP:=Pos('=',P);                   {*Search for Sous-Paramtre...*}
      If PP>0 Then St:=Copy(P,PP+1,Length(P)-PP+1);
      Parameter:=A;                     {*Renvois Numro Paramtre dans Liste*}
      End;
   End;
End;

Function TEST_FILE_EXIST(Name:String):Boolean;
Var Fichier:Text;
Begin
Test_File_Exist:=False;
If Name='' Then Exit;                {*Pas de noms de Fichier*}
Assign(Fichier,Name);
{$I-}
Reset(Fichier);
{$I+}
If IOResult=0 Then                   {*Pas d'erreurs*}
   Begin
   Test_File_Exist:=True;            {*Renvois Rsultat*}
   Close(Fichier);
   End
End;

{ΙΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ»
 Ί           FONCTION TEST_BMP(NameFile:string):boolean                      Ί
 ΜΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΉ
 Ί IN.....: Chemin et nom du fichier                                         Ί
 Ί OUT....: Renvoie true si il s'agit bien d'une image BMP lisible par Mos   Ί
 Ί          sinon renvoie false.                                             Ί
 Ί EXPLAIN: Permet de rpondre a la question : est-ce bien une image bmp?    Ί
 Ί          Si le fichier n'est pas trouv renvoie false                     Ί
 ΘΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΌ}

FUNCTION TEST_BMP(NameFile:string):Boolean;
Var  F : File;
     G : Array[1..2] of char;
     E : Word;
Begin
 If TEST_FILE_EXIST(NameFile) then
   Begin
   Assign(F,Namefile);
   {$i-}
   Reset(F, 1);
   {$i+}
   If ioresult=0 then
     Begin
     {$i-}
     Blockread(F, G, SizeOf(G),e);
     {$i+}
     If ioresult<>0 then
       Begin
       test_bmp:=false;
       Close(F);
       exit
       End;
     Close(F);
     If (e=Sizeof(g)) and ((UPPER(G)='BM')) then TEST_BMP:=true else TEST_BMP:=false;
     End else test_bmp:=false;
   End else test_bmp:=false;
End;

{ΙΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ»
 Ί                         CHARGEMENT DE L'IMAGE BMP                         Ί
 ΜΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΉ
 Ί IN.....: /                                                                Ί
 Ί OUT....: /                                                                Ί
 Ί EXPLAIN: Ouvre le fichier BMP et charge les couleurs et l'image dans des  Ί
 Ί          tableaux en mmoire XMS.                                         Ί
 ΘΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΌ}

Procedure LOAD_BMP;
Const Points='..............................';
var Correction:longint;

Begin
Source:=Path+Name+Ext;                         {*Cre le nom Source*}
If Not NoMess Then Write('Reading file ',Source,Copy(Points,1,20-Length(Source)),' ');
If Save_Info Then Write(Fr,'Reading file ',Source,Copy(Points,1,20-Length(Source)),' ');

{*Partie de code by Sybaris*}

 Assign(F,Source);
 {$i-}
 Reset(F, 1);
 {$i+}
 if ioresult=0 then
  begin
   {$i-}
   Blockread(F,header,SizeOf(header),E);
   {$i+}
   If (ioresult<>0) or (e<>Sizeof(header)) then
    begin
     close(f);                                 {*Pas le format BMP !!!*}
     If Not NoMess Then Writeln('This image is not in the BMP fomat...');
     If Save_Info  Then Writeln(Fr,'This image is not in the BMP fomat...');
     exit;
    end;
   With header DO
   begin
    If (ID='BM') or (ID='bm') then
     begin
     {*Correction d'erreur de taille*}
     If (header.bits=8) and (Filesize(f)<>54+1024+header.width*header.height) then
      begin
      If ((Filesize(f)-54-1024)-header.width*header.height) mod header.height=0 then
        begin
        Correction:=((Filesize(f)-54-1024)-header.width*header.height) div header.height;
        If Correction<4 then header.width:=header.width+correction
        Else write(^g); {*Taille d'image incorrecte !!!! *}
        end;
      End;
      ScreenX:=width;
      ScreenY:=height;
      Qttp:=ScreenX*ScreenY-1;
      If PSize=0 Then Case Bits Of
        1 : colors:=2;         { These are the only valid bits in a BMP }
        4 : colors:=16;
        8 : colors:=256;
        24: colors:=16777216;  { A 24 bit image does not have a palette }
      End else colors:=Psize;
      Compression:=header.comp<>0;
     end Else
        Begin                                  {*Mauvaise Entte de Fichier*}
        If Not NoMess Then Writeln('The file header of ',Source,' is not from a BMP...');
        If Save_Info  Then Writeln('The file header of ',Source,' is not from a BMP...');
        Exit;
        End;
   end;
   If Not NoMess Then Begin                    {*Affiche Infos sur l'Image*}
      TextColor(14); Writeln('Ok'); TextColor(7);
      Writeln('  ώ Image Width.................. ',ScreenX);
      Writeln('  ώ Image Height................. ',ScreenY);
      Writeln('  ώ RLE Compression.............. ',Compression);
      Writeln('  ώ Number of colors............. ',Colors);
      End;
   If Save_Info Then Begin
      Writeln(Fr,'Ok');
      Writeln(Fr,'  ώ Image Width.................. ',ScreenX);
      Writeln(Fr,'  ώ Image Height................. ',ScreenY);
      Writeln(Fr,'  ώ RLE Compression.............. ',Compression);
      Writeln(Fr,'  ώ Number of colors............. ',Colors);
      End;

   If (colors=256) and Not compression then
    begin
     {--------------}
       for i:=0 to Qttc do TQP[i]:=0;          { --> Initialisation des tableaux }
       Load_Palette;
       If Init_XMSArray(Tab_Xms,1,ScreenY,Buff^,1284) then
        Begin
         l:=0;
         Repeat
          inc(l);
          blockread(f,buff^,ScreenX,e);
          Put_XMSArray(Tab_xms,l,Buff^);
          For i:=1 to ScreenX do
           Begin
            inc(TQP[Buff^[i]]);                {*Compte le nombre de points pour Chaque Couleur*}
           End;
         Until l=ScreenY;
        End Else Begin
           ErrorSyb:=True;
           If Not NoMess Then Writeln('Not enought XMS memory to run correctly...');
           If Save_Info  Then Writeln(Fr,'Not enought XMS memory to run correctly...');
           End;
     {--------------}
    end else Begin                             {*Impossible de Traiter l'Image*}
       ErrorSyb:=True;
       If Not NoMess Then Begin
          If Compression Then Writeln('Cannot process a RLE compressed image...');
          If Colors<>256 Then Writeln('The graphic must have 256 colors and not ',Colors,' colors...');
          End;
       If Save_Info Then Begin
          If Compression Then Writeln(Fr,'Cannot process a RLE compressed image...');
          If Colors<>256 Then Writeln(Fr,'The graphic must have 256 colors and not ',Colors,' colors...');
          End;
       End;
  end
  else Begin
     TextColor(12);
     If Not NoMess Then Writeln('ERROR accessing file !');
     If Save_Info  Then Writeln(Fr,'ERROR accessing file !');
     TextColor(7);
     readln;
     Exit;
     End;

Close(f);
End;

{ΙΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ»
 Ί                         SAUVEGARDE DE L'IMAGE MGF                         Ί
 ΜΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΉ
 Ί IN.....: /                                                                Ί
 Ί OUT....: /                                                                Ί
 Ί EXPLAIN: Cr le fichier MGF contenant l'image retravaille.              Ί
 ΘΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΌ}

Procedure SAVE_MGF;
Const Points='..........................';
Var BmpFile:File;
    i,j:Word;
    Pal:Tpalette;
Begin
If Force=1 Then Begin                          {*Force la BMP*}
   If Not NoMess Then Writeln('Need to saving in................ BMP Format');
   If Save_Info Then Writeln(Fr,'Need to saving in................ Format BMP');
   End;
If Force=2 Then Begin                          {*Force la MGF*}
   If Not NoMess Then Writeln('Need to saving in................ Format MGF');
   If Save_Info Then Writeln(Fr,'Need to saving in................ Format MGF');
   End;

If SDiff>0 Then Begin
   If Save_Info Then Begin
      Writeln(Fr);
      Writeln(Fr,'Image has been altered resulting of a partial compression.');
      Writeln(Fr,'So, the image have a lower quality than previously...');
      If Force<>1 Then Writeln(Fr,'The image will be saved in MGF format');
      If Force<>1 Then Writeln(Fr,'for not overwrite the source image.');
      End;
   If Not NoMess Then Begin
      TextColor(15);
      Writeln;
      Writeln('Image has been altered resulting of a partial compression.');
      Writeln('So, the image have a lower quality than previously...');
      If Force<>1 Then Writeln('The image will be saved in MGF format');
      If Force<>1 Then Writeln('for not overwrite the source image.');
      TextColor(7);
      End;
   Target:=Path+Name+'.MGF';                   {*Crer le nom Destination*}
   End Else
   Target:=Path+Name+'.BMP';                   {*Crer le nom Destination*}

If Force=1 Then Target:=Path+Name+'.BMP';      {*Force la BMP*}
If Force=2 Then Target:=Path+Name+'.MGF';      {*Force la MGF*}

If (Not NoMess) And (Error>0) Then Begin
   Writeln; TextColor(12);
   Target:=Path+Name+'.ERR';                   {*Erreur dans l'Image*}
   Writeln('                         ! ATTENTION !');
   TextColor(15);
   If Error=2 Then Writeln('An Error is occured during the relocation of colors.');
   If Error=1 Then Writeln('An Error is occured during the compression of colors.');
   Writeln('The target image is probably dammaged.');
   Writeln('So, the image name will be : ',Target);
   If Save_Info Then Begin
      Writeln(Fr,'                         ! ATTENTION !');
      If Error=2 Then Writeln(Fr,'An Error is occured during the relocation of colors.');
      If Error=1 Then Writeln(FR,'An Error is occured during the compression of colors.');
      Writeln(Fr,'The target image is probably dammaged.');
      Writeln(Fr,'So, the image name will be : ',Target);
      End;
   End;

TextColor(7);
If Not NoMess Then Begin Writeln;
   Write('Writing file ',Target,Copy(Points,1,20-Length(Source)),' ');{*Affichage de l'criture*}
   End;

If Save_Info Then Begin Writeln(Fr); Write(Fr,'Writing file ',Target,Copy(Points,1,20-Length(Source)),' '); End;

{* CODE BY SYBARIS *}

Assign(BmpFile,Target);
Rewrite(BmpFile,1);
BlockWrite(BmpFile,Header,Sizeof(Header));
For i:=0 To Qttc Do
 Begin
  If I>=CSuc Then Begin                     {*Ne Sauve que les couleurs >=16*}
     TC[i,0]:=TC[i,0] Shl 2;
     TC[i,1]:=TC[i,1] Shl 2;
     TC[i,2]:=TC[i,2] Shl 2;
     End;
  Pal.r:=TC[i,0];                           {*Stocke dans la Structure Color*}
  Pal.g:=TC[i,1];
  Pal.b:=TC[i,2];
  BlockWrite(BmpFile,Pal,Sizeof(Pal));
 End;
{BlockWrite(BmpFile,TC,Sizeof(TC));}
For j:=1 to ScreenY do
 Begin
  Get_XMSArray(Tab_xms,j,Buff^);
  BlockWrite(BmpFile,Buff^,ScreenX);
 End;

{* CODE BY ZUUL *}

If Not NoMess Then Begin TextColor(14); Writeln('Ok'); TextColor(7); End;
If Save_Info Then Writeln(Fr,'Ok');
End;

{ΙΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ»
 Ί              AFFICHE INFOS SUR LA QTT DE PIXELS PAR COULEURS              Ί
 ΜΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΉ
 Ί IN.....: /                                                                Ί
 Ί OUT....: /                                                                Ί
 ΘΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΌ}

Procedure GESTION_PIXELS;                   {*Affiche Stats Sur Pixels*}
Var A:Integer;
    Min,Max:Longint;                        {*Qtt Min et Max des Points Utiliss*}
    CMin,CMax:Integer;                      {*Numro des Couleurs de Min et Max*}
Begin
Min:=TQP[0]; Max:=TQP[0];                   {*Init All*}
For A:=1 to QttC do Begin                   {*Parcours le Tableau*}
   If TQP[A]>Max Then Begin Max:=TQP[A]; CMax:=A; End;
   If TQP[A]<Min Then Begin Min:=TQP[A]; CMin:=A; End;
   End;

If Save_Info Then Begin
   Writeln(Fr);
   Writeln(Fr,'Less used color.................. ',CMin,' / Pixels = ',Min);
   Writeln(Fr,'More used color.................. ',CMax,' / Pixels = ',Max);
   End;
End;

{ΙΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ»
 Ί                  SAUVEGARDE DES INFOS SUR LA COMPRESSION                  Ί
 ΜΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΉ
 Ί IN.....: /                                                                Ί
 Ί OUT....: /                                                                Ί
 Ί EXPLAIN: Cr un fichier info contenant les dtails de la compression.    Ί
 ΘΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΌ}

Procedure CREATE_INFOS;
Var Ch:Char;
Begin
If Test_File_Exist(Rapport) Then Begin      {*Test si Fichier Existe Dja*}
   If Not NoMess Then Begin
      Write('The file ',Rapport,' exist, do you want to overwite it (Y/N) ? ');
      If Not OUI Then
         Repeat
         Ch:=Upcase(Readkey);               {*Oui ou Non*}
         Until (Ch='Y') Or (Ch='N')
         Else Ch:='Y';                      {*Rponds Oui de Base...*}
      Writeln(Ch);                          {*Affiche Rsultat*}
      End
      Else Ch:='Y';
   If Ch='N' Then Exit;                     {*Ecrase le Fichier*}
   End;

Save_Info:=True;                            {*Confiramtion Sauvegarde*}
Assign(Fr,Rapport);
{$I-}
Rewrite(Fr);                                {*Cration du Fichier de Rapport*}
{$I+}
If IOResult=0 Then Begin
   Writeln(Fr,'Image conversion report ',Path+Name+Ext);
   Writeln(Fr);
   End;
End;

{ΙΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ»
 Ί                         CONVERSION DE BMP EN MGF                          Ί
 ΜΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΉ
 Ί IN.....: /                                                                Ί
 Ί OUT....: /                                                                Ί
 Ί EXPLAIN: Convertit en mmoire l'image au format BMP en format MGF.        Ί
 Ί          La seule diffrence, rside dans le fait que le format MGF laisseΊ
 Ί          libre les 16 premires couleurs de la palette des 256.           Ί
 ΘΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΌ}

Procedure CONVERSION;
Var
  A,B          :Integer;
  QttUsedCol16 :Integer;
  QttUsedColOt :Integer;
  Coul1        :Integer;
  Coul2        :Integer;
  DR,DG,DB     :Longint;                    {*Delta des RGB pour Couleur Approchante*}
  MDR,MDG,MDB  :Longint;                    {*Minimum des Deltas des RGB*}
  Diff         :Longint;                    {*Coefficient DR+DG+DB*}
  Min_Diff     :Longint;                    {*Plus petit Coefficient*}
  CApp         :Integer;                    {*Indice de la couleur la plus Approchante*}
  Alter        :Boolean;                    {*ALtration de l'image ?*}

{****************** RELOCATION DES 16 PREMIERES COULEURS ********************}

Procedure RELOC_COLORS;
Var C,X,Y:Integer;
Begin
A:=0; B:=CSuc;                        {*Couleur 0 et N (16)*}
X:=WhereX; Y:=WhereY;                 {*Keep Pos de Dpart*}
Repeat
   If TCTag[A]>0 Then Begin
      Coul1:=A;                       {*Couleur  dplacer...*}
      Coul2:=0;
      While (B<256) And (Coul2=0) do Begin
         If TCTag[B]=0 Then Begin     {*Couleur Libre...?*}
            Coul2:=B;
            Gotoxy(X,Y); TextColor(15);     {*Show Result*}
            If Not NoMess Then Writeln(Coul1,' -> ',Coul2,'   ');
            If Save_Info Then Writeln(Fr,'Col ',Coul1:2,' -> Col ',Coul2,'   ');
            TC[Coul2,0]:=TC[Coul1,0];
            TC[Coul2,1]:=TC[Coul1,1]; {*Echange des deux Couleurs*}
            TC[Coul2,2]:=TC[Coul1,2];
            TCTag[Coul2]:=1;          {*Taggue la couleur B comme Utilise*}

            For j:=1 to ScreenY do    {*Parcours l'image*}
               Begin
               Get_XMSArray(Tab_xms,j,Buff^);
               for i:=1 to ScreenX do {*Remplace Couleur*}
                  If Buff^[i]=Coul1 then Buff^[i]:=Coul2;
               Put_XMSArray(Tab_xms,j,Buff^);
               End;

            End;
         Inc(B);                      {*Recherhe Couleur Libre*}
         End;
      If (B=256) And (A<=CSuc-1) Then Begin
         If Mode=2 Then Begin TextColor(12);  {*Red for ERRORS*}
            If Not NoMess Then Writeln('ERROR : Not enought free colors for relocation !');
            If Save_Info Then Writeln(Fr,'ERROR : Not enought free colors for relocation !');
            TextColor(7); Error:=2;   {*Erreur !*}
            End;
         TCTag[Coul1]:=2;             {*Taggue la couleur A pour Compression*}
         End
      Else TCTag[Coul1]:=1;           {*Taggue la couleur A comme Utilise*}
      End;
   Inc(A);                            {*Next Color*}
Until A>CSuc-1;                       {*Jusqu' la Nime Couleur ou Tableau Full*}
If Not NoMess Then Begin
   TextColor(14);Gotoxy(X,Y); Writeln('Ok                ');
   End;
TextColor(7);
End;

{************* COMPRESSION DES 16 PREMIERES COULEURS RESTANTES **************}

Procedure COMPRESS_COLORS;
Var A,B,C,X,Y:Integer;
Begin
A:=0; SDiff:=0;                       {*Begin by Couleur 0*}
X:=WhereX; Y:=WhereY;                 {*Keep Pos de Dpart*}
Repeat                                {*Recherche une Couleur Approchante*}
If TCTag[A]=2 Then                    {*Couleur  Dplacer ?*}
   Begin
   Coul1:=A;                          {*Oui ! C'est une Couleur  Dplacer !*}
   CApp:=-1; Min_Diff:=12289;         {*Maximum indpassable*}
   For B:=CSuc to QttC do Begin       {*Parcourir les 255-N(16) autres couleurs*}
       Coul2:=B;
       DR:=Abs((TC[Coul1,0]-TC[Coul2,0])*(TC[Coul1,0]-TC[Coul2,0]));
       DG:=Abs((TC[Coul1,1]-TC[Coul2,1])*(TC[Coul1,1]-TC[Coul2,1]));
       DB:=Abs((TC[Coul1,2]-TC[Coul2,2])*(TC[Coul1,2]-TC[Coul2,2]));
       Diff:=DR+DG+DB;                {*Calcul Coef Couleur Approchante*}
       If Diff<Min_Diff Then Begin
          Min_Diff:=Diff; CApp:=B;    {*Couleur la plus Approchante*}
          MDR:=Round(Sqrt(DR)); MDG:=Round(Sqrt(DG)); MDB:=Round(Sqrt(DB));
          End;                        {*Save Minimum des Delta RGB*}
      End;
   If CApp<>-1 Then Begin             {*Assimilation des deux Couleurs*}
      Gotoxy(X,Y); TextColor(15);     {*Show Result*}
      If Not NoMess Then Writeln(Coul1:2,' -> ',CApp,' - α = ',Min_Diff,'     ');
      If Save_Info Then Begin Write(Fr,'Col ',Coul1:2,' -> Col ',CApp:3,' - α = ',Min_Diff:3);
                        Writeln(Fr,'     Delta R=',MDR:2,'   Delta G=',MDG:2,'   Delta B=',MDB:2); End;
      SDiff:=SDiff+Min_Diff;          {*Somme des diffrences*}

      For j:=1 to ScreenY do          {*Parcours l'image*}
         Begin
         Get_XMSArray(Tab_xms,j,Buff^);
         for i:=1 to ScreenX do
            If Buff^[i]=Coul1 Then
               Begin
               Buff^[i]:=CApp;
               TCTag[Coul2]:=1;       {*Taggue la couleur comme Utilise*}
               End;
         Put_XMSArray(Tab_xms,j,Buff^);{*Refout le bordel en XMS*}
         End;

      End
      Else If Not NoMess Then Begin TextColor(12); Error:=1;
              If Not NoMess Then Writeln('ERROR : Replacing color not found !');
              If Save_Info Then Writeln(Fr,'ERROR : Replacing color not found !');
              TextColor(7);
              End;                    {*ERROR !*}
   End;
Inc(A);                               {*Next Color Parmis les N(16) Premires*}
Until A>CSuc-1;                       {*Parcours les N(16) Premires Couleurs*}
If Not NoMess Then Begin
   TextColor(14); Gotoxy(X,Y); Writeln('Ok                   ');
   TextColor(7); Write('Alteration coefficient........... ');
   TextColor(12); Writeln(SDiff);     {*Affiche Altration de l'image*}
   End;
If Save_Info Then Writeln(Fr,'Alteration coefficient........... ',SDiff);
End;                                  {*Fin de l'algo de Compression de Couleurs*}

{************************** MAIN CODE CONVERSION ****************************}

Begin
For A:=0 to QttC do TCTag[A]:=0;            {*Vide le tableau des couleurs utilises*}

For j:=1 to ScreenY do                      {*Recherche des couleurs utilises*}
   Begin
   Get_XMSArray(Tab_xms,j,Buff^);            {*Cette couleur est utilis par l'image !*}
   for i:=1 to ScreenX do TCTag[Buff^[i]]:=1;
   Put_XMSArray(Tab_xms,j,Buff^);
   End;

QttUsedCol16:=0;
QttUsedColOt:=0;
For A:=0 to QttC do                         {*Compte le nombre de couleurs utilises*}
   If TCTag[A]>0
      Then If A<=CSuc-1 Then Inc(QttUsedCol16)  {*Qtt de couleurs utilises dans les N(16) Premires*}
                    Else Inc(QttUsedColOt); {*Qtt de couleurs utilises dans les 256-N(16)*}

If Not NoMess Then Begin
   If CSuc<>16 Then Begin Write('Number of colors to purge........ '); TextColor(14); Writeln(CSuc); TextColor(7); End;
   Write('       Used colors (  0->',CSuc-1:3,').... '); TextColor(14); Writeln(QttUsedCol16); TextColor(7);
   Write('       Used colors (',CSuc:3,'->255).... '); TextColor(14); Writeln(QttUsedColOt); TextColor(7);
   Write('       Used colors (  0->255).... '); TextColor(14); Writeln(QttUsedCol16+QttUsedColOt); TextColor(7);
   Write('       Free colors (',CSuc:3,'->255).... '); TextColor(14); Writeln(256-CSuc-QttUsedColOt); TextColor(7);
   End;

If Save_Info Then Begin
   Writeln(Fr);
   Writeln(Fr,'Number of colors to purge........ ',CSuc);
   Writeln(Fr,'       Used colors (  0->',CSuc-1:3,').... ',QttUsedCol16);
   Writeln(Fr,'       Used colors (',CSuc:3,'->255).... ',QttUsedColOt);
   Writeln(Fr,'       Used colors (  0->255).... ',QttUsedCol16+QttUsedColOt);
   Writeln(Fr,'       Free colors (',CSuc:3,'->255).... ',256-CSuc-QttUsedColOt);
   End;

If QttUsedCol16=0 Then Begin                {*Pas besoin de modifier l'image !*}
   Mode:=1; Error:=3;
   If Not NoMess Then Begin Writeln; Write('No needs to modify something..... ');
      Textcolor(14); Writeln('Ok'); TextColor(7);
      If Save_Info Then Begin Writeln(Fr); Writeln(Fr,'No needs to modify something..... Ok'); End;
      End;
   End
   Else Begin                               {*Ncessite un traitement de l'image*}
   If 256-CSuc-QttUsedColOt<QttUsedCol16 Then {*Y-a-t'il suffisamment de couleurs libres ?*}
      Begin                                 {*NON ! => COMPRESSIONS DES COULEURS*}
      Mode:=3;
      If Not NoMess Then Write('Colors relocation................ ');
      If Save_Info Then Begin Writeln(Fr); Writeln(Fr,'Colors relocation................ Processed'); End;
      RELOC_COLORS;                         {*Relocation des Couleurs*}
      If Not NoMess Then Write('Colors compression............... ');
      If Save_Info Then Begin Writeln(Fr); Writeln(Fr,'Colors compression............... Processed'); End;
      COMPRESS_COLORS;                      {*Compression des Couleurs*}
      End                                   {*Fin de la Compression de Couleurs*}
      Else Begin                            {*OUI ! => TRANSFERT DES COULEURS*}
      Mode:=2;
      If Not NoMess Then Write('Colors relocation................ ');
      If Save_Info Then Begin Writeln(Fr); Writeln(Fr,'Colors relocation................ Processed'); End;
      RELOC_COLORS;                         {*Relocation des Couleurs*}
      End;                                  {*Fin du Transfert de Couleurs*}
   End;                                     {*Fin du Traitement de l'Image*}
End;

{***************** GESTION DE LA CONVERTION POUR UN FICHIER *****************}

Procedure CONVERT_ONE_FILE;
Begin
Error:=0;                                   {*Pas d'erreurs de Base*}
Errorsyb:=False;
DejaConv:=False;                            {*Image de base pas au format MGF*}

{============================}

Par:='/SI';
If Parameter(Par)>0 Then Begin              {*Sauvegarde des Infos*}
   If Par='/SI' Then Begin
      Rapport:=Path+Name+'.RAP';            {Nom automatique**}
      End Else Rapport:=Upper(Par);         {*Nom du Fichier de Rapport*}
   CREATE_INFOS;                            {*Sauvegarde les infos sur la compression*}
   End;

If Maxavail>=1284 then
   Begin
   New(Buff);
   End Else Begin
    If Not NoMess Then Writeln('Not enough conventional memory...');
    If Save_Info  Then Writeln(Fr,'Not enough conventional memory...');
    Exit;
    End;

Source:=Path+Name+Ext;                      {*Cre le nom Source*}
If TEST_RLE(Source)=1 Then                  {*RLE ?*}
   Begin
   If Not NoMess Then Begin
      Write('Decrunching RLE image............ ');
      TextColor(14); Writeln('Ok'); TextColor(7); Writeln;
      End;
   If Save_Info Then
      Begin
      Writeln(Fr,'Decrunching RLE image............ Ok');
      Writeln(Fr);
      End;
   RLE_to_BMP(Source,'TOTO.TMP');           {*Decrunch RLE BMP*}
   If bmperreur=6 then
     Begin
     Writeln;
     Writeln('Image can''t be converted in MGF, because this image is RLE compressed');
     Writeln('Use Pv to decompress it');
     Exit;
     End;
   Assign(Fil1,Source);
   Erase(Fil1);
   Assign(Fil1,'TOTO.TMP');                 {*Rename TMP as Original*}
   Rename(Fil1,Source);
   End;

LOAD_BMP;                                   {*Charge la BMP en Mmoire XMS*}
If ErrorSyb=True Then Exit;                 {*Erreur Grave Survenue !!!*}
If DejaConv=True Then Begin
   If Not NoMess Then Begin
      Writeln; TextColor(15);
      Write('Image is yet in the MGF format... ');
      TextColor(14); Writeln('Ok'); TextColor(7); Writeln;
      End;
   If Save_Info Then Begin Writeln(Fr); Writeln(Fr,'Image is yet in the MGF format... Ok'); End;
   End;

GESTION_PIXELS;                             {*Affiche Stats Sur Pixels*}

If Not TagOnly Then CONVERSION;             {*Appel de la procdure de conversion*}

TC[1,0]:=49; TC[1,1]:=46; TC[1,2]:=49;      {*Marque l'image Format MGF 1.1*}
TC[0,0]:=70; TC[0,1]:=71; TC[0,2]:=77;

If Not NoMess Then Writeln;                 {*Saute Une Ligne*}
If Save_Info Then Writeln(Fr);              {*Saute Une Ligne (Fichier)*}

If ((FTag) And (Error=3)) Or (TagOnly) Then {*Force Tag...*}
   Begin
   Error:=0;
   If Save_Info Then Writeln(Fr,'Force image tagging.............. Ok');
   If Not NoMess Then Begin
      Write('Force image tagging.............. ');
      TextColor(14); Writeln('Ok'); TextColor(7); End;
   End;

TextColor(7);
If (Save_Info) And (Error<>3) Then
   Begin Writeln(Fr,'Tag image with the MGF format.... Ok'); End;
If (Error<>3) And (Not NoMess) Then
   Begin Write('Tag image with the MGF format.... ');
   TextColor(14); Writeln('Ok'); TextColor(7); End;

If (Not NoMess) And (Save_Info) Then Begin
   TextColor(7);
   Write('Saving file...................... ');
   TextColor(14); Writeln(Rapport); TextColor(7);
   End;
If Save_Info Then Writeln(Fr,'Saving file...................... ',Rapport);

If Error=3 Then Begin
   If Save_Info Then Close(Fr);             {*Pas Besoin de Modifier l'Image*}
   Exit; End;

SAVE_MGF;

If Save_Info=True Then Close(Fr);           {*Ferme le Fichier d'informations*}
If NoMess Then Gotoxy(WhereX,WhereY-1);     {*Revient 1 ligne plus Haut*}

If Not Errorsyb Then End_XMSArray(Tab_xms);  {*Libre la mmoire XMS*}

Dispose(Buff);
TextColor(7); Writeln;
End;

{************************** PROGRAMME PRINCIPAL *****************************}

Begin
Oui:=False;
DN:=False;
CSuc:=16;                                   {*De base 16 Couleurs  Virer*}
FTag:=False;
TagOnly:=False;
DoneOne:=False;
{F}Alias:=False;
TextColor(7);

Par:='/NM';
If Parameter(Par)>0 Then NoMess:=True       {*Pas d'affichage  l'cran*}
                    Else NoMess:=False;

If Not NoMess Then Clrscr;                  {*Clear Screen*}

If Not NoMess Then Begin
   Writeln('BMP to MGF v1.7');
   Writeln('Image converter from BMP (256 colors) to BMP/MGF (240 colors) format');
   Writeln('(C)1996-97 F.Cheveau. 11.01.1999 - Phone: 04.68.50.77.15');
   Writeln('The MGF format is used by the MOS v2.8 Graphic Interface or higher.');
   Writeln;
   End;

Par:='/?';
If Parameter(Par)>0 Then Begin
   Source:=ParamStr(0);
   FSplit(Source,Path,Name,Ext);
   Writeln('Synopsis : ',Name,Ext,' <SourceFile> /Parameters');
   Writeln('           The source file must be a BMP 256 colors image.');
   Writeln('           RLE compressed images are supported.');
   Writeln('           Don''t need to specify files extentions. Alias supported.');
   Writeln;
   Writeln('Parameters : /FB           = Save file in the BMP format');
   Writeln('             /FM           = Save file in the MGF format');
   Writeln('             /FT           = Force image tagging');
   Writeln('             /TO           = Tag image only (no modifications)');
   Writeln('             /SI=<Name>    = Save informations during transformation');
   Writeln('             /NM           = Do not display screen messages');
   Writeln('             /DN           = Display only File Names');
   Writeln('             /Y            = Assumes YES on all queries');
   Writeln('             /C=<Quantity> = Number of colors to delete (Default = 16)');
   Exit;
   End;

Par:='/Y';
If Parameter(Par)>0 Then OUI:=True;         {*Rponds OUI  toutes les questions poses*}

Par:='/FT';
If Parameter(Par)>0 Then FTag:=True         {*Force le Taggage de l'Image...*}
                    Else FTag:=False;
Par:='/TO';
If Parameter(Par)>0 Then TagOnly:=True      {*Tag Image Only...*}
                    Else TagOnly:=False;
Par:='/C';
If Parameter(Par)>0 Then                    {*Spcifie le nombre de couleurs  Virer*}
   If Par<>'/C' Then Begin
      Val(Par,CSuc,A);
      If A<>0 Then Begin
         Writeln('You must specify exactly the number of colors to delete...');
         Exit;
         End;
      If (CSuc<0) Or (CSuc>255) Then Begin
         Writeln('The number of colors to delete must be beetween 0 and 255...');
         Exit;
         End;
      End;

Force:=0;                                   {*Pas de forage du format de Sauvegarde*}
Par:='/FB';
If Parameter(Par)>0 Then Force:=1;          {*Force Save to BMP*}
Par:='/FM';
If Parameter(Par)>0 Then Force:=2;          {*Force Save to MGF*}

Source:='';
For A:=1 to ParamCount do                   {*Rcupre le Nom du Fichier*}
   If Copy(ParamStr(A),1,1)<>'/' Then Source:=Upper(ParamStr(A));
If Source='' Then Begin                     {*Pas de Source Spcifie*}
   If Not NoMess Then Writeln('You must specify a BMP image file...');
   Exit;
   End;

If Pos('*',Source)>0 Then Alias:=True;      {*Il y a des "*" dans le Nom*}

FSplit(Source,Path,Name,Ext);
If Ext='' Then Ext:='.BMP';                 {*Vrifie l'extension*}
If (Not Test_File_Exist(Path+Name+Ext)) And (Not Alias) Then
   Begin                                    {*File Not Exist*}
   If Not NoMess Then Writeln('Unable to locate file ',Path+Name+Ext);
   Exit;
   End;

Par:='/DN';
If Parameter(Par)>0 Then
   Begin DN:=True; NoMess:=True; End;      {*Affiche uniquement les Noms*}

{**************************** GESTION DES ALIAS *****************************}

{F}If Alias Then                             {*Gre les Alias....*}
   Begin
   Mask:=Source;
   FindFirst(Mask,AnyFile,DirI);           {*Get First Name*}
   While DosError=0 do
      Begin
      Source:=DirI.Name;
      FSplit(Source,Path,Name,Ext);        {*Get File Name and Split It....*}
      DoneOne:=True;
      If Test_BMP(Source) Then
         Begin
         If DN Then
            Begin
            Write('Converting file.................. ');
            TextColor(14); Writeln(DirI.Name); TextColor(7);
            End
            Else Clrscr;                   {*Efface Screen... Plus Clean !*}

         CONVERT_ONE_FILE;                 {*Action sur le Fichier...*}
         End

         Else Begin                        {*File is not a BMP !*}
         Write('Skipping file (Not a BMP)........ ');
         TextColor(14); Writeln(DirI.Name); TextColor(7);
         End;

      FindNext(DirI);                      {*Next Name...*}
      End;
   If (Not DoneOne) And (Not NoMess) Then Writeln('No files "',Mask,'" found...');
   End
   Else CONVERT_ONE_FILE;                  {*Convertir un Fichier....*}
TextColor(7);
End.
