unit wParamApplic2;

{ Feel free to use this unit as you want.
  First developped by Bernard Gisin

  To save and load parameters of an application, as for example
  the position and size of the main window.
  The file where the parameters are saved is a text file, saved
  in the same directory as the  .exe  file, with the same name as
  the  .exe  file, but with the extension  .prm
  ----------------------------------------------------------------}

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

INTERFACE
//"""""""

uses wStringDataLink2, wGlobals2;

type
  PParamApplic2 = ^TParamApplic2;
  TParamApplic2 = object
  //""""""""""""""""""""
  strEXEDir   // directory where the main application is. (the .exe directory)
              : ShortString;  // with the '\' at the end
  strEXEName  // filename of the application, without directory and extension
              : String[80];
  strEXEExt   // extension of the application = '.exe'
              : String[12]; // 12 is quite arbitrary.

  strParamPath : ShortString;
  // Complete pathname where the parameters are saved and loaded.

  // Information concerning the Hints popup window
  nHintStart,  // time in 1/10 sec after which the hints starts.
  nHintStop     // time in 1/10 sec after which the hints stops.
           : int32;  // put more that 20000 to never stop.
  colHintText : word32;
  colHintBack : word32;
  nHintDXPos,  // little positionning of the hint
  nHintDYPos,
  nHintDWidth,
  nHintDHeight : int32;

  fHintDraw    : boolean; // Show the hints ?

  // position, size and state of the main window.
  nMainWinLeft,
  nMainWinTop,
  nMainWinWidth,
  nMainWinHeight
              : int32;
  wMainWinSizeStateLoc : word32;

  // Memorise from the start of the program,
  // the width and Height in pixel of character
  wWidthPix_Ch, // mean character width
  wHeightPix_Ch, // max height of a line
  wScreenWidthPix,   // width of the screen in pixels
  wScreenHeightPix   // height of the screen in pixels
              : word;

  oSDL : TStringDataLink;
  // To a name of a window or dialog  (.strWindowName) will be associated
  // its position and size.
  // Thus, each time we reopen a dialog, it will come at the place it was
  // last time.
  // This is saved in a file (.sdl  for String Data Link)
  // at the same place where the .prm file is saved.

  constructor Init;
  destructor  Done; virtual;

  procedure GetNameParam( strS:ShortString;
                          var strNameV, strParamV:ShortString); virtual;
  // gets the identificator and the parameter sting which follows.
  // strNameV = '' if it's a comment or an empty line.
  // example, a line :
  // ParamPath = .\$_App.prm  // Path Name of the parameter file
  // Would return :
  // strNameV = 'PARAMPATH'
  // strParamV = ' .\$_App.prm'
  // with the leading spaces, if there are any.
  // without the ending spaces.
  // // are comments and are removed.
  // This is usually not overriden. Could be in the utilties.

  function Interpret(strS:ShortString):ShortString; virtual;
  // In the string  strS  interpret the signification of  *1  and  *2
  // and return the string with the following substitution
  // *1 is replaced by the applications directory, '\' included
  // Examples  'c:\'  or 'c:\FreePascal\Examples\'
  // *2 os replaced b the application's filename
  // Example  'tEx025' without any  '\'  or  '.'
  // This is usually not overriden.

  function LTrim(strS:ShortString):ShortString; virtual;
  // Return the string strS, with the leading spaces removed.
  // Could be in the utilties.

  procedure GetDirectoriesRead(var fIn:text); virtual;
  // Called from GetDirectories, after the filename has been opened.
  // This is usually not overriden

  procedure GetDirectories; virtual;
  // If the file  'filename.dir'  exist in the same directory as
  // the application's directory (the .exe one),
  // where 'filename' is the name of the application's file,
  // then it contains information about where parameters files
  // and messages files should be searched and saved.
  // This is usually not overriden

  procedure GetParamDirName(var strDirV,strNameV:ShortString); virtual;
  // Returns the directory where the parameters are stored,
  // with the "\" at the end.
  // and the filename, without entension (.prm)

  procedure SavePrmWrite(var fOut:text); virtual;
  // To save some parameters informations in the text file fOut
  // This is often overriden, see tEx006.pp for example

  procedure SavePrm; virtual;
  // Call from the TWindow0.WindowProc method at the Quit of the application
  // This is usually not overriden

  procedure LoadPrmRead(var fIn:text);  virtual;
  // To load some parameters informations from the text file fIn
  // This is often overriden, see tEx006.pp for example

  procedure LoadPrm; virtual;
  // Called from the TWindow0.Init method when creating the main window
  // This is usually not overriden

  end; // TParamApplic2 = object
  TParamApplic =  TParamApplic2;
  PParamApplic = ^TParamApplic;

