home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / PM-M2B.ZIP / ROTATE.MOD < prev    next >
Text File  |  1990-10-03  |  12KB  |  308 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. (*                                                                            *)
  32. (*  Creates a Client Window with two menu selections which are defined        *)
  33. (*  in the resource file ROTATE.RC.                                           *)
  34. (*  Page 226.                                                                 *)
  35. (*                                                                            *)
  36. (*----------------------------------------------------------------------------*)
  37. (*  Compiling Notes:                                                          *)
  38. (*                                                                            *)
  39. (*  The following files should be available:                                  *)
  40. (*  ROTATE.H, ROTATE.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. (*  In addition, the following def should be set to true in Win.def:          *)
  49. (*  i_TIMER           = TRUE;    (* Timer routines *)                         *)
  50. (*                                                                            *)
  51. (*                                                                            *)
  52. (*----------------------------------------------------------------------------*)
  53. (*# call(same_ds => off) *)
  54. (*# data(heap_size=> 3000) *)
  55.  
  56. MODULE ROTATE;
  57.  
  58. IMPORT OS2DEF,Win,Gpi,Dos,Lib,SYSTEM;
  59. FROM OS2DEF IMPORT HDC,HRGN,HAB,HPS,HBITMAP,HWND,HMODULE,HSEM,
  60.                    POINTL,RECTL,PID,TID,LSET,NULL,
  61.                    COLOR,NullVar,NullStr,BOOL ;
  62. FROM OS2MAC IMPORT SHORT1FROMMP,SHORT2FROMMP,MPFROMSHORT,MPFROM2SHORT,MPFROMCHAR;
  63.  
  64. TYPE
  65.   StrPtr = POINTER TO ARRAY[0..0] OF CHAR;
  66.  
  67. CONST
  68.   szClientClass   = 'Client Window';
  69.   ID_FRAMERC      = 1;
  70.   ID_START_STOP   = 10;
  71.   ID_OPTIONS_SUBMENU = 11;
  72.   ID_COLORS_SUBMENU = 111;
  73.   ID_CSET0          = 1111;
  74.   ID_CSET1          = 1112;
  75.   ID_CSET2          = 1113;
  76.   ID_CSET3          = 1114;
  77.   ID_CSET4          = 1115;
  78.   ID_CSET5          = 1116;
  79.   ID_DELAY_SUBMENU  = 20;
  80.   ID_DELAY0000      = 20000;
  81.   ID_DELAY0100      = 20100;
  82.   ID_DELAY0250      = 20250;
  83.   ID_DELAY0500      = 20500;
  84.   ID_DELAY1000      = 21000;
  85.   ID_EXIT           = 12;
  86.   TID_ROTATE        = 1;
  87.  
  88. VAR
  89.   rslt          : INTEGER;
  90.   hab           : HAB;
  91.   hmq           : Win.HMQ;
  92.   qmsg          : Win.QMSG;
  93.   hwndMenu      : HWND;
  94.   hwnd,
  95.   hwndClient    : HWND;
  96.   r             : Win.MRESULT;
  97.   flcreateFlags : LSET;
  98.   fsSound       : Win.WA;
  99.   idCheckedItem : CARDINAL;
  100.   fRunning      : BOOLEAN;
  101.   iColorSet     : CARDINAL;
  102.   dtDelay       : CARDINAL;
  103.   aclr          : ARRAY [0..5],[0..3] OF COLOR;
  104.  
  105. (*--------------------  Error reporting procedure  ---------------------*)
  106. PROCEDURE Error;
  107. VAR
  108. BEGIN
  109. END Error;
  110. (*-----------------  End of Error reporting procedure  ------------------*)
  111.  
  112. (*--------------------  Start of window procedure  ---------------------*)
  113. (*# save,call(near_call=>off,reg_param=>(),reg_saved=>(di,si,ds,es,st1,st2)) *)
  114.  
  115. PROCEDURE ClientWinProc(hwnd : HWND;
  116.                         msg:CARDINAL;
  117.                         mp1,mp2:Win.MPARAM)
  118.                         : Win.MRESULT;
  119.  
  120. VAR
  121.   hps : HPS;
  122.   rcl,
  123.   rclWindow : RECTL;
  124.   clrTemp : LONGCARD;
  125.  
  126.  
  127. BEGIN
  128.   CASE msg OF
  129.     | Win.WM_COMMAND :
  130.         CASE SHORT1FROMMP(mp1) OF
  131.           | ID_START_STOP :
  132.               IF NOT fRunning THEN
  133.                 Win.SendMsg(hwndMenu,Win.MM_SETITEMTEXT,
  134.                             MPFROMSHORT(ID_START_STOP),MPFROMCHAR('~Stop'));
  135.                 Win.SendMsg(hwndMenu,Win.MM_SETITEMATTR,
  136.                             MPFROM2SHORT(ID_OPTIONS_SUBMENU,CARDINAL(FALSE)),
  137.                             MPFROM2SHORT(CARDINAL(Win.MIA_DISABLED),
  138.                                          CARDINAL(Win.MIA_DISABLED)));
  139.                 Win.StartTimer(hab,hwnd,TID_ROTATE,dtDelay);
  140.               ELSE
  141.                 Win.StopTimer(hab,hwnd,TID_ROTATE);
  142.                 Win.SendMsg(hwndMenu,Win.MM_SETITEMTEXT,
  143.                             MPFROMSHORT(ID_START_STOP),MPFROMCHAR('~Start'));
  144.                 Win.SendMsg(hwndMenu,Win.MM_SETITEMATTR,
  145.                             MPFROM2SHORT(ID_OPTIONS_SUBMENU,CARDINAL(FALSE)),
  146.                             MPFROM2SHORT(CARDINAL(Win.MIA_DISABLED),0));
  147.               END;
  148.               fRunning := NOT fRunning;
  149.  
  150.           | ID_CSET0, ID_CSET1, ID_CSET2, ID_CSET3, ID_CSET4, ID_CSET5 :
  151.                 Win.SendMsg(hwndMenu,Win.MM_SETITEMATTR,
  152.                             MPFROM2SHORT(iColorSet+ID_CSET0,CARDINAL(TRUE)),
  153.                             MPFROM2SHORT(CARDINAL(Win.MIA_CHECKED),0));
  154.  
  155.                 Win.SendMsg(hwndMenu,Win.MM_SETITEMATTR,
  156.                             MPFROM2SHORT(CARDINAL(SHORT1FROMMP(mp1)),CARDINAL(TRUE)),
  157.                             MPFROM2SHORT(CARDINAL(Win.MIA_CHECKED),
  158.                             CARDINAL(Win.MIA_CHECKED)));
  159.  
  160.                 iColorSet := SHORT1FROMMP(mp1) - ID_CSET0;
  161.                 Win.InvalidateRect(hwnd,RECTL(NullVar),B_FALSE)
  162.  
  163.           | ID_DELAY0000, ID_DELAY0100, ID_DELAY0250, ID_DELAY0500,
  164.             ID_DELAY1000 :
  165.                 Win.SendMsg(hwndMenu,Win.MM_SETITEMATTR,
  166.                             MPFROM2SHORT(dtDelay+ID_DELAY0000,CARDINAL(TRUE)),
  167.                             MPFROM2SHORT(CARDINAL(Win.MIA_CHECKED),0));
  168.  
  169.                 Win.SendMsg(hwndMenu,Win.MM_SETITEMATTR,
  170.                             MPFROM2SHORT(SHORT1FROMMP(mp1),CARDINAL(TRUE)),
  171.                             MPFROM2SHORT(CARDINAL(Win.MIA_CHECKED),
  172.                             CARDINAL(Win.MIA_CHECKED)));
  173.  
  174.                 dtDelay := SHORT1FROMMP(mp1) - ID_DELAY0000;
  175.  
  176.           | ID_EXIT :
  177.               Win.PostMsg(hwnd,Win.WM_QUIT,NULL,NULL);
  178.         END;
  179.  
  180.     | Win.WM_TIMER :
  181.         IF (SHORT1FROMMP(mp1) = TID_ROTATE) THEN
  182.           clrTemp := aclr[INTEGER(iColorSet),3];
  183.           aclr[INTEGER(iColorSet),3] := aclr[INTEGER(iColorSet),2];
  184.           aclr[INTEGER(iColorSet),2] := aclr[INTEGER(iColorSet),1];
  185.           aclr[INTEGER(iColorSet),1] := aclr[INTEGER(iColorSet),0];
  186.           aclr[INTEGER(iColorSet),0] := clrTemp;
  187.           Win.InvalidateRect(hwnd,RECTL(NullVar),B_FALSE)
  188.         END;
  189.  
  190.     | Win.WM_PAINT :
  191.         hps := Win.BeginPaint(hwnd,HPS(NULL),RECTL(NullVar));
  192.         Win.QueryWindowRect(hwnd,rclWindow);
  193.  
  194.         rcl.xLeft := 0;
  195.         rcl.yBottom := 0;
  196.         rcl.xRight := rclWindow.xRight DIV 2;
  197.         rcl.yTop := rclWindow.yTop DIV 2;
  198.         Win.FillRect(hps,rcl,aclr[INTEGER(iColorSet),0]);
  199.  
  200.         rcl.yBottom := rcl.yTop;
  201.         rcl.yTop := rclWindow.yTop;
  202.         Win.FillRect(hps,rcl,aclr[INTEGER(iColorSet),1]);
  203.  
  204.         rcl.xLeft := rcl.xRight;
  205.         rcl.xRight := rclWindow.xRight;
  206.         Win.FillRect(hps,rcl,aclr[INTEGER(iColorSet),2]);
  207.  
  208.         rcl.yTop := rcl.yBottom;
  209.         rcl.yBottom := 0;
  210.         Win.FillRect(hps,rcl,aclr[INTEGER(iColorSet),3]);
  211.  
  212.         Win.EndPaint(hps);
  213.  
  214.     | Win.WM_CREATE :
  215.         hwndMenu := Win.WindowFromID(Win.QueryWindow(hwnd,Win.QW_PARENT,
  216.                                          B_FALSE),Win.FID_MENU);
  217.  
  218.   ELSE
  219.     RETURN Win.DefWindowProc(hwnd, msg, mp1, mp2)
  220.   END;
  221.   RETURN Win.MPARAM(FALSE);
  222. END ClientWinProc;
  223.  
  224. (*# restore *)
  225. (*---------------------  End of window procedure  ----------------------*)
  226.  
  227. BEGIN
  228.   flcreateFlags := Win.FCF_TITLEBAR + Win.FCF_SYSMENU + Win.FCF_SIZEBORDER +
  229.                    Win.FCF_MINMAX + Win.FCF_SHELLPOSITION + Win.FCF_TASKLIST +
  230.                    Win.FCF_MENU;
  231.  
  232.   aclr[0,0]   := Gpi.CLR_RED;
  233.   aclr[0,1]   := Gpi.CLR_RED;
  234.   aclr[0,2]   := Gpi.CLR_RED;
  235.   aclr[0,3]   := Gpi.CLR_WHITE;
  236.  
  237.   aclr[1,0]   := Gpi.CLR_BLUE;
  238.   aclr[1,1]   := Gpi.CLR_BLUE;
  239.   aclr[1,2]   := Gpi.CLR_BLUE;
  240.   aclr[1,3]   := Gpi.CLR_RED;
  241.  
  242.   aclr[2,0]   := Gpi.CLR_RED;
  243.   aclr[2,1]   := Gpi.CLR_WHITE;
  244.   aclr[2,2]   := Gpi.CLR_RED;
  245.   aclr[2,3]   := Gpi.CLR_WHITE;
  246.  
  247.   aclr[3,0]   := Gpi.CLR_RED;
  248.   aclr[3,1]   := Gpi.CLR_BLUE;
  249.   aclr[3,2]   := Gpi.CLR_RED;
  250.   aclr[3,3]   := Gpi.CLR_BLUE;
  251.  
  252.   aclr[4,0]   := Gpi.CLR_RED;
  253.   aclr[4,1]   := Gpi.CLR_RED;
  254.   aclr[4,2]   := Gpi.CLR_BLUE;
  255.   aclr[4,3]   := Gpi.CLR_WHITE;
  256.  
  257.   aclr[5,0]   := Gpi.CLR_RED;
  258.   aclr[5,1]   := Gpi.CLR_GREEN;
  259.   aclr[5,2]   := Gpi.CLR_BLUE;
  260.   aclr[5,3]   := Gpi.CLR_WHITE;
  261.  
  262.   iColorSet := 5;
  263.   dtDelay   := 250;
  264.   fRunning  := FALSE;
  265.  
  266.   hab := Win.Initialize(NULL);
  267.   hmq := Win.CreateMsgQueue(hab,0);
  268.  
  269.   IF NOT Win.RegisterClass(             (* Register window class        *)
  270.      hab,                               (* Anchor block handle          *)
  271.      szClientClass,                     (* Window class name            *)
  272.      ClientWinProc,                  (* Address of window procedure  *)
  273.      Win.CS_SIZEREDRAW,
  274.      0                                  (* No extra window words        *)
  275.      ) THEN Error END;
  276.  
  277.   hwnd := Win.CreateStdWindow(
  278.               Win.HWND_DESKTOP,
  279.               Win.WS_VISIBLE,
  280.               flcreateFlags,
  281.               szClientClass,
  282.               ' - Rotate',
  283.               0,
  284.               NULL,
  285.               ID_FRAMERC,
  286.               hwndClient);
  287.  
  288.  
  289.   WHILE (Win.GetMsg(hab,qmsg,HWND(NULL),0,0)) DO
  290.     r := Win.DispatchMsg(hab,qmsg);
  291.   END;
  292.  
  293.   IF NOT Win.DestroyWindow(hwnd) THEN
  294.     Error;
  295.   END;
  296.  
  297.   IF NOT Win.DestroyMsgQueue(hmq) THEN
  298.     Error;
  299.   END;
  300.  
  301.   IF NOT Win.Terminate(hab) THEN
  302.     Error;
  303.   END;
  304.  
  305.   HALT;
  306.  
  307. END ROTATE.
  308.