Property.mod: Translation to Stony Brook Modula-2

Last updated: 14. 2.1998, 10: 0

<*/NOWARN:F*>
(*--------------------------------------
   PROPERTY.C      --- Property sheet example
                   (c) Paul Yao,      1996
   Property.MOD    --- Translation to Stony Brook Modula-2
                   (c) Peter Stadler, 1997
  --------------------------------------*)
MODULE Property;
%IF WIN32 %THEN
    <*/Resource:PROPERTY.RES*>
%ELSE
%END
IMPORT SYSTEM;
IMPORT COMMCTRL;
IMPORT WINUSER;
IMPORT WIN32;
IMPORT WINGDI;
IMPORT WINX;
IMPORT Sheet;
IMPORT comcthlp;
IMPORT h2d_property;
IMPORT Page1;
IMPORT Page2;
IMPORT MemUtils;

VAR szAppName :  ARRAY[0..30] OF CHAR = "Property Sheet";
  hInst       :  WIN32.HINSTANCE;
  hwnd        :  WIN32.HWND;
  hwndMain    :  WIN32.HWND;
  hwndChild   :  WIN32.HWND;
  hwndModeless:  WIN32.HWND;
  hiconApp    :  WIN32.HICON;
  bWizard     :  BOOLEAN;
(* Values modified by property sheet                                           *)
  dwChildStyle  : WIN32.DWORD;
  dwChildExStyle: WIN32.DWORD;
(* Value modified by menu item selection                                       *)
  dwSheetStyles : WIN32.DWORD;

  msg         :  WINUSER.MSG;
  wc          :  WINUSER.WNDCLASSEX;

(*******************************************************************-          *)
PROCEDURE MenuCheckMark (hmenu : WIN32.HMENU;
                         id    : INTEGER;
                         bCheck: BOOLEAN);
VAR
  iState   :  INTEGER;
BEGIN
     IF(bCheck) THEN
        iState := WINUSER.MF_CHECKED;
     ELSE
        iState := WINUSER.MF_UNCHECKED;
     END;
     WINUSER.CheckMenuItem (hmenu, id, iState);
END MenuCheckMark;

