{ Test of the unit wVariableNumLink2.pp  and  wErrors2.pp
  While developping a new unit, it's a good idea to test it specially.
  Simple and short test, but usefull to detect errors and
  to understand how some procedures (or methodes) works.
  --------------------------------------------}
program tEx028;

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

Uses
  Windows
 ,wApplication0
 ,wWindow0
 ,wMessages2
 ,wVariableNumLink2
 ,wErrors2
 ,wDebug0;

type
  PMyWindow = ^TMyWindow;
  TMyWindow = object(TWindow)
  //"""""""""""""""""""""""""
  constructor Init(strWinTitlePrm:ShortString);

  procedure MenuCreate; virtual;
  // Add a menu to the window

  procedure TestVariableNumLink1;
  // A test of the unit wVariableNumLink2.p

  procedure TestErrors2;
  // A test of wErrors2.pp

  // Handles the menu messages
  function WMCommand(wPar:WPARAM; lPar:LPARAM):LRESULT; virtual;

  function WindowProc(hWindow:HWND; wMsg:UINT; wPar:WPARAM; lPar:LPARAM):LRESULT; virtual;
  end; // TMyWindow = object(TWindow)

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

constructor TMyWindow.Init(strWinTitlePrm:ShortString);
//=====================================================
begin
inherited Init(strWinTitlePrm);
end;  // TMyWindow.Init

procedure TMyWindow.MenuCreate;
//=============================
var
  hSubMenu    : HMenu;
begin
hMenuWin := CreateMenu;
hSubMenu := CreateMenu;
AppendMenu(hSubmenu,MF_STRING,101,'&1 Test of wVariableNumLink2.pp');
AppendMenu(hSubmenu,MF_STRING,102,'&2 Test of wErrors2.pp');

AppendMenu(hSubmenu,MF_SEPARATOR,0,Nil);
AppendMenu(hSubmenu,MF_STRING,100,'&Open debug window');
AppendMenu(hSubmenu,MF_SEPARATOR,0,Nil);
AppendMenu(hSubMenu,MF_String, 200, 'E&xit');
AppendMenu(hMenuWin, MF_POPUP, hSubMenu, '&File');

hSubMenu := CreateMenu;
AppendMenu(hSubMenu,MF_String, 401, '&Info...');
AppendMenu(hMenuWin, MF_POPUP, hSubMenu, '&Help');

// usually hWin = 0 here, and the menu is set into the window
// at the creation of the window
if (hWin <> 0) then SetMenu(hWin, hMenuWin);
end;  // TMyWindow.MenuCreate

procedure TMyWindow.TestVariableNumLink1;
//=======================================
// First test of the hash table
var
  strS2,
  strS        : ShortString;
  w1
              : word32;
begin
// First test, very simple
strS :='A simple text, normal.';
DBW0(1, Interpret(strS));

// Second test, with one variable coded into it.
w1:=12345;
Word32Field(111, w1); // makes the association : to the number 111 link the variable w1
strS :='A simple text with a number = @111';
DBW0(1, Interpret(strS));

// 3rd test, with one variable coded into it.
w1:=56789;
Word32Field(111, w1); // it is useless, since already done. But it's harmless
strS :='A simple text with a number = @111. The ''.'' after the number is missing.';
DBW0(1, Interpret(strS));

// 4th test, with one variable coded into it.
w1:=745;
// Word32Field(111, w1); It has already been done. Don't need to do it again.
strS :='A simple text with a number = @111.. Double the ''.'' to have one after the number.';
DBW0(1, Interpret(strS));

// 5th test, with one variable coded into it.
w1:=-45;
// Word32Field(111, w1); Already done
StrField(112, strS2, SizeOf(strS2));
strS2:='A CODED TEXT';  // you can define the content of the value also after
                        // having called StrField, since a pointer on it is
                        // memorised.
strS :='Text in strS2 = @112.. Number = @111.. This @113 is not coded.';
DBW0(1, Interpret(strS));

