Last updated: 18. 1.1998, 14:30
<* +M2EXTENSIONS *>
MODULE OwnerDrw;
(*----------------------------------------------
OWNERDRW.C --- Owner-Draw Button Demo Program
(c) Charles Petzold, 1996
OwnerDrw.mod --- Translation to XDS Modula-2
(c) Peter Stadler, 1998
----------------------------------------------*)
IMPORT Windows;
IMPORT SYSTEM;
CONST
IDC_SMALLER = 1;
IDC_LARGER = 2;
VAR
hInst : Windows.HINSTANCE;
CONST
szAppName = "OwnerDrw";
VAR
hwnd : Windows.HWND;
msg : Windows.MSG;
wc : Windows.WNDCLASSEX;
VAR
hwndSmaller : Windows.HWND;
hwndLarger : Windows.HWND;
cxClient : INTEGER;
cyClient : INTEGER;
cxChar : INTEGER;
cyChar : INTEGER;
BTN_WIDTH : INTEGER;
BTN_HEIGHT : INTEGER;
(**********************************************************************)
PROCEDURE Triangle (hdc : Windows.HDC; pt : ARRAY OF Windows.POINT);
(**********************************************************************)
BEGIN
Windows.SelectObject (hdc, Windows.GetStockObject (Windows.BLACK_BRUSH));
Windows.Polygon (hdc, pt, 3);
Windows.SelectObject (hdc, Windows.GetStockObject (Windows.WHITE_BRUSH));
END Triangle;
(*++++*****************************************************************)
PROCEDURE [Windows.CALLBACK] WndProc (hwnd : Windows.HWND;
(**********************************************************************)
iMsg : Windows.UINT;
wParam : Windows.WPARAM;
lParam : Windows.LPARAM) : Windows.LRESULT;
VAR
cx : INTEGER;
cy : INTEGER;
rc : Windows.RECT;
pdis : Windows.PDRAWITEMSTRUCT;
pt : ARRAY[0..2] OF Windows.POINT;
BEGIN
CASE (iMsg) OF
| Windows.WM_CREATE :
cxChar := Windows.LOWORD (Windows.GetDialogBaseUnits ());
cyChar := Windows.HIWORD (Windows.GetDialogBaseUnits ());
BTN_WIDTH := 8*cxChar;
BTN_HEIGHT := 4*cyChar;
(* Create the owner-draw pushbuttons *)
hwndSmaller := Windows.CreateWindow ("button", "",
Windows.WS_CHILD + Windows.WS_VISIBLE + Windows.BS_OWNERDRAW,
0, 0, BTN_WIDTH, BTN_HEIGHT,
hwnd, SYSTEM.CAST(Windows.HMENU,IDC_SMALLER), hInst, NIL);
hwndLarger := Windows.CreateWindow ("button", "",
Windows.WS_CHILD + Windows.WS_VISIBLE + Windows.BS_OWNERDRAW,
0, 0, BTN_WIDTH, BTN_HEIGHT,
hwnd, SYSTEM.CAST(Windows.HMENU,IDC_LARGER), hInst, NIL);
RETURN 0;
| Windows.WM_SIZE :
cxClient := Windows.LOWORD (lParam);
cyClient := Windows.HIWORD (lParam);
(* Move the buttons to the new center *)
Windows.MoveWindow (hwndSmaller, cxClient DIV 2 - 3 * BTN_WIDTH DIV 2,
cyClient DIV 2 - BTN_HEIGHT DIV 2,
BTN_WIDTH, BTN_HEIGHT, TRUE);
Windows.MoveWindow (hwndLarger, cxClient DIV 2 + BTN_WIDTH DIV 2,
cyClient DIV 2 - BTN_HEIGHT DIV 2,
BTN_WIDTH, BTN_HEIGHT, TRUE);
RETURN 0;
| Windows.WM_COMMAND :
Windows.GetWindowRect (hwnd, rc);
(* Make the window 10% smaller or larger *)
CASE (wParam) OF
| IDC_SMALLER :
rc.left := rc.left + cxClient DIV 20;
rc.right := rc.right - cxClient DIV 20;
rc.top := rc.top + cyClient DIV 20;
rc.bottom := rc.bottom - cyClient DIV 20;
| IDC_LARGER :
rc.left := rc.left - cxClient DIV 20;
rc.right := rc.right + cxClient DIV 20;
rc.top := rc.top - cyClient DIV 20;
rc.bottom := rc.bottom + cyClient DIV 20;
ELSE
END;
Windows.MoveWindow (hwnd, rc.left, rc.top, rc.right - rc.left,
rc.bottom - rc.top, TRUE);
RETURN 0;
| Windows.WM_DRAWITEM :
pdis := SYSTEM.CAST(Windows.PDRAWITEMSTRUCT,lParam);
(* Fill area with white and frame it black *)
Windows.FillRect (pdis^.hDC, pdis^.rcItem,
SYSTEM.CAST(Windows.HBRUSH,Windows.GetStockObject (Windows.WHITE_BRUSH)));
Windows.FrameRect (pdis^.hDC, pdis^.rcItem,
SYSTEM.CAST(Windows.HBRUSH,Windows.GetStockObject (Windows.BLACK_BRUSH)));
(* Draw inward and outward black triangles *)
cx := pdis^.rcItem.right - pdis^.rcItem.left;
cy := pdis^.rcItem.bottom - pdis^.rcItem.top ;
CASE (pdis^.CtlID) OF
| IDC_SMALLER :
pt[0].x := 3 * cx DIV 8; pt[0].y := 1 * cy DIV 8;
pt[1].x := 5 * cx DIV 8; pt[1].y := 1 * cy DIV 8;
pt[2].x := 4 * cx DIV 8; pt[2].y := 3 * cy DIV 8;
Triangle (pdis^.hDC, pt);
pt[0].x := 7 * cx DIV 8; pt[0].y := 3 * cy DIV 8;
pt[1].x := 7 * cx DIV 8; pt[1].y := 5 * cy DIV 8;
pt[2].x := 5 * cx DIV 8; pt[2].y := 4 * cy DIV 8;
Triangle (pdis^.hDC, pt);
pt[0].x := 5 * cx DIV 8; pt[0].y := 7 * cy DIV 8;
pt[1].x := 3 * cx DIV 8; pt[1].y := 7 * cy DIV 8;
pt[2].x := 4 * cx DIV 8; pt[2].y := 5 * cy DIV 8;
Triangle (pdis^.hDC, pt);
pt[0].x := 1 * cx DIV 8; pt[0].y := 5 * cy DIV 8;
pt[1].x := 1 * cx DIV 8; pt[1].y := 3 * cy DIV 8;
pt[2].x := 3 * cx DIV 8; pt[2].y := 4 * cy DIV 8;
Triangle (pdis^.hDC, pt);
| IDC_LARGER :
pt[0].x := 5 * cx DIV 8; pt[0].y := 3 * cy DIV 8;
pt[1].x := 3 * cx DIV 8; pt[1].y := 3 * cy DIV 8;
pt[2].x := 4 * cx DIV 8; pt[2].y := 1 * cy DIV 8;
Triangle (pdis^.hDC, pt);
pt[0].x := 5 * cx DIV 8; pt[0].y := 5 * cy DIV 8;
pt[1].x := 5 * cx DIV 8; pt[1].y := 3 * cy DIV 8;
pt[2].x := 7 * cx DIV 8; pt[2].y := 4 * cy DIV 8;
Triangle (pdis^.hDC, pt);
pt[0].x := 3 * cx DIV 8; pt[0].y := 5 * cy DIV 8;
pt[1].x := 5 * cx DIV 8; pt[1].y := 5 * cy DIV 8;
pt[2].x := 4 * cx DIV 8; pt[2].y := 7 * cy DIV 8;
Triangle (pdis^.hDC, pt);
pt[0].x := 3 * cx DIV 8; pt[0].y := 3 * cy DIV 8;
pt[1].x := 3 * cx DIV 8; pt[1].y := 5 * cy DIV 8;
pt[2].x := 1 * cx DIV 8; pt[2].y := 4 * cy DIV 8;
Triangle (pdis^.hDC, pt);
ELSE
END;
(* Invert the rectangle if the button is selected *)
IF (pdis^.itemState - Windows.ODS_SELECTED=SYSTEM.CAST(Windows.ODS_SET,1)) THEN
Windows.InvertRect (pdis^.hDC, pdis^.rcItem);
END;
(* Draw a focus rectangle if the button has the focus *)
IF (pdis^.itemState - Windows.ODS_FOCUS=SYSTEM.CAST(Windows.ODS_SET,1)) THEN
pdis^.rcItem.left := pdis^.rcItem.left + cx DIV 16;
pdis^.rcItem.top := pdis^.rcItem.top + cy DIV 16;
pdis^.rcItem.right := pdis^.rcItem.right - cx DIV 16;
pdis^.rcItem.bottom := pdis^.rcItem.bottom - cy DIV 16;
Windows.DrawFocusRect (pdis^.hDC, pdis^.rcItem);
END;
RETURN 0;
| Windows.WM_DESTROY :
Windows.PostQuitMessage (0);
RETURN 0;
ELSE
RETURN Windows.DefWindowProc (hwnd, iMsg, wParam, lParam);
END;
END WndProc;
(*++++*****************************************************************)
PROCEDURE InitApplication () : BOOLEAN;
(**********************************************************************)
VAR
rc : CARDINAL;
BEGIN
hInst := Windows.MyInstance();
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 := SYSTEM.CAST(Windows.HBRUSH,Windows.GetStockObject(Windows.WHITE_BRUSH));
wc.lpszMenuName := SYSTEM.ADR(szAppName);
wc.lpszClassName := SYSTEM.ADR(szAppName);
wc.hIconSm := Windows.LoadIcon (NIL,Windows.IDI_APPLICATION);
rc := Windows.RegisterClassEx(wc);
RETURN rc#0;
END InitApplication;
(*++++*****************************************************************)
PROCEDURE InitMainWindow () : BOOLEAN;
(**********************************************************************)
BEGIN
hwnd := Windows.CreateWindow (
szAppName, (* window class name *)
"Owner-Draw Button Demo: Translation to XDS Modula-2",
(* window caption *)
Windows.WS_OVERLAPPEDWINDOW, (* window style *)
Windows.CW_USEDEFAULT, (* initial x position *)
Windows.CW_USEDEFAULT, (* initial y position *)
Windows.CW_USEDEFAULT, (* initial x size *)
Windows.CW_USEDEFAULT, (* initial y size *)
NIL, (* parent window handle *)
NIL, (* window menu handle *)
wc.hInstance, (* program instance handle *)
NIL); (* creation parameters *)
IF hwnd = NIL THEN
RETURN FALSE;
END;
Windows.ShowWindow (hwnd, Windows.SW_SHOWDEFAULT);
Windows.UpdateWindow (hwnd);
RETURN TRUE;
END InitMainWindow;
BEGIN
IF InitApplication() AND InitMainWindow() THEN
WHILE (Windows.GetMessage(msg,NIL,0,0)) DO
Windows.TranslateMessage(msg);
Windows.DispatchMessage(msg);
END;
END;
END OwnerDrw.