Last updated: 5. 3.1998, 7:40
<*/NOWARN:F*>
MODULE StrProg;
(*--------------------------------------------------------
STRPROG.C --- Program using STRLIB dynamic link library
(c) Charles Petzold, 1996
StrProg.mod --- Translation to Stony Brook Modula-2
(c) Peter Stadler, 1998
--------------------------------------------------------*)
%IF WIN32 %THEN
<*/Resource:STRPROG.RES*>
%ELSE
%END
IMPORT SYSTEM;
IMPORT WINUSER;
IMPORT WIN32;
IMPORT WINGDI;
IMPORT Strings;
IMPORT WINX;
IMPORT h2d_strprog;
IMPORT StrStuff;
IMPORT Str;
CONST szAppName = "StrProg";
CONST MAXLEN = 32;
CONST WM_DATACHANGE = WINUSER.WM_USER;
VAR
hwnd : WIN32.HWND;
msg : WINUSER.MSG;
wc : WINUSER.WNDCLASSEX;
szString : ARRAY[0..MAXLEN-1] OF CHAR;
VAR (* static in WndProc *)
hInst : WIN32.HINSTANCE;
cxChar : INTEGER;
cyChar : INTEGER;
cxClient : INTEGER;
cyClient : INTEGER;
TYPE
CBPARAM = RECORD
hdc : WIN32.HDC;
xText : INTEGER;
yText : INTEGER;
xStart : INTEGER;
yStart : INTEGER;
xIncr : INTEGER;
yIncr : INTEGER;
xMax : INTEGER;
yMax : INTEGER;
END;
PCBPARAM = POINTER TO CBPARAM;
<*/PUSH*>
%IF WIN32 %THEN
<*/CALLS:WIN32SYSTEM*>
%ELSE
<*/CALLS:WINSYSTEM*>
%END
(*++++*****************************************************************)
PROCEDURE DlgProc (hDlg : WIN32.HWND;
iMsg : WIN32.UINT;
wParam : WIN32.WPARAM;
lParam : WIN32.LPARAM) : WIn32.BOOL [EXPORT];
(**********************************************************************)
BEGIN
CASE (iMsg) OF
| WINUSER.WM_INITDIALOG :
WINUSER.SendDlgItemMessage (hDlg, h2d_strprog.IDD_STRING, WINUSER.EM_LIMITTEXT,
MAXLEN - 1, 0);
RETURN TRUE;
| WINUSER.WM_COMMAND :
CASE (wParam) OF
| WINUSER.IDOK :
WINUSER.GetDlgItemText (hDlg, h2d_strprog.IDD_STRING, szString, MAXLEN);
WINUSER.EndDialog (hDlg, 1);
RETURN TRUE;
| WINUSER.IDCANCEL :
WINUSER.EndDialog (hDlg, 0);
RETURN TRUE;
ELSE
END;
ELSE
END;
RETURN FALSE;
END DlgProc;
<*/POP*>
<*/PUSH*>
%IF WIN32 %THEN
<*/CALLS:WIN32SYSTEM*>
%ELSE
<*/CALLS:WINSYSTEM*>
%END
(*++++*****************************************************************)
PROCEDURE EnumCallBack (hwnd : WIN32.HWND;
lParam : WIN32.LPARAM) : WIN32.BOOL [EXPORT];
(**********************************************************************)
VAR
szClassName : ARRAY[0..15] OF CHAR;
BEGIN
WINUSER.GetClassName (hwnd, szClassName, SIZE (szClassName));
IF (0 = Str.Compare (szClassName, szAppName)) THEN
WINUSER.SendMessage (hwnd, WM_DATACHANGE, 0, 0);
END;
RETURN TRUE;
END EnumCallBack;
<*/POP*>
<*/PUSH*>
%IF WIN32 %THEN
<*/CALLS:WIN32SYSTEM*>
%ELSE
<*/CALLS:WINSYSTEM*>
%END
(*++++*****************************************************************)
PROCEDURE GetStrCallBack (pString : WIN32.PSTR;
pcbp : PCBPARAM) : WIN32.BOOL [EXPORT];
(**********************************************************************)
BEGIN
WINGDI.TextOut (pcbp^.hdc, pcbp^.xText, pcbp^.yText,
pString^, LENGTH(pString^));
pcbp^.yText := pcbp^.yText + pcbp^.yIncr;
IF (pcbp^.yText > pcbp^.yMax) THEN
pcbp^.yText := pcbp^.yStart;
pcbp^.xText := pcbp^.xText + pcbp^.xIncr;
IF (pcbp^.xText > pcbp^.xMax) THEN
RETURN FALSE;
END;
END;
RETURN TRUE;
END GetStrCallBack;
<*/POP*>
<*/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
hdc : WIN32.HDC;
ps : WINUSER.PAINTSTRUCT;
tm : WINGDI.TEXTMETRIC;
cbparam : CBPARAM;
lpcr : WINUSER.LPCREATESTRUCT;
BEGIN
CASE (iMsg) OF
| WINUSER.WM_CREATE :
lpcr := SYSTEM.CAST(WINUSER.LPCREATESTRUCT,lParam);
hInst := lpcr^.hInstance;
hdc := WINUSER.GetDC (hwnd);
WINGDI.GetTextMetrics (hdc, tm);
cxChar := SYSTEM.CAST(INTEGER,tm.tmAveCharWidth);
cyChar := SYSTEM.CAST(INTEGER,tm.tmHeight + tm.tmExternalLeading);
WINUSER.ReleaseDC (hwnd, hdc);
RETURN 0;
| WINUSER.WM_COMMAND :
CASE (wParam) OF
| h2d_strprog.IDM_ENTER :
IF (WINUSER.DialogBox (hInst, "EnterDlg", hwnd, DlgProc)=1) THEN
IF (StrStuff.AddString (SYSTEM.ADR(szString))) THEN
WINUSER.EnumWindows (SYSTEM.CAST(WINUSER.WNDENUMPROC,EnumCallBack), 0);
ELSE
WINUSER.MessageBeep (0);
END;
END;
| h2d_strprog.IDM_DELETE :
IF (WINUSER.DialogBox (hInst, "DeleteDlg", hwnd, DlgProc)=1) THEN
IF (StrStuff.DeleteString (SYSTEM.ADR(szString))) THEN
WINUSER.EnumWindows (SYSTEM.CAST(WINUSER.WNDENUMPROC,EnumCallBack), 0);
ELSE
WINUSER.MessageBeep (0);
END;
END;
ELSE
END;
RETURN 0;
| WINUSER.WM_SIZE :
cxClient := VAL(INTEGER,WINUSER.LOWORD (lParam));
cyClient := VAL(INTEGER,WINUSER.HIWORD (lParam));
RETURN 0;
| WM_DATACHANGE :
WINUSER.InvalidateRect (hwnd, WINX.NIL_RECT, TRUE);
RETURN 0;
| WINUSER.WM_PAINT :
hdc := WINUSER.BeginPaint (hwnd, ps);
cbparam.hdc := hdc;
cbparam.xText := cxChar;
cbparam.xStart := cxChar;
cbparam.yText := cyChar;
cbparam.yStart := cyChar;
cbparam.xIncr := cxChar * MAXLEN;
cbparam.yIncr := cyChar;
cbparam.xMax := cbparam.xIncr * (1 + cxClient DIV cbparam.xIncr);
cbparam.yMax := cyChar * (cyClient DIV cyChar - 1);
StrStuff.GetStrings (SYSTEM.CAST(StrStuff.PSTRCB,GetStrCallBack), SYSTEM.CAST(WIN32.PVOID,SYSTEM.ADR(cbparam)));
WINUSER.EndPaint (hwnd, ps);
RETURN 0;
| WINUSER.WM_DESTROY :
WINUSER.PostQuitMessage (0);
RETURN 0;
ELSE
RETURN WINUSER.DefWindowProc (hwnd, iMsg, wParam, lParam);
END;
END WndProc;
<*/POP*>
(*++++*****************************************************************)
PROCEDURE InitApplication () : BOOLEAN;
(**********************************************************************)
VAR
rc : CARDINAL;
BEGIN
wc.cbSize := SIZE(WINUSER.WNDCLASSEX);
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 := SYSTEM.CAST(WIN32.HBRUSH, WINGDI.GetStockObject (WINGDI.WHITE_BRUSH));
wc.lpszMenuName := SYSTEM.ADR(szAppName);
wc.lpszClassName := SYSTEM.ADR(szAppName);
wc.hIconSm := WINUSER.LoadIcon (NIL, WINUSER.IDI_APPLICATION^);
rc := WINUSER.RegisterClassEx (wc);
RETURN rc #0;
END InitApplication;
(*++++*****************************************************************)
PROCEDURE InitMainWindow () : BOOLEAN;
(**********************************************************************)
BEGIN
hwnd := WINUSER.CreateWindow
(szAppName, (* window class name *)
"DLL Demonstration Program, Translation to Stony Brook Modula-2",
(* window caption *)
WINUSER.WS_OVERLAPPEDWINDOW, (* window style *)
WINUSER.CW_USEDEFAULT, (* initial x position *)
WINUSER.CW_USEDEFAULT, (* initial y position *)
WINUSER.CW_USEDEFAULT, (* initial x size *)
WINUSER.CW_USEDEFAULT, (* initial y size *)
NIL, (* parent window handle *)
NIL, (* window menu handle *)
WINX.Instance, (* program instance handle *)
NIL); (* creation parameters *)
IF hwnd = NIL THEN
RETURN FALSE;
END;
WINUSER.ShowWindow (hwnd, WINUSER.SW_SHOWDEFAULT);
WINUSER.UpdateWindow (hwnd);
RETURN TRUE;
END InitMainWindow;
(*++++*****************************************************************)
BEGIN
IF InitApplication() AND InitMainWindow() THEN
WHILE (WINUSER.GetMessage(msg,NIL,0,0)) DO
WINUSER.TranslateMessage(msg);
WINUSER.DispatchMessage(msg);
END;
END;
END StrProg.