Last updated: 15. 2.1998, 18:17
<*/NOWARN:F*>
MODULE DDEPop2;
(*---------------------------------------------
DDEPOP2.C --- DDEML Server for Population Data
(c) Charles Petzold, 1996
DDEPop2.mod --- Translation to Stony Brook Modula-2
(c) Peter Stadler, 1998
---------------------------------------------*)
%IF WIN32 %THEN
<*/Resource:DDEPOP2.RES*>
%ELSE
%END
IMPORT Helper;
IMPORT WINUSER;
IMPORT WINGDI;
IMPORT WIN32;
IMPORT WINX;
IMPORT SYSTEM;
IMPORT DDEML;
IMPORT h2d_ddepop;
IMPORT Str;
CONST WM_USER_INITIATE = WINUSER.WM_USER + 1;
CONST ID_TIMER = 1;
szAppName = "DdePop2";
szTopic = "US_Population";
VAR
hInst : WIN32.HINSTANCE;
hwnd : WIN32.HWND;
wc : WINUSER.WNDCLASSEX;
msg : WINUSER.MSG;
idInst : WIN32.DWORD;
hszService : DDEML.HSZ;
hszTopic : DDEML.HSZ;
(*********************************************************************)
PROCEDURE GetStateNumber (iFmt : WIN32.UINT; hszItem : DDEML.HSZ): INTEGER;
(*********************************************************************)
VAR
szItem : ARRAY[0..31] OF CHAR;
i : INTEGER;
BEGIN
IF (iFmt # WINUSER.CF_TEXT) THEN
RETURN -1;
END;
DDEML.DdeQueryString (idInst, hszItem, szItem, SIZE (szItem), 0);
i := 0;
LOOP
IF (Str.Compare(szItem, h2d_ddepop.pop[i].szState^) = 0) THEN
EXIT;
END;
INC(i);
IF(i > h2d_ddepop.NUM_STATES-1) THEN
EXIT;
END;
END;
IF (i >= h2d_ddepop.NUM_STATES) THEN
RETURN -1;
END;
RETURN i;
END GetStateNumber;
<*/PUSH*>
%IF WIN32 %THEN
<*/CALLS:WIN32SYSTEM*>
%ELSE
<*/CALLS:WINSYSTEM*>
%END
(*++++*****************************************************************)
PROCEDURE DdeCallback (iType : WIN32.UINT;
(**********************************************************************)
iFmt : WIN32.UINT;
hConv : DDEML.HCONV;
hsz1 : WIN32.WPARAM;
hsz2 : WIN32.WPARAM;
hData : WIN32.WPARAM;
dwData1 : WIN32.DWORD;
dwData2 : WIN32.DWORD) : DDEML.HDDEDATA [EXPORT];
VAR
szBuffer : ARRAY[0..31] OF CHAR;
i : INTEGER;
BEGIN
CASE (iType) OF
| DDEML.XTYP_CONNECT : (* hsz1 = topic *)
(* hsz2 = service *)
DDEML.DdeQueryString (idInst, hsz2, szBuffer, SIZE (szBuffer), 0);
IF (Str.Compare(szBuffer, szAppName)#0) THEN
RETURN 0;
END;
DDEML.DdeQueryString (idInst, hsz1, szBuffer, SIZE (szBuffer), 0);
IF (Str.Compare(szBuffer, szTopic)#0) THEN
RETURN 0;
END;
RETURN VAL(DDEML.HDDEDATA,TRUE);
| DDEML.XTYP_ADVSTART : (* hsz1 := topic *)
(* hsz2 := item *)
(* Check for matching format and data item DO *)
i := GetStateNumber (iFmt, hsz2);
IF (i = -1) THEN
RETURN 0;
END;
h2d_ddepop.pop[i].lPopLast := 0;
WINUSER.PostMessage (hwnd, WINUSER.WM_TIMER, 0, 0h);
RETURN VAL(DDEML.HDDEDATA,TRUE);
| DDEML.XTYP_REQUEST :
(* hsz1 := topic *)
(* hsz2 := item *)
(* Check for matching format and data item *)
i := GetStateNumber (iFmt, hsz2);
IF (i = -1) THEN
RETURN 0;
END;
WINUSER.wsprintf (szBuffer, "%ld\r"+"", h2d_ddepop.pop[i].lPop);
RETURN DDEML.DdeCreateDataHandle (idInst, SYSTEM.ADR(szBuffer),
LENGTH(szBuffer) + 1,
0, hsz2, WINUSER.CF_TEXT, 0);
| DDEML.XTYP_ADVREQ :
(* hsz1 := topic *)
(* hsz2 := item *)
(* Check for matching format and data item *)
i := GetStateNumber (iFmt, hsz2);
IF (i = -1) THEN
RETURN 0;
END;
WINUSER.wsprintf (szBuffer, "%ld\r"+"", h2d_ddepop.pop[i].lPop);
RETURN DDEML.DdeCreateDataHandle (idInst, SYSTEM.ADR(szBuffer),
LENGTH(szBuffer) + 1,
0, hsz2, WINUSER.CF_TEXT, 0);
| DDEML.XTYP_ADVSTOP : (* hsz1 := topic *)
(* hsz2 := item *)
(* Check for matching format and data item DO *)
i := GetStateNumber (iFmt, hsz2);
IF (i=-1) THEN
RETURN 0;
END;
RETURN VAL(DDEML.HDDEDATA,TRUE);
ELSE
RETURN 0;
END;
END DdeCallback;
<*/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
hszItem : DDEML.HSZ;
i : INTEGER;
BEGIN
CASE (iMsg) OF
| WM_USER_INITIATE :
Helper.InitPops ();
hszService := DDEML.DdeCreateStringHandle (idInst, szAppName, 0);
hszTopic := DDEML.DdeCreateStringHandle (idInst, szTopic, 0);
DDEML.DdeNameService (idInst, hszService, 0, DDEML.DNS_REGISTER);
RETURN 0;
| WINUSER.WM_TIMER :
(* Calculate new current populations *)
Helper.CalcPops ();
FOR i := 0 TO h2d_ddepop.NUM_STATES-1 DO
IF (h2d_ddepop.pop[i].lPop # h2d_ddepop.pop[i].lPopLast) THEN
hszItem := DDEML.DdeCreateStringHandle (idInst,
h2d_ddepop.pop[i].szState^, 0);
DDEML.DdePostAdvise (idInst, hszTopic, hszItem);
DDEML.DdeFreeStringHandle (idInst, hszItem);
h2d_ddepop.pop[i].lPopLast := h2d_ddepop.pop[i].lPop;
END;
END;
RETURN 0;
| WINUSER.WM_TIMECHANGE :
(* Calculate new current populations *)
Helper.CalcPops ();
FOR i := 0 TO h2d_ddepop.NUM_STATES-1 DO
IF (h2d_ddepop.pop[i].lPop # h2d_ddepop.pop[i].lPopLast) THEN
hszItem := DDEML.DdeCreateStringHandle (idInst,
h2d_ddepop.pop[i].szState^, 0);
DDEML.DdePostAdvise (idInst, hszTopic, hszItem);
DDEML.DdeFreeStringHandle (idInst, hszItem);
h2d_ddepop.pop[i].lPopLast := h2d_ddepop.pop[i].lPop;
END;
END;
RETURN 0;
| WINUSER.WM_QUERYOPEN :
RETURN 0;
| WINUSER.WM_DESTROY :
DDEML.DdeNameService (idInst, hszService, 0, DDEML.DNS_UNREGISTER);
DDEML.DdeFreeStringHandle (idInst, hszService);
DDEML.DdeFreeStringHandle (idInst, hszTopic);
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(wc);
wc.style := 0;
wc.lpfnWndProc := WndProc;
wc.cbClsExtra := 0;
wc.cbWndExtra := 0;
wc.hInstance := WINX.Instance;
wc.hIcon := WINUSER.LoadIcon (WINX.Instance,szAppName);
wc.hCursor := WINUSER.LoadCursor (NIL, WINUSER.IDC_ARROW^);
wc.hbrBackground := SYSTEM.CAST(WIN32.HBRUSH, WINGDI.GetStockObject (WINGDI.WHITE_BRUSH));
wc.lpszMenuName := NIL;
wc.lpszClassName := SYSTEM.ADR(szAppName);
wc.hIconSm := WINUSER.LoadIcon (WINX.Instance,szAppName);
rc := WINUSER.RegisterClassEx(wc);
RETURN rc#0;
END InitApplication;
(*++++*****************************************************************)
PROCEDURE InitMainWindow () : BOOLEAN;
(**********************************************************************)
BEGIN
hwnd := WINUSER.CreateWindow (szAppName,
"DDEML Population Server: 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);
WINUSER.ShowWindow (hwnd, WINUSER.SW_SHOWMINNOACTIVE);
WINUSER.UpdateWindow (hwnd);
(* Initialize for using DDEML *)
IF (DDEML.DdeInitialize (idInst, SYSTEM.CAST(DDEML.PFNCALLBACK,SYSTEM.ADR(DdeCallback)),
DDEML.CBF_FAIL_EXECUTES BOR DDEML.CBF_FAIL_POKES BOR
DDEML.CBF_SKIP_REGISTRATIONS BOR DDEML.CBF_SKIP_UNREGISTRATIONS, 0)=1) THEN
WINUSER.MessageBox (hwnd, "Could not initialize server!",
szAppName, WINUSER.MB_ICONEXCLAMATION BOR WINUSER.MB_OK);
WINUSER.DestroyWindow (hwnd);
RETURN FALSE;
END;
(* Set the timer *)
WINUSER.SetTimer (hwnd, ID_TIMER, 5000, NIL);
(* Start things going *)
WINUSER.SendMessage (hwnd, WM_USER_INITIATE, 0, 0h);
END InitMainWindow;
BEGIN
IF InitApplication() AND InitMainWindow() THEN
WHILE (WINUSER.GetMessage(msg,NIL,0,0)) DO
WINUSER.TranslateMessage(msg);
WINUSER.DispatchMessage(msg);
END;
(* Clean up *)
DDEML.DdeUninitialize (idInst);
WINUSER.KillTimer (hwnd, ID_TIMER);
END;
END DDEPop2.