{ Example of program special.
  This Example tries to solve the following problem, or
  to answer the following question.

  We know that when a window is destroyed (having closed it or with
  DestroyWindow(...)), Windows automatically destroys its child windows.
  It would be natural that all its child object windows would be
  disposed also.
  We can assume that the parent has pointer on all of its children.
  This is not difficult to implement.
  But some pointers on child object windows will have been allocated with
  the  new(poW..., Init)  procedure, either before or after the Parent
  object window, other could have been defined as global variable, other
  could have been defined as member (= property) of the parent object,
  and finally, other could have been defined as member of another
  object.
  We should  dispose  the child object window only if it was created
  with the  new(...)  procedure.
  How can we distinguish between all these cases ?
  First it's usually better to have pointer on objects than only objects.
  We will see that we can easily know that a child object is a member
  of its parent, and thus should not be  disposed.
  I don't know how to automatically distinguish the other cases with
  certitude. Thus you MUST avoid using child object not being members of
  their parent, or not being created with the  new(...)  procedure.

  Parents will maintain a list of pointers on their child.
  type RPointerOnChildren = record
     poChild : PWindowBase;
      hChild : HWND;  // keep also the handle on the window.
     end;
  ARPointersOnChildren = array[0..100] of RPointerOnChildren;
  PARPointersOnChildren = ^ARPointersOnChildren;
  // The last pointer (poChild) is a pointer on another PARPointersOnChildren
  // it is usefull if a parent has more than 100 childrens.

  // Verifications can be done :
  IsBadWritePtr(poChild, sizeOf(TWindowBase))
     must be false to have a valid pointer.
  poChild^.hWin = hChild    must be right to have a valid pointer.
  poChild^.hWin = Self.hWin must be right to have a valid pointer.

  In TWindowBase, we have :
  // Number of child object windows
  // It could be lower than the number of child windows, because some
  // could have been created by Windows.
  nNumberOfChild : integer;  // = 0 by default, (the case for controls
  parpChild : PARPointersOnChildren;
  // = NIL if no children, as is the case for controls.

  RESUME :
  """"""""
  You can ignore all the previous points except that an object window
  must always use as children windows :
  Either a member of its structure (= a property) or Better
  an object created with the  new(...)  procedure.

  The library will  dispose  its child object windows when the parent
  window is  disposed.
  --------------------------------------------}
program tEx021;

// 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
 ,wGlobals2
 ,wApplication0
 ,wWindowBase0
 ,wWindow0
 ,wObjectCreatorLOW2
 ,wButtonPush0
 ,wErrors0
 ,wDebug0;

type
  PMyButton = ^TMyButton;
  TMyButton = object(TButtonPush)
  //"""""""""""""""""""""""""""""
  // To test object created outside of TMyWindow

  poBtn1 : PButtonPush;  // pointer on oButton1
  poBtn2 : PButtonPush;  // allocated with new(...)

  oButton1 : TButtonPush;

  constructor Init(poParentW:PWindowBase);
  destructor Done; virtual;

  end;  // TMyButton = object(TButtonPush)

type
  PMyWindow = ^TMyWindow;
  TMyWindow = object(TWindow0)
  //""""""""""""""""""""""""""

  poMyBtn1 : PMyButton;  // pointer on oMyButton1
  poMyBtn2 : PMyButton;  // allocated with new(...)

  oMyButton1 : TMyButton;
  // handle on a push button

  oMyButtonQuit : TButtonPush;
  // handle on a push button, will be used to quit the application.

  constructor Init(strWinTitlePrm:ShortString);
  destructor Done; virtual;

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

  procedure WinCreate(strWinClass:ShortString); virtual;
  // When creating the window, controls will be added.

  procedure TestMemory1;
  // to make some tests

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

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

var
  // to have also global variables.
  gloButton1  : TButtonPush;
  glpoBtn1    : PButtonPush;  // Pointer on gloButton1
  glpoBtn2    : PButtonPush;  // allocated with new, after the main window object
  glpoBtn3    : PButtonPush;  // allocated with new, before the main window object

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

//***************************************************
// TMyButton = object(TButtonPush)
//***************************************************

constructor TMyButton.Init(poParentW:PWindowBase);
//================================================
begin
inherited Init(poParentW);

