unit wErrors0;

{  Feel free to use this unit as you want.
   First developped by Bernard Gisin
   This is a unit to write in an independent window, errors messages.
   There are always parts of program, where normally, a condition must
   be satified,
   but we are never sure.
   For example, when memory becomes unavailable, many errors can occurs,
   which were not planned.

   There are three kind of errors :
   1) User errors, like :
     - No floppy disk, or write protected floppy disk.
     - Printer is off.
     - Tried to do an impossible task, like saving an unexistent window
     - ...
   2) System errors, like :
     - Not enough memory.
     - Handle was not created (Why)
     - Pointer = NIL, but it should not
   3) Programming errors, : A condition should be satisfied but is not. Ex. :
     - GetMem(ptr, -100);  ! negative number
     - Two variables should have the same value, but have not. (Why)
     - ...

   This unit treats the kind of errors  2  and  3.
   Errors 1 should open a dialog box, to notify the user that he did
   a little mistake, and can correct.

   ErrorWindow(...) should come to notify this kind of errors. It would
   open a dialog box to notify the error.

   Some errors could be either given in a dialog box, or in the error window.
   It should be up to the user to decide which kind of notification
   he wants.

   When you want to write an error message in the Errors window,
   do it this way :
   1) ErrorWrite(dwErrorNumber, msgError:word32; strMsg:ShortString)
      This skips a line, write 'Error Nr=' lErrorNumber, strMsg, at time & date
   2) ErrorComment(ErrorNumber:word32; strMsg:ShortString);
      This second line can be called 0, 1, 2, ... times.
      It adds information to the first error message.

   dwErrorNumber = a constant number defined in this unit.
   msgError      = a number describing the text message
                   which is stored in the external file  .msg
                   (this will come at the end of january 2002)
   strMsg = name of the unit . name of the method (=procedure)
            & additionnal information

   If (dwErrorNumber = 0) and (strMsg = '') then only the
   error window is opened, but nothing in written in it.

   If an error is just the continuation of another one, an you know
   that it has already been notified in the previous line, you can
   ommit the call to  ErrorWrite  and just add comments with  ErrorComment.

   The textlength of the window is limited to about 28'000 characters.
   It more is written in it, part of text in the middle will be deleted.
   But this would mean that an error occured too often.

   Masking error will be possible later.

   The position of the error window will be save in the  ErrorWin.prm  file,
   saved in the same directory as the  .exe  application file.
-----------------------------------------------------}

INTERFACE
//"""""""

uses wGlobals2, windows;

const  // Errors numbers

// Errors in wControl0.pp
ERR_TControl0                          = 100;
ERR_TControl0_Init_1                   = ERR_TControl0 + 1;
ERR_TControl0_Init_2                   = ERR_TControl0 + 2;
ERR_TControl0_Init_3                   = ERR_TControl0 + 3;

ERR_TControl0_CtrlCreate_1             = ERR_TControl0 + 4;
ERR_TControl0_CtrlCreate_2             = ERR_TControl0 + 5;
ERR_TControl0_CtrlCreate_3             = ERR_TControl0 + 6;
ERR_TControl0_CtrlCreate_4             = ERR_TControl0 + 7;

ERR_TControl0_CtrlWindowProc_1         = ERR_TControl0 + 8;

// Errors in wStatic0.pp
ERR_TStatic0                           = 500;
ERR_TStatic0_StaticCreate_1            = ERR_TStatic0 + 1;

// Errors in wEditBox0.pp
ERR_TEditBox0                          = 600;
ERR_TEditBox0_EditCreate_1             = ERR_TEditBox0 + 1;

// Errors in wRichText0.pp
ERR_TRichText0                         = 800;
ERR_TRichText0_RichEditCreate_1        = ERR_TRichText0 + 1;
ERR_TRichText0_SaveRICH_1              = ERR_TRichText0 + 2;
ERR_TRichText0_SaveRICH_2              = ERR_TRichText0 + 3;
ERR_TRichText0_LoadRICH_1              = ERR_TRichText0 + 4;
ERR_TRichText0_LoadRICH_2              = ERR_TRichText0 + 5;
ERR_TRichText0_GetClipboardRichTextLength_1 = ERR_TRichText0 + 6;
ERR_TRichText0_CtrlWindowProc_1        = ERR_TRichText0 + 7;

// Errors in wStatus0.pp
ERR_TStatus0                           = 2000;
ERR_TStatusLine0_StatusCreate_1        = ERR_TStatus0 + 1;

// Errors in wDialog0.pp
ERR_TDialog0                           = 2100;

