Last updated: 5. 3.1998, 7:41
<*/NOWARN:F*> MODULE DDEPop1; (*--------------------------------------------- DDEPOP1.C --- DDE Server for Population Data (c) Charles Petzold, 1996 DDEPop1.mod --- Translation to Stony Brook Modula-2 (c) Peter Stadler, 1997 ---------------------------------------------*) %IF WIN32 %THEN <*/Resource:DDEPOP1.RES*> %ELSE %END IMPORT Helper; IMPORT WINUSER; IMPORT WINGDI; IMPORT WIN32; IMPORT WINX; IMPORT SYSTEM; IMPORT DDE; IMPORT h2d_ddepop; IMPORT Str; TYPE POPADVISE = RECORD flags: BITSET16; lPopPrev: INTEGER32 END; CONST fAdvise = 0; fDeferUpd = 1; fAckReq = 2; CONST ID_TIMER = 1; DDE_TIMEOUT = 3000; szAppName = "DdePop1"; szServerClass = "DdePop1.Server"; szTopic = "US_Population"; VAR hInst : WIN32.HINSTANCE; hwnd : WIN32.HWND; msg : WINUSER.MSG; wc : WINUSER.WNDCLASSEX; <*/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 hBrush : WIN32.HBRUSH; hdc : WIN32.HDC; ps : WINUSER.PAINTSTRUCT; rc : WIN32.RECT; aApp : WIN32.ATOM; aTop : WIN32.ATOM; hwndClient : WIN32.HWND; hwndServer : WIN32.HWND; BEGIN CASE (iMsg) OF | DDE.WM_DDE_INITIATE : (* wParam -- sending window handle *) (* WINUSER.LOWORD (lParam) -- application atom *) (* WINUSER.HIWORD (lParam) -- topic atom *) hwndClient := SYSTEM.CAST(WIN32.HWND,wParam); aApp := WIN32.GlobalAddAtom (szAppName); aTop := WIN32.GlobalAddAtom (szTopic); (* Check for matching atoms, create window, and acknowledge*) IF ((WINUSER.LOWORD (lParam) = 0) OR (WINUSER.LOWORD (lParam) = aApp)) AND ((WINUSER.HIWORD (lParam) = 0) OR (WINUSER.HIWORD (lParam) = aTop)) THEN hwndServer := WINUSER.CreateWindow (szServerClass, "", WINUSER.WS_CHILD, 0, 0, 0, 0, hwnd, NIL, hInst, NIL); WINUSER.SetWindowLong (hwndServer, 0, SYSTEM.CAST(WIN32.LONG,hwndClient)); WINUSER.SendMessage (SYSTEM.CAST(WIN32.HWND,wParam), DDE.WM_DDE_ACK, SYSTEM.CAST(WIN32.WPARAM,hwndServer), WINUSER.MAKELPARAM (aApp, aTop)); (* Otherwise, delete the atoms just created *) ELSE WIN32.GlobalDeleteAtom (aApp); WIN32.GlobalDeleteAtom (aTop); END; RETURN 0; | WINUSER.WM_TIMER : (* Calculate new current populations *) Helper.CalcPops (); (* Notify all child windows *) WINUSER.EnumChildWindows (hwnd, SYSTEM.CAST(WINUSER.WNDENUMPROC,TimerEnumProc), 0h); RETURN 0; | WINUSER.WM_TIMECHANGE : (* Calculate new current populations *) Helper.CalcPops (); (* Notify all child windows *) WINUSER.EnumChildWindows (hwnd, SYSTEM.CAST(WINUSER.WNDENUMPROC,TimerEnumProc), 0h); RETURN 0; | WINUSER.WM_QUERYOPEN : RETURN 0; | WINUSER.WM_CLOSE : (* Notify all child windows *) WINUSER.EnumChildWindows (hwnd, SYSTEM.CAST(WINUSER.WNDENUMPROC,CloseEnumProc), 0h); (* For default processing *) | WINUSER.WM_DESTROY : WINUSER.PostQuitMessage (0); RETURN 0; ELSE RETURN WINUSER.DefWindowProc (hwnd, iMsg, wParam, lParam); END; END WndProc; <*/POP*> <*/PUSH*> %IF WIN32 %THEN <*/CALLS:WIN32SYSTEM*> %ELSE <*/CALLS:WINSYSTEM*> %END (*++++*****************************************************************) PROCEDURE ServerProc (hwnd : WIN32.HWND; (**********************************************************************) iMsg : WIN32.UINT; wParam : WIN32.WPARAM; lParam : WIN32.LPARAM) : WIN32.LRESULT [EXPORT]; VAR aItem : WIN32.ATOM; szItem : ARRAY[0..9] OF CHAR; DdeAck : DDE.DDEACK; pDdeAdvise : POINTER TO DDE.DDEADVISE; pPopAdvise : POINTER TO POPADVISE; dwTime : WIN32.DWORD; hPopAdvise : WIN32.GLOBALHANDLE; hDdeAdvise : WIN32.GLOBALHANDLE; hCommands : WIN32.GLOBALHANDLE; hDdePoke : WIN32.GLOBALHANDLE; i : INTEGER; uiLow : CARDINAL; uiHi : CARDINAL; hwndClient : WIN32.HWND; msg : WINUSER.MSG; cfFormat : WIN32.WORD; wStatus : WIN32.WORD; BEGIN CASE (iMsg) OF | WINUSER.WM_CREATE : (* Allocate memory for POPADVISE structures *) hPopAdvise := WIN32.GlobalAlloc (WIN32.GHND, h2d_ddepop.NUM_STATES * SIZE (POPADVISE)); IF (hPopAdvise = NIL) THEN WINUSER.DestroyWindow (hwnd); ELSE WINUSER.SetWindowLong (hwnd, 4, SYSTEM.CAST(WIN32.LONG, hPopAdvise)); END; RETURN 0; | DDE.WM_DDE_REQUEST : (* wParam -- sending window handle *) (* WINUSER.LOWORD (lParam) -- data format *) (* WINUSER.HIWORD (lParam) -- item atom *) hwndClient := SYSTEM.CAST(WIN32.HWND, wParam); cfFormat := WINUSER.LOWORD (lParam); aItem := WINUSER.HIWORD (lParam); (* Check for matching format and data item *) IF (cfFormat = WINUSER.CF_TEXT) THEN WIN32.GlobalGetAtomName (aItem, szItem, SIZE (szItem)); i := 0; LOOP IF (Str.Compare(szItem, h2d_ddepop.pop[i].szState^) = 0) THEN EXIT; END; INC(i); IF(i>= h2d_ddepop.NUM_STATES) THEN EXIT; END; END; IF (i < h2d_ddepop.NUM_STATES) THEN WIN32.GlobalDeleteAtom (aItem); PostDataMessage (hwnd, hwndClient, i, FALSE, FALSE, TRUE); RETURN 0; END; (* Negative acknowledge if no match *) EXCL(DdeAck.status,DDE.bAppReturnCode); EXCL(DdeAck.status,DDE.reserved); EXCL(DdeAck.status,DDE.fBusy); EXCL(DdeAck.status,DDE.fAck); (* DdeAck.status DDE.bAppReturnCode := 0; DdeAck.reserved := 0; DdeAck.fBusy := FALSE; DdeAck.fAck := FALSE; *) wStatus := DdeAck; (* wStatus := *((WORD *) SYSTEM.ADR(DdeAck)); *) IF (NOT PostMessage (hwndClient, WINUSER.WM_DDE_ACK, SYSTEM.CAST(WIN32.WPARAM,hwnd), PackDDElParam (WM_DDE_ACK, wStatus, aItem))) THEN GlobalDeleteAtom (aItem); END; RETURN 0; | WINUSER.WM_DDE_ADVISE : (* wParam -- sending window handle *) (* lParam -- DDEADVISE memory handle BAND item atom *) UnpackDDElParam (WM_DDE_ADVISE, lParam, SYSTEM.ADR(uiLow), SYSTEM.ADR(uiHi)); FreeDDElParam (WM_DDE_ADVISE, lParam); hwndClient := SYSTEM.CAST(WIN32.HWND,wParam); hDdeAdvise := SYSTEM.CAST(GLOBALHANDLE,uiLow); aItem := SYSTEM.CAST(WIN32.ATOM,uiHi); pDdeAdvise := SYSTEM.CAST(DDEADVISE,GlobalLock (hDdeAdvise)); (* Check for matching format and data item do *) IF (pDdeAdvise^.cfFormat = CF_TEXT) THEN GlobalGetAtomName (aItem, szItem, SIZE (szItem)); i := 0; LOOP IF (Str.Compare(szItem, pop[i].szState) = 0) THEN EXIT; END; INC(i); IF(i>= NUM_STATES) THEN EXIT; END; END; (* Fill in the POPADVISE structure and acknowledge *) IF (i < NUM_STATES) THEN hPopAdvise := (GLOBALHANDLE) GetWindowLong (hwnd, 4); pPopAdvise := SYSTEM.CAST(PPOPADVISE, GlobalLock (hPopAdvise)); pPopAdvise[i].flags := pDdeAdvise^.flags; INCL(pPopAdvise[i].flags,fAdvise); pPopAdvise[i].lPopPrev := pop[i].lPop; GlobalUnlock (hDdeAdvise); GlobalFree (hDdeAdvise); DdeAck.bAppReturnCode := 0; DdeAck.reserved := 0; DdeAck.fBusy := FALSE; DdeAck.fAck := TRUE; wStatus := DdeAck; (* wStatus := *((WORD *) SYSTEM.ADR(DdeAck)); *) IF (NOT PostMessage (hwndClient, WINUSER.WM_DDE_ACK, (WPARAM) hwnd, PackDDElParam (WM_DDE_ACK, wStatus, aItem))) THEN GlobalDeleteAtom (aItem); ELSE PostDataMessage (hwnd, hwndClient, i, fDeferUpd IN pPopAdvise[i].flags, fAckReq IN pPopAdvise[i].flags, FALSE); END; GlobalUnlock (hPopAdvise); RETURN 0; END; END; (* Otherwise, post a negative WM_DDE_ACK *) GlobalUnlock (hDdeAdvise); DdeAck.bAppReturnCode := 0; DdeAck.reserved := 0; DdeAck.fBusy := FALSE; DdeAck.fAck := FALSE; wStatus := DdeAck; (* wStatus := *((WORD *) SYSTEM.ADR(DdeAck)); *) IF (NOT PostMessage (hwndClient, WINUSER.WM_DDE_ACK, SYSTEM.CAST(WIN32.WPARAM,hwnd), PackDDElParam (WM_DDE_ACK, wStatus, aItem))) THEN GlobalFree (hDdeAdvise); GlobalDeleteAtom (aItem); END; RETURN 0; | WINUSER.WM_DDE_UNADVISE : (* wParam -- sending window handle *) (* WINUSER.LOWORD (lParam) -- data format *) (* WINUSER.HIWORD (lParam) -- item atom *) hwndClient := SYSTEM.CAST(WIN32.HWND,wParam); cfFormat := WINUSER.LOWORD (lParam); aItem := WINUSER.HIWORD (lParam); DdeAck.bAppReturnCode := 0; DdeAck.reserved := 0; DdeAck.fBusy := FALSE; DdeAck.fAck := TRUE; hPopAdvise := SYSTEM.CAST(GLOBALHANDLE,GetWindowLong (hwnd, 4)); pPopAdvise := SYSTEM.CAST(PPOPADVISE,GlobalLock (hPopAdvise)); (* Check matching format and data item *) IF (cfFormat = CF_TEXT) OR (cfFormat = NIL) THEN IF (aItem = SYSTEM.CAST(WIN32.ATOM,NIL)) THEN FOR i := 0 TO NUM_STATES-1 DO EXCL(pPopAdvise[i].flags,fAdvise); END; ELSE GlobalGetAtomName (aItem, szItem, SIZE (szItem)); i := 0; LOOP IF (Str.Compare(szItem, pop[i].szState) = 0) THEN EXIT; END; INC(i); IF(i>= NUM_STATES) THEN EXIT; END; END; IF (i < NUM_STATES) THEN EXCL(pPopAdvise[i].flags,fAdvise); ELSE DdeAck.fAck := FALSE; END; END; ELSE DdeAck.fAck := FALSE; (* Acknowledge either positively or negatively *) wStatus := DdeAck; (* wStatus := *((WORD *) SYSTEM.ADR(DdeAck)); *) IF (NOT PostMessage (hwndClient, WINUSER.WM_DDE_ACK, SYSTEM.CAST(WIN32.WPARAM,hwnd), PackDDElParam (WM_DDE_ACK, wStatus, aItem))) THEN IF (aItem # SYSTEM.CAST(WIN32.ATOM,NIL)) THEN GlobalDeleteAtom (aItem); END; END; GlobalUnlock (hPopAdvise); RETURN 0; | WINUSER.WM_DDE_EXECUTE : (* Post negative acknowledge *) hwndClient := SYSTEM.CAST(WIN32.HWND,wParam); hCommands := SYSTEM.CAST(GLOBALHANDLE,lParam); DdeAck.bAppReturnCode := 0; DdeAck.reserved := 0; DdeAck.fBusy := FALSE; DdeAck.fAck := FALSE; wStatus := DdeAck; (* wStatus := *((WORD *) SYSTEM.ADR(DdeAck)); *) IF (NOT PostMessage (hwndClient, WINUSER.WM_DDE_ACK, SYSTEM.CAST(WIN32.WPARAM,hwnd) PackDDElParam (WM_DDE_ACK, wStatus, SYSTEM.CAST(CARDINAL,hCommands))) THEN GlobalFree (hCommands); END; RETURN 0; | WINUSER.WM_DDE_POKE : (* Post negative acknowledge *) UnpackDDElParam (WM_DDE_POKE, lParam, SYSTEM.ADR(uiLow), SYSTEM.ADR(uiHi)); FreeDDElParam (WM_DDE_POKE, lParam); hwndClient := SYSTEM.CAST(WIN32.HWND,wParam); hDdePoke := SYSTEM.CAST(GLOBALHANDLE,uiLow); aItem := SYSTEM.CAST(WIN32.ATOM,uiHi); DdeAck.bAppReturnCode := 0; DdeAck.reserved := 0; DdeAck.fBusy := FALSE; DdeAck.fAck := FALSE; wStatus := DdeAck; (* wStatus := *((WORD *) SYSTEM.ADR(DdeAck)); *) IF (NOT PostMessage (hwndClient, WINUSER.WM_DDE_ACK, SYSTEM.CAST(WIN32.WPARAM,hwnd), PackDDElParam (WM_DDE_ACK, wStatus, aItem))) GlobalFree (hDdePoke); GlobalDeleteAtom (aItem); END; RETURN 0; | WINUSER.WM_DDE_TERMINATE : (* Respond with another WINUSER.WM_DDE_TERMINATE iMsg *) hwndClient := SYSTEM.CAST(WIN32.HWND,wParam); PostMessage (hwndClient, WINUSER.WM_DDE_TERMINATE, SYSTEM.CAST(WPARAM,hwnd, 0h)); DestroyWindow (hwnd); RETURN 0; | WINUSER.WM_TIMER : (* Post WINUSER.WM_DDE_DATA iMsgs for changed populations *) hwndClient := SYSTEM.CAST(WIN32.HWND,GetWindowLong (hwnd, 0)); hPopAdvise := SYSTEM.CAST(GLOBALHANDLE,GetWindowLong (hwnd, 4)); pPopAdvise := SYSTEM.CAST(PPOPADVISE,GlobalLock (hPopAdvise)); i := 0; LOOP IF (fAdvise IN pPopAdvise[i].flags) THEN IF (pPopAdvise[i].lPopPrev # pop[i].lPop) THEN IF (NOT PostDataMessage (hwnd, hwndClient, i, fDeferUpd IN pPopAdvise[i].flags, fAckReq IN pPopAdvise[i].flags, FALSE)) THEN EXIT; END; pPopAdvise[i].lPopPrev := pop[i].lPop; END; END; INC(i); IF(i>= NUM_STATES) THEN EXIT; END; END; GlobalUnlock (hPopAdvise); RETURN 0; | WINUSER.WM_CLOSE : (* Post a WINUSER.WM_DDE_TERMINATE iMsg to the client *) hwndClient := SYSTEM.CAST(WIN32.HWND,GetWindowLong (hwnd, 0)); PostMessage (hwndClient, WINUSER.WM_DDE_TERMINATE, SYSTEM.CAST(WPARAM,hwnd, 0h)); dwTime := GetCurrentTime (); WHILE (GetCurrentTime () - dwTime < DDE_TIMEOUT) DO IF (PeekMessage (SYSTEM.ADR(msg), hwnd, WINUSER.WM_DDE_TERMINATE, WINUSER.WM_DDE_TERMINATE, PM_REMOVE)) THEN (* break; *) END; END; DestroyWindow (hwnd); RETURN 0; | WINUSER.WM_DESTROY : hPopAdvise := SYSTEM.CAST(GLOBALHANDLE,GetWindowLong (hwnd, 4)); GlobalFree (hPopAdvise); RETURN 0; ELSE RETURN DefWindowProc (hwnd, iMsg, wParam, lParam); END; END ServerProc; <*/POP*> <*/PUSH*> %IF WIN32 %THEN <*/CALLS:WIN32SYSTEM*> %ELSE <*/CALLS:WINSYSTEM*> %END (*++++*****************************************************************) PROCEDURE TimerEnumProc(hwnd : WIN32.HWND; (**********************************************************************) lParam : WIN32.LPARAM) : WIN32.BOOL [EXPORT]; BEGIN SendMessage (hwnd, WINUSER.WM_TIMER, 0, 0h); RETURN TRUE; END TimerEnumProc; <*/POP*> <*/PUSH*> %IF WIN32 %THEN <*/CALLS:WIN32SYSTEM*> %ELSE <*/CALLS:WINSYSTEM*> %END (*++++*****************************************************************) PROCEDURE CloseEnumProc(hwnd : WIN32.HWND; (**********************************************************************) lParam : WIN32.LPARAM) : WIN32.BOOL [EXPORT]; BEGIN SendMessage (hwnd, WINUSER.WM_CLOSE, 0, 0h); RETURN TRUE; END CloseEnumProc; <*/POP*> (*++++*****************************************************************) PROCEDURE PostDataMessage (hwndServer : WIN32.HWND; hwndClient : WIN32.HWND; iState : INTEGER; fDeferUpd : BOOLEAN; fAckReq : BOOLEAN; fResponse : BOOLEAN) : BOOLEAN; VAR atom : WIN32.ATOM; szPopulation : ARRAY[0..15] OF CHAR; DdeAck : DDEACK; pDdeData : POINTER TO DDEDATA; dwTime : WIN32.DWORD; hDdeData : GLOBALHANDLE; msg : WIN32.MSG; wStatus : WIN32.WORD; BEGIN aItem := GlobalAddAtom (pop[iState].szState); (* Allocate a DDEDATA structure if not deferred update *) IF (fDeferUpd) THEN hDdeData := NIL; ELSE WINUSER.wsprintf (szPopulation, "%ld\r"+"", pop[iState].lPop); hDdeData := GlobalAlloc (GHND BOR GMEM_DDESHARE, SIZE (DDEDATA) + LENGTH(szPopulation)); pDdeData := SYSTEM.CAST(PDDEDATA,GlobalLock (hDdeData)); pDdeData^.fResponse := fResponse; pDdeData^.fRelease := TRUE; pDdeData^.fAckReq := fAckReq; pDdeData^.cfFormat := CF_TEXT; Str.Copy(SYSTEM.CAST(WIN32.PSTR,pDdeData^.Value), szPopulation); GlobalUnlock (hDdeData); END; (* Post the WINUSER.WM_DDE_DATA iMsg *) IF (NOT PostMessage (hwndClient, WINUSER.WM_DDE_DATA, SYSTEM.CAST(WIN32.WPARAM,hwndServer), PackDDElParam (WM_DDE_DATA, SYSTEM.CAST(CARDINAL,hDdeData), aItem))) THEN IF (hDdeData # NIL) THEN GlobalFree (hDdeData); END; GlobalDeleteAtom (aItem); RETURN FALSE; (* Wait for the acknowledge iMsg if it's requested *) IF (fAckReq) THEN DdeAck.fAck := FALSE; dwTime := GetCurrentTime (); WHILE (GetCurrentTime () - dwTime < DDE_TIMEOUT) DO IF (PeekMessage (SYSTEM.ADR(msg), hwndServer, WINUSER.WM_DDE_ACK, WINUSER.WM_DDE_ACK, PM_REMOVE)) THEN wStatus := WINUSER.LOWORD (msg.lParam); DdeAck := SYSTEM.CAST(DDEACK,SYSTEM.ADR(wStatus))); (* DdeAck := *((DDEACK *) SYSTEM.ADR(wStatus)); *) aItem := WINUSER.HIWORD (msg.lParam); GlobalDeleteAtom (aItem); (* break; *) END; END; IF (DdeAck.fAck = FALSE) THEN IF (hDdeData # NIL) THEN GlobalFree (hDdeData); END; RETURN FALSE; END; RETURN TRUE; END PostDataMessage; (*++++*****************************************************************) PROCEDURE InitApplication () : BOOLEAN; (**********************************************************************) BEGIN hInst := WINX.Instance; 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); WINUSER.RegisterClassEx(wc); (* Register window class DDE Server *) wndclass.cbSize := SIZE (wndclass); wndclass.style := 0; wndclass.lpfnWndProc := ServerProc; wndclass.cbClsExtra := 0; wndclass.cbWndExtra := 2 * SIZE (DWORD); wndclass.hInstance := hInstance; wndclass.hIcon := NIL; wndclass.hCursor := NIL; wndclass.hbrBackground := NIL; wndclass.lpszMenuName := NIL; wndclass.lpszClassName := szServerClass; wndclass.hIconSm := NIL; RETURN WINUSER.RegisterClassEx(wc)#0; END InitApplication; (*++++*****************************************************************) PROCEDURE InitMainWindow () : BOOLEAN; (**********************************************************************) BEGIN hwnd := WINUSER.CreateWindow (szAppName, "DDE 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); InitPops (); (* initialize 'pop' structure *) SetTimer (hwnd, ID_TIMER, 5000, NIL); ShowWindow (hwnd, SW_SHOWMINNOACTIVE); UpdateWindow (hwnd); END InitMainWindow; BEGIN IF InitApplication() AND InitMainWindow() THEN WHILE (WINUSER.GetMessage(msg,NIL,0,0)) DO WINUSER.TranslateMessage(msg); WINUSER.DispatchMessage(msg); END; KillTimer (hwnd, ID_TIMER); END; END DDEPop1.