//oButton1.Init(poParentW);
oButton1.Init(@Self);

new(poBtn2, Init(poParentW));

// Pointer on a button which was not created with new(poBtn1, Init);
poBtn1 :=@oButton1;
end;  // TMyButton.Init

destructor TMyButton.Done;
//========================
begin
// The dispose are useless, since they are disposed by their parents.
// But they do not harm
dispose(poBtn2, Done);
// dispose(poBtn1, Done);  would generate a runtime error 216
oButton1.Done;             // since it was never created with the "new(..."

inherited Done;
end;  // TMyButton.Done

//***************************************************
// TMyWindow = object(TWindow)
//***************************************************

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

oMyButton1.Init(@Self);
oMyButtonQuit.Init(@Self);

new(poMyBtn2, Init(@Self));
new(glpoBtn2, Init(@Self));

// Pointer on a button which was not created with new(poBtn1, Init);
poMyBtn1 :=@oMyButton1;
glpoBtn1 :=@gloButton1;

end;  // TMyWindow.Init

destructor TMyWindow.Done;
//========================
begin
// This is the only case where crashes cannot be avoided if it is
// not removed before the destructor is called.
// But we saw that it is not a natural case.
RemoveChildObjectWindow(poMyBtn2^.poBtn1);

// Useless disposes, but do not harm
dispose(glpoBtn2, Done);
dispose(poMyBtn2, Done);
// dispose(poMyBtn1, Done);  would generate a runtime error 216
                           // since it was never created with the "new(..."
oMyButtonQuit.Done;
oMyButton1.Done;

inherited Done;
end;  // TMyWindow.Done

procedure TMyWindow.MenuCreate;
//=============================
var
  hSubMenu    : HMenu;
begin
hMenuWin := CreateMenu;

hSubMenu := CreateMenu;
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 &1...');
AppendMenu(hMenuWin, MF_POPUP, hSubMenu, '&Help');
end;  // TMyWindow.MenuCreate

procedure TMyWindow.WinCreate(strWinClass:ShortString);
//=====================================================
// Creates a new window.
// with controls in it.
Begin
inherited WinCreate(strWinClass);

// defines position, size, label, ID of the button
with oMyButton1 do begin
   // the default values could be left unchanged.
   vXPosMM    :=   3; // X position in milimeters in the parent window
   vYPosMM    :=   2; // Y position in milimeters in the parent window

   nXSizePix  :=120; // 150 = default value
   nYSizePix  := 30; //  50 default value

   strCtrlLabel  :='Test 1'; // Text on the button
   wCtrlID:=1001; // identifier of the control

   // creates the button
   CtrlCreate;
   end; // with oMyButton1 do begin

// defines position, size, label, ID of the button
with oMyButtonQuit do begin
   // the default values are not shown again here.
   vXPosMM    :=  -2; // X position in milimeters in the parent window
   vYPosMM    :=  -2; // Y position in milimeters in the parent window
   nXSizePix  :=100; // 150 = default value
   nYSizePix  := 30; //  50 default value

   vXPosCtrlRef :=1; // Position relative to the Right  of the control. 0=default
   vYPosCtrlRef :=1; // Position relative to the Bottom of the control. 0=default

   // Defines which point of the parent window is take as the origine
   vXPosParentRef :=1; // Position relative to the Right  of the parent window. 0=default
   vYPosParentRef :=1; // Position relative to the Bottom of the parent window. 0=default

   strCtrlLabel  :='Quit'; // Text on the button
   wCtrlID:=1002; // identifier of the control, any number

   // creates the button
   CtrlCreate;
   end; // with oMyButtonQuit do begin
End;  // TMyWindow.WinCreate

procedure TMyWindow.TestMemory1;
//==============================
// This is to test Errors handler, it works, but not used now.
// const fFirst : boolean = TRUE; // to call only once the SetHeapErrorHandle
var
  nSizeSelf : int32;  // size of the structure of the main window.
  nAddrSelf : int32;  // Address of the begining of the data of the Main window.
begin
nAddrSelf:=int32(@Self);
nSizeSelf:=SizeOf(Self);

// I think this remains true, even if the memory manager moves blocks of
// memory.
// At last, the first following affirmation must be true.

