Page2.mod: Translation to Stony Brook Modula-2

Last updated: 5. 3.1998, 7:38

<*/NOWARN:F*>
(*----------------------------------
   PAGE2.C      --- Property sheet page 2
                (c) Paul Yao,      1996
   Page2.mod    --- Translation to Stony Brook Modula-2
                (c) Peter Stadler, 1997
  ----------------------------------*)
IMPLEMENTATION MODULE Page2;
IMPORT SYSTEM;
IMPORT WIN32;
IMPORT WINUSER;
IMPORT COMMCTRL;
IMPORT h2d_property;
IMPORT Notify;
IMPORT Helper;


VAR
  pTheExStyles   :  WIN32.LPDWORD;

(*-------------------------------------------------------------------          *)
(*-------------------------------------------------------------------          *)
<*/PUSH*>
%IF WIN32 %THEN
    <*/CALLS:WIN32SYSTEM*>
%ELSE
    <*/CALLS:WINSYSTEM*>
%END
(*++++*****************************************************************)
PROCEDURE ExStylePageProc (hwnd        : WIN32.HWND;
(**********************************************************************)
          uMsg        : WIN32.UINT;
          ppsp        : COMMCTRL.LPPROPSHEETPAGE): WIN32.UINT [EXPORT];
BEGIN
     CASE (uMsg) OF
          | COMMCTRL.PSPCB_CREATE :
               (* Store pointer to extended style data                         *)
               pTheExStyles := SYSTEM.CAST(WIN32.LPDWORD,ppsp^.lParam);
               RETURN 1;

          | COMMCTRL.PSPCB_RELEASE :
               RETURN 0;
     ELSE

        RETURN 0;
     END;
END ExStylePageProc;

(*******************************************************************-          *)
<*/POP*>

(*******************************************************************-          *)
<*/PUSH*>
%IF WIN32 %THEN
    <*/CALLS:WIN32SYSTEM*>
%ELSE
    <*/CALLS:WINSYSTEM*>
%END
(*++++*****************************************************************)
PROCEDURE ExStyleDlgProc (hwndDlg     : WIN32.HWND;
(**********************************************************************)
          msg         : WIN32.UINT;
          wParam      : WIN32.WPARAM;
          lParam      : WIN32.LPARAM) : WIN32.BOOL [EXPORT];
VAR
  bCheck       :  BOOLEAN;
  dwOrigStyle  :  WIN32.DWORD;
  wNotifyCode  :  WIN32.WORD;
  wID          :  WIN32.WORD;
  hwndSheet    :  WIN32.HWND;
  pnmh         :  WINUSER.LPNMHDR;
  hwndPS       :  WIN32.HWND;
  hwndActive   :  WIN32.HWND;
  psh          :  COMMCTRL.LPPSHNOTIFY;
  hwndPropSheet:  WIN32.HWND;

