home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / PM-M2B.ZIP / CHECKBOX.MOD < prev    next >
Text File  |  1990-10-03  |  7KB  |  182 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. (*    An example of a checkbox control device.  Placing a check in the box    *)
  32. (*    on the screen will cause a beep to occur whenever the window is moved   *)
  33. (*    or resized.                                                             *)
  34. (*    Source code on page 135.                                                *)
  35. (*----------------------------------------------------------------------------*)
  36.  
  37. (*# call(same_ds => off) *)
  38. (*# data(heap_size=> 3000) *)
  39.  
  40. MODULE CHECKBOX;
  41.  
  42. IMPORT OS2DEF,Win,Gpi,Dos,Lib,SYSTEM,IO;
  43. FROM OS2DEF IMPORT HDC,HRGN,HAB,HPS,HBITMAP,HWND,HMODULE,HSEM,
  44.                    POINTL,RECTL,PID,TID,LSET,NULL,
  45.                    COLOR,NullVar,NullStr,BOOL ;
  46. FROM OS2MAC IMPORT SHORT1FROMMP,SHORT2FROMMP,MPFROMSHORT,MPFROM2SHORT,
  47.                    SHORT1FROMMR;
  48.  
  49.  
  50. TYPE
  51.   StrPtr = POINTER TO ARRAY[0..0] OF CHAR;
  52.  
  53. CONST
  54.   szClientClass = 'Client Window';
  55.   ID_BUTTON = 1;
  56.   CWPM_CREATE = Win.WM_USER;
  57.   ID_WINDOW = 1;
  58.  
  59. VAR
  60.   hab           : HAB;
  61.   hmq           : Win.HMQ;
  62.   qmsg          : Win.QMSG;
  63.   hwndClient,
  64.   client,
  65.   hwnd          : HWND;
  66.   r             : Win.MRESULT;
  67.   clrOldIndRGB  : COLOR;
  68.   flcreateFlags : LSET;
  69.   hwndControl   : HWND;
  70.   fsButtonState : BOOLEAN;
  71.  
  72. PROCEDURE Error;
  73. BEGIN
  74. END Error;
  75.  
  76. (*--------------------  Start of window procedure  ---------------------*)
  77. (*# save,call(near_call=>off,reg_param=>(),reg_saved=>(di,si,ds,es,st1,st2)) *)
  78.  
  79. PROCEDURE ClientWinProc(
  80.                        hwnd : HWND;
  81.                        msg:CARDINAL;
  82.                        mp1,mp2:Win.MPARAM)
  83.                        : Win.MRESULT;
  84. VAR
  85.   rcl                    : RECTL;
  86.   cx, cy                 : INTEGER;
  87.   cm                     : Win.COMMANDMSG;
  88.  
  89. BEGIN
  90.   CASE msg OF
  91.     | Win.WM_CREATE :
  92.         Win.PostMsg(hwnd,CWPM_CREATE,0,0);
  93.         RETURN Win.MPARAM(FALSE);
  94.  
  95.     | CWPM_CREATE :
  96.         IF NOT Win.QueryWindowRect(hwnd,rcl) THEN Error END;
  97.         cx := INTEGER(INTEGER(rcl.xRight - rcl.xLeft) DIV 2);
  98.         cy := INTEGER(INTEGER(rcl.yTop - rcl.yBottom) DIV 2);
  99.  
  100.         hwndControl := Win.CreateWindow(
  101.                           hwnd,
  102.                           StrPtr(Win.WC_BUTTON)^,
  103.                           'Beep on WM_PAINT',
  104.                           Win.WS_VISIBLE + Win.BS_AUTOCHECKBOX,
  105.                           cx - 100,cy - 10,200,20,
  106.                           hwnd,Win.HWND_TOP,ID_BUTTON,NIL,NIL);
  107.  
  108.     | Win.WM_CONTROL :
  109.         fsButtonState := BOOLEAN(
  110.                       SHORT1FROMMR(
  111.                       Win.SendMsg(hwndControl,Win.BM_QUERYCHECK,0,0)));
  112.  
  113.     | Win.WM_PAINT :
  114.         IF (fsButtonState) THEN Win.Alarm(Win.HWND_DESKTOP,Win.WA_NOTE) END;
  115.         RETURN Win.DefWindowProc(hwnd,msg,mp1,mp2);
  116.  
  117.  
  118.     | Win.WM_ERASEBACKGROUND :
  119.         RETURN Win.MPARAM(TRUE);
  120.  
  121.   ELSE
  122.     RETURN Win.DefWindowProc(hwnd,msg,mp1,mp2)
  123.   END;
  124.   RETURN Win.MPARAM(FALSE);
  125. END ClientWinProc;
  126.  
  127. (*# restore *)
  128. (*---------------------  End of window procedure  ----------------------*)
  129.  
  130. BEGIN
  131.   fsButtonState := FALSE;
  132.   flcreateFlags := Win.FCF_TITLEBAR + Win.FCF_SYSMENU + Win.FCF_SIZEBORDER +
  133.                    Win.FCF_MINMAX + Win.FCF_SHELLPOSITION + Win.FCF_TASKLIST;
  134.  
  135.   hab := Win.Initialize(NULL);
  136.   hmq := Win.CreateMsgQueue(hab,0);
  137.  
  138.  
  139.   IF NOT Win.RegisterClass(             (* Register window class        *)
  140.      hab,                               (* Anchor block handle          *)
  141.      szClientClass,                     (* Window class name            *)
  142.      ClientWinProc,                  (* Address of window procedure  *)
  143.      Win.CS_SIZEREDRAW,
  144.      0                                  (* No extra window words        *)
  145.      ) THEN Error END;
  146.  
  147.   hwnd := Win.CreateStdWindow(
  148.               Win.HWND_DESKTOP,
  149.               Win.WS_VISIBLE,
  150.               flcreateFlags,
  151.               szClientClass,
  152.               ' - Controls',
  153.               0,
  154.               NULL,
  155.               0,
  156.               hwndClient);
  157.  
  158.  
  159.   WHILE( Win.GetMsg( hab, qmsg, HWND(NULL), 0, 0 ) ) DO
  160.     r := Win.DispatchMsg( hab, qmsg );
  161.   END;
  162.  
  163.   IF NOT Win.DestroyWindow(hwndClient) THEN      (* and                          *)
  164.     Error;
  165.   END;
  166.  
  167.   IF NOT Win.DestroyWindow(hwnd) THEN      (* and                          *)
  168.     Error;
  169.   END;
  170.  
  171.   IF NOT Win.DestroyMsgQueue(hmq) THEN      (* and                          *)
  172.     Error;
  173.   END;
  174.  
  175.   IF NOT Win.Terminate(hab) THEN            (* terminate the application    *)
  176.     Error;
  177.   END;
  178.  
  179.   HALT;
  180.  
  181. END CHECKBOX.
  182.