home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / PM-M2.ZIP / BUTTONS.MOD < prev    next >
Text File  |  1990-08-05  |  8KB  |  205 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, August 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. (*    After creating the client window, two push buttons are displayed whose  *)
  32. (*    function should be obvious.                                             *)
  33. (*    Source code on page 125.                                                *)
  34. (*                                                                            *)
  35. (*----------------------------------------------------------------------------*)
  36.  
  37. MODULE BUTTONS;
  38.  
  39. (*# call(same_ds => off) *)
  40.  
  41. IMPORT OS2DEF,Win,Gpi,Dos,Lib,SYSTEM,IO;
  42. FROM OS2DEF IMPORT HDC,HRGN,HAB,HPS,HBITMAP,HWND,HMODULE,HSEM,
  43.                    POINTL,RECTL,PID,TID,LSET,NULL,
  44.                    COLOR,NullVar,NullStr,BOOL ;
  45.  
  46. TYPE
  47.   StrPtr = POINTER TO ARRAY[0..0] OF CHAR;
  48.  
  49. CONST
  50.   szClientClass = 'Client Window';
  51.   ID_BUTTON1 = 1;
  52.   ID_BUTTON2 = 2;
  53.   CWPM_CREATE = Win.WM_USER;
  54.   ID_WINDOW = 1;
  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.  
  66. PROCEDURE Error;
  67. BEGIN
  68. END Error;
  69.  
  70. (*--------------------  Start of window procedure  ---------------------*)
  71. (*# save,call(near_call=>off,reg_param=>(),reg_saved=>(di,si,ds,es,st1,st2)) *)
  72.  
  73. PROCEDURE ClientWinProc(
  74.                        hwnd : HWND;
  75.                        msg:CARDINAL;
  76.                        mp1,mp2:Win.MPARAM)
  77.                        : Win.MRESULT;
  78. CONST
  79.   textsettings = Win.WS_VISIBLE+Win.WS_CLIPSIBLINGS+
  80.                  Win.SS_TEXT+CARDINAL(Win.DT_LEFT)+CARDINAL(Win.DT_TOP)+
  81.                  CARDINAL(Win.DT_WORDBREAK);
  82.  
  83. VAR
  84.   hwndControl1,
  85.   hwndControl2           : HWND;
  86.   rcl                    : RECTL;
  87.   cx, cy,
  88.   x , y                  : INTEGER;
  89.   cm                     : Win.COMMANDMSG;
  90.  
  91. BEGIN
  92.   CASE msg OF
  93.     | Win.WM_CREATE :
  94.         Win.PostMsg(hwnd,CWPM_CREATE,0,0);
  95.         RETURN Win.MPARAM(FALSE);
  96.  
  97.     | CWPM_CREATE :
  98.         x := 60; y := 30;
  99.         Win.QueryWindowRect(hwnd,rcl);
  100.         cx := INTEGER(INTEGER(rcl.xRight - rcl.xLeft) DIV 2 - x - x DIV 2);
  101.         cy := INTEGER(INTEGER(rcl.yTop - rcl.yBottom) DIV 2 - y DIV 2);
  102.  
  103.         hwndControl1 := Win.CreateWindow(
  104.                           hwnd,
  105.                           StrPtr(Win.WC_BUTTON)^,
  106.                           'Beep',
  107.                           Win.WS_VISIBLE + Win.BS_PUSHBUTTON,
  108.                           cx,cy,x,y,
  109.                           hwnd,Win.HWND_TOP,ID_BUTTON1,NIL,NIL);
  110.  
  111.         cx := cx + x;
  112.         cx := cx + x;
  113.  
  114.         hwndControl2 := Win.CreateWindow(
  115.                           hwnd,
  116.                           StrPtr(Win.WC_BUTTON)^,
  117.                           'Quit',
  118.                           Win.WS_VISIBLE + Win.BS_PUSHBUTTON,
  119.                           cx,cy,x,y,
  120.                           hwnd,
  121.                           Win.HWND_TOP,ID_BUTTON2,NIL,NIL);
  122.  
  123.         RETURN Win.MPARAM(TRUE);
  124.  
  125.  
  126.     | Win.WM_COMMAND :
  127.         cm := Win.COMMANDMSG(mp2);
  128.         IF cm.source = Win.CMDSRC_PUSHBUTTON THEN
  129.           cm := Win.COMMANDMSG(mp1);
  130.           IF cm.source = ID_BUTTON1 THEN
  131.             Win.Alarm(Win.HWND_DESKTOP,Win.WA_NOTE);
  132.           ELSE
  133.             cm := Win.COMMANDMSG(mp1);
  134.             IF cm.source = ID_BUTTON2 THEN
  135.               Win.PostMsg(hwnd,Win.WM_QUIT,0,0);
  136.             END;
  137.           END;
  138.         END;
  139.         RETURN Win.MPARAM(TRUE);
  140.  
  141.  
  142.     | Win.WM_ERASEBACKGROUND :
  143.         RETURN Win.MPARAM(TRUE);
  144.  
  145.   ELSE
  146.     RETURN Win.DefWindowProc(hwnd, msg, mp1, mp2)
  147.   END;
  148.   RETURN Win.MPARAM(FALSE);
  149. END ClientWinProc;
  150.  
  151. (*# restore *)
  152. (*---------------------  End of window procedure  ----------------------*)
  153.  
  154. BEGIN
  155.   flcreateFlags := Win.FCF_TITLEBAR + Win.FCF_SYSMENU + Win.FCF_SIZEBORDER +
  156.                    Win.FCF_MINMAX + Win.FCF_SHELLPOSITION + Win.FCF_TASKLIST;
  157.  
  158.   hab := Win.Initialize(NULL);
  159.   hmq := Win.CreateMsgQueue(hab,0);
  160.  
  161.  
  162.   IF NOT Win.RegisterClass(             (* Register window class        *)
  163.      hab,                               (* Anchor block handle          *)
  164.      szClientClass,                     (* Window class name            *)
  165.      ClientWinProc,                  (* Address of window procedure  *)
  166.      Win.CS_SIZEREDRAW,
  167.      0                                  (* No extra window words        *)
  168.      ) THEN Error END;
  169.  
  170.   hwnd := Win.CreateStdWindow(
  171.               Win.HWND_DESKTOP,
  172.               Win.WS_VISIBLE,
  173.               flcreateFlags,
  174.               szClientClass,
  175.               ' - Controls',
  176.               0,
  177.               NULL,
  178.               0,
  179.               hwndClient);
  180.  
  181.  
  182.   WHILE( Win.GetMsg( hab, qmsg, HWND(NULL), 0, 0 ) ) DO
  183.     r := Win.DispatchMsg( hab, qmsg );
  184.   END;
  185.  
  186.   IF NOT Win.DestroyWindow(hwndClient) THEN      (* and                          *)
  187.     Error;
  188.   END;
  189.  
  190.   IF NOT Win.DestroyWindow(hwnd) THEN      (* and                          *)
  191.     Error;
  192.   END;
  193.  
  194.   IF NOT Win.DestroyMsgQueue(hmq) THEN      (* and                          *)
  195.     Error;
  196.   END;
  197.  
  198.   IF NOT Win.Terminate(hab) THEN            (* terminate the application    *)
  199.     Error;
  200.   END;
  201.  
  202.   HALT;
  203.  
  204. END BUTTONS.
  205.