DBW0(1, ' 0 < ' + IntToStr(Int32(poMyBtn1) - nAddrSelf, 5) + ' < ' +
     IntToStr(nSizeSelf, 5) + ' => Not created with "new" (SURE).');

DBW0(1, 'gl_1:' + IntToStr(Int32(glpoBtn1) - nAddrSelf, 5) +
       '     < 0 => Created with "new" before the TMyWindow object (wrong), or');
DBW0(1, '                      ' +
        'global variable not created with "new" (right).');
DBW0(1, '                      ' +
        'But we can see that it is lower than  "main:", which gives information');

DBW0(1, 'main:' + IntToStr(Int32(gglpoObjCreate) - nAddrSelf, 5) +
       '         =  lower limit of pointer created with "new".');
DBW0(1, '                   ' +
        '=  First object created with new (in oApp.Init).');
DBW0(1, '                      ' +
        'Bellow this value, are global variables.');

DBW0(1, 'gl_3:' + IntToStr(Int32(glpoBtn3) - nAddrSelf, 5) +
       '     < 0 => Created with "new" before the TMyWindow object (right), or');
DBW0(1, '                      ' +
        'global variable not created with "new" (wrong).');
DBW0(1, '                      ' +
        'But we can see that it is higer than  "main:", which gives information');

DBW0(1, 'B1_1:' + IntToStr(Int32(poMyBtn1^.poBtn1) - nAddrSelf, 5) + ' < ' +
        IntToStr(nSizeSelf, 5) + ' => Not created with "new" (SURE).');

DBW0(1, 'B1_2:' + IntToStr(Int32(poMyBtn1^.poBtn2) - nAddrSelf, 5) + ' > ' +
        IntToStr(nSizeSelf, 5) + ' => Created with "new" after (right), or');
DBW0(1, '                      ' +
        'member of an object created with "new" after the TMyWindow object (wrong).');

DBW0(1, 'My_2:' + IntToStr(Int32(poMyBtn2) - nAddrSelf, 5) + ' > ' +
        IntToStr(nSizeSelf, 5) + ' => Created with "new" (right), or');
DBW0(1, '                      ' +
        'member of another object which was created with "new" (wrong).');

// This is the hardest case to distinguish.
DBW0(1, 'B2_1:' + IntToStr(Int32(poMyBtn2^.poBtn1) - nAddrSelf, 5) + ' > ' +
        IntToStr(nSizeSelf, 5) + ' => Created with "new" after (WRONG), or');
DBW0(1, '                      ' +
        'member of an object created with "new" after the TMyWindow object (right).');
DBW0(1, '                 ---> ' +
        'In this case, the library will make a runtime error.');
DBW0(1, '                 ---> ' +
        'Avoid using obects not created with "new" and not member of its parent.');

DBW0(1, 'B2_2:' + IntToStr(Int32(poMyBtn2^.poBtn2) - nAddrSelf, 5) + ' > ' +
        IntToStr(nSizeSelf, 5) + ' => Created with "new" after (right), or');
DBW0(1, '                      ' +
        'Member of an object created with "new" after the TMyWindow object (wrong).');

DBW0(1, 'gl_2:' + IntToStr(Int32(glpoBtn2) - nAddrSelf, 5) + ' > ' +
        IntToStr(nSizeSelf, 5) + ' => Created with "new" after (right), or');
DBW0(1, '                      ' +
        'Member of an object created with "new" after the TMyWindow object (wrong).');

{ DBW0(262144, '----- for info, useless -----');
DBW0(262144, 'poMyBtn1 = ' + PTS(poMyBtn1));
DBW0(262144, 'poMyBtn2 = ' + PTS(poMyBtn2));
DBW0(262144, '@Self    = ' + PTS(@Self));
}
exit;

{  This is to test Errors handler, defined in wErrors0.pp, but not used.
   It works, but is useless for the moment.
if fFirst then begin
   // sets the Heap error handler of the library
   SetExitProcHandle;
   fFirst:=FALSE;
   end;

if fFirst then begin
   // sets the Heap error handler of the library
   SetHeapErrorHandle;
   fFirst:=FALSE;
   end;
}
end; // TMyWindow.TestMemory1

