{ Ninth example of program using only the Window unit
  This example show how to create a Multiple Document Interface (MDI)
  which is a window containing other windows.

  The library is not used, to show how MDI can be created from nothing.
  But with the library, as shown in tEx011.pp, it is much simpler.

  This is a minimal example, of creating an MDI, with a menu,
  and default simple behaviour
  --------------------------------------------}
program tEx009;

// 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
 ,wDebug0;

// any string without spaces or special characters to designate the
// registration class of MDI child windows
const strMdi = 'MdiChildClass'#0;

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

type
  TMyApplication = object
  //"""""""""""""""""""""
  constructor Init;
  destructor  Done; virtual;

  // loop which processes the application messages
  procedure Run; virtual;
  end; // TMyApplication = object

type
  PMyWindow = ^TMyWindow;
  TMyWindow = object
  //""""""""""""""""
  // handle on the main window
  hWin : HWND;

  // handle on the Client Window of the main MDI window
  // It is this client window which contains the child MDI windows.
  hWinClient : HWND;

  // Position and size of the window when created
  nLeft, nTop, nWidth, nHeight : integer;

  // Handle on the menu
  hMenuWin      : HMenu;

  // classname of the window
  strClassWinName : string[30];

  // Window Class to register a new window
  WindowClass : WndClass;

  // title of the window, when it is created
  // Memorise the strWinTitlePrm parameter of the init constructor.
  strWinTitle : string[200];

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

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

  // creation of the window
  // Can be overriden, but not overriden usually
  // For the main window, it is automatically called in TApplication.Run
  procedure WinCreate; virtual;

  procedure CreateMDIChild;

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

  // Handles the windows messages WM_... send to the main MDI window
  function WindowProc(hWindow:HWND; wMsg:UINT; wPar:WPARAM; lPar:LPARAM):LRESULT; virtual;
  end; // TMyWindow = object

var
  oApp        : TMyApplication;
  poMyMainWin : PMyWindow;
  wndclassChild : WndClass;

Function MainWindowProc(hWindow:HWND; wMsg:UINT; wPar:WPARAM; lPar:LPARAM):LRESULT; stdcall; export;
//==================================================================================================
// This is the message handle function, which calls the
// Main Window  'WindowProc' function
Begin
if (poMyMainWin = NIL) then begin
   // This is not normal, the main window should exist when entering this procedure
   MainWindowProc:=1;  // not processed
   exit;
   end;

// Call the event handler of the main application window.
MainWindowProc := poMyMainWin^.WindowProc(hWindow, wMsg, wPar, lPar);
End;  // MainWindowProc

//***************************************************
// TMyApplication
//***************************************************

constructor TMyApplication.Init;
//=============================
begin
end;  // TMyApplication.Init

destructor TMyApplication.Done;
//============================
begin
if (poMyMainWin <> NIL) then dispose(poMyMainWin, Done);  
poMyMainWin:=NIL;
end;  // TMyApplication.Done

procedure TMyApplication.Run;
//===========================
var
  rMessage    : Msg;

begin
// Registering the class of the main window
if (RegisterClass(poMyMainWin^.WindowClass) = 0) then begin
   MessageBox (0, 'Register failed', NIL, mb_Ok);
   exit;
   end;

// Creating the main window
poMyMainWin^.WinCreate;
if longint(poMyMainWin^.hWin)=0 then begin
   MessageBox (0, 'WinCreate failed', NIL, MB_OK);
   exit;
   end;

// Loop to treat the WM_ messages
While GetMessage(@rMessage,0,0,0) Do Begin
   // try translate Accelerators messages into window messages
   // if (TranslateMDISysAccel(poMyMainWin^.hWinClient, @rMessage)) then ...
   // if (TranslateAccelerator(poMyMainWin^.hWin, hAccel, @rMessage) = 0) then ...
   TranslateMessage(rMessage);
   DispatchMessage(rMessage);
   End;
End;  // TMyApplication.Run

//***************************************************
// TMyWindow
//***************************************************

constructor TMyWindow.Init(strWinName, strWinTitlePrm:ShortString);
//=================================================================
begin
// To set the default position and size of the window when created.
nLeft   :=5;
nTop    :=50;
nWidth  :=400;
nHeight :=200;

strClassWinName:=strWinName + #0;

// Memorise the strWinTitlePrm parameter.
strWinTitle:=strWinTitlePrm;

// define a standard default window class
with WindowClass do begin
   Style         := cs_hRedraw Or cs_vRedraw;
   lpfnWndProc   := WndProc(@MainWindowProc);
   cbClsExtra    := 0;
   cbWndExtra    := 0;
   hInstance     := system.MainInstance;
   hIcon         := LoadIcon (0,idi_Application);
   hCursor       := LoadCursor (0,idc_Arrow);
   hbrBackground := GetStockObject(WHITE_BRUSH);