// Errors in wApplication0.pp
ERR_TApplication0                        = 2100;
ERR_TApplication0_Run_1                  = ERR_TApplication0 + 1;
ERR_TApplication0_Run_2                  = ERR_TApplication0 + 2;

// Errors in wWindowBase0.pp
ERR_TWindowBase0                         = 2200;
ERR_TWindowBase0_Done_1                  = ERR_TWindowBase0 +1;
ERR_TWindowBase0_WMToAllChildren_1       = ERR_TWindowBase0 +2;
ERR_TWindowBase0_WindowDestroyAllChild_1 = ERR_TWindowBase0 +3;
ERR_TWindowBase0_AddChildObjectWindow_1  = ERR_TWindowBase0 +4;

// Errors in wWindow0.pp
ERR_TWindow0                             = 2300;

// Errors in wMDIWindow0.pp
ERR_TMDIWindow0                          = 2400;
ERR_TMDIWindow0_ClientWinProc_1          = ERR_TMDIWindow0 + 1;

// Errors in wHashTable2.pp
ERR_THashTableW2                         = 5100;
ERR_THashTableW2_Init_1                  = ERR_THashTableW2 + 1;
ERR_THashTableW2_IncreaseTableSizeW2_1   = ERR_THashTableW2 + 2;
ERR_THashTableW2_IncreaseTableSizeW2_2   = ERR_THashTableW2 + 3;
ERR_THashTableW2_AddPointerW2_1          = ERR_THashTableW2 + 4;

// Errors in wMenus0.pp
ERR_TMenu                                = 6000;
// all descriptions are made in the StandardEn.msg file.

procedure SetHeapErrorHandle;
//===========================
// Defines a new HeapError handler, from this library.

procedure SetExitProcHandle;
//==========================
// Sets a new exit procedure handler

procedure ERRSavePositionAndSize;
//===============================
{ Save in a text file the position and size of the error window,
  in order to restore the same position and size, at the next
  creation of the error window.
  Noramlly there is no reason to call it, since it is called
  automatically when the error window is closed, and
  when the application is terminated.
  ------------------------------------------------------------}

procedure ErrorWrite(dwErrorNumber:word32; strMsg:ShortString);
//=============================================================
{  This skips a line,
   write 'Error Nr=' lErrorNumber, strMsg, at time & date
   dwErrorNumber = a constant number defined in this unit.
   strMsg       = name of the unit . name of the method (=procedure)
                  & additionnal information
  ------------------------------------------------------------}

procedure ErrorComment2(dwErrorNumber:word32; strMsg:ShortString);
//================================================================
{  This procedure is normally called after the ErrorWrite procedure.
   It can be called 0, 1, 2, ... times.
   It adds information to the first error message.
  ------------------------------------------------------------}

procedure ErrorComment(dwErrorNumber:word32; strMsg:ShortString);
//===============================================================
// Same as ErrorComment2, but add  5  spaces before the message string

const
  gglstrErrorPathName : ShortString = '';
  // If this is set to a pathname, it is where the errors parameters
  // are being loaded and saved.

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

uses wDebug0, Strings;

var nUnused : integer; // to avoid error in DevPascal while compiling

const
  glcteAppName = 'ErrWin';

  // name of the file where parameters concerning the error window are stored
  glcteErrorFilename = 'ErrorWin.prm';

const
  glfRegistered : boolean = FALSE; // has the 'DebWin' window been registered ?
                                   // it has to be registered only once.
  glfPrmLoaded  : boolean = FALSE; // has the parameters been ridden ?
  glfInitDone   : boolean = FALSE; // has the error window been created ?

  // while initialisation is beeing done, cannot enter again in the
  // DBW0 procedure.
  glfWhileInit : boolean = FALSE;

type
  str200      = string[200];
  word32      = Cardinal;

var
  glhWindow   : HWnd; // handle on the error window
  glhEdit     : HWND;
  gllMask     // bits to be masked when wrinting in the error window
              : Cardinal;
  glnXPos,  glnYPos,  // X and Y position of the error window
  glnWidth, glnHeight // size of the error window
              : integer ;
  glstrFileName // name of the file where the texte is being saved
              : str200;
  glfShowMaskNumber // indicate if after the text, the mask number is displayed.
              : boolean;

var
  glpfHeapErrorHandler : pointer;
  glpfExitHandler      : pointer;

function HeapErrorHandle(lSize:word32):integer;
//==============================================
// To redefine the default  HeapError  funtion. see doc  prog.pdf p 64
// must call once  SetHeapErrorHandle.
type
  THeapErrorHandleFunction = function (lSize:word32):integer;
//  PHeapErrorHandleFunction = ^THeapErrorHandleFunction;
var
  nResult     : int32;
  Func        : THeapErrorHandleFunction;

