{█▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀█}
{█                                                       █}
{█      Virtual Pascal Examples. Version 1.10            █}
{█        Restricting window size example                █}
{█        The Art Of OS/2, Chapter 10, p. 168-173        █}
{█      ─────────────────────────────────────────────────█}
{█      Copyright (c) 1992-1996 by Kathleen Panov        █}
{█      VP/2 Version Copyright (C) 1996 fPrint UK Ltd    █}
{█                                                       █}
{▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀}

Program WinSize;

{$PMTYPE PM}

Uses
  Os2Def, Os2PmApi;

{$D Window sizing example - Copyright (c) 1992-1995 by Kathleen Panov}
{$IFDEF VPDEMO}
  {&Dynamic VP11Demo.Lib}
{$ENDIF}

Const
 CLS_CLIENT  = 'MyClass';
 NULL = Nil;

Type
  pFrameInfo = ^FrameInfo;
  FrameInfo = Record
    lWidth             : LONG;
    lHeight            : LONG;
    pfnNormalFrameProc : FNWP;
  end;

Function ClientWndProc ( hwndWnd : HWND ;
                         ulMsg   : ULONG;
                         mpParm1 : MPARAM;
                         mpParm2 : MPARAM ) : mResult; cdecl;
begin
  ClientWndProc := ord(False);

  Case ulMsg of
    WM_ERASEBACKGROUND :
      ClientWndProc := ord(True);

  else
    ClientWndProc := WinDefWindowProc ( hwndWnd,
                                        ulMsg,
                                        mpParm1,
                                        mpParm2 ) ;
   end;  { Case }
end;

Function SubClassFrameProc ( hwndFrame : HWND ;
                             ulMsg     : ULONG;
                             mpParm1   : MPARAM;
                             mpParm2   : MPARAM ) : mResult; cdecl;
Var
  ipFrameInfo        : PFRAMEINFO;
  pfnNormalFrameProc : FNWP;
  iclassInfo         : CLASSINFO;
  ihab               : HAB;

  ipTrackInfo        : PTRACKINFO;
  mrReply            : MRESULT;

begin
   {************************************************************}
   {* retrieve frame information from frame window word        *}
   {************************************************************}

   ipFrameInfo := WinQueryWindowPtr( hwndFrame,
                                     QWL_USER);
   if ipFrameInfo = nil then
     begin

      {*********************************************************}
      {* if cannot find window word, use the default window    *}
      {* proc                                                  *}
      {*********************************************************}

      ihab := WinQueryAnchorBlock(hwndFrame);
      WinQueryClassInfo(ihab,
                        WC_FRAME,
                        iclassInfo);
      pfnNormalFrameProc := iclassInfo.pfnWindowProc;
      SubClassFrameProc := pfnNormalFrameProc(hwndFrame,
                                    ulMsg,
                                    mpParm1,
                                    mpParm2);
      Exit;
   end;

   pfnNormalFrameProc := ipFrameInfo^.pfnNormalFrameProc;

   Case ulMsg of
     WM_QUERYTRACKINFO :
       begin

         {***************************************************}
         {* call default procedure first to get TRACKINFO   *}
         {* structure                                       *}
         {***************************************************}

         mrReply := pfnNormalFrameProc(hwndFrame,
                                         ulMsg,
                                         mpParm1,
                                         mpParm2);
         ipTrackInfo := PTRACKINFO(PVOIDFROMMP(mpParm2));

         {***************************************************}
         {* set limits at 1/2 the height and width of screen*}
         {***************************************************}

         ipTrackInfo^.ptlMinTrackSize.x := ipFrameInfo^.lWidth div 2;
         ipTrackInfo^.ptlMinTrackSize.y := ipFrameInfo^.lHeight div 2;

         {***************************************************}
         {* put limits in TRACKINFO structure               *}
         {***************************************************}

         SubClassFrameProc := mrReply;
         Exit;
      end;
    WM_DESTROY :
      begin
        {***************************************************}
        {* clean up                                        *}
        {***************************************************}

        if ipFrameInfo <> nil then
          Dispose(ipFrameInfo);
      end;
   end;

   {************************************************************}
   {* return normal frame window procedure                     *}
   {************************************************************}
   SubClassFrameProc := pfnNormalFrameProc(hwndFrame,
                                 ulMsg,
                                 mpParm1,
                                 mpParm2);
