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.