home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / PM-M2B.ZIP / RADIOBUT.MOD < prev    next >
Text File  |  1990-10-03  |  8KB  |  212 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. (*    Three choices will displayed on the client window in the Radio Button   *)
  32. (*    style.  Selecting one of the choices will subsequently change the desk- *)
  33. (*    top background to the color indicated.  When the program ends the desk- *)
  34. (*    top should be returned to its original color.                           *)
  35. (*    Source code on page 131.                                                *)
  36. (*----------------------------------------------------------------------------*)
  37.  
  38. (*# call(same_ds => off) *)
  39. (*# data(heap_size=> 3000) *)
  40.  
  41. MODULE RADIOBUT;
  42.  
  43. IMPORT OS2DEF,Win,Gpi,Dos,Lib,SYSTEM,IO;
  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 OS2MAC IMPORT SHORT1FROMMP,SHORT2FROMMP,MPFROMSHORT,MPFROM2SHORT;
  48.  
  49. TYPE
  50.   StrPtr = POINTER TO ARRAY[0..0] OF CHAR;
  51.  
  52. CONST
  53.   szClientClass = 'Client Window';
  54.   ID_BUTTON1 = 1;
  55.   ID_BUTTON2 = 2;
  56.   ID_BUTTON3 = 3;
  57.   CWPM_CREATE = Win.WM_USER;
  58.   ID_WINDOW = 1;
  59.  
  60. VAR
  61.   hab           : HAB;
  62.   hmq           : Win.HMQ;
  63.   qmsg          : Win.QMSG;
  64.   hwndClient,
  65.   client,
  66.   hwnd          : HWND;
  67.   r             : Win.MRESULT;
  68.   clrOldIndRGB  : COLOR;
  69.   flcreateFlags : LSET;
  70.  
  71. PROCEDURE Error;
  72. BEGIN
  73. END Error;
  74.  
  75. (*--------------------  Start of window procedure  ---------------------*)
  76. (*# save,call(near_call=>off,reg_param=>(),reg_saved=>(di,si,ds,es,st1,st2)) *)
  77.  
  78. PROCEDURE ClientWinProc(
  79.                        hwnd : HWND;
  80.                        msg:CARDINAL;
  81.                        mp1,mp2:Win.MPARAM)
  82.                        : Win.MRESULT;
  83. VAR
  84.   hwndControl1,
  85.   hwndControl2,
  86.   hwndControl3           : HWND;
  87.   rcl                    : RECTL;
  88.   cx, cy                 : INTEGER;
  89.   aclrIndRGB             : ARRAY [0..1] OF COLOR;
  90.   cm                     : Win.COMMANDMSG;
  91.  
  92. BEGIN
  93.   aclrIndRGB[0] := Win.SYSCLR_BACKGROUND;
  94.  
  95.   CASE msg OF
  96.     | Win.WM_CREATE :
  97.         Win.PostMsg(hwnd,CWPM_CREATE,0,0);
  98.         RETURN Win.MPARAM(FALSE);
  99.  
  100.     | CWPM_CREATE :
  101.         IF NOT Win.QueryWindowRect(hwnd,rcl) THEN Error END;
  102.         cx := INTEGER(INTEGER(rcl.xRight - rcl.xLeft) DIV 2);
  103.         cy := INTEGER(INTEGER(rcl.yTop - rcl.yBottom) DIV 2);
  104.  
  105.         hwndControl1 := Win.CreateWindow(
  106.                           hwnd,
  107.                           StrPtr(Win.WC_BUTTON)^,
  108.                           'Red',
  109.                           Win.WS_VISIBLE + Win.BS_AUTORADIOBUTTON,
  110.                           cx,cy + 20,60,15,
  111.                           hwnd,Win.HWND_TOP,ID_BUTTON1,NIL,NIL);
  112.  
  113.         hwndControl2 := Win.CreateWindow(
  114.                           hwnd,
  115.                           StrPtr(Win.WC_BUTTON)^,
  116.                           'Green',
  117.                           Win.WS_VISIBLE + Win.BS_AUTORADIOBUTTON,
  118.                           cx,cy,60,15,
  119.                           hwnd,
  120.                           Win.HWND_TOP,ID_BUTTON2,NIL,NIL);
  121.  
  122.         hwndControl3 := Win.CreateWindow(
  123.                           hwnd,
  124.                           StrPtr(Win.WC_BUTTON)^,
  125.                           'Blue',
  126.                           Win.WS_VISIBLE + Win.BS_AUTORADIOBUTTON,
  127.                           cx,cy -20,60,15,
  128.                           hwnd,
  129.                           Win.HWND_TOP,ID_BUTTON3,NIL,NIL);
  130.  
  131.         clrOldIndRGB := Win.QuerySysColor(Win.HWND_DESKTOP,Win.SYSCLR_BACKGROUND,
  132.                                           0);
  133.  
  134.     | Win.WM_CONTROL :
  135.         CASE SHORT1FROMMP(mp1) OF
  136.           | ID_BUTTON1 : aclrIndRGB[1] := Gpi.RGB_RED;
  137.           | ID_BUTTON2 : aclrIndRGB[1] := Gpi.RGB_GREEN;
  138.           | ID_BUTTON3 : aclrIndRGB[1] := Gpi.RGB_BLUE;
  139.         END;
  140.         IF NOT Win.SetSysColors(Win.HWND_DESKTOP,0,Gpi.LCOLF_INDRGB,0,2,
  141.                                 aclrIndRGB) THEN Error END;
  142.         RETURN Win.MPARAM(TRUE);
  143.  
  144.     | Win.WM_DESTROY :
  145.         aclrIndRGB[1] := clrOldIndRGB;
  146.         IF NOT Win.SetSysColors(Win.HWND_DESKTOP,0,Gpi.LCOLF_INDRGB,0,2,
  147.                          aclrIndRGB) THEN Error END;
  148.  
  149.     | Win.WM_ERASEBACKGROUND :
  150.         RETURN Win.MPARAM(TRUE);
  151.  
  152.   ELSE
  153.     RETURN Win.DefWindowProc(hwnd, msg, mp1, mp2)
  154.   END;
  155.   RETURN Win.MPARAM(FALSE);
  156. END ClientWinProc;
  157.  
  158. (*# restore *)
  159. (*---------------------  End of window procedure  ----------------------*)
  160.  
  161. BEGIN
  162.   flcreateFlags := Win.FCF_TITLEBAR + Win.FCF_SYSMENU + Win.FCF_SIZEBORDER +
  163.                    Win.FCF_MINMAX + Win.FCF_SHELLPOSITION + Win.FCF_TASKLIST;
  164.  
  165.   hab := Win.Initialize(NULL);
  166.   hmq := Win.CreateMsgQueue(hab,0);
  167.  
  168.  
  169.   IF NOT Win.RegisterClass(             (* Register window class        *)
  170.      hab,                               (* Anchor block handle          *)
  171.      szClientClass,                     (* Window class name            *)
  172.      ClientWinProc,                  (* Address of window procedure  *)
  173.      Win.CS_SIZEREDRAW,
  174.      0                                  (* No extra window words        *)
  175.      ) THEN Error END;
  176.  
  177.   hwnd := Win.CreateStdWindow(
  178.               Win.HWND_DESKTOP,
  179.               Win.WS_VISIBLE,
  180.               flcreateFlags,
  181.               szClientClass,
  182.               ' - Controls',
  183.               0,
  184.               NULL,
  185.               0,
  186.               hwndClient);
  187.  
  188.  
  189.   WHILE( Win.GetMsg( hab, qmsg, HWND(NULL), 0, 0 ) ) DO
  190.     r := Win.DispatchMsg( hab, qmsg );
  191.   END;
  192.  
  193.   IF NOT Win.DestroyWindow(hwndClient) THEN      (* and                          *)
  194.     Error;
  195.   END;
  196.  
  197.   IF NOT Win.DestroyWindow(hwnd) THEN      (* and                          *)
  198.     Error;
  199.   END;
  200.  
  201.   IF NOT Win.DestroyMsgQueue(hmq) THEN      (* and                          *)
  202.     Error;
  203.   END;
  204.  
  205.   IF NOT Win.Terminate(hab) THEN            (* terminate the application    *)
  206.     Error;
  207.   END;
  208.  
  209.   HALT;
  210.  
  211. END RADIOBUT.
  212.