(*******************************************************************-          *)
PROCEDURE FlipFlag (dwStyle : WIN32.LPDWORD; flag : WIN32.DWORD);
(*******************************************************************-          *)
BEGIN
     IF ((dwStyle^ BAND flag)#0) THEN  (* Flag on -- turn off                              *)
          dwStyle^ := BNOT flag;
     ELSE                  (* Flag off -- turn on                              *)
          dwStyle^ := dwStyle^ BOR flag;
     END;
END FlipFlag;

(*******************************************************************-          *)
<*/PUSH*>
%IF WIN32 %THEN
    <*/CALLS:WIN32SYSTEM*>
%ELSE
    <*/CALLS:WINSYSTEM*>
%END

(*++++*****************************************************************)
PROCEDURE  WndProc (hwnd        : WIN32.HWND;
                    mMsg        : WIN32.UINT;
                    wParam      : WIN32.WPARAM;
                    lParam      : WIN32.LPARAM) : WIN32.LRESULT [EXPORT];
(**********************************************************************)
VAR
  bRet    :  BOOLEAN;
  bCheck  :  BOOLEAN;
  hmenu   :  WIN32.HMENU;
  cxWidth :  INTEGER;
  cyHeight:  INTEGER;
  cx      :  INTEGER;
  cy      :  INTEGER;
  x       :  INTEGER;
  y       :  INTEGER;
  rClient :  WIN32.RECT;
  l       :  WIN32.LPARAM;
BEGIN

  CASE (mMsg) OF
          | WINUSER.WM_CREATE :
               hwndChild := WINUSER.CreateWindowEx (dwChildExStyle, "CHILD",
                                           "First Window", dwChildStyle,
                                           0, 0, 0, 0, hwnd, SYSTEM.CAST(WIN32.HMENU,1),
                                                                                   hInst, NIL);


               WINUSER.CreateWindowEx (dwChildExStyle, "CHILD", "Second Window",
                               WINUSER.WS_CLIPSIBLINGS BOR dwChildStyle,
                               10, 10, 200, 50, hwnd,
                               SYSTEM.CAST(WIN32.HMENU,2), hInst, NIL);
               RETURN 0;

          | WINUSER.WM_COMMAND :
               CASE (WINUSER.LOWORD (wParam))                                                                                                                                                          OF

                    | h2d_property.IDM_WINDOW_PROPERTIES :

                         (* If modeless, active existing property sheet        *)
                         IF (hwndModeless#NIL) THEN
                              WINUSER.SetActiveWindow (hwndModeless);
                         ELSE
                           (* Are we creating a wizard?                          *)
                           bWizard := SYSTEM.CAST(BOOLEAN,(dwSheetStyles BAND COMMCTRL.PSH_WIZARD));

                           (* Create actual property sheet                       *)
                           bRet := Sheet.CreatePropertySheet (hwnd);

                           (* Store handle if modeless                           *)
                           IF (dwSheetStyles BAND COMMCTRL.PSH_MODELESS#0) THEN
                                hwndModeless := SYSTEM.CAST(WIN32.HWND,bRet);
                           END;
                         END;

                    | h2d_property.IDM_WIZARD :
                         FlipFlag (SYSTEM.ADR(dwSheetStyles), COMMCTRL.PSH_WIZARD);

                    | h2d_property.IDM_HASHELP :
                         FlipFlag (SYSTEM.ADR(dwSheetStyles), COMMCTRL.PSH_HASHELP);

                    | h2d_property.IDM_MODELESS :
                         FlipFlag (SYSTEM.ADR(dwSheetStyles), COMMCTRL.PSH_MODELESS);

                    | h2d_property.IDM_NOAPPLYNOW :
                         FlipFlag (SYSTEM.ADR(dwSheetStyles), COMMCTRL.PSH_NOAPPLYNOW);

                    | h2d_property.IDM_PROPTITLE :
                         FlipFlag (SYSTEM.ADR(dwSheetStyles), COMMCTRL.PSH_PROPTITLE);

                    | h2d_property.IDM_RTLREADING :
                         FlipFlag (SYSTEM.ADR(dwSheetStyles), COMMCTRL.PSH_RTLREADING);
               ELSE
                    RETURN 0;
               END;

          | WINUSER.WM_DESTROY :
               WINUSER.PostQuitMessage (0);
               RETURN 0;

          | WINUSER.WM_INITMENU :
               hmenu := SYSTEM.CAST(WIN32.HMENU,wParam);

               bCheck := SYSTEM.CAST(BOOLEAN,dwSheetStyles BAND COMMCTRL.PSH_WIZARD);
               MenuCheckMark (hmenu, h2d_property.IDM_WIZARD, bCheck);

               bCheck := SYSTEM.CAST(BOOLEAN,dwSheetStyles BAND COMMCTRL.PSH_HASHELP);
               MenuCheckMark (hmenu, h2d_property.IDM_HASHELP, bCheck);

               bCheck := SYSTEM.CAST(BOOLEAN,dwSheetStyles BAND COMMCTRL.PSH_MODELESS);
               MenuCheckMark (hmenu, h2d_property.IDM_MODELESS, bCheck);

               bCheck := SYSTEM.CAST(BOOLEAN,dwSheetStyles BAND COMMCTRL.PSH_NOAPPLYNOW);
               MenuCheckMark (hmenu, h2d_property.IDM_NOAPPLYNOW, bCheck);

               bCheck := SYSTEM.CAST(BOOLEAN,dwSheetStyles BAND COMMCTRL.PSH_PROPTITLE);
               MenuCheckMark (hmenu, h2d_property.IDM_PROPTITLE, bCheck);

               bCheck := SYSTEM.CAST(BOOLEAN,dwSheetStyles BAND COMMCTRL.PSH_RTLREADING);
               MenuCheckMark (hmenu, h2d_property.IDM_RTLREADING, bCheck);

               RETURN 0;

          | WINUSER.WM_SETFOCUS :
               WINUSER.SetFocus (hwndChild);
               RETURN 0;

          | WINUSER.WM_SIZE :
               cxWidth  := WINUSER.LOWORD (lParam);
               cyHeight := WINUSER.HIWORD (lParam);

               x  := cxWidth  DIV 4;
               cx := cxWidth  DIV 2;
               y  := cyHeight DIV 4;
               cy := cyHeight DIV 2;

               WINUSER.MoveWindow (hwndChild, x, y, cx, cy, TRUE);
               RETURN 0;

          | h2d_property.PM_CREATEWINDOW :

               WINUSER.DestroyWindow (hwndChild);
               hwndChild := WINUSER.CreateWindowEx (dwChildExStyle, "CHILD",
                                           "First Window", dwChildStyle,
                                           0, 0, 0, 0, hwnd, SYSTEM.CAST(WIN32.HMENU,1),
                                                                                   hInst, NIL);

               (* Send ourselves a WINUSER.WM_SIZE to resize child window              *)
               WINUSER.GetClientRect (hwnd, rClient);
               l := WINUSER.MAKELPARAM (rClient.right, rClient.bottom);
               WINUSER.SendMessage (hwnd, WINUSER.WM_SIZE, 0, l);
               RETURN 0;

   ELSE
               RETURN (WINUSER.DefWindowProc (hwnd, mMsg, wParam, lParam));
   END;
END WndProc;
<*/POP*>
(*++++*****************************************************************)
PROCEDURE InitApplication () : BOOLEAN;
(**********************************************************************)
VAR
  lpstr   :  WIN32.LPSTR;
BEGIN
  hInst := WINX.Instance;
  lpstr := WINUSER.MAKEINTRESOURCE (h2d_property.IDI_APP);
  MemUtils.FillMemBYTE (wc, SIZE (WINUSER.WNDCLASSEX),0);
  hiconApp := WINUSER.LoadIcon (hInst,lpstr^ );
  wc.cbSize        := SIZE(WINUSER.WNDCLASSEX);
  wc.style         := WINUSER.CS_HREDRAW BOR WINUSER.CS_VREDRAW;
  wc.lpfnWndProc   := WndProc;
  wc.cbClsExtra    := 0;
  wc.cbWndExtra    := 0;
  wc.hInstance     := WINX.Instance;
  wc.hIcon         := hiconApp;
  wc.hCursor       := WINUSER.LoadCursor (NIL, WINUSER.IDC_ARROW^);
  wc.hbrBackground := SYSTEM.CAST(WIN32.HBRUSH, WINUSER.COLOR_APPWORKSPACE+1);
  wc.lpszMenuName  := NIL;
  wc.lpszClassName := SYSTEM.ADR("MAIN");
  wc.hIconSm       := hiconApp;
  WINUSER.RegisterClassEx (wc);

  wc.lpszClassName := SYSTEM.ADR("CHILD");
  wc.lpfnWndProc   := SYSTEM.CAST(WINUSER.WNDPROC,WINUSER.DefWindowProc);
  wc.hCursor       := WINUSER.LoadCursor (NIL, WINUSER.IDC_IBEAM^);
  wc.hIcon         := NIL;
  wc.lpszMenuName  := NIL;
  wc.hbrBackground := SYSTEM.CAST(WIN32.HBRUSH,(WINUSER.COLOR_WINDOW + 1));
  wc.hIconSm       := NIL;

  RETURN WINUSER.RegisterClassEx (wc)#0;
END InitApplication;
(*++++*****************************************************************)
PROCEDURE InitMainWindow () : BOOLEAN;
(**********************************************************************)
BEGIN
  hwnd := WINUSER.CreateWindowEx
           (WINUSER.WS_EX_OVERLAPPEDWINDOW,
           "MAIN",                               (* window class name            *)
           szAppName,
                                                 (* window caption               *)
           WINUSER.WS_OVERLAPPEDWINDOW,          (* window style                 *)
           WINUSER.CW_USEDEFAULT,                (* initial x position           *)
           WINUSER.CW_USEDEFAULT,                (* initial y position           *)
           WINUSER.CW_USEDEFAULT,                (* initial x size               *)
           WINUSER.CW_USEDEFAULT,                (* initial y size               *)
           NIL,                                  (* parent window handle         *)
           NIL,                                  (* window menu handle           *)
           WINX.Instance,                        (* program instance handle      *)
           NIL);                                 (* creation parameters          *)

  IF hwnd = NIL THEN
    RETURN FALSE;
  END;
  WINUSER.ShowWindow (hwnd, WINUSER.SW_SHOWDEFAULT);
  WINUSER.UpdateWindow (hwnd);
  COMMCTRL.InitCommonControls ();
  RETURN TRUE;
END InitMainWindow;
(*++++*****************************************************************)
BEGIN
  hwndMain    := NIL;
  hwndChild   := NIL;
  hwndModeless:= NIL;
  dwChildStyle  := WINUSER.WS_CHILD BOR WINUSER.WS_VISIBLE BOR WINUSER.WS_BORDER BOR WINUSER.WS_CAPTION;
  dwChildExStyle := 0h;
  dwSheetStyles  := COMMCTRL.PSH_PROPTITLE;
  IF InitApplication()  AND  InitMainWindow() THEN
    WHILE (WINUSER.GetMessage(msg,NIL,0,0)) DO
      IF ((hwndModeless#NIL) AND
          (NOT (COMMCTRL.PropSheet_IsDialogMessage (hwndModeless, msg)))) THEN
        WINUSER.TranslateMessage(msg);
        WINUSER.DispatchMessage(msg);
      END;
    END;  
  END;
END Property.