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