// pointer to the application parameter, which saves for example
// the position and size of the main window.
const
  gglpoPrm : PParamApplic2 = NIL;

IMPLEMENTATION
//""""""""""""

Uses wMessages2, // only to have the gglstrMsgPathName  and  gglstrMsgDirectory  strings.
     wUtiles0, wErrors0, wDebug0;

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

constructor TParamApplic2.Init;
//=============================
var
  strPath : ShortString;
  fIn     : file;  // to test the existance of a file
//  nErr    : int32;

begin
// Later these parameters will be saved and loaded automatically in
// a parameter text file.

// Hints window, starting and stopping
nHintStart  := 4;
nHintStop   :=20;

// Colors for the hint.
colHintText :=0; // = RGB(0,0,0); (RGB not used, to not include the windows unit
colHintBack :=(196*int32(256) + 255)*int32(256) + 255; // =RGB(255, 255, 196);

// little positionning of the hint
nHintDXPos   := 2;
nHintDYPos   :=20;
nHintDWidth  := 6;
nHintDHeight := 4;

fHintDraw    :=TRUE; // by default, show the hints.

// position, size and state of the main window.
nMainWinLeft   := 10;
nMainWinTop    := 10;
nMainWinWidth  :=600;
nMainWinHeight :=400;
wMainWinSizeStateLoc :=0; // = SIZE_RESTORED; from windows

// Default pathnames for parameters files and messages files.
strPath:=ParamStr(0); // directory and name of the .exe file

oSDL.Init(''); // path name will be given while loading the parameters

// splits the application's pathname into its part
// and memorises it
FileSplit(strPath, strEXEDir,strEXEName,strEXEExt);

// Default pathname where the parameters are loaded and saved.
strParamPath:=strEXEDir + strEXEName + '.prm';

if (gglstrMsgPathName = '') then begin
   // Default pathname where the messages are stored.
   // do not change here. Maybe there are no messages associated with the progr.
   gglstrMsgPathName:=strEXEDir + strEXEName + '.msg';

   // If this file exist, then we suppose it's the application's
   // associated message file
   // Try to open it, just to see if it exists.
   {$i-}
   assign(fIn, gglstrMsgPathName);
   FileMode:=0;  { read only }
   reset(fIn);
   FileMode:=2;  { read / write }
   eof(fIn); // access the file, to see if it exists.

   if (IOResult <> 0) then gglstrMsgPathName:='' // file doesn't exist.
   else begin
      // The message file with the same name as the application exist.
      // By default, the directory of the other message file is the same.
      gglstrMsgDirectory:=strEXEDir;
      end;

   close(fIn);
   IOResult; // to clear IOErrors, if any

   // gglstrMsgPathName is probably the application's message file
   end;

// Memorise a global pointer on the application parameters
if (gglpoPrm = NIL) then gglpoPrm:=@Self;
end;  // TParamApplic2.Init

destructor  TParamApplic2.Done;
//=============================
begin
oSDL.Done;
end;  // TParamApplic2.Done

procedure  TParamApplic2.GetNameParam( strS:ShortString;
{====================================} var strNameV, strParamV:ShortString);
// gets the identificator and the parameter sting which follows.
// strNameV = '' if it's a comment or an empty line.
// example, a line :
// ParamPath = .\$_App.prm  // Path Name of the parameter file
// Would return :
// strNameV = 'PARAMPATH'
// strParamV = ' .\$_App.prm'
// with the leading spaces, if there are any.
// without the ending spaces.
// // are comments and are removed.
var
  nLen,
  nn          : integer;

begin
strNameV  :='';
strParamV :='';

nLen:=length(strS);
nn:=1;

// store the strNameV, skips the spaces, convert to uppercase
while (nn < nLen) and (strS[nn] <> '=') and
   ((strS[nn] <> '/') or (strS[nn+1] <> '/')) do begin
   if (strS[nn] <> ' ') then strNameV:=strNameV + UpCase(strS[nn]);
   inc(nn);
   end;

// if there is no '=' signe after it, then nothing is defined.
if (strS[nn] <> '=') then exit;

inc(nn);

// store the strParamV, don't skips the leading spaces.
while (nn <= nLen) and
   ((strS[nn] <> '/') or (nn = nLen) or (strS[nn+1] <> '/')) do begin
   strParamV:=strParamV + strS[nn];
   inc(nn);
   end;

// remove the spaces at the end, if there are any.
nLen:=length(strParamV);
nn:=nLen;
while (nn > 0) and (strParamV[nn] = ' ') do dec(nn);

if (nn < nLen) then strParamV:=Copy(strParamV, 1, nn);

end;  // TParamApplic2.GetNameParam