//  hbrBackground :=COLOR_BACKGROUND+1; // to have the desktop color
   lpszMenuName  := NIL; // no menu is defined in the resources
   lpszClassName := @strClassWinName[1];
   end; // with

// Default position and size of the window when created
nLeft   :=5;
nTop    :=5;
nWidth  :=500;
nHeight :=300;

// The menu handle will be defined in the MenuCreate method
hMenuWin:=0;
end;  // TMyWindow.Init

destructor TMyWindow.Done;
//========================
begin
end;  // TMyWindow.Done

procedure TMyWindow.MenuCreate;
//=============================
var
  hSubMenu    : HMenu;

begin
hMenuWin := CreateMenu;
hSubMenu := CreateMenu;
AppendMenu(hSubmenu,MF_STRING,100,'&New child window');
AppendMenu(hSubmenu,MF_STRING,101,'&Close child window');
AppendMenu(hSubmenu,MF_SEPARATOR,0,Nil);
AppendMenu(hSubMenu,MF_String,199,'E&xit');
AppendMenu(hMenuWin, MF_POPUP, hSubMenu, '&File');

hSubMenu := CreateMenu;
AppendMenu(hSubmenu,MF_STRING,200,'&Tile');
AppendMenu(hSubmenu,MF_STRING,201,'&Cascade');
AppendMenu(hSubmenu,MF_STRING,202,'&Arange icons');
AppendMenu(hMenuWin, MF_POPUP, hSubMenu, '&Window');
end;  // TMyWindow.MenuCreate

procedure TMyWindow.WinCreate;
//============================
var
  // to create the client part of an MDI main window.
  // It is the client part which controls the MDI child windows.
  clientcreate : TCLIENTCREATESTRUCT; // = CLIENTCREATESTRUCT in win32 SDK ref.

Begin
MenuCreate;  // defines hMenuWin = handle on the main menu

// the string must be a null terminated string to be passed to Windows
strWinTitle:=strWinTitle+#0;

// must be set to zero, before it is defined in the CreateWindow calling the WM_Create message
hWinClient:=0;

// Create the main application MDI window
hWin := CreateWindow ( WindowClass.lpszClassName, @strWinTitle[1],
                       WS_OVERLAPPEDWINDOW or WS_CLIPCHILDREN,
                       nLeft, nTop, nWidth, nHeight,
                       0, // no parent window
                       hMenuWin, system.MainInstance, NIL) ;

// in which menu will the child window menu appair
// 0 => appair in the File menu
// 1 => appair in the Window menu
// 2 => appair in the next menu, if it exist
clientcreate.hWindowMenu  := GetSubMenu(hMenuWin, 1);

// When a child window is created, it will appair in the Window menu.
// When it is selected, it will send a WM_Command
// with wPar = 500 for the first child,
//  with wPar = 501 for the second child, wPar = 502 for the third child, etc.
clientcreate.idFirstChild := 500;  // MenuID ;

// Create the client window, containing the child windows.
// 'MDICLIENT' is a Windows predefined class
hWinClient := CreateWindow ('MDICLIENT', '',  // no title for the client
                            ws_Child or ws_Visible or ws_Group or ws_TabStop
                            or ws_ClipChildren or ws_HScroll or ws_VScroll,
                            0, 0, 0, 0, // no positionning
                            hWin, 1, MainInstance,
                            @clientcreate) ;
ShowWindow(hWin, SW_Show);
End;  // TMyWindow.WinCreate

procedure TMyWindow.CreateMDIChild;
//=================================
// From the menu, a new child window can be opened
const nCpt : integer = 0; // Child window count

var
  mdicreate : TMDICREATESTRUCT; // = MDICREATESTRUCT in win32 SDK ref.
//  hWinChild : HWND;
  strTitle    : string[30];

begin
inc(nCpt);
strTitle:='Hello ' + IntToStr(nCpt,3) + #0;
mdicreate.szClass := strMdi;
mdicreate.szTitle := @strTitle[1];
mdicreate.hOwner  := MainInstance ;

//default position and size
mdicreate.x       := CW_USEDEFAULT ;
mdicreate.y       := CW_USEDEFAULT ;
mdicreate.cx      := 150; // CW_USEDEFAULT ;
mdicreate.cy      := 100; // CW_USEDEFAULT ;

// no special styles
mdicreate.style   := 0;
mdicreate.lParam  := 0;

// create a MDI child window
{hWinChild :=} SendMessage ( hWinClient, WM_MDICREATE, 0, longint(@mdicreate));

// another way to do the same creation
{
hWinChild :=CreateMDIWindow( strMdi, @strTitle[1],
                 0, // style
                 CW_USEDEFAULT, CW_USEDEFAULT, 150, 100,
                 hWinClient, // handle to parent window (MDI client)
                 MainInstance, // handle to application instance
                 0 // application-defined value
                 );
}
end;  // TMyWindow.CreateMDIChild