end;


Procedure DisplayError( pszText : pChar );
begin
   {************************************************************}
   {* small function to display error string                   *}
   {************************************************************}

   WinAlarm(HWND_DESKTOP,
            WA_ERROR);
   WinMessageBox(HWND_DESKTOP,
                 HWND_DESKTOP,
                 pszText,
                 'Error!',
                 0,
                 MB_OK OR MB_ERROR);
end;

Var
  habAnchor           : HAB;
  hmqQueue            : HMQ;
  ulFlags             : ULONG;
  hwndFrame           : HWND;
  bLoop               : BOOL;
  qmMsg               : QMSG;
  ipFrameInfo         : PFRAMEINFO;
  pfnNormalFrameProc  : FNWP;
  lHeight,lWidth      : LONG;

begin
   habAnchor := WinInitialize(0);
   hmqQueue := WinCreateMsgQueue(habAnchor, 0);

   WinRegisterClass(habAnchor,
                    CLS_CLIENT,
                    ClientWndProc,
                    0,
                    sizeof(Pointer));

   ulFlags := FCF_TITLEBAR OR FCF_SYSMENU OR FCF_SIZEBORDER OR FCF_MINMAX OR
      FCF_TASKLIST;

   {************************************************************}
   {* create frame window                                      *}
   {************************************************************}

   hwndFrame := WinCreateStdWindow(HWND_DESKTOP,
                                  0,
                                  ulFlags,
                                  CLS_CLIENT,
                                  'Frame Window',
                                  0,
                                  NULLHANDLE,
                                  0,
                                  NULL);

   {************************************************************}
   {* subclass the frame window and point to subclass frame    *}
   {* proc                                                     *}
   {************************************************************}

   @pfnNormalFrameProc := WinSubclassWindow(hwndFrame,
                                           SubclassFrameProc);

   {************************************************************}
   {* get screen height and width                              *}
   {************************************************************}

   lWidth := WinQuerySysValue(HWND_DESKTOP,
                             SV_CXSCREEN);

   lHeight := WinQuerySysValue(HWND_DESKTOP,
                              SV_CYSCREEN);

   {************************************************************}
   {* if failed, display error, and set to default value       *}
   {************************************************************}

   if ( lWidth = 0 ) or ( lHeight = 0 ) then
     begin
       DisplayError('WinQuerySysValue failed');
       lWidth := 640;
       lHeight := 480;
     end;

   if (hwndFrame <> NULLHANDLE) then
     begin

      {*********************************************************}
      {* allocate memory for window word                       *}
      {*********************************************************}

      New( ipFrameInfo );
      if ( ipFrameInfo = nil ) then
      begin

         {******************************************************}
         {* error handling                                     *}
         {******************************************************}

         DisplayError('No memory allocated for frame info');
         WinDestroyWindow(hwndFrame);
         WinDestroyMsgQueue(hmqQueue);
         WinTerminate(habAnchor);

         Halt(0);
      end;

      WinSetWindowPtr(hwndFrame,
                      QWL_USER,
                      ipFrameInfo );
      ipFrameInfo^.lWidth := lWidth;
      ipFrameInfo^.lHeight := lHeight;
      ipFrameInfo^.pfnNormalFrameProc := pfnNormalFrameProc;

      {*********************************************************}
      {* set window position                                   *}
      {*********************************************************}

      WinSetWindowPos(hwndFrame,
                      NULLHANDLE,
                      lWidth div 4,
                      lHeight div 4,
                      lWidth div 2,
                      lHeight div 2,
                      SWP_SIZE OR SWP_MOVE OR SWP_ACTIVATE OR SWP_SHOW);

      bLoop := WinGetMsg(habAnchor,
                        qmMsg,
                        NULLHANDLE,
                        0,
                        0);
      while ( bLoop ) do
        begin
          WinDispatchMsg(habAnchor,
                         qmMsg);
          bLoop := WinGetMsg(habAnchor,
                            qmMsg,
                            NULLHANDLE,
                            0,
                            0);
        end;

      WinDestroyWindow(hwndFrame);
   end;
   WinDestroyMsgQueue(hmqQueue);
   WinTerminate(habAnchor);
end.