home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / PM-M2B.ZIP / MESSAGES.MOD < prev    next >
Text File  |  1990-10-04  |  7KB  |  173 lines
  1. (*----------------------------------------------------------------------------*)
  2. (* Example OS/2 Presentation Manager Program adapted from the book            *)
  3. (* "OS/2 Presentation Manager - Programming Primer" by Asael Dror &           *)
  4. (* Robert Lafore                                                              *)
  5. (*                                                                            *)
  6. (* Example programs converted to JPI Modula-2 Version 2 for OS/2 1.2 by       *)
  7. (* Chris Barker, October 1990                                                 *)
  8. (*                                                                            *)
  9. (* Notes:  I am distributing these programs so that others can learn and also *)
  10. (*         so I can elicit feedback from the user community on programming for*)
  11. (*         OS/2 PM using Modula-2.  If your have any questions, suggestions,  *)
  12. (*         or comments I'd love to hear from you.  I may be reached at the    *)
  13. (*         following addresses:                                               *)
  14. (*                                                                            *)
  15. (*         Compuserve ID: 72261,2312                                          *)
  16. (*         Pete Norloff's OS/2 Shareware BBS - (703) 385-4325                 *)
  17. (*         Max's Doghouse BBS - (703) 548-7849                                *)
  18. (*           The above two BBS carry the Fidonet OS/2 echo which I read       *)
  19. (*           regularly.                                                       *)
  20. (*         Programmer's Corner - (301) 596-1180                               *)
  21. (*         CPCUG Mix (Window Sig) BBS - (301) 738-9060                        *)
  22. (*                                                                            *)
  23. (*         I hope I hear from you!                                            *)
  24. (*                                                                            *)
  25. (*               - Chris                                                      *)
  26. (*                                                                            *)
  27. (*----------------------------------------------------------------------------*)
  28.  
  29. (*----------------------------------------------------------------------------*)
  30. (*  Program Notes:                                                            *)
  31. (*    Provides a excellent way to see what messages are really being sent     *)
  32. (*    during the execution of this program.  When it first starts, you        *)
  33. (*    hear beeps for about 15 seconds before the client window is drawn.      *)
  34. (*    Every time you move the mouse a message will be posted.                 *)
  35. (*    Source code on page 106.                                                *)
  36. (*----------------------------------------------------------------------------*)
  37.  
  38. (*# call(same_ds => off) *)
  39. (*# data(heap_size=> 3000) *)
  40.  
  41. MODULE MESSAGES;
  42.  
  43. IMPORT OS2DEF,Win,Gpi,Dos,Lib,SYSTEM,IO,Str;
  44. FROM OS2DEF IMPORT HDC,HRGN,HAB,HPS,HBITMAP,HWND,HMODULE,HSEM,
  45.                    POINTL,RECTL,PID,TID,LSET,NULL,
  46.                    COLOR,NullVar,NullStr,BOOL ;
  47. FROM PMMSG IMPORT msglist,NumMsg;
  48. FROM OS2MAC IMPORT SHORT1FROMMP,SHORT2FROMMP,MPFROMSHORT,MPFROM2SHORT;
  49.  
  50. TYPE
  51.   StrPtr = POINTER TO ARRAY[0..0] OF CHAR;
  52.  
  53. CONST
  54.   szClientClass = 'Display Messages';
  55.  
  56. VAR
  57.   hab           : HAB;
  58.   hmq           : Win.HMQ;
  59.   qmsg          : Win.QMSG;
  60.   hwndClient,
  61.   client,
  62.   hwnd          : HWND;
  63.   r             : Win.MRESULT;
  64.   flcreateFlags : LSET;
  65.   route         : ARRAY [0..10] OF CHAR;
  66.  
  67. PROCEDURE Error;
  68. BEGIN
  69. END Error;
  70.  
  71. (*--------------------  Start of window procedure  ---------------------*)
  72. (*# save,call(near_call=>off,reg_param=>(),reg_saved=>(di,si,ds,es,st1,st2)) *)
  73.  
  74. PROCEDURE ClientWinProc(
  75.                        hwnd : HWND;
  76.                        msg:CARDINAL;
  77.                        mp1,mp2:Win.MPARAM)
  78.                        : Win.MRESULT;
  79. CONST
  80.   questions = '??? ';
  81.   delim = ' ';
  82. VAR
  83.   hps : HPS;
  84.   rcl : RECTL;
  85.   szText,
  86.   str1,
  87.   str2,
  88.   str3,
  89.   msgnumstr : ARRAY [0..80] OF CHAR;
  90.   Done : BOOLEAN;
  91. BEGIN
  92.   Str.CardToStr(VAL(LONGCARD,msg),msgnumstr,10,Done);
  93.  
  94.   IF (msg > NumMsg + 1) THEN
  95.     Str.Concat(str1,questions,delim);
  96.     Str.Concat(str2,msgnumstr,delim);
  97.     Str.Concat(str3,str1,str2);
  98.     Str.Concat(szText,str3,route);
  99.   ELSE
  100.     Str.Concat(str1,msglist[msg],delim);
  101.     Str.Concat(str2,msgnumstr,delim);
  102.     Str.Concat(str3,str1,str2);
  103.     Str.Concat(szText,str3,route);
  104.   END;
  105.  
  106.   hps := Win.GetPS(hwnd);
  107.   Win.QueryWindowRect(hwnd,rcl);
  108.   Win.DrawText(hps,-1,szText,rcl,0,0,
  109.                Win.DT_CENTER+Win.DT_VCENTER+Win.DT_ERASERECT+Win.DT_TEXTATTRS);
  110.   Win.ReleasePS(hps);
  111.   Win.Alarm(Win.HWND_DESKTOP,Win.WA_NOTE);
  112.   Dos.Sleep(300);
  113.   RETURN Win.DefWindowProc(hwnd, msg, mp1, mp2)
  114. END ClientWinProc;
  115.  
  116. (*# restore *)
  117. (*---------------------  End of window procedure  ----------------------*)
  118.  
  119. BEGIN
  120.   route := 'sent';
  121.   flcreateFlags := Win.FCF_TITLEBAR + Win.FCF_SYSMENU + Win.FCF_SIZEBORDER +
  122.                    Win.FCF_MINMAX + Win.FCF_SHELLPOSITION + Win.FCF_TASKLIST;
  123.  
  124.   hab := Win.Initialize(NULL);
  125.   hmq := Win.CreateMsgQueue(hab,0);
  126.  
  127.  
  128.   IF NOT Win.RegisterClass(             (* Register window class        *)
  129.      hab,                               (* Anchor block handle          *)
  130.      szClientClass,                     (* Window class name            *)
  131.      ClientWinProc,                  (* Address of window procedure  *)
  132.      0,
  133.      0                                  (* No extra window words        *)
  134.      ) THEN Error END;
  135.  
  136.   hwnd := Win.CreateStdWindow(
  137.               Win.HWND_DESKTOP,
  138.               Win.WS_VISIBLE,
  139.               flcreateFlags,
  140.               szClientClass,
  141.               'Messages',
  142.               0,
  143.               NULL,
  144.               0,
  145.               hwndClient);
  146.  
  147.  
  148.   WHILE( Win.GetMsg( hab, qmsg, HWND(NULL), 0, 0 ) ) DO
  149.     route := 'posted';
  150.     r := Win.DispatchMsg( hab, qmsg );
  151.     route := 'sent';
  152.   END;
  153.  
  154.   IF NOT Win.DestroyWindow(hwndClient) THEN      (* and                          *)
  155.     Error;
  156.   END;
  157.  
  158.   IF NOT Win.DestroyWindow(hwnd) THEN      (* and                          *)
  159.     Error;
  160.   END;
  161.  
  162.   IF NOT Win.DestroyMsgQueue(hmq) THEN      (* and                          *)
  163.     Error;
  164.   END;
  165.  
  166.   IF NOT Win.Terminate(hab) THEN            (* terminate the application    *)
  167.     Error;
  168.   END;
  169.  
  170.   HALT;
  171.  
  172. END MESSAGES.
  173.