unit wMsgFileCreate2;

{ Feel free to use this unit as you want.
  First developped by Bernard Gisin
  This unit uses object programming to simplify the developpment
  of programs.

  This unit Creates a text message file '.msg'
  Which can then be used with the  GetMsg  procedure

  Maybe not very usefull.

  Not tested ... and mixed comment, french and english.
----------------------------------}

// To tell FreePascal that the application is a Graphical User Interface
// i.e. is running in windows, not in text mode.
{$APPTYPE GUI}

INTERFACE
//"""""""

{$i-}

Uses wGlobals2;

type
  PMsgFileCreate2 = ^TMsgFileCreate2;
  TMsgFileCreate2 = object
  //""""""""""""""""""""""
  strMSGFileName  : ShortString; { nom complet du fichier }
  fIsOpen         : boolean;  { indique si le fichier est ouvert }
  fOut            : text;     { fichier texte }
  pMsgFile1       : pointer;  { pointeur sur le fichier message,
                                utile pour le fermer. }

  constructor Init(strName:ShortString; var nErr:integer);
  { ouvre un fichier de message.
    Si strName ='', choisi le nom automatiquement }

  destructor Done; virtual;
  { Ferme le fichier de message si il est ouvert.
    Si flags = 0, efface le fichier. }

  procedure AddLine(wNum:word32; strS:ShortString);
  { Ajoute une ligne avec numéro initial.
    Si wNum = msgNext, le numéro n'est pas mis, ce qui permet d'ajouter
    des lignes blanches ou de commentaires. }

  procedure OpenMSGFile(nPos:integer; var nError:integer); virtual;
  { Si il est fermé, ne fait rien. Sinon
    ferme le fichier fOut, et l'ajoute au fichier des messages
    nPos = 0 => on the top, it will be the first one where a message
    number is search.
    nPos = big (=100) => on the bottom, it will be the last one where
    a message number will be search. It will first seach in
    all other opened messages files.
  ----------------------------------------------------------------}

  end; // TMsgFileCreate2 = object
  TMsgFileCreate =  TMsgFileCreate2;
  PMsgFileCreate = ^TMsgFileCreate;

IMPLEMENTATION
{""""""""""""}

Uses wMessages2, wDebug0;

var nNotUsed : integer; // only to avoid an error message while compliling in DevPascal 1.9

constructor TMsgFileCreate2.Init(strName:ShortString; var nErr:integer);
//======================================================================
{ ouvre un fichier de message.
  Si strName ='', choisi le nom automatiquement }
begin
pMsgFile1:=NIL;
strMSGFileName:=strName;

fileMode:=2; // Read / Write mode
assign(fOut, strMSGFileName);
rewrite(fOut);

nErr:=IOResult;

if (nErr <> 0) then begin
   fIsOpen:=FALSE;
   exit;
   end;

fIsOpen:=TRUE;
{ fOut est prêt en écriture }
end;  // TMsgFileCreate2.Init

destructor TMsgFileCreate2.Done;
//==============================
// Close the .msg file and erase it
var
  nErr             : integer;

begin
if (pMsgFile1 <> NIL) then CloseMsgPlaced(pMsgFile1, nErr);

{ efface le fichier .msg du disque }
assign(fOut, strMSGFileName);
erase(fOut);

{ efface l'index du fichier .msg du disque }
assign(fOut, strMSGFileName);
erase(fOut);

nErr:=IOResult;  { vide le IOResult }
fIsOpen:=FALSE;
end;  // TMsgFileCreate2.Done

procedure TMsgFileCreate2.AddLine(wNum:Word32; strS:ShortString);
//===============================================================
{ Ajoute une ligne avec numéro initial.
  Si wNum = msgNext, le numéro n'est pas mis, ce qui permet d'ajouter
  des lignes blanches ou de commentaires. }
begin
if not fIsOpen then exit;

if (wNum <> msgNext) then writeln(fOut, wNum:5, ' ', strS)
else writeln(fOut, strS);
end;  // TMsgFileCreate2.AddLine

procedure TMsgFileCreate2.OpenMSGFile(nPos:integer; var nError:integer);
//======================================================================
{ Si il est fermé, ne fait rien. Sinon
  ferme le fichier fOut, et l'ajoute au fichier des messages
  nPos = 0 => on the top, it will be the first one where a message
  number is search.
  nPos = big (=100) => on the bottom, it will be the last one where
  a message number will be search. It will first seach in
  all other opened messages files.
----------------------------------------------------------------}
begin
if not fIsOpen then exit;

Close(fOut);
fIsOpen:=FALSE;

pMsgFile1:=OpenMsgPlaced(strMSGFileName, nPos, 0, nError);
end;  // TMsgFileCreate2.OpenMSGFile


END. // wMsgFileCreate2