begin
// defines that  Func  is a function to the normal memory handler
Func:=THeapErrorHandleFunction(glpfHeapErrorHandler);

// Calls the normal memory handler
nResult:=Func(lSize);

// Normally, nResult = 2.
if (nResult = 2) then begin
   // no errors, and allocation completed
   HeapErrorHandle:=2;
   exit;
   end;

// Here, an error occured.
// We can simply ignore it, or write info in the error window.
// but this could try to allocate memory, generating a Heap error !
ErrorWrite(2000000000, 'While trying to allocate memory with New or GetMem.');

// HeapErrorHandle:=0; // => returns a run time error
HeapErrorHandle:=1; // => New and GetMem return a nil pointer
                    // This is what would be suggested by default.
// HeapErrorHandle:=2; // => retries to allocate memory
end;  // HeapErrorHandle

procedure SetHeapErrorHandle;
//===========================
// Defines a new HeapError handler, from this library.
const  fFirst : boolean = TRUE; // security, such that entering a second time is harmless
begin
if (not fFirst) then exit;

fFirst:=FALSE;  // the next time, will exit immediatly

// Memorises the original Heap error handler
glpfHeapErrorHandler:=HeapError;

// defines the address of the new Heap Error handler.
HeapError:=@HeapErrorHandle;
end;  // SetHeapErrorHandle

procedure ExitProcHandle;
//=======================
// a new Exit procedure handler.
type
  TExitHandlerProc = procedure;
var
//  pMemExitProc : pointer;
  proc         : TExitHandlerProc;

begin
// three variables defined in the Free Pascal.
// Here it is the last moment before the program exits.
{
DBW0(1, 'do an exit. ExitCode=' + ITS(ExitCode));
DBW0(1, 'StackBottom = ' + ITS(StackBottom));
DBW0(1, 'LowestStack = ' + ITS(LowestStack));
DBW0(1, 'proc= ' + PTS(glpfExitHandler));
DBWaitSec(2); // wait before continuing.
}
if (glpfExitHandler <> NIL) then begin
   // gets the previous exit procedure
   proc:=TExitHandlerProc(glpfExitHandler);

   // call the previous exit procedure
   proc;
   end;
end;  // ExitProcHandle

procedure SetExitProcHandle;
//==========================
// Sets a new exit procedure handler
//
// See also ref.pdf  p 109,
// TExceptProc = procedure(Obj : TObject; Addr,Frame: Pointer);
// for unhandeled execptions...
//
const  fFirst : boolean = TRUE; // security, such that entering a second time is harmless
begin
if (not fFirst) then exit;
fFirst:=FALSE;  // the next time, will exit immediatly

glpfExitHandler:= ExitProc; // saves the standard ExitProc

ExitProc:=@ExitProcHandle; // Exit procedure handling of the library
end;  // SetExitProcHandle

function FileDir(strPath:str200):str200;
//======================================
{ Returns the directory part of the full Path name,
  with a  '\'  at the end.
  ----------------------------------------------------------------}
var
  nLen,       // length of strPath
  nLast,      // position of the last  '\'
  nn          : integer;
  strDir      // directory part of strPath
              : str200;
begin
nLen:=length(strPath);
nLast:=0;