BEGIN
     CASE (msg) OF
          | WINUSER.WM_INITDIALOG :
               dwOrigStyle := pTheExStyles^;

               bCheck := SYSTEM.CAST(BOOLEAN,(dwOrigStyle BAND WINUSER.WS_EX_CLIENTEDGE));
               Helper.SetButtonCheck (hwndDlg, h2d_property.IDC_CLIENTEDGE, bCheck);

               bCheck := SYSTEM.CAST(BOOLEAN,(dwOrigStyle BAND WINUSER.WS_EX_CONTEXTHELP));
               Helper.SetButtonCheck (hwndDlg, h2d_property.IDC_CONTEXTHELP, bCheck);

               bCheck := SYSTEM.CAST(BOOLEAN,(dwOrigStyle BAND WINUSER.WS_EX_DLGMODALFRAME));
               Helper.SetButtonCheck (hwndDlg, h2d_property.IDC_DLGMODALFRAME, bCheck);

               bCheck := SYSTEM.CAST(BOOLEAN,(dwOrigStyle BAND WINUSER.WS_EX_OVERLAPPEDWINDOW));
               Helper.SetButtonCheck (hwndDlg, h2d_property.IDC_EXOVERLAPPED, bCheck);

               bCheck := SYSTEM.CAST(BOOLEAN,(dwOrigStyle BAND WINUSER.WS_EX_PALETTEWINDOW));
               Helper.SetButtonCheck (hwndDlg, h2d_property.IDC_PALETTE, bCheck);

               bCheck := SYSTEM.CAST(BOOLEAN,(dwOrigStyle BAND WINUSER.WS_EX_STATICEDGE));
               Helper.SetButtonCheck (hwndDlg, h2d_property.IDC_STATICEDGE, bCheck);

               bCheck := SYSTEM.CAST(BOOLEAN,(dwOrigStyle BAND WINUSER.WS_EX_TOOLWINDOW));
               Helper.SetButtonCheck (hwndDlg, h2d_property.IDC_TOOLWINDOW, bCheck);

               bCheck := SYSTEM.CAST(BOOLEAN,(dwOrigStyle BAND WINUSER.WS_EX_WINDOWEDGE));
               Helper.SetButtonCheck (hwndDlg, h2d_property.IDC_WINDOWEDGE, bCheck);

               bCheck := SYSTEM.CAST(BOOLEAN,(dwOrigStyle BAND WINUSER.WS_EX_ACCEPTFILES));
               Helper.SetButtonCheck (hwndDlg, h2d_property.IDC_ACCEPTFILES, bCheck);

               bCheck := SYSTEM.CAST(BOOLEAN,(dwOrigStyle BAND WINUSER.WS_EX_APPWINDOW));
               Helper.SetButtonCheck (hwndDlg, h2d_property.IDC_APPWINDOW, bCheck);

               bCheck := SYSTEM.CAST(BOOLEAN,(dwOrigStyle BAND WINUSER.WS_EX_TOPMOST));
               Helper.SetButtonCheck (hwndDlg, h2d_property.IDC_TOPMOST, bCheck);

               bCheck := SYSTEM.CAST(BOOLEAN,(dwOrigStyle BAND WINUSER.WS_EX_TRANSPARENT));
               Helper.SetButtonCheck (hwndDlg, h2d_property.IDC_TRANSPARENT, bCheck);

               bCheck := SYSTEM.CAST(BOOLEAN,(dwOrigStyle BAND WINUSER.WS_EX_CONTROLPARENT));
               Helper.SetButtonCheck (hwndDlg, h2d_property.IDC_CONTROLPARENT, bCheck);

               bCheck := SYSTEM.CAST(BOOLEAN,(dwOrigStyle BAND WINUSER.WS_EX_MDICHILD));
               Helper.SetButtonCheck (hwndDlg, h2d_property.IDC_MDICHILD, bCheck);

               bCheck := SYSTEM.CAST(BOOLEAN,(dwOrigStyle BAND WINUSER.WS_EX_NOPARENTNOTIFY));
               Helper.SetButtonCheck (hwndDlg, h2d_property.IDC_NOPARENTNOTIFY, bCheck);

               RETURN TRUE;


          | WINUSER.WM_COMMAND :
               wNotifyCode := WINUSER.HIWORD (wParam);
               wID := WINUSER.LOWORD (wParam);

               CASE (wID) OF
                    | h2d_property.IDC_CLIENTEDGE :
                         hwndSheet := WINUSER.GetParent (hwndDlg);
                         COMMCTRL.PropSheet_Changed (hwndSheet, hwndDlg);
                    | h2d_property.IDC_CONTEXTHELP :
                         hwndSheet := WINUSER.GetParent (hwndDlg);
                         COMMCTRL.PropSheet_Changed (hwndSheet, hwndDlg);
                    | h2d_property.IDC_DLGMODALFRAME :
                         hwndSheet := WINUSER.GetParent (hwndDlg);
                         COMMCTRL.PropSheet_Changed (hwndSheet, hwndDlg);
                    | h2d_property.IDC_EXOVERLAPPED :
                         hwndSheet := WINUSER.GetParent (hwndDlg);
                         COMMCTRL.PropSheet_Changed (hwndSheet, hwndDlg);
                    | h2d_property.IDC_PALETTE :
                         hwndSheet := WINUSER.GetParent (hwndDlg);
                         COMMCTRL.PropSheet_Changed (hwndSheet, hwndDlg);
                    | h2d_property.IDC_STATICEDGE :
                         hwndSheet := WINUSER.GetParent (hwndDlg);
                         COMMCTRL.PropSheet_Changed (hwndSheet, hwndDlg);
                    | h2d_property.IDC_TOOLWINDOW :
                         hwndSheet := WINUSER.GetParent (hwndDlg);
                         COMMCTRL.PropSheet_Changed (hwndSheet, hwndDlg);
                    | h2d_property.IDC_WINDOWEDGE :
                         hwndSheet := WINUSER.GetParent (hwndDlg);
                         COMMCTRL.PropSheet_Changed (hwndSheet, hwndDlg);
                    | h2d_property.IDC_ACCEPTFILES :
                         hwndSheet := WINUSER.GetParent (hwndDlg);
                         COMMCTRL.PropSheet_Changed (hwndSheet, hwndDlg);
                    | h2d_property.IDC_APPWINDOW :
                         hwndSheet := WINUSER.GetParent (hwndDlg);
                         COMMCTRL.PropSheet_Changed (hwndSheet, hwndDlg);
                    | h2d_property.IDC_TOPMOST :
                         hwndSheet := WINUSER.GetParent (hwndDlg);
                         COMMCTRL.PropSheet_Changed (hwndSheet, hwndDlg);
                    | h2d_property.IDC_TRANSPARENT :
                         hwndSheet := WINUSER.GetParent (hwndDlg);
                         COMMCTRL.PropSheet_Changed (hwndSheet, hwndDlg);
                    | h2d_property.IDC_CONTROLPARENT :
                         hwndSheet := WINUSER.GetParent (hwndDlg);
                         COMMCTRL.PropSheet_Changed (hwndSheet, hwndDlg);
                    | h2d_property.IDC_MDICHILD :
                         hwndSheet := WINUSER.GetParent (hwndDlg);
                         COMMCTRL.PropSheet_Changed (hwndSheet, hwndDlg);
                    | h2d_property.IDC_NOPARENTNOTIFY :
                         hwndSheet := WINUSER.GetParent (hwndDlg);
                         COMMCTRL.PropSheet_Changed (hwndSheet, hwndDlg);
               ELSE
               END;
               RETURN TRUE;

          | WINUSER.WM_HELP :
               (* Catch F1 key strike                                          *)
               WINUSER.MessageBox (hwndDlg, "WM_HELP Message Received",
                           "ExStyleDlgProc", WINUSER.MB_OK);
               RETURN TRUE;

          | WINUSER.WM_NOTIFY :
               pnmh := SYSTEM.CAST(WINUSER.LPNMHDR,lParam);

                           (* Handle Finish button on wizard page                                   *)
                           IF (pnmh^.code = COMMCTRL.PSN_WIZFINISH) THEN
                                        hwndPS := WINUSER.GetParent (hwndDlg);
                                        COMMCTRL.PropSheet_Apply (hwndPS);
                                        RETURN TRUE;
                           END;

               (* Handle OK and Apply buttons                                  *)
               IF (pnmh^.code = COMMCTRL.PSN_APPLY) OR (pnmh^.code = COMMCTRL.PSN_RESET) THEN
                    (* Overwrite current style value                           *)
                    pTheExStyles^ := FetchExStyles (hwndDlg);

                    (* Tell main window to re-create child window              *)
                    hwndPS := WINUSER.GetParent (hwndDlg);
                    hwndActive := COMMCTRL.PropSheet_GetCurrentPageHwnd(hwndPS);

                    (* Only re-create if we're the active page                 *)
                    IF (hwndDlg = hwndActive) THEN
                         WINUSER.PostMessage (hwndMain, h2d_property.PM_CREATEWINDOW, 0, 0h);
                    END;
                END;

               (* Destroy modeless dialog on OK or Cancel                      *)
               IF ((WINUSER.IsWindowEnabled (hwndMain) AND
                   ((pnmh^.code = COMMCTRL.PSN_APPLY) OR (pnmh^.code = COMMCTRL.PSN_RESET)))) THEN
                    psh := SYSTEM.CAST(COMMCTRL.LPPSHNOTIFY,lParam);

                    (* Ignore Apply button                                     *)
                    IF (pnmh^.code = COMMCTRL.PSN_APPLY) AND (psh^.lParam = 0) THEN
                         RETURN TRUE;
                    END;
                    (* Clicking OK or Cancel, destroy property sheet           *)
                    hwndPropSheet := WINUSER.GetParent (hwndDlg);
                    WINUSER.DestroyWindow (hwndPropSheet);
                    hwndModeless := NIL;
               END;

               (* Enable Back and Finish buttons on wizard page                *)
               IF (bWizard) AND (pnmh^.code = COMMCTRL.PSN_SETACTIVE) THEN
                    hwndSheet := WINUSER.GetParent (hwndDlg);
                    COMMCTRL.PropSheet_SetWizButtons (hwndSheet, COMMCTRL.PSWIZB_BACK BOR
                                                        COMMCTRL.PSWIZB_FINISH);
               END;

               (* Support FOR Help button DO                               *)
               IF (pnmh^.code = COMMCTRL.PSN_HELP) THEN
                    WINUSER.MessageBox (hwndDlg, "PSN_HELP Notification Received",
                                "ExStyleDlgProc", WINUSER.MB_OK);
               END;

               RETURN TRUE;

          ELSE
               RETURN FALSE;
          END;
END ExStyleDlgProc;

(*******************************************************************-          *)
<*/POP*>
(*+++***************************************************************-          *)
PROCEDURE FetchExStyles (hwndDlg  :  WIN32.HWND) : WIN32.DWORD;
(*******************************************************************-          *)
VAR
  dwStyle   :  WIN32.DWORD;
BEGIN
     dwStyle := 0h;
     IF (Helper.QueryButtonCheck (hwndDlg, h2d_property.IDC_CLIENTEDGE)) THEN
          dwStyle  := dwStyle BOR WINUSER.WS_EX_CLIENTEDGE;
     END;

     IF (Helper.QueryButtonCheck (hwndDlg, h2d_property.IDC_CONTEXTHELP)) THEN
          dwStyle  := dwStyle BOR WINUSER.WS_EX_CONTEXTHELP;
     END;

     IF (Helper.QueryButtonCheck (hwndDlg, h2d_property.IDC_DLGMODALFRAME)) THEN
          dwStyle  := dwStyle BOR WINUSER.WS_EX_DLGMODALFRAME;
     END;

     IF (Helper.QueryButtonCheck (hwndDlg, h2d_property.IDC_EXOVERLAPPED)) THEN
          dwStyle  := dwStyle BOR WINUSER.WS_EX_OVERLAPPEDWINDOW;
     END;

     IF (Helper.QueryButtonCheck (hwndDlg, h2d_property.IDC_PALETTE)) THEN
          dwStyle  := dwStyle BOR WINUSER.WS_EX_PALETTEWINDOW;
     END;

     IF (Helper.QueryButtonCheck (hwndDlg, h2d_property.IDC_STATICEDGE)) THEN
          dwStyle  := dwStyle BOR WINUSER.WS_EX_STATICEDGE;
     END;

     IF (Helper.QueryButtonCheck (hwndDlg, h2d_property.IDC_TOOLWINDOW)) THEN
          dwStyle  := dwStyle BOR WINUSER.WS_EX_TOOLWINDOW;
     END;

     IF (Helper.QueryButtonCheck (hwndDlg, h2d_property.IDC_WINDOWEDGE)) THEN
          dwStyle  := dwStyle BOR WINUSER.WS_EX_WINDOWEDGE;
     END;

     IF (Helper.QueryButtonCheck (hwndDlg, h2d_property.IDC_ACCEPTFILES)) THEN
          dwStyle  := dwStyle BOR WINUSER.WS_EX_ACCEPTFILES;
     END;

     IF (Helper.QueryButtonCheck (hwndDlg, h2d_property.IDC_APPWINDOW)) THEN
          dwStyle  := dwStyle BOR WINUSER.WS_EX_APPWINDOW;
     END;

     IF (Helper.QueryButtonCheck (hwndDlg, h2d_property.IDC_TOPMOST)) THEN
          dwStyle  := dwStyle BOR WINUSER.WS_EX_TOPMOST;
     END;

     IF (Helper.QueryButtonCheck (hwndDlg, h2d_property.IDC_TRANSPARENT)) THEN
          dwStyle  := dwStyle BOR WINUSER.WS_EX_TRANSPARENT;
     END;

     IF (Helper.QueryButtonCheck (hwndDlg, h2d_property.IDC_CONTROLPARENT)) THEN
          dwStyle  := dwStyle BOR WINUSER.WS_EX_CONTROLPARENT;
     END;

     IF (Helper.QueryButtonCheck (hwndDlg, h2d_property.IDC_MDICHILD)) THEN
          dwStyle  := dwStyle BOR WINUSER.WS_EX_MDICHILD;
     END;

     IF (Helper.QueryButtonCheck (hwndDlg, h2d_property.IDC_NOPARENTNOTIFY)) THEN
          dwStyle  := dwStyle BOR WINUSER.WS_EX_NOPARENTNOTIFY;
     END;


     RETURN dwStyle;
END FetchExStyles;
END Page2.