Last updated: 11. 1.1998, 0:42
<*/NOWARN:F*> MODULE Colors2; (*------------------------------------------------ COLORS2.C --- Version using Modeless Dialog Box (c) Charles Petzold, 1996 Colors2.mod --- Translation to Stony Brook Modula-2 (c) Peter Stadler, 1997 ------------------------------------------------*) %IF WIN32 %THEN <*/Resource:COLORS2.RES*> %ELSE %END IMPORT WIN32; IMPORT WINUSER; IMPORT SYSTEM; IMPORT WINGDI; IMPORT WINX; CONST szAppName = "Colors2"; VAR msg : WINUSER.MSG; hwnd : WIN32.HWND; wc : WINUSER.WNDCLASSEX; hDlgModeless : WIN32.HWND; iColor : ARRAY[0..2] OF INTEGER; (*++++*****************************************************************) PROCEDURE MaxInt (a,b : INTEGER) : INTEGER; (**********************************************************************) BEGIN IF(a>b) THEN RETURN a; ELSE RETURN b; END; END MaxInt; (*++++*****************************************************************) PROCEDURE MinInt (a,b : INTEGER) : INTEGER; (**********************************************************************) BEGIN IF(a>b) THEN RETURN b; ELSE RETURN a; END; END MinInt; <*/PUSH*> %IF WIN32 %THEN <*/CALLS:WIN32SYSTEM*> %ELSE <*/CALLS:WINSYSTEM*> %END (*++++*****************************************************************) PROCEDURE WndProc (hwnd : WIN32.HWND; (**********************************************************************) iMsg : WIN32.UINT; wParam : WIN32.WPARAM; lParam : WIN32.LPARAM) : WIN32.LRESULT [EXPORT]; BEGIN CASE (iMsg) OF | WINUSER.WM_DESTROY : WINGDI.DeleteObject ( SYSTEM.CAST(WIN32.HGDIOBJ,WINUSER.SetClassLong (hwnd, WINUSER.GCL_HBRBACKGROUND, SYSTEM.CAST(WIN32.LONG,WINGDI.GetStockObject (WINGDI.WHITE_BRUSH))))); WINUSER.PostQuitMessage (0); RETURN 0; ELSE RETURN WINUSER.DefWindowProc (hwnd, iMsg, wParam, lParam); END; END WndProc; <*/POP*> <*/PUSH*> %IF WIN32 %THEN <*/CALLS:WIN32SYSTEM*> %ELSE <*/CALLS:WINSYSTEM*> %END (*++++*****************************************************************) PROCEDURE ColorScrDlg (hDlg : WIN32.HWND; (**********************************************************************) iMsg : WIN32.UINT; wParam : WIN32.WPARAM; lParam : WIN32.LPARAM) : WIN32.BOOL [EXPORT]; VAR hwndParent : WIN32.HWND; hCtrl : WIN32.HWND; iCtrlID : INTEGER; iIndex : INTEGER; BEGIN CASE (iMsg) OF | WINUSER.WM_INITDIALOG : FOR iCtrlID := 10 TO 13-1 DO hCtrl := WINUSER.GetDlgItem (hDlg, iCtrlID); WINUSER.SetScrollRange (hCtrl, WINUSER.SB_CTL, 0, 255, FALSE); WINUSER.SetScrollPos (hCtrl, WINUSER.SB_CTL, 0, FALSE); END; RETURN TRUE; | WINUSER.WM_VSCROLL : hCtrl := SYSTEM.CAST(WIN32.HWND,lParam); iCtrlID := WINUSER.GetWindowLong (hCtrl, WINUSER.GWL_ID); iIndex := iCtrlID - 10; hwndParent := WINUSER.GetParent (hDlg); CASE (WINUSER.LOWORD (wParam)) OF | WINUSER.SB_PAGEDOWN : iColor[iIndex] := iColor[iIndex] + 15; (* fall through *) | WINUSER.SB_LINEDOWN : iColor[iIndex] := MinInt (255, iColor[iIndex] + 1); | WINUSER.SB_PAGEUP : iColor[iIndex] := iColor[iIndex] - 15; (* fall through *) | WINUSER.SB_LINEUP : iColor[iIndex] := MaxInt (0, iColor[iIndex] - 1); | WINUSER.SB_TOP : iColor[iIndex] := 0; | WINUSER.SB_BOTTOM : iColor[iIndex] := 255; | WINUSER.SB_THUMBPOSITION : iColor[iIndex] := WINUSER.HIWORD (wParam); | WINUSER.SB_THUMBTRACK : iColor[iIndex] := WINUSER.HIWORD (wParam); ELSE RETURN FALSE; END; WINUSER.SetScrollPos (hCtrl, WINUSER.SB_CTL, iColor[iIndex], TRUE); WINUSER.SetDlgItemInt (hDlg, iCtrlID + 3, iColor[iIndex], FALSE); WINGDI.DeleteObject ( (SYSTEM.CAST(WIN32.HGDIOBJ,WINUSER.SetClassLong (hwndParent, WINUSER.GCL_HBRBACKGROUND, (SYSTEM.CAST(WIN32.LONG, WINGDI.CreateSolidBrush ( WINGDI.RGB (iColor[0], iColor[1], iColor[2])))))))); WINUSER.InvalidateRect (hwndParent, WINX.NIL_RECT, TRUE); RETURN TRUE; ELSE RETURN FALSE; END; END ColorScrDlg; <*/POP*> (*++++*****************************************************************) PROCEDURE InitApplication () : BOOLEAN; (**********************************************************************) VAR rc : CARDINAL; BEGIN wc.cbSize := SIZE(wc); wc.style := WINUSER.CS_HREDRAW BOR WINUSER.CS_VREDRAW; wc.lpfnWndProc := WndProc; wc.cbClsExtra := 0; wc.cbWndExtra := 0; wc.hInstance := WINX.Instance; wc.hIcon := WINUSER.LoadIcon (wc.hInstance,WINUSER.IDI_APPLICATION^); wc.hCursor := WINUSER.LoadCursor (NIL, WINUSER.IDC_ARROW^); wc.hbrBackground := WINGDI.CreateSolidBrush(00000h); wc.lpszMenuName := NIL; wc.lpszClassName := SYSTEM.ADR(szAppName); wc.hIconSm := WINUSER.LoadIcon (wc.hInstance,WINUSER.IDI_APPLICATION^); rc := WINUSER.RegisterClassEx(wc); RETURN rc#0; END InitApplication; (*++++*****************************************************************) PROCEDURE InitMainWindow () : BOOLEAN; (**********************************************************************) BEGIN hwnd := WINUSER.CreateWindow (szAppName, "Colors Scroll:Translation to Stony Brook Modula-2", WINUSER.WS_OVERLAPPEDWINDOW BOR WINUSER.WS_CLIPCHILDREN, WINUSER.CW_USEDEFAULT, WINUSER.CW_USEDEFAULT, WINUSER.CW_USEDEFAULT, WINUSER.CW_USEDEFAULT, NIL, NIL, WINX.Instance, NIL); IF hwnd = NIL THEN RETURN FALSE; END; WINUSER.ShowWindow (hwnd, WINUSER.SW_SHOWDEFAULT); WINUSER.UpdateWindow (hwnd); hDlgModeless := WINUSER.CreateDialog (WINX.Instance, "ColorScrDlg", hwnd, ColorScrDlg); RETURN TRUE; END InitMainWindow; BEGIN IF InitApplication() AND InitMainWindow() THEN WHILE (WINUSER.GetMessage(msg,NIL,0,0)) DO IF (hDlgModeless = NIL) OR (WINUSER.IsDialogMessage (hDlgModeless, msg)=FALSE) THEN WINUSER.TranslateMessage(msg); WINUSER.DispatchMessage(msg); END; END; END; END Colors2.