Last updated: 18. 1.1998, 14:38
<* +M2EXTENSIONS *>
MODULE PoePoem;
(*-------------------------------------------------
POEPOEM.C --- Demonstrates User-Defined Resource
(c) Charles Petzold, 1996
PoePoem.mod --- translation to XDS Modula-2
(c) Peter Stadler, 1997
-------------------------------------------------*)
IMPORT h2d_PoePoem;
IMPORT Windows;
IMPORT SYSTEM;
TYPE
TEXT = ARRAY[0..4000] OF CHAR;
PTEXT = POINTER TO TEXT;
VAR
szAppName : ARRAY[0..9] OF CHAR;
szCaption : ARRAY[0..34] OF CHAR;
hInst : Windows.HINSTANCE;
hwnd : Windows.HWND;
msg : Windows.MSG;
wc : Windows.WNDCLASSEX;
pText : PTEXT;
hResource : Windows.HGLOBAL;
hScroll : Windows.HWND;
iPosition : INTEGER;
cxChar : INTEGER;
cyChar : INTEGER;
cyClient : INTEGER;
iNumLines : INTEGER;
xScroll : 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
szPoemRes : ARRAY[0..14] OF CHAR;
hdc : Windows.HDC;
ps : Windows.PAINTSTRUCT;
rect : Windows.RECT;
tm : Windows.TEXTMETRIC;
nH : INTEGER;
i : CARDINAL;
BEGIN
CASE (iMsg) OF
| Windows.WM_CREATE :
hdc := Windows.GetDC (hwnd);
Windows.GetTextMetrics (hdc, tm);
cxChar := tm.tmAveCharWidth;
cyChar := tm.tmHeight + tm.tmExternalLeading;
Windows.ReleaseDC (hwnd, hdc);
xScroll := Windows.GetSystemMetrics (Windows.SM_CXVSCROLL);
hScroll := Windows.CreateWindow ("scrollbar", "",
Windows.WS_CHILD + Windows.WS_VISIBLE + Windows.SBS_VERT,
0, 0, 0, 0,
hwnd, SYSTEM.CAST(Windows.HMENU,1), hInst, NIL);
Windows.LoadString (hInst, h2d_PoePoem.IDS_POEMRES, szPoemRes, SIZE (szPoemRes));
hResource := Windows.LoadResource (hInst,
Windows.FindResource (hInst, szPoemRes, "TEXT"));
pText := SYSTEM.CAST(PTEXT,Windows.LockResource (hResource));
iNumLines := 0;
FOR i := 0 TO LENGTH(pText^) DO
IF(pText^[i] = CHR(13)) AND(pText^[i+1]= CHR(10)) THEN
INC(iNumLines);
END;
END;
Windows.SetScrollRange (hScroll, Windows.SB_CTL, 0, iNumLines, FALSE);
Windows.SetScrollPos (hScroll, Windows.SB_CTL, 0, FALSE);
RETURN 0;
| Windows.WM_SIZE :
IF(cyClient = SYSTEM.CAST(INTEGER,Windows.HIWORD(lParam))) THEN
nH := 1;
ELSE
nH := 0;
END;
Windows.MoveWindow (hScroll, VAL(INTEGER,Windows.LOWORD (lParam)) - xScroll, 0,
xScroll, nH, TRUE);
Windows.SetFocus (hwnd);
RETURN 0;
| Windows.WM_SETFOCUS :
Windows.SetFocus (hScroll);
RETURN 0;
| Windows.WM_VSCROLL :
CASE SYSTEM.CAST(Windows.SB_ENUM,wParam) OF
| Windows.SB_TOP :
iPosition := 0;
| Windows.SB_BOTTOM :
iPosition := iNumLines;
| Windows.SB_LINEUP :
iPosition := iPosition - 1;
| Windows.SB_LINEDOWN :
iPosition := iPosition + 1;
| Windows.SB_PAGEUP :
iPosition := iPosition - cyClient DIV cyChar;
| Windows.SB_PAGEDOWN :
iPosition := iPosition + cyClient DIV cyChar;
| Windows.SB_THUMBPOSITION :
iPosition := Windows.LOWORD (lParam);
ELSE
END;
iPosition := MaxInt (0, MinInt (iPosition, iNumLines));
IF (iPosition # Windows.GetScrollPos (hScroll, Windows.SB_CTL)) THEN
Windows.SetScrollPos (hScroll, Windows.SB_CTL, iPosition, TRUE);
Windows.InvalidateRect (hwnd, NIL, TRUE);
END;
RETURN 0;
| Windows.WM_PAINT :
hdc := Windows.BeginPaint (hwnd, ps);
pText := SYSTEM.CAST(PTEXT, Windows.LockResource (hResource));
Windows.GetClientRect (hwnd, rect);
rect.left := rect.left + cxChar;
rect.top := rect.top + cyChar * (1 - iPosition);
Windows.DrawText (hdc, pText^, -1, rect, Windows.DT_EXTERNALLEADING);
Windows.EndPaint (hwnd, ps);
RETURN 0;
| Windows.WM_DESTROY :
Windows.FreeResource (hResource);
Windows.PostQuitMessage (0);
RETURN 0;
ELSE
RETURN Windows.DefWindowProc (hwnd, iMsg, wParam, lParam);
END;
END WndProc;
(*++++*****************************************************************)
PROCEDURE InitApplication () : BOOLEAN;
(**********************************************************************)
BEGIN
Windows.LoadString (Windows.MyInstance(), h2d_PoePoem.IDS_APPNAME, szAppName, SIZE(szAppName));
Windows.LoadString (Windows.MyInstance(), h2d_PoePoem.IDS_CAPTION, szCaption, SIZE(szCaption));
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 (Windows.MyInstance(), szAppName);
wc.hCursor := Windows.LoadCursor (NIL, Windows.IDC_ARROW);
wc.hbrBackground := SYSTEM.CAST(Windows.HBRUSH, Windows.GetStockObject(Windows.WHITE_BRUSH));
wc.lpszMenuName := NIL;
wc.lpszClassName := SYSTEM.ADR(szAppName);
wc.hIconSm := Windows.LoadIcon (Windows.MyInstance(), szAppName);
RETURN Windows.RegisterClassEx(wc)#0;
END InitApplication;
(*++++*****************************************************************)
PROCEDURE InitMainWindow () : BOOLEAN;
(**********************************************************************)
BEGIN
hInst := Windows.MyInstance();
hwnd := Windows.CreateWindow (szAppName,
szCaption,
Windows.WS_OVERLAPPEDWINDOW + Windows.WS_CLIPCHILDREN,
Windows.CW_USEDEFAULT,
Windows.CW_USEDEFAULT,
Windows.CW_USEDEFAULT,
Windows.CW_USEDEFAULT,
NIL,
NIL,
Windows.MyInstance(),
NIL);
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 PoePoem.