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.