function TMyWindow.WMCommand(wPar:WPARAM; lPar:LPARAM):LRESULT;
//=============================================================
// Handles the menu messages
Var
  wNoticode,  // notification code, from a child window.
  wNrMenu     : word;
  wType       : word; // not used, type of the button, as defined in the library
  poBtn       : PButtonPush; // the push button pressed, if any

begin
WMCommand:=0; // default return value
wNotiCode := HiWord(wPar);

// Thus there is no distinction between a button click and a menu selection !
// BN_CLICKED = 0 !
if (wNotiCode = BN_CLICKED) then begin
   // For each menu selection, we enter here too.

   gglGetPointerObjectWinCtrl(lPar, wType, poBtn);
   // if we didn't click a button, poBtn = NIL

   if (poBtn <> NIL) then begin
      if (poBtn^.hWin = oMyButton1.hWin) then begin
         // do a first test
         TestMemory1;
         exit; // Test 1 button handeled.
         end;

      if (poBtn <> NIL) and (poBtn^.hWin = oMyButtonQuit.hWin) then begin
         PostQuitMessage (0); // Tells the application to quit.
         exit; // Quit button handeled.
         end;

      end; // if (poBtn <> NIL) then begin
   end; // if (wNotiCode = BN_CLICKED) then begin

if (lPar <> 0) then begin
   WMCommand:=inherited WMCommand(wPar, lPar);
   exit;
   end;

// for the menu, lPar = 0
wNrMenu   := LoWord(wPar);
Case wNrMenu Of
   // these calls to DBW0 can be done from anywhere
   100 : DBW0(0, '');  // just open the debugging window

   200 : PostMessage( hWin,WM_Close,0,0);
   401 : MessageBox( hWin,
       'Test if pointers have been created with the "new" procedure or not. See the code to understand.',
       'Test of pointers',
                     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

{ if (wMsg <> WM_MouseMove)   and (wMsg <> WM_NCMouseMove) and
   (wMsg <> WM_MENUSELECT )   and (wMsg <> WM_ENTERIDLE ) and
   (wMsg <> WM_SetCursor)   and (wMsg <> WM_NCHittest) and
   (wMsg <> WM_SetFocus) and (wMsg <> WM_KillFocus) and
   (wMsg <> WM_KEYDOWN) and (wMsg <> WM_KEYUP) and
   (wMsg <> WM_Move)        and (wMsg <> WM_NCActivate) then
   DBW0(32, DBMsgToStr(wMsg) + ITS(wPar) + ITS(lPar)); }

Case wMsg Of
   WM_Command     : WindowProc:=WMCommand(wPar, lPar);
   WM_Size : begin
      // these calls, will be automatic in the next version of the library.
      oMyButton1.NotifyParentResize(FALSE); // not usefull, since its position is relative
                                   // to the top left of parent window.
      oMyButtonQuit.NotifyParentResize(TRUE); // must replace the control in the window
      end;

   WM_Destroy : begin
                DBW(1, 'before' + ITS(nNumberOfChild));
                RemoveChildObjectWindow(poMyBtn2^.poBtn1);
                dbw(1, 'after' + ITS(nNumberOfChild));
                DBWaitSec(1);
                end;

   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        : TApplication0;
  poMyMainWin : PMyWindow;

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

// created the Btn3 before the main window
new(glpoBtn3, Init(NIL));

// Creation of the main window
new(poMyMainWin, Init('tEx021. A special test to see when an object was created with "new(...)"'));

// The App.WindowClass can be modified here, if wanted. (Not usual)
oApp.Run;

// As a security, test is the pointer is still valide.
// It might be not valide, if it would have been disposed in the parent window
// Normally you don't have to do this test.
// The main window is disposed in  oApp.Done,  thus it is in the
// library that such a test will have to be done, to verify that
// the child oject window can be disposed.
// Conclusion, you have the choice.
// Either do the complete test as bellow
// Or only  dispose(glpoBtn2, Done)
// Or The Best, do nothing. This last case is the one I would suggest.
// The  "IsBadWritePtr"  is not a secure function, its answer can be wrong.
if not IsBadWritePtr(glpoBtn3, sizeOf(TWindowBase)) then dispose(glpoBtn3, Done);

oApp.Done;  // The main window object is disposed here.
End.