function TMyWindow.WMCommand(wPar:WPARAM; lPar:LPARAM):LRESULT;
//=============================================================
// Handles the menu messages
Var
  wNrMenu     : word;
  hWinChild   : HWND; // handle of the active MDI child window
begin
WMCommand := 0; // Default return value when processing a message

if (lPar <> 0) then begin
   WMCommand:=DefFrameProc(hWin, hWinClient, WM_COMMAND, wPar, lPar);
   exit;
   end;

// for the menu, lPar = 0
wNrMenu   := wPar;
Case wNrMenu Of
   // from the file menu
   100 : CreateMDIChild;
   199 : PostMessage( hWin,WM_Close,0,0);

   // from the window menu
   101 : begin
      hWinChild:=LOWORD (SendMessage (hWinClient, WM_MDIGETACTIVE, 0, 0)) ;

      if (SendMessage ( hWinChild, WM_QUERYENDSESSION, 0, 0) <> 0) then
         SendMessage (hWinClient, WM_MDIDESTROY, hWinChild, 0);
      end;
{
   102 : begin // Attempt to close all children
         lpfnEnum = MakeProcInstance (CloseEnumProc, hInst) ;
         EnumChildWindows (hwndClient, lpfnEnum, 0) ;
         FreeProcInstance (lpfnEnum) ;
         end;
}
   // Messages for arranging windows
   200 : SendMessage (hWinClient, WM_MDITILE, 0, 0);
   201 : SendMessage (hWinClient, WM_MDICASCADE, 0, 0);
   202 : SendMessage (hWinClient, WM_MDIICONARRANGE, 0, 0);

   500..509 : begin
      // it is difficult to know to which MDI child window
      // this menu message is destinated.
      // But using the default window handling, does what one expect.
      // DBW0(16, 'menu :' + ITS(wPar) + ITS(lPar));
      WMCommand:=DefFrameProc(hWin, hWinClient, WM_COMMAND, wPar, lPar);
      end;
   else WMCommand:=DefFrameProc(hWin, hWinClient, WM_COMMAND, 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_Create : exit;
   WM_Destroy : PostQuitMessage (0); // quit the application
   WM_Command : begin
      WindowProc:=WMCommand(wPar, lPar);
      if (wPar >= 500) then
         WindowProc :=DefFrameProc(hWindow, hWinClient, wMsg, wPar, lPar);
      end;
   else begin // Case wMsg Of
      // Default processing of the messages, for MDI windows
      WindowProc :=DefFrameProc(hWindow, hWinClient, wMsg, wPar, lPar);
      end; // else Case wMsg Of
   End; // Case wMsg Of
End;  // TMyWindow.WindowProc

Function ChildWindowProc(hWindow:HWND; wMsg:UINT; wPar:WPARAM; lPar:LPARAM):LRESULT; stdcall; export;
//==================================================================================================
// This is the message handling function for the MDI child windows,
var
  hDevC       : HDC; // handle on a device context, to paint.
  rPaint      : TPAINTSTRUCT; // = PAINTSTRUCT in C c.f. Win 32 Reference help (Win32.hlp)
  rRec        : RECT;

Begin
ChildWindowProc:=0; // default return value

case wMsg of
   // processing of messages
   WM_PAINT : begin // Paint the MDI Child window
      hDevC := BeginPaint (hWindow, @rPaint) ;
      SetTextColor (hDevC, RGB(255,0,0)) ;
      GetClientRect (hWindow, @rRec);
      DrawText ( hDevC, 'Hello, World!', -1, @rRec,
                 DT_SINGLELINE or DT_CENTER or DT_VCENTER);
      EndPaint (hWindow, @rPaint) ;
      end;
   else ChildWindowProc := DefMDIChildProc(hWindow, wMsg, wPar, lPar);
        // Default message handling for MDI child windows
   end; // case
End;  // ChildnWindowProc

//*********************************************************
// Main programm
//*********************************************************

Begin // MAIN ******
oApp.Init;

new(poMyMainWin, Init( 'MDIExample1' // Name under which the main window is registered
                                     // Spaces are not allowed
                      ,'Title of the Example009 (Ex009.pp) Window'));

// Registering the class window for MDI child windows
wndclassChild.style         := CS_HREDRAW or CS_VREDRAW ;
wndclassChild.lpfnWndProc   := WndProc(@ChildWindowProc);
wndclassChild.cbClsExtra    := 0 ;
wndclassChild.cbWndExtra    := 0;  // sizeof (LOCALHANDLE) ;
wndclassChild.hInstance     := MainInstance;
wndclassChild.hIcon         := LoadIcon (0, IDI_APPLICATION) ;
wndclassChild.hCursor       := LoadCursor (0, IDC_ARROW) ;
wndclassChild.hbrBackground := GetStockObject (WHITE_BRUSH) ;
wndclassChild.lpszMenuName  := '' ;
wndclassChild.lpszClassName := strMdi;
RegisterClass(wndclassChild);

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

