home *** CD-ROM | disk | FTP | other *** search
- MODULE Generic;
-
- FROM SYSTEM IMPORT
- (*TYPE*) ADDRESS, BYTE,
- (*PROC*) ADR;
-
- FROM Windows IMPORT
- (*TYPE*) HWND, BOOL, DlgProc, WNDCLASS, HANDLE, LPSTR, MSG,
- (*CONST*) True, False, WM_INITDIALOG, WM_COMMAND, IDOK, IDCANCEL,
- WM_DESTROY, NULL, IDC_ARROW, WHITE_BRUSH, WS_OVERLAPPEDWINDOW,
- CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT,
- (*PROC*) DefWindowProc, EndDialog, MakeDlgProcInstance, DialogBox,
- FreeDlgProcInstance, PostQuitMessage, LoadIcon, LoadCursor,
- GetStockObject, RegisterClass, CreateWindow, ShowWindow,
- UpdateWindow, GetMessage, TranslateMessage, DispatchMessage;
-
- CONST
-
- (* ID of "About" dialog. Must also define this in resource file. *)
-
- IDM_ABOUT = 100;
-
- (* "About" box message processing *)
-
- PROCEDURE About ['About'] ( hDlg : HWND;
- wMsg, wParam : CARDINAL;
- lParam : LONGINT) : BOOL [WINDOWS, LONG];
- BEGIN
- CASE wMsg OF
- WM_INITDIALOG:
- RETURN True;
- |
- WM_COMMAND:
- IF (wParam = IDOK) OR (wParam = IDCANCEL) THEN
- EndDialog(hDlg, True);
- RETURN True;
- END;
- END;
- RETURN False;
- END About;
-
- (* This is the windows procedure. Windows automatically calls *)
- (* this procedure whenever the window needs repainting, etc. *)
-
- PROCEDURE MainWndProc ['MainWndProc'] (hWnd : HWND;
- wMsg, wParam : CARDINAL;
- lParam : LONGINT) : LONGINT [WINDOWS, LONG];
- VAR
- lpProcDialog : DlgProc;
- BEGIN
- CASE wMsg OF
- WM_COMMAND:
- IF wParam = IDM_ABOUT THEN
- lpProcDialog := MakeDlgProcInstance(About, Instance);
- DialogBox(Instance, ADR('AboutBox'), hWnd, lpProcDialog);
- FreeDlgProcInstance(lpProcDialog);
- ELSE
- RETURN DefWindowProc(hWnd, wMsg, wParam, lParam);
- END;
- |
- WM_DESTROY:
- PostQuitMessage(0);
- ELSE
- RETURN DefWindowProc(hWnd, wMsg, wParam, lParam);
- END;
- RETURN NULL;
- END MainWndProc;
-
- (* The following application creates the window class shared by
- all instances of the program. Several instances might be running
- at once, so this procedure is only called by the first to run. *)
-
- PROCEDURE InitApplication() : BOOL;
- VAR
- Class : WNDCLASS;
- BEGIN
- WITH Class DO
- style := NULL;
- lpfnWndProc := MainWndProc;
- cbClsExtra := 0;
- cbWndExtra := 0;
- hInstance := Instance;
- hIcon := LoadIcon(hInstance, ADR('GenericIcon'));
- hCursor := LoadCursor(NULL, IDC_ARROW);
- hbrBackground := GetStockObject(WHITE_BRUSH);
- lpszMenuName := ADR('GenericMenu');
- lpszClassName := ADR('GenericWClass');
- END;
- RETURN RegisterClass(Class);
- END InitApplication;
-
- (* The following procedure creates the data structures and
- main window for a specific instance of the application. *)
-
- PROCEDURE InitInstance() : BOOL;
- VAR
- hWnd : HWND;
- BEGIN
- hWnd := CreateWindow(
- ADR('GenericWClass'),
- ADR('Generic Sample Application'),
- WS_OVERLAPPEDWINDOW,
- CW_USEDEFAULT,
- CW_USEDEFAULT,
- CW_USEDEFAULT,
- CW_USEDEFAULT,
- NULL,
- NULL,
- Instance,
- ADDRESS(0));
-
- IF Instance = NULL THEN
- RETURN False;
- END;
-
- ShowWindow(hWnd, CmdShow);
- UpdateWindow(hWnd);
- RETURN True;
- END InitInstance;
-
- VAR
- Instance ['SYSTEM_Instance'] : HANDLE;
- PrevInstance ['SYSTEM_PrevInstance'] : HANDLE;
- CmdLine ['SYSTEM_CmdLine'] : LPSTR;
- CmdShow ['SYSTEM_CmdShow'] : INTEGER;
-
- VAR
- Msg : MSG;
-
- BEGIN
-
- (* Register the window class if we are the first instance to run *)
-
- IF PrevInstance = NULL THEN
- IF InitApplication() = False THEN
- HALT;
- END;
- END;
-
- (* Create the main window *)
-
- IF InitInstance() = False THEN
- HALT;
- END;
-
- LOOP
- IF GetMessage(Msg, NULL, NULL, NULL) = False THEN
- EXIT;
- END;
- TranslateMessage(Msg);
- DispatchMessage(Msg);
- END;
- END Generic.