// search the last occurence of '\' in the file full path name
for nn:=1 to nLen do if (strPath[nn] = '\') then nLast:=nn;

// copy the path part of the strPath
strDir:='';
for nn:=1 to nLast do strDir:=strDir + strPath[nn];

strDir:=strDir + '\';
FileDir:=strDir;
end;  // FileDir

procedure ERRSavePositionAndSize;
//==============================
{ Save in a text file the position and size of the error window,
  in order to restore the same position and size, at the next
  creation of the error window.
  ------------------------------------------------------------}
var
  fOut        : text;
  nErr        : integer;
  strDir,     // directory of the .exe file
  strS        : str200;

begin
if (gglstrErrorPathName <> '') then strS:=gglstrErrorPathName
else begin
   strS:=ParamStr(0); // directory and name of the .exe file
   strDir:= FileDir(strS);
   strS:=strDir + glcteErrorFilename;
   end;

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

nErr:=IOResult;
if (nErr <> 0) then exit;

writeln(fOut, '...Signature ErrorWindow');
writeln(fOut, 101); // Version number
writeln(fOut, glnXPos:6);
writeln(fOut, glnYPos:6);
writeln(fOut, glnWidth:6);
writeln(fOut, glnHeight:6);

writeln(fOut, gllMask:12);

writeln(fOut, ord(glfShowMaskNumber):6);  // 101

Close(fOut);
nErr:=IOResult;
{$i+}
end;  // ERRSavePositionAndSize

procedure LoadPositionAndSize;
//============================
{ Load from a file the position and size of the error window to be set }
var
  fIn         : text;
  nVersion,
  nErr        : integer;
  strDir,     // directory of the .exe file
  strS        : str200;

begin
// set the default position and site of the error window
glnXPos   :=600;
glnYPos   := 10;
glnWidth  :=200;
glnHeight :=550;
gllMask   :=0;
glfShowMaskNumber := TRUE;

{$i-}
if (gglstrErrorPathName <> '') then strS:=gglstrErrorPathName
else begin
   strS:=ParamStr(0); // directory and name of the .exe file
   strDir:= FileDir(strS);
   strS:=strDir + glcteErrorFilename;
   end;

assign(fIn, strS);
FileMode := 0;  // Set file access to read only
reset(fIn);
FileMode := 2;  // Set file access to read/write

nErr:=IOResult;
if (nErr <> 0) then exit; // file doesn't exist

readln(fIn, strS);  { signature }
readln(fIn, nVersion);

readln(fIn, glnXPos);
readln(fIn, glnYPos);
readln(fIn, glnWidth);
readln(fIn, glnHeight);

readln(fIn, gllMask);

if (nVersion >= 101) then readln(fIn, byte(glfShowMaskNumber));

Close(fIn);
nErr:=IOResult;
{$i+}

glfPrmLoaded:=TRUE;
end;  // LoadPositionAndSize

// ***********************************************************
// Saving and loading a new text in the error window
// ***********************************************************

function SelectFile(var strFName:str200; Open:Boolean): Boolean;
//==============================================================
const
  Filter      : PChar = 'Text files (*.txt)'#0'*.txt'#0 +
                        'All files (*.*)'#0'*.*'#0#0;
  Ext         : PChar = 'txt';
var
  NameRec     : OpenFileName;

begin
FillChar(NameRec,SizeOf(NameRec),0);
strFName := #0;
with NameRec do begin
   lStructSize := SizeOf(NameRec);
   hWndOwner   := glhWindow;
   lpStrFilter := Filter;
   LpStrFile   := @strFName[1];
   nMaxFile    := Max_Path;
   Flags       := OFN_Explorer Or OFN_HideReadOnly;
   if Open then begin
      Flags := Flags Or OFN_FileMustExist;
      end;

   lpStrDefExt := Ext;
   end; // with NameRec

if Open then SelectFile := GetOpenFileName(@NameRec)
else         SelectFile := GetSaveFileName(@NameRec);

// convert the lpz string into a pascal string
strFName[0]:=char(strlen(@strFName[1]));
end;  // SelectFile

procedure SaveText;
//=================
var
  lLen        : word32;
  pCh         : PChar;
  fOut        : File;
  strFName    : str200;

begin
if SelectFile(strFName,False) then begin
   Assign(fOut,strFName);
   Rewrite(fOut,1);
   lLen := GetWindowTextLength(glhEdit);
   GetMem(pCh,lLen+1);
   pCh[lLen] := #0;

   if (lLen > 0) then begin
      GetWindowText(glhEdit, pCh, lLen+1);
      BlockWrite(fOut, pCh^, lLen);
      end;

   Close(fOut);

   FreeMem(pCh, lLen+1);
   SendMessage(glhEdit, EM_SetModify, 0, 0);
   end;  // if
end;  // SaveText

procedure AskSave;
//================
const
  BoxType = MB_IconQuestion Or MB_YesNo;

begin
if SendMessage(glhEdit,EM_GetModify,0,0)<>0 then begin
   if MessageBox(glhWindow,'Save text?','Edited',BoxType)=IdYes then begin
      SaveText;
      end;
   end;
end;  // AskSave

procedure LoadText;
//=================
var
  fIn         : File;
  lLen        : word32;
  pCh         : PChar;
begin
AskSave;
if SelectFile(glstrFileName, TRUE) then begin
   Assign(fIn, glstrFileName);
   Reset(fIn,1);
   lLen := FileSize(fIn);
   GetMem(pCh, lLen+1);
   pCh[lLen] := #0;
   if (lLen > 0) then BlockRead(fIn, pCh^, lLen);
   Close(fIn);
   SetWindowText(glhEdit, pCh);
   SendMessage(glhEdit, EM_SetModify, 0, 0);
   FreeMem(pCh, lLen+1);
   end;
end;  // LoadText

procedure NewText;
//================
const
  Empty       : PChar = '';

begin
AskSave;
glstrFileName := 'Unsaved';
SendMessage(glhEdit, WM_SetText, 1, word32(Empty));
SendMessage(glhEdit, EM_SetModify, 0, 0);
end;  // NewText

// ************************************************
// WindowProc, Window creation and Edit creation
// ************************************************

function WindowProc(hWindow:HWND;AMessage:UINT;wPar:WPARAM;lPar:LPARAM):LRESULT; stdcall; export;
//================================================================================================
var
  rWndRect    : rect;
  lNrMenu     : word32;
  lNotiCode   : word32;
  hMenuWin        : hMenu;
  wCheck      : word;
  lPow2       : word32; // 2 power the mask to be toggled
  nCount      : integer; // to compute lPow2

begin
WindowProc := 0;
Case AMessage Of
//   WM_Close:begin end;
   WM_Destroy:begin  // last message before destruction
//     AskSave;
      DBSavePositionAndSize;
      glfInitDone:=FALSE;
      end;
   WM_SetFocus:begin
      SetFocus(glhEdit);
      end;
   WM_EraseBkgnd:begin
      Exit(1);
      end;
   WM_Size:begin
      GetClientRect(hWindow,@rWndRect);
      MoveWindow (glhEdit,0,0,rWndRect.Right,rWndRect.Bottom,False);

     // gets the actual position and size of the error window
     GetWindowRect(hWindow, rWndRect);
     glnXPos   :=rWndRect.left;
     glnYPos   :=rWndRect.top;
     glnWidth  :=rWndRect.right  - rWndRect.left;
     glnHeight :=rWndRect.bottom - rWndRect.top;
     end;
   WM_Move:begin
      GetClientRect(hWindow,@rWndRect);
      MoveWindow (glhEdit,0,0,rWndRect.Right,rWndRect.Bottom,False);

     // gets the actual position and size of the error window
     GetWindowRect(hWindow, rWndRect);
     glnXPos   :=rWndRect.left;
     glnYPos   :=rWndRect.top;
     glnWidth  :=rWndRect.right  - rWndRect.left;
     glnHeight :=rWndRect.bottom - rWndRect.top;
     end;
   WM_Command:begin
      lNotiCode := HiWord(WPar);
      Case lNotiCode of
         en_Change:begin //Editor has changed
         // do nothing
         end; // en_Change
      else begin //Menu item  (else of case lNotiCode of)
         lNrMenu := LoWord(WPar);
         Case lNrMenu Of
            101 : NewText;
            102 : LoadText;
            103 : SaveText;
            109 : PostMessage(hWindow,WM_Close,0,0);
            // a test
            111 : SendMessage(glhEdit, em_SetSel, 100000000, 100000000); // position the caret at the end of the text
            201 : SendMessage(glhEdit,WM_Undo,0,0);
            202 : SendMessage(glhEdit,WM_Cut,0,0);
            203 : SendMessage(glhEdit,WM_Copy,0,0);
            204 : SendMessage(glhEdit,WM_Paste,0,0);

            299 : begin // Toggle Show mask number
                  hMenuWin:=GetMenu(hWindow);
                  if (hMenuWin <> 0) then begin
                     glfShowMaskNumber:=not glfShowMaskNumber;
                     if glfShowMaskNumber then wCheck:=MF_CHECKED
                     else                      wCheck:=MF_UNCHECKED;

                     CheckMenuItem(hMenuWin, lNrMenu, MF_BYCOMMAND or wCheck);
                     end;
                  end;
            300..330 : begin // Toggle Show mask number
                  lPow2:=1;
                  nCount:=lNrMenu - 300;
                  while (nCount >= 1) do begin
                     lPow2:=2*lPow2;
                     dec(nCount);
                     end;

                  // lPow2 = 2 power  (lNrMenu - 300)

                  hMenuWin:=GetMenu(hWindow);
                  if (hMenuWin <> 0) then begin
                     if ((gllMask and lPow2) = 0) then begin
                        gllMask:=gllMask + lPow2;
                        wCheck:=MF_CHECKED;
                        end
                     else begin
                        gllMask:=gllMask - lPow2;
                        wCheck:=MF_UNCHECKED;
                        end;

                     CheckMenuItem(hMenuWin, lNrMenu, MF_BYCOMMAND or wCheck);
                     end;
                  end;
            401 : MessageBox( hWindow,'Help','Not implemented',
                              MB_OK Or MB_IconInformation);
            end; // Case lNrMenu Of
         end; // else of case lNotiCode of
         end; // Case lNotiCode of
      end; // WM_Command
{   WM_CtlColorEdit:begin
      SetTextColor(WPar,TheColor);
      Exit(GetSysColorBrush(COLOR_WINDOW));
      end;
}    end; // Case AMessage Of

WindowProc := DefWindowProc(hWindow, AMessage, wPar, lPar);
end;  // WindowProc

procedure WinCreate;
//==================
var
  hMenuWin        : hMenu;
  SubMenu     : hMenu;
  lPow2       : word32; // 2 power the mask to be toggled
  nCount      : integer; // to compute lPow2
  wCheck      : word;
  hWinActive  : HWND;  // handle on the active window

begin
// get the handle of the active window,
// to set it active again after the creation of the error window.
hWinActive:=GetActiveWindow;

glhWindow := CreateWindow (glcteAppName,'Errors Window',ws_OverlappedWindow,
                           glnXPos,glnYPos,glnWidth,glnHeight
                           ,0,0,MainInstance,NIL);
if (glhWindow <> 0) then begin
   hMenuWin := CreateMenu;
   SubMenu := CreateMenu;
   AppendMenu(Submenu,MF_STRING,101,'&New...');
   AppendMenu(Submenu,MF_STRING,102,'&Open...');
   AppendMenu(Submenu,MF_STRING,103,'&Save...');
//   AppendMenu(Submenu,MF_STRING,111,'Test &1...');
//   AppendMenu(Submenu,MF_STRING,112,'Test &2...');
   AppendMenu(Submenu,MF_SEPARATOR,0,NIL);
   AppendMenu(SubMenu,MF_String,109,'E&xit');
   AppendMenu(hMenuWin,MF_POPUP,SubMenu,'&File');

   SubMenu := CreateMenu;
   AppendMenu(SubMenu,MF_String,201,'&Undo'#8'Ctrl+Z');
   AppendMenu(Submenu,MF_SEPARATOR,0,NIL);
   AppendMenu(SubMenu,MF_String,202,'&Cut'#8'Ctrl+X');
   AppendMenu(SubMenu,MF_String,203,'&Copy'#8'Ctrl+C');
   AppendMenu(SubMenu,MF_STRING,204,'&Paste'#8'Ctrl+V');
   AppendMenu(hMenuWin,MF_POPUP,SubMenu,'&Edit');

   SubMenu := CreateMenu;
   AppendMenu(SubMenu,MF_String,299,'Toggle &Show mask number');
   AppendMenu(Submenu,MF_SEPARATOR,0,NIL);
   AppendMenu(SubMenu,MF_String,300,'&0 Toggle mask 1');
   AppendMenu(SubMenu,MF_String,301,'&1 Toggle mask 2');
   AppendMenu(SubMenu,MF_String,302,'&2 Toggle mask 4');
   AppendMenu(SubMenu,MF_String,303,'&3 Toggle mask 8');
   AppendMenu(SubMenu,MF_String,304,'&4 Toggle mask 16');
   AppendMenu(SubMenu,MF_String,305,'&5 Toggle mask 32');
   AppendMenu(SubMenu,MF_String,306,'&6 Toggle mask 64');
   AppendMenu(SubMenu,MF_String,307,'&7 Toggle mask 128');
   AppendMenu(SubMenu,MF_String,308,'&8 Toggle mask 256');
   AppendMenu(SubMenu,MF_String,309,'&9 Toggle mask 512');
   AppendMenu(SubMenu,MF_String,310,'&A Toggle mask 1024');
   AppendMenu(SubMenu,MF_String,311,'&B Toggle mask 2048');
   AppendMenu(SubMenu,MF_String,312,'&C Toggle mask 4096');
   AppendMenu(SubMenu,MF_String,313,'&D Toggle mask 8192');
   AppendMenu(SubMenu,MF_String,314,'&E Toggle mask 16384');
   AppendMenu(SubMenu,MF_String,315,'&F Toggle mask 32768');
   AppendMenu(SubMenu,MF_String,316,'&G Toggle mask 65536');
   AppendMenu(SubMenu,MF_String,317,'&H Toggle mask 131072');
   AppendMenu(SubMenu,MF_String,318,'&J Toggle mask 262144');
   AppendMenu(hMenuWin,MF_POPUP,SubMenu,'&Masks');

//   AppendMenu(hMenuWin,MF_STRING,401,'&Help');
   SetMenu(glhWindow, hMenuWin);
   ShowWindow(glhWindow, SW_SHOWNORMAL);

   // Sets the active window, the active one before creation of this window
   SetActiveWindow(hWinActive);

   // Sets the check marks in the Masks menu
   if glfShowMaskNumber then wCheck:=MF_CHECKED
   else                      wCheck:=MF_UNCHECKED;
   CheckMenuItem(hMenuWin, 299, MF_BYCOMMAND or wCheck);

   // check mark of each Toggle mask
   lPow2:=1;
   for nCount:=0 to 18 do begin
      // lPow2 = 2 power nCount
      if ((gllMask and lPow2) <> 0) then wCheck:=MF_CHECKED
      else                               wCheck:=MF_UNCHECKED;
      CheckMenuItem(hMenuWin, 300 + nCount, MF_BYCOMMAND or wCheck);

      lPow2:=2*lPow2;
      end; // for nCount
   end; // if (glhWindow <> 0) then begin
end;  // WinCreate

function WinRegister: Boolean;
//============================
var
  WindowClass : WndClass;

begin
with WindowClass do begin
   Style         := cs_hRedraw Or cs_vRedraw;
   lpfnWndProc   := WndProc(@WindowProc);
   cbClsExtra    := 0;
   cbWndExtra    := 0;
   hInstance     := system.MainInstance;
   hIcon         := LoadIcon (0,idi_Application);
   hCursor       := LoadCursor (0,idc_Arrow);
   hbrBackground := GetStockObject(GRAY_BRUSH);
   lpszMenuName  := NIL;
   lpszClassName := glcteAppName;
   end;

WinRegister := RegisterClass (WindowClass)<>0;
end;  // WinRegister

function EditCreate: HWnd;
//========================
const
  CS_Start    = WS_Child or WS_HScroll or WS_VScroll or ES_MultiLine or ES_Left;
  CS_Ex       = WS_EX_ClientEdge;
  EdiTText    : PChar = '';

var
  R     : TRect;
  TheLogFont            : TLogFont;
//  TheColor              : DWORD;
  TheFont               : HFont;

begin
GetClientRect(glhWindow,@R);
glhEdit:=CreateWindowEx( CS_Ex,'EDIT',EditText,CS_Start,0,0,
                         R.Right-R.Left,R.Bottom-R.Top,glhWindow,0,
                         MainInstance,NIL);
if (glhEdit <> 0) then begin
   //Set Courier new as default font
   with TheLogFont do begin
      lfHeight         := 0;                // Default logical height of font
      lfWidth          := 0;                // Default logical average character width
      lfEscapement     := 0;                // angle of escapement
      lfOrientation    := 0;                // base-line orientation angle
      lfWeight         := FW_NORMAL;        // font weight
      lfItalic         := 0;                // italic attribute flag
      lfUnderline      := 0;                // underline attribute flag
      lfStrikeOut      := 0;                // strikeout attribute flag
      lfCharSet        := DEFAULT_CHARSET;  // character set identifier
      lfOutPrecision   := OUT_DEFAULT_PRECIS;  // output precision
      lfClipPrecision  := CLIP_DEFAULT_PRECIS; // clipping precision
      lfQuality        := DEFAULT_QUALITY;     // output quality
      lfPitchAndFamily := DEFAULT_PITCH;    // pitch and family
      Strcopy(lfFaceName,'Courier New');    // pointer to typeface name string
      end; // with
//      TheColor := GetSysColor(COLOR_WINDOWTEXT);
      TheFont  := CreateFontIndirect(@TheLogFont);
      SendMessage(glhEdit,WM_SETFONT,TheFont,1);
      ShowWindow(glhEdit,SW_Show);
      UpdateWindow(glhEdit);
   end; // if

EditCreate := glhEdit;

// Sets the limit text size contained in the rich text control.
// by default it is about 30000 bytes.
// Cannot be set much higher
SendMessage(glhEdit, EM_SETLIMITTEXT, 0, 32760);
end;  // EditCreate

procedure OpenErrorWindow;
//========================
{ Opens the error window if necessary and
  Delete part of the middle of the text if more that 29000 characters
  are written in the window.
  ------------------------------------------------------------}
var
  lLen        : word32; // length of text in the edit control
begin
if (not glfInitDone) then begin
   glfWhileInit:=TRUE;

   // register the 'WinDeb' window if needed
   if (not glfRegistered) and (Not WinRegister) then begin
      MessageBox (0,'Register failed',NIL, mb_Ok);
      glfWhileInit:=FALSE;
      exit;
      end
   else begin
      glfRegistered:=TRUE;
      WinCreate;  // create the error window
      if (word32(glhWindow) = 0) then begin
         MessageBox (0,'WinCreate failed',NIL,MB_OK);
         glfWhileInit:=FALSE;
         exit;
         end
      else begin
         glhEdit := EditCreate; // create the Edit window, which is inside the error window
//         SetFocus(glhEdit); do not give the focus to the created debbuging window
         end;
      end;

   glfInitDone:=TRUE;
   glfWhileInit:=FALSE;
   end;

// if Edit buffer is full, empty some characters in the middle
lLen := GetWindowTextLength(glhEdit);
if (lLen > 28000) then begin
   // to delete, must be in read-write mode
   SendMessage(glhEdit, EM_SetReadOnly, 0 {0=Read-Write.}, 0);

   // select part of the text, delete it and goes to the end
   SendMessage(glhEdit, em_SetSel, 10000, 12000);
   SendMessage(glhEdit, wm_Clear, 0, 0);
   SendMessage(glhEdit, em_SetSel, -1, -1);

   // back to the original read-write state.
//   SendMessage(glhEdit, EM_SetReadOnly, integer(fReadOnly), 0);
   end;
end;  // OpenErrorWindow

function GetStrWeekOfDay(wDayOfWeek:word):ShortString;
//====================================================
begin
case wDayOfWeek of
   0 : GetStrWeekOfDay:='Sunday';
   1 : GetStrWeekOfDay:='Monday';
   2 : GetStrWeekOfDay:='Tuesday';
   3 : GetStrWeekOfDay:='Wednesday';
   4 : GetStrWeekOfDay:='Thursday';
   5 : GetStrWeekOfDay:='Friday';
   6 : GetStrWeekOfDay:='Saturday';
   7 : GetStrWeekOfDay:='Sunday';
   end;
end;  // GetStrWeekOfDay

procedure ErrorWrite(dwErrorNumber:word32; strMsg:ShortString);
//=======================================================================
{  This skips a line,
   write 'Error Nr=' lErrorNumber, strMsg, at time & date
   lErrorNumber = a constant number defined in this unit.
   strMsg       = name of the unit . name of the method (=procedure)
                  & additionnal information
  ------------------------------------------------------------}
var
  strS        : string[5];
  rTime       : SYSTEMTIME;

begin
if ((dwErrorNumber and gllMask) <> 0) then exit;

// cannot write info while the error window is beeing created
// cannot be reentered while creation is in process.
if glfWhileInit then begin MessageBeep(0); exit; end;

// Opens the window and clear text if necessary
OpenErrorWindow;

if (dwErrorNumber = 0) and (strMsg = '') then exit;  // noting is written.

// add the string at the end of the text
SendMessage(glhEdit, em_SetSel, 100000000, 100000000);

// Skip a line to have an empty line
strS:=#13 + #10 + #0;
SendMessage(glhEdit, em_ReplaceSel, 0, word32(@strS[1]));

GetSystemTime(@rTime);

// add return linfeed at the end of the string,
// plus #0 to indicate the end of the string
with rTime do
   strMsg:='Error Number (' + IntToStr(dwErrorNumber,0) + ') ' +
        strMsg + '  at ' +
        IntToStr(wHour,0) + ':' + IntToStr(wMinute,0) + '::' +
        IntToStr(wSecond,0) + ',  ' +
        GetStrWeekOfDay(wDayOfWeek) + ', the ' +
        IntToStr(wDay,0) + ' of ' + IntToStr(wMonth,0) + ' ' +
        IntToStr(wYear,0) + #13 + #10 + #0;

SendMessage(glhEdit, em_ReplaceSel, 0, word32(@strMsg[1]));
end;  // ErrorWrite

procedure ErrorComment2(dwErrorNumber:word32; strMsg:ShortString);
//================================================================
{  This procedure is normally called after the ErrorWrite procedure.
   It can be called 0, 1, 2, ... times.
   It adds information to the first error message.
  ------------------------------------------------------------}
begin
if ((dwErrorNumber and gllMask) <> 0) then exit;

// cannot write info while the error window is beeing created
// cannot be reentered while creation is in process.
if glfWhileInit then begin MessageBeep(0); exit; end;

// Opens the window and clear text if necessary
OpenErrorWindow;

if (dwErrorNumber = 0) and (strMsg = '') then exit;  // noting is written.

// add the string at the end of the text
SendMessage(glhEdit, em_SetSel, 100000000, 100000000);

// add return linfeed at the end of the string,
// plus #0 to indicate the end of the string
strMsg:=strMsg + #13 + #10 + #0;
SendMessage(glhEdit, em_ReplaceSel, 0, word32(@strMsg[1]));
end;  //  ErrorComment2

procedure ErrorComment(dwErrorNumber:word32; strMsg:ShortString);
//===============================================================
// Same as ErrorComment2, but add  5  spaces before the message string
begin
ErrorComment2(dwErrorNumber, '     ' + strMsg);
end;  //  ErrorComment

initialization
  LoadPositionAndSize;

finalization
  // To save the position, size etc. of the error window.
  // If it is not called here, these parameters will only be saved
  // when the error window is closed by the user.
  ERRSavePositionAndSize;


end. // unit wErrors0;
