Last updated: 15. 1.1998, 21:42
<*/NOWARN:F*> MODULE Colors1; (*---------------------------------------- COLORS1.C --- Colors Using Scroll Bars (c) Charles Petzold, 1996, Chapter 8 Colors1.mod --- Translation to Stony Brook Modula-2 (c) Peter Stadler, 1997 ----------------------------------------*) IMPORT WIN32; IMPORT WINX; IMPORT WINGDI; IMPORT WINUSER; IMPORT SYSTEM; IMPORT WholeStr; CONST szAppName = "Colors1"; TYPE ColorLabel = ARRAY[0..10] OF CHAR; VAR fnOldScr : ARRAY[0..2] OF WINUSER.WNDPROC; hwndScrol : ARRAY[0..2] OF WIN32.HWND; hwndLabel : ARRAY[0..2] OF WIN32.HWND; hwndValue : ARRAY[0..2] OF WIN32.HWND; hwndRect : WIN32.HWND; color : ARRAY[0..2] OF INTEGER; iFocus : INTEGER; szColorLabel : ARRAY[0..2] OF ColorLabel; hwnd : WIN32.HWND; msg : WINUSER.MSG; wc : WINUSER.WNDCLASSEX; crPrim : ARRAY[0..2] OF WIN32.COLORREF; hBrush : ARRAY[0..2] OF WIN32.HBRUSH; hBrushStatic : WIN32.HBRUSH; cyChar : INTEGER; rcColor : WIN32.RECT; szBuffer : ARRAY[0..9] OF CHAR; cxClient : INTEGER; cyClient : 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]; VAR i : INTEGER; currentObject : WIN32.HBRUSH; currentBrush : WIN32.HBRUSH; BEGIN CASE (iMsg) OF | WINUSER.WM_CREATE : FOR i := 0 TO 3-1 DO hBrush[i] := WINGDI.CreateSolidBrush (crPrim[i]); END; hBrushStatic := WINGDI.CreateSolidBrush (WINUSER.GetSysColor (WINUSER.COLOR_BTNHIGHLIGHT)); cyChar := WINUSER.HIWORD (WINUSER.GetDialogBaseUnits ()); RETURN 0; | WINUSER.WM_SIZE : cxClient := WINUSER.LOWORD (lParam); cyClient := WINUSER.HIWORD (lParam); WINUSER.SetRect (rcColor, cxClient / 2, 0, cxClient, cyClient); WINUSER.MoveWindow (hwndRect, 0, 0, cxClient / 2, cyClient, TRUE); FOR i := 0 TO 3-1 DO WINUSER.MoveWindow (hwndScrol[i], (2 * i + 1) * cxClient / 14, 2 * cyChar, cxClient / 14, cyClient - 4 * cyChar, TRUE); WINUSER.MoveWindow (hwndLabel[i], (4 * i + 1) * cxClient / 28, cyChar / 2, cxClient / 7, cyChar, TRUE); WINUSER.MoveWindow (hwndValue[i], (4 * i + 1) * cxClient / 28, cyClient - 3 * cyChar / 2, cxClient / 7, cyChar, TRUE); END; WINUSER.SetFocus (hwnd); RETURN 0; | WINUSER.WM_SETFOCUS : WINUSER.SetFocus (hwndScrol[iFocus]); RETURN 0; | WINUSER.WM_VSCROLL : i := WINUSER.GetWindowLong (SYSTEM.CAST(WIN32.HWND, lParam), WINUSER.GWL_ID); CASE (WINUSER.LOWORD (wParam)) OF | WINUSER.SB_PAGEDOWN : color[i] := color[i] + 15; (* fall through *) | WINUSER.SB_LINEDOWN : color[i] := MinInt (255, color[i] + 1); | WINUSER.SB_PAGEUP : color[i] := color[i] - 15; (* fall through *) | WINUSER.SB_LINEUP : color[i] := MaxInt (0, color[i] - 1); | WINUSER.SB_TOP : color[i] := 0; | WINUSER.SB_BOTTOM : color[i] := 255; | WINUSER.SB_THUMBPOSITION : | WINUSER.SB_THUMBTRACK : color[i] := WINUSER.HIWORD (wParam); ELSE END; WINUSER.SetScrollPos (hwndScrol[i], WINUSER.SB_CTL, color[i], TRUE); WholeStr.IntToStr(color[i],szBuffer); WINUSER.SetWindowText (hwndValue[i], szBuffer); currentBrush := WINGDI.CreateSolidBrush(WINGDI.RGB(color[0], color[1], color[2])); currentObject := SYSTEM.CAST(WIN32.HBRUSH, WINUSER.SetClassLong(hwnd,WINUSER.GCL_HBRBACKGROUND, SYSTEM.CAST(WIN32.WORD,currentBrush))); WINGDI.DeleteObject(SYSTEM.CAST(WIN32.HGDIOBJ,currentObject)); WINUSER.InvalidateRect (hwnd, rcColor, TRUE); RETURN 0; | WINUSER.WM_CTLCOLORSCROLLBAR : i := WINUSER.GetWindowLong (SYSTEM.CAST(WIN32.HWND,lParam), WINUSER.GWL_ID); RETURN SYSTEM.CAST(WIN32.LRESULT,hBrush[i]); | WINUSER.WM_CTLCOLORSTATIC : i := WINUSER.GetWindowLong (SYSTEM.CAST(WIN32.HWND, lParam), WINUSER.GWL_ID); IF (i >= 3) AND (i <= 8) THEN (* static text controls *) WINGDI.SetTextColor (SYSTEM.CAST(WIN32.HDC, wParam), crPrim[i REM 3]); WINGDI.SetBkColor (SYSTEM.CAST(WIN32.HDC, wParam), WINUSER.GetSysColor (WINUSER.COLOR_BTNHIGHLIGHT)); RETURN SYSTEM.CAST(WIN32.LRESULT, hBrushStatic); END; | WINUSER.WM_SYSCOLORCHANGE : WINGDI.DeleteObject (SYSTEM.CAST(WIN32.HGDIOBJ,hBrushStatic)); hBrushStatic := WINGDI.CreateSolidBrush ( WINUSER.GetSysColor (WINUSER.COLOR_BTNHIGHLIGHT)); RETURN 0; | WINUSER.WM_DESTROY : WINGDI.DeleteObject (SYSTEM.CAST(WIN32.HGDIOBJ, WINUSER.SetClassLong (hwnd, WINUSER.GCL_HBRBACKGROUND, SYSTEM.CAST(WIN32.DWORD, WINGDI.GetStockObject(WINGDI.WHITE_BRUSH))))); FOR i := 0 TO 3-1 DO WINGDI.DeleteObject (SYSTEM.CAST(WIN32.HGDIOBJ,hBrush[i])); END; WINGDI.DeleteObject (SYSTEM.CAST(WIN32.HGDIOBJ,hBrushStatic)); WINUSER.PostQuitMessage (0); RETURN 0; ELSE RETURN WINUSER.DefWindowProc (hwnd, iMsg, wParam, lParam); END; RETURN WINUSER.DefWindowProc (hwnd, iMsg, wParam, lParam); END WndProc; <*/POP*> <*/PUSH*> %IF WIN32 %THEN <*/CALLS:WIN32SYSTEM*> %ELSE <*/CALLS:WINSYSTEM*> %END (*++++*****************************************************************) PROCEDURE ScrollProc (hwnd : WIN32.HWND; (**********************************************************************) iMsg : WIN32.UINT; wParam : WIN32.WPARAM; lParam : WIN32.LPARAM) : WIN32.LRESULT [EXPORT]; VAR i : INTEGER; BEGIN i := WINUSER.GetWindowLong (hwnd, WINUSER.GWL_ID); CASE (iMsg) OF | WINUSER.WM_KEYDOWN : IF (wParam = WINUSER.VK_TAB) THEN IF(WINUSER.GetKeyState (WINUSER.VK_SHIFT) < 0) THEN WINUSER.SetFocus (hwndScrol[(i + 2) REM 3]); ELSE WINUSER.SetFocus (hwndScrol[(i + 1) REM 3]); END; END; | WINUSER.WM_SETFOCUS : iFocus := i; ELSE RETURN WINUSER.CallWindowProc (fnOldScr[i], hwnd, iMsg, wParam, lParam); END; RETURN WINUSER.CallWindowProc (fnOldScr[i], hwnd, iMsg, wParam, lParam); END ScrollProc; <*/POP*> (*++++*****************************************************************) PROCEDURE InitApplication () : BOOLEAN; (**********************************************************************) 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 (NIL, WINUSER.IDI_APPLICATION^); wc.hCursor := WINUSER.LoadCursor (NIL, WINUSER.IDC_ARROW^); wc.hbrBackground := WINGDI.CreateSolidBrush(000h); wc.lpszMenuName := NIL; wc.lpszClassName := SYSTEM.ADR(szAppName); wc.hIconSm := WINUSER.LoadIcon (NIL,WINUSER.IDI_APPLICATION^); RETURN WINUSER.RegisterClassEx(wc)#0; END InitApplication; (*++++*****************************************************************) PROCEDURE InitMainWindow () : BOOLEAN; (**********************************************************************) VAR i : CARDINAL; BEGIN hwnd := WINUSER.CreateWindow (szAppName, "Color Scroll: Translation to Stony Brook Modula-2", WINUSER.WS_OVERLAPPEDWINDOW, WINUSER.CW_USEDEFAULT, WINUSER.CW_USEDEFAULT, WINUSER.CW_USEDEFAULT, WINUSER.CW_USEDEFAULT, NIL, NIL, WINX.Instance, NIL); hwndRect := WINUSER.CreateWindow ("static", "", WINUSER.WS_CHILD BOR WINUSER.WS_VISIBLE BOR WINUSER.SS_WHITERECT, 0, 0, 0, 0, hwnd, SYSTEM.CAST(WIN32.HMENU,9), WINX.Instance, NIL); FOR i := 0 TO 3-1 DO hwndScrol[i] := WINUSER.CreateWindow ("scrollbar", "", WINUSER.WS_CHILD BOR WINUSER.WS_VISIBLE BOR WINUSER.WS_TABSTOP BOR WINUSER.SBS_VERT, 0, 0, 0, 0, hwnd, SYSTEM.CAST(WIN32.HMENU,i), WINX.Instance, NIL); hwndLabel[i] := WINUSER.CreateWindow ("static", szColorLabel[i], WINUSER.WS_CHILD BOR WINUSER.WS_VISIBLE BOR WINUSER.SS_CENTER, 0, 0, 0, 0, hwnd, SYSTEM.CAST(WIN32.HMENU,i+3), WINX.Instance, NIL); hwndValue[i] := WINUSER.CreateWindow ("static", "0", WINUSER.WS_CHILD BOR WINUSER.WS_VISIBLE BOR WINUSER.SS_CENTER, 0, 0, 0, 0, hwnd, SYSTEM.CAST(WIN32.HMENU,i+6), WINX.Instance, NIL); fnOldScr[i] := SYSTEM.CAST(WINUSER.WNDPROC,WINUSER.SetWindowLong (hwndScrol[i], WINUSER.GWL_WNDPROC, SYSTEM.CAST(WIN32.LONG,ScrollProc))); WINUSER.SetScrollRange (hwndScrol[i], WINUSER.SB_CTL, 0, 255, FALSE); WINUSER.SetScrollPos (hwndScrol[i], WINUSER.SB_CTL, 0, FALSE); END; WINUSER.ShowWindow (hwnd, WINUSER.SW_SHOWDEFAULT); WINUSER.UpdateWindow (hwnd); RETURN TRUE; END InitMainWindow; BEGIN szColorLabel[0] := "Red"; szColorLabel[1] := "Green"; szColorLabel[2] := "Blue"; crPrim[0] := WINGDI.RGB (255, 0, 0); crPrim[1] := WINGDI.RGB (0, 255, 0); crPrim[2] := WINGDI.RGB (0, 0, 255); IF InitApplication() AND InitMainWindow() THEN WHILE (WINUSER.GetMessage(msg,NIL,0,0)) DO WINUSER.TranslateMessage(msg); WINUSER.DispatchMessage(msg); END; END; END Colors1.