// 5th test, with one variable coded into it.
w1:=567;
// StrField(112, strS2, SizeOf(strS2)); already done, useless, but harmless if you do it
strS2:='Another TEXT';  // you can define the content of the value also after
                        // having called StrField, since a pointer on it is
                        // memorised.
strS :='Text in strS2 = @112.. Number = @111.. This @113 is not coded.';
DBW0(1, Interpret(strS));

// a security to clear the association 111 --> w1
// Since the variable w1 will not exist any more, when we quite this procedure
// If you don't call this ClearField function, it's not a problem
// except if you use the  @111  reference without having associated it again
// with another variable.
ClearField(111);

// 6th test, with one variable coded into it.
// Since the association  111 -->  w1 has been cleared, the value
// of w1 will not appear again.
// StrField(112, strS2, SizeOf(strS2)); already done
strS2:='A 3rd text.';  // you can define the content of the value also after
                        // having called StrField, since a pointer on it is
                        // memorised.
strS :='Text in strS2 = @112.. No Number = @111..';
DBW0(1, Interpret(strS));

// 7th test, with one variable coded into it.
// Since the association  111 -->  w1 has been cleared, the value
// of w1 will not appear again.
// StrField(112, strS2, SizeOf(strS2)); already done
strS2:='An @112 will not be reinterpreted here.';
strS :='Text in strS2 = @112';
DBW0(1, Interpret(strS));


ClearField(112);
end;  // TMyWindow.TestVariableNumLink1

procedure TMyWindow.TestErrors2;
//==============================
// A test of wErrors2.pp
var
  strS        : ShortString;
  w1          : word32;
begin
// just to test if we get the string
strS:=GetMsg(50000);
DBW0(1, 'strS=' + strS);

// write the error corresponding to the number 500000
ErrorWriteMsg(50000);

// Second test
ErrorWriteMsg(50010);

// Error message, with a parameter in it.
w1:=97555;
Word32Field(111, w1);
ErrorWriteMsg(50020);
end;  // TMyWindow.TestErrors2

function TMyWindow.WMCommand(wPar:WPARAM; lPar:LPARAM):LRESULT;
//=============================================================
// Handles the menu messages
Var wNrMenu     : word;
begin
WMCommand := 0; // Default return value when processing a message

if (lPar <> 0) then begin
   // call the parent WMCommand method.
   WMCommand:=inherited WMCommand(wPar, lPar);
   exit;
   end;

// for the menus,  lPar = 0
//=========================
wNrMenu   := LoWord(wPar);
Case wNrMenu Of
   100 : DBW0(0, '');  // just open the debugging window
   101 : TestVariableNumLink1;
   102 : TestErrors2;

   200 : PostMessage( hWin,WM_Close,0,0);
   401 : MessageBox( hWin,'Test some units','Just a unit test.',
                     MB_OK Or MB_IconInformation);
   else WMCommand:=inherited WMCommand(wPar, lPar);
   end;  // Case NrMenu Of
end;  // TMyWindow.WMCommand

function TMyWindow.WindowProc(hWindow:HWND; wMsg:UINT; wPar:WPARAM; lPar:LPARAM):LRESULT;
//=======================================================================================
// All window messages are send here.
Begin
WindowProc := 0; // Default return value when processing a message

Case wMsg Of
   WM_Command : WindowProc:=WMCommand(wPar, lPar);
   else begin // Case wMsg Of
      // Default processing of the messages.
      WindowProc:=inherited WindowProc(hWindow, wMsg, wPar, lPar);
      end; // Case wMsg Of
   End; // Case wMsg Of

End;  // TMyWindow.WindowProc

var
  oApp        : TApplication;
  poMyMainWin : PMyWindow;

Begin // MAIN ******
// Name under which the main window is registered. Spaces are not allowed
oApp.Init('Example028');

// Creation of the main window
new(poMyMainWin, Init('tEx028 : Test of the unit wVariableNumLink2.pp  and  wErrors2.pp'));

// The App.WindowClass can be modified here, if wanted. (Not usual)
oApp.Run;
oApp.Done;  // The main window object is disposed here.
End.

