home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / PM-M2B.ZIP / BEEPSACC.MOD < prev    next >
Text File  |  1990-10-03  |  9KB  |  216 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. (*                                                                            *)
  32. (*  Creates a Client Window with two menu selections which are defined        *)
  33. (*  in the resource file BEEPSACC.RC.                                         *)
  34. (*  Page 219.                                                                 *)
  35. (*                                                                            *)
  36. (*----------------------------------------------------------------------------*)
  37. (*  Compiling Notes:                                                          *)
  38. (*                                                                            *)
  39. (*  The following files should be available:                                  *)
  40. (*  BEEPSACC.H, BEEPSACC.RC                                                   *)
  41. (*                                                                            *)
  42. (*  Add the line: "run rc %N" to the end of your project file.  This will     *)
  43. (*  cause TS to invoke the Microsoft resource compiler after it has created   *)
  44. (*  the EXE file.  You also should have rc.exe in your path along with the    *)
  45. (*  OS/2 header files located in a directory that is referenced by the OS/2   *)
  46. (*  environment variable: INCLUDE.  For example SET INCLUDE = C:\TS\INCLUDE.  *)
  47. (*                                                                            *)
  48. (*----------------------------------------------------------------------------*)
  49. (*# call(same_ds => off) *)
  50. (*# data(heap_size=> 3000) *)
  51.  
  52. MODULE BEEPSACC;
  53.  
  54. IMPORT OS2DEF,Win,Gpi,Dos,Lib,SYSTEM;
  55. FROM OS2DEF IMPORT HDC,HRGN,HAB,HPS,HBITMAP,HWND,HMODULE,HSEM,
  56.                    POINTL,RECTL,PID,TID,LSET,NULL,
  57.                    COLOR,NullVar,NullStr,BOOL ;
  58. FROM OS2MAC IMPORT SHORT1FROMMP,SHORT2FROMMP,MPFROMSHORT,MPFROM2SHORT;
  59.  
  60. TYPE
  61.   StrPtr = POINTER TO ARRAY[0..0] OF CHAR;
  62.  
  63. CONST
  64.   szClientClass   = 'Client Window';
  65.   ID_FRAMERC      = 1;
  66.   ID_BEEP_SUBMENU = 100;
  67.   ID_BEEP         = 101;
  68.   ID_NOTESEL      = 103;
  69.   ID_WARNINGSEL   = 104;
  70.   ID_ERRORSEL     = 105;
  71.   ID_EXIT         = 110;
  72.  
  73.  
  74. VAR
  75.   rslt          : INTEGER;
  76.   hab           : HAB;
  77.   hmq           : Win.HMQ;
  78.   qmsg          : Win.QMSG;
  79.   hwndMenu      : HWND;
  80.   hwnd,
  81.   hwndClient    : HWND;
  82.   r             : Win.MRESULT;
  83.   flcreateFlags : LSET;
  84.   fsSound       : Win.WA;
  85.   idCheckedItem : CARDINAL;
  86.  
  87. (*--------------------  Error reporting procedure  ---------------------*)
  88. PROCEDURE Error;
  89. VAR
  90. BEGIN
  91. END Error;
  92. (*-----------------  End of Error reporting procedure  ------------------*)
  93.  
  94. (*--------------------  Start of window procedure  ---------------------*)
  95. (*# save,call(near_call=>off,reg_param=>(),reg_saved=>(di,si,ds,es,st1,st2)) *)
  96.  
  97. PROCEDURE ClientWinProc(hwnd : HWND;
  98.                         msg:CARDINAL;
  99.                         mp1,mp2:Win.MPARAM)
  100.                         : Win.MRESULT;
  101.  
  102. VAR
  103.   cm  : Win.CHARMSG;
  104.   SH,
  105.   AT,
  106.   CT  : BOOLEAN;
  107.   hps : HPS;
  108.   rcl : RECTL;
  109.   bs  : BITSET;
  110.  
  111. BEGIN
  112.   CASE msg OF
  113.     | Win.WM_HELP :
  114.         hps := Win.GetPS(hwnd);
  115.         Win.QueryWindowRect(hwnd,rcl);
  116.         Win.DrawText(hps,-1,'Not much help is it?!',rcl,
  117.                      0,0,Win.DT_CENTER + Win.DT_VCENTER + Win.DT_ERASERECT +
  118.                      Win.DT_TEXTATTRS);
  119.         Win.ReleasePS(hps);
  120.  
  121.     | Win.WM_COMMAND :
  122.         bs := {0..15} - Win.MIA_CHECKED;
  123.         CASE SHORT1FROMMP(mp1) OF
  124.           | ID_BEEP :
  125.               Win.Alarm(Win.HWND_DESKTOP,fsSound);
  126.  
  127.           | ID_NOTESEL, ID_WARNINGSEL, ID_ERRORSEL :
  128.               Win.SendMsg(hwndMenu,Win.MM_SETITEMATTR,
  129.                          MPFROM2SHORT(idCheckedItem,CARDINAL(TRUE)),
  130.                          MPFROM2SHORT(CARDINAL(Win.MIA_CHECKED),0));
  131.  
  132.               Win.SendMsg(hwndMenu,Win.MM_SETITEMATTR,
  133.                          MPFROM2SHORT(SHORT1FROMMP(mp1),CARDINAL(TRUE)),
  134.                          MPFROM2SHORT(CARDINAL(Win.MIA_CHECKED),
  135.                                       CARDINAL(Win.MIA_CHECKED)));
  136.  
  137.               idCheckedItem := SHORT1FROMMP(mp1);
  138.  
  139.               CASE SHORT1FROMMP(mp1) OF
  140.                 | ID_NOTESEL : fsSound := Win.WA_NOTE;
  141.                 | ID_WARNINGSEL : fsSound := Win.WA_WARNING;
  142.                 | ID_ERRORSEL : fsSound := Win.WA_ERROR;
  143.               END;
  144.  
  145.           | ID_EXIT :
  146.               Win.PostMsg(hwnd,Win.WM_QUIT,NULL,NULL);
  147.  
  148.         END;
  149.  
  150.     | Win.WM_CREATE :
  151.         hwndMenu := Win.WindowFromID(Win.QueryWindow(hwnd,Win.QW_PARENT,
  152.                                          B_FALSE),Win.FID_MENU);
  153.  
  154.     | Win.WM_ERASEBACKGROUND :
  155.         RETURN Win.MPARAM(TRUE);
  156.  
  157.   ELSE
  158.     RETURN Win.DefWindowProc(hwnd, msg, mp1, mp2)
  159.   END;
  160.   RETURN Win.MPARAM(FALSE);
  161. END ClientWinProc;
  162.  
  163. (*# restore *)
  164. (*---------------------  End of window procedure  ----------------------*)
  165.  
  166. BEGIN
  167.   flcreateFlags := Win.FCF_TITLEBAR + Win.FCF_SYSMENU + Win.FCF_SIZEBORDER +
  168.                    Win.FCF_MINMAX + Win.FCF_SHELLPOSITION + Win.FCF_TASKLIST +
  169.                    Win.FCF_MENU + Win.FCF_ACCELTABLE;
  170.  
  171.   fsSound         := Win.WA_NOTE;
  172.   idCheckedItem   := ID_NOTESEL;
  173.  
  174.   hab := Win.Initialize(NULL);
  175.   hmq := Win.CreateMsgQueue(hab,0);
  176.  
  177.   IF NOT Win.RegisterClass(             (* Register window class        *)
  178.      hab,                               (* Anchor block handle          *)
  179.      szClientClass,                     (* Window class name            *)
  180.      ClientWinProc,                  (* Address of window procedure  *)
  181.      0,
  182.      0                                  (* No extra window words        *)
  183.      ) THEN Error END;
  184.  
  185.   hwnd := Win.CreateStdWindow(
  186.               Win.HWND_DESKTOP,
  187.               Win.WS_VISIBLE,
  188.               flcreateFlags,
  189.               szClientClass,
  190.               ' - Menu',
  191.               0,
  192.               NULL,
  193.               ID_FRAMERC,
  194.               hwndClient);
  195.  
  196.  
  197.   WHILE (Win.GetMsg(hab,qmsg,HWND(NULL),0,0)) DO
  198.     r := Win.DispatchMsg(hab,qmsg);
  199.   END;
  200.  
  201.   IF NOT Win.DestroyWindow(hwnd) THEN
  202.     Error;
  203.   END;
  204.  
  205.   IF NOT Win.DestroyMsgQueue(hmq) THEN
  206.     Error;
  207.   END;
  208.  
  209.   IF NOT Win.Terminate(hab) THEN
  210.     Error;
  211.   END;
  212.  
  213.   HALT;
  214.  
  215. END BEEPSACC.
  216.