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.