function TParamApplic2.Interpret(strS:ShortString):ShortString;
//=============================================================
// In the string  strS  interpret the signification of  *1  and  *2
// and return the string with the following substitution
// *1 is replaced by the applications directory, '\' included
// Examples  'c:\'  or 'c:\FreePascal\Examples\'
// *2 os replaced b the application's filename
// Example  'tEx025' without any  '\'  or  '.'
var
  nLen,
  nn          : integer;
  strOut      : ShortString;

begin
nLen:=length(strS);
nn:=1;

// store the interpreted string
strOut:='';

// Do the interpretation, and substitute the *1 and *2.
while (nn < nLen) do begin
   if (strS[nn] = '*') and (strS[nn+1] = '1') then begin
      strOut:=strOut + strEXEDir;
      inc(nn); // skip the '*1'

      // skip a '\' following the '*1', since one is already in the strEXEDir
      if (nn < nLen) and (strS[nn+1] = '\') then inc(nn);
      end
   else if (strS[nn] = '*') and (strS[nn+1] = '2') then begin
      strOut:=strOut + strEXEName;
      inc(nn); // skip the '*2'
      end
   else strOut:=strOut + strS[nn];

   inc(nn); // next char.
   end;

// nn > nLen, if strS is empty.
if (nn <= nLen) then strOut:=strOut + strS[nn]; // last character,

Interpret:=strOut;
end;  // TParamApplic2.Interpret

function TParamApplic2.LTrim(strS:ShortString):ShortString;
//=========================================================
// Return the string strS, with the leading spaces removed.
var
  nLen,
  nn          : integer;

begin
nLen:=length(strS);
nn:=1;

// Search the first non space character.
while (nn <= nLen) and (strS[nn] = ' ') do inc(nn);

LTrim:=Copy(strS, nn, nLen);
end;  // TParamApplic2.LTrim

procedure TParamApplic2.GetDirectoriesRead(var fIn:text);
//=======================================================
// Called from GetDirectories, after the filename has been opened.
var
  strName,    // identificator, like 'ParamPath' or 'ErrorPath'
  strParam,   // parameter string following.
  strS        : ShortString;

begin
{$i-}
while not eof(fIn) do begin
   readln(fIn, strS);

   // gets the identificator and the parameter sting which follows.
   // strName = '' if it's a comment or an empty line.
   GetNameParam(strS, strName, strParam);

   // open to write in the file where the .exe is changed in .prm
   // to save the position and size of the main window

   if (strName = 'PARAMPATH') then
      strParamPath:=Interpret(LTrim(strParam));

   if (strName = 'MSGPATH') then
      gglstrMsgPathName:=Interpret(LTrim(strParam));

   if (strName = 'MSGDIR') then
      gglstrMsgDirectory:=Interpret(LTrim(strParam));

   if (strName = 'ERRORPATH') then
      gglstrErrorPathName:=Interpret(LTrim(strParam));

   if (strName = 'DEBUGPATH') then
      gglstrDebugPathName:=Interpret(LTrim(strParam));
   end; // while not eof(fIn) do begin

end;  // TParamApplic2.GetDirectoriesRead

procedure TParamApplic2.GetDirectories;
//=====================================
// If the file  'filename.dir'  exist in the same directory as
// the application's directory (the .exe one),
// where 'filename' is the name of the application's file,
// then it contains information about where parameters files
// and messages files should be searched and saved.
// This is usually not overriden
var
  fIn        : text;
  nErr       : integer;
  strPath    : ShortString;

begin
// open to read from the file where the extension .exe is changed in .dir
// It this file exists, then loads the default directories to use.
strPath:=strEXEDir + strEXEName + '.dir';
{$i-}
assign(fIn, strPath);
FileMode:=0;  { read only }
reset(fIn);
FileMode:=2;  { read / write }

// Reads the directories where the parameters and messages files are stored.
GetDirectoriesRead(fIn);

close(fIn);
nErr:=IOResult; // ignore the errors
nErr:=nErr; // to avoid a Note
end;  // TParamApplic2.GetDirectories


procedure TParamApplic2.GetParamDirName(var strDirV,strNameV:ShortString);
//========================================================================
// Returns the directory where the parameters are stored,
// with the "\" at the end.
// and the filename, without entension (.prm)
var
  strEXEExtL   : String[12]; // 12 is quite arbitrary.
begin
// Put it at the same place as the parameters, but with another extension.
FileSplit(strParamPath, strDirV, strNameV, strEXEExtL);
end;  // TParamApplic2.GetParamDir

procedure TParamApplic2.SavePrmWrite(var fOut:text);
//==================================================
var nErr : integer;
begin
// Saves the position and size of the main window in the .prm file
{$i-}
writeln(fOut, '...Signature : Parameters of Application');
writeln(fOut, '...Signature : Size and Position');
writeln(fOut, 'Version = 102');
writeln(fOut, 'MAIN_POS_SIZE =', nMainWinLeft:6,   ' ', nMainWinTop:6, ' ',
                                 nMainWinWidth:6, ' ',  nMainWinHeight:6, ' ',
                                 wMainWinSizeStateLoc:6);  // 102
writeln(fOut, '...END : Parameters of Application');
// This last line is a mark for the begining of parameters of another section
// Thus other parameters can be added before this '...END' mark,
// it will not disturb reading the parameters of the main application

nErr:=IOResult; // ignore the errors, errors shouldn't occure if writing is alowed
nErr:=nErr; // to avoid a Note
end;  // TParamApplic2.SavePrmWrite

Procedure TParamApplic2.SavePrm;
//==============================
var
  fOut        : text;
  nErr        : integer;

begin
{$i-}
assign(fOut, strParamPath);
rewrite(fOut);

// Reads the parameters relevent for the library
// This is often overriden
SavePrmWrite(fOut);

close(fOut);
nErr:=IOResult; // ignore the errors
nErr:=nErr; // to avoid a Note
end;  // TParamApplic2.SavePrm

procedure TParamApplic2.LoadPrmRead(var fIn:text);
//================================================
var
  strName,    // identificator, like 'Version'
  strParam,   // parameter string following.
  strS        : ShortString;
  nVersion,  // version of the parameter file
  nErr,
  nSizeStateLoc,
  nLeft, nTop,
  nWidth, nHeight : int32;
  nEnd            : integer;

begin
{$i-}
readln(fIn, strS); // strS = '...Signature : Parameters of Application'
readln(fIn, strS); // strS = '...Signature : Size and Position'

readln(fIn, strS); // the version
GetNameParam(strS, strName, strParam);

if (strName = 'VERSION') then begin
   Val(LTrim(strParam), nVersion);
   end
else begin
   Val(strName, nVersion);
   end;

if (nVersion <= 101) then begin
   readln(fIn, nLeft, nTop, nWidth, nHeight);

   if (nVersion >= 101) then readln(fIn, nSizeStateLoc);
   end
else begin
   // newer way to save parameters.
   readln(fIn, strS);
   GetNameParam(strS, strName, strParam);  // here strName = 'MAIN_POS_SIZE'
   nLeft        :=GetIntValue(   1, strParam, nEnd);
   nTop         :=GetIntValue(nEnd, strParam, nEnd);
   nWidth       :=GetIntValue(nEnd, strParam, nEnd);
   nHeight      :=GetIntValue(nEnd, strParam, nEnd);
   nSizeStateLoc:=GetIntValue(nEnd, strParam, nEnd);
   end;

// skip everything till the signature of the end of the
// library parameters.
repeat
   readln(fIn, strS);
   until (strS = '...END : Parameters of Application') or eof(fIn);

nErr:=IOResult;

// If there are errors in the parameter file, cannot do anything.
if (nErr <> 0) then exit; // not normal

// Test abnormal positions and sizes
if (nMainWinWidth <= 10)   or (nMainWinHeight <= 10) or
   (nMainWinWidth > 10000) or (nMainWinHeight > 10000) or
   (nMainWinLeft <= 10 - nMainWinWidth) or
   (nMainWinTop  <= 10 - nMainWinHeight) then exit; // not normal

nMainWinLeft   :=nLeft;
nMainWinTop    :=nTop;
nMainWinWidth  :=nWidth;
nMainWinHeight :=nHeight;
if (nVersion >= 101) then wMainWinSizeStateLoc:=word32(nSizeStateLoc);
end;  // TParamApplic2.LoadPrmRead

Procedure TParamApplic2.LoadPrm;
//==============================
var
  fIn         : text;
  wError      : Word32;
  strEXEDirL  : ShortString;  // with the '\' at the end
  strEXENameL : String[80];
  strEXEExtL  : String[12]; // 12 is quite arbitrary.

begin
// Put the String - Data Link table in the same directery as the parameters,
// with the same filename, but with another extension.
FileSplit(strParamPath, strEXEDirL,strEXENameL,strEXEExtL);

oSDL.strPathName:=strEXEDirL + strEXENameL + '.sdl';
oSDL.SetupStringDataLink(wError); // I hope there are no errors.

// open to read the parameter's file.
// to load the position and size of the main window.
{$i-}
assign(fIn, strParamPath);
FileMode:=0;  { read only }
reset(fIn);
FileMode:=2;  { read / write }

// Reads the parameters relevent for the library
// This is often overriden
LoadPrmRead(fIn);

close(fIn);
wError:=IOResult; // ignore the errors
end;  // TParamApplic2.LoadPrm

End.  // unit wParamApplic2;

