home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / modu1096.zip / sample / pmdemo / spintest.mod < prev    next >
Text File  |  1995-03-13  |  10KB  |  289 lines
  1. (****************************************************************)
  2. (*                                                              *)
  3. (*       GPM example for OS/2 Presentation Manager              *)
  4. (*              Example Application Module                      *)
  5. (*                                                              *)
  6. (****************************************************************)
  7.  
  8. MODULE SpinTest;
  9.  
  10.   FROM SYSTEM     IMPORT CAST, ADDRESS;
  11.   FROM ProgArgs   IMPORT Assert;
  12.                                     (* Interface to custom ctrl module *)
  13.   FROM SpinCube   IMPORT SS_ERASE, SS_INMOTION, SPINCUBECLASS, SpinCubeInit;
  14.  
  15.                                     (* Interface to dialog templates *)
  16.   FROM SpinDlg    IMPORT IDM_DLGEDITDIALOG, IDM_ABOUT, IDM_ASSERT, IDM_RANGE,
  17.                          IDD_DLG, IDD_ABOUT, IDC_SPINCUBE;
  18.                          
  19.   FROM OS2        IMPORT            (* #include <os2.h> *)
  20.     HWND, QMSG, HAB, HMQ, RECTL, BOOL, LONG, ULONG, APIRET, NULL, NULLHANDLE,
  21.     MPARAM, MRESULT, PSZ, HPS, MakePSTR, MPFROM2SHORT, SHORT1FROMMP, SHORT2FROMMP, 
  22.     MM_DELETEITEM, SC_RESTORE, SC_SIZE, SC_MINIMIZE, SC_MAXIMIZE,
  23.     WinInitialize, WinCreateMsgQueue, WinGetMsg, WinDispatchMsg,
  24.     WinRegisterClass,   CS_SIZEREDRAW, CS_CLIPCHILDREN, WS_VISIBLE,
  25.     WinCreateStdWindow, FCF_STANDARD, FCF_AUTOICON, FCF_ACCELTABLE,
  26.     WinCreateWindow,    HWND_DESKTOP, HWND_TOP,
  27.     WinBeginPaint, WinFillRect, SYSCLR_WINDOW, WinEndPaint,
  28.     WinSendMsg, WM_PAINT, WM_COMMAND, WM_SIZE, WM_INITDLG,
  29.     WinSetWindowPos, SWP_SIZE, SWP_MOVE,
  30.     WinWindowFromID, FID_SYSMENU, DID_OK,
  31.     WinDefWindowProc, WinDefDlgProc, WinShowWindow,
  32.     WinDlgBox, WinDismissDlg, WinSetDlgItemShort, WinQueryWindowRect,
  33.     WinIsWindow, WinDestroyWindow, WinDestroyMsgQueue, WinTerminate,
  34.     DosExitList, PFNEXITLIST, EXLST_ADD, EXLST_EXIT,
  35.     WinSetWindowULong, WinQueryWindowULong, QWL_STYLE;
  36.  
  37.  
  38.   CONST IDR_MAIN = 1;
  39.          BORDER  = 4;
  40.  
  41.  
  42.   VAR  hab   : HAB;
  43.        hmq   : HMQ;
  44.        hwnd  : HWND;
  45.        rect  : RECTL;
  46.        qmsg  : QMSG;
  47.        b     : BOOL;
  48.        mr    : MRESULT;
  49.        hwndMainFrame : HWND;
  50.        gahwndSpin    : ARRAY [0 .. 3] OF HWND;
  51.  
  52. (******************************************************************************
  53. *
  54. *  MainWndProc
  55. *
  56. ******************************************************************************)
  57. PROCEDURE MainWndProc(hwnd : HWND; msg : ULONG;
  58.                                    mp1 : MPARAM; mp2 : MPARAM) : MRESULT;
  59.  
  60.   VAR  width, height : LONG;
  61.        j             : [2000 .. 3000];
  62.        b             : BOOL;
  63.        rc            : ULONG;
  64.        rclUpdate     : RECTL;
  65.        hps           : HPS;
  66. BEGIN
  67.   CASE msg OF
  68.   | WM_PAINT :
  69.     hps := WinBeginPaint(hwnd, NULLHANDLE, rclUpdate);
  70.     b   := WinFillRect(hps, rclUpdate, SYSCLR_WINDOW);
  71.     b   := WinEndPaint(hps);
  72.  
  73.   | WM_COMMAND :
  74.     CASE SHORT1FROMMP(mp1) OF
  75.     | IDM_DLGEDITDIALOG:
  76.       rc := WinDlgBox(HWND_DESKTOP, hwnd, DlgProc, NULLHANDLE, IDD_DLG, NULL);
  77.  
  78.     | IDM_ABOUT:
  79.       rc := WinDlgBox(hwnd, hwnd, DlgProc, NULLHANDLE, IDD_ABOUT, NULL);
  80.  
  81.     | IDM_ASSERT:
  82.       Assert(FALSE,"This is a test of GPM error dialog with automatic resizing facility");
  83.  
  84.     | IDM_RANGE:
  85.       rc := 1234;
  86.       j  := rc;
  87.  
  88.     ELSE  (* ignore *)
  89.     END;
  90.  
  91.   | WM_SIZE :
  92.     (*
  93.      * Resize the controls such that each cover quarter of the client area
  94.      *   (plus a little border).
  95.     *)
  96.     width  := SHORT1FROMMP(mp2);
  97.     height := SHORT2FROMMP(mp2);
  98.     IF (width > 0) AND (height > 0) THEN
  99.       b := WinSetWindowPos(gahwndSpin[0], NULLHANDLE,
  100.                            BORDER, BORDER,
  101.                            width/2 - BORDER, height/2 - BORDER,
  102.                            SWP_SIZE + SWP_MOVE);
  103.       b := WinSetWindowPos(gahwndSpin[1], NULLHANDLE,
  104.                            width/2 + BORDER,   BORDER,
  105.                            width/2 - BORDER*2, height/2 - BORDER,
  106.                            SWP_SIZE + SWP_MOVE);
  107.       b := WinSetWindowPos(gahwndSpin[2], NULLHANDLE,
  108.                            BORDER,           height/2 + BORDER,
  109.                            width/2 - BORDER, height/2 - BORDER*2,
  110.                            SWP_SIZE + SWP_MOVE);
  111.       b := WinSetWindowPos(gahwndSpin[3], NULLHANDLE,
  112.                            width/2 + BORDER,   height/2 + BORDER,
  113.                            width/2 - BORDER*2, height/2 - BORDER*2,
  114.                            SWP_SIZE + SWP_MOVE);
  115.     END;
  116.  
  117.   ELSE RETURN WinDefWindowProc(hwnd, msg, mp1, mp2);
  118.   END;
  119.  
  120.   RETURN NULL;
  121. END MainWndProc;
  122.  
  123.  
  124. (******************************************************************************
  125. *
  126. *  DlgProc
  127. *
  128. ******************************************************************************)
  129. PROCEDURE DlgProc(hwnd : HWND; msg : ULONG;
  130.                                mp1 : MPARAM; mp2 : MPARAM) : MRESULT;
  131.   VAR b : BOOL;
  132. BEGIN
  133.   CASE msg OF
  134.   | WM_INITDLG:
  135.       FixSysMenu(hwnd);
  136.  
  137.   | WM_COMMAND:
  138.     IF SHORT1FROMMP(mp1) = DID_OK THEN
  139.       b := WinDismissDlg(hwnd, 1);
  140.     END;
  141.  
  142.   ELSE RETURN WinDefDlgProc(hwnd, msg, mp1, mp2);
  143.   END;
  144.  
  145.   RETURN NULL;
  146. END DlgProc;
  147.  
  148.  
  149. (******************************************************************************
  150. *
  151. * FixSysMenu
  152. *
  153. ******************************************************************************)
  154. PROCEDURE FixSysMenu(hwndDlg : HWND);
  155.    VAR hwndMenu : HWND;            (* handle to system menu *)
  156.        mr       : MRESULT;
  157. BEGIN
  158.    hwndMenu := WinWindowFromID(hwndDlg, FID_SYSMENU);
  159.  
  160.    mr := WinSendMsg(hwndMenu,       (* delete Restore from the system menu *)
  161.                     MM_DELETEITEM,
  162.                     MPFROM2SHORT(SC_RESTORE, 1), NULL);
  163.  
  164.    mr := WinSendMsg(hwndMenu,       (* delete Size from the system menu *)
  165.                     MM_DELETEITEM,
  166.                     MPFROM2SHORT(SC_SIZE, 1), NULL);
  167.  
  168.    mr := WinSendMsg(hwndMenu,       (* delete Minimize from the system menu *)
  169.                     MM_DELETEITEM,
  170.                     MPFROM2SHORT(SC_MINIMIZE, 1), NULL);
  171.  
  172.    mr := WinSendMsg(hwndMenu,       (* delete Maximize from the system menu *)
  173.                     MM_DELETEITEM,
  174.                     MPFROM2SHORT(SC_MAXIMIZE, 1), NULL);
  175. END FixSysMenu;
  176.  
  177.  
  178. (******************************************************************************
  179. *
  180. *  ExitProc
  181. *
  182. ******************************************************************************)
  183. PROCEDURE ExitProc(usTermCode : ULONG);
  184.   VAR rc : APIRET;
  185.       b  : BOOL;
  186.       pf : ADDRESS;
  187. BEGIN
  188.   IF WinIsWindow(hab, hwndMainFrame) THEN
  189.     b := WinDestroyWindow(hwndMainFrame);
  190.   END;                          (* destroy main window if it exists *)
  191.  
  192.   b := WinDestroyMsgQueue(hmq);
  193.   b := WinTerminate(hab);
  194.  
  195.   pf := NULL;                   (* termination complete *)
  196.   rc := DosExitList(EXLST_EXIT, CAST(PFNEXITLIST,pf));
  197. END ExitProc;
  198.  
  199.  
  200. (******************************************************************************
  201. *
  202. *  CreateAppWindow
  203. *
  204. ******************************************************************************)
  205. PROCEDURE CreateAppWindow() : HWND;
  206.  
  207.   VAR   hwndMain  : HWND;
  208.         pszClass  : PSZ;
  209.         flCtlData : ULONG;
  210.     flStyle   : ULONG;
  211.         i         : ULONG;
  212. BEGIN
  213.  (*  Register the main client window class
  214.   *  and create the application frame window
  215.   *)
  216.   pszClass := MakePSTR("Main");
  217.   IF NOT WinRegisterClass(hab, pszClass, MainWndProc,
  218.                           CS_SIZEREDRAW + CS_CLIPCHILDREN, 0) THEN
  219.     RETURN NULLHANDLE
  220.   END;
  221.  
  222.   flCtlData := FCF_STANDARD + FCF_AUTOICON - FCF_ACCELTABLE;
  223.   hwndMainFrame := WinCreateStdWindow(HWND_DESKTOP, 0, flCtlData,
  224.                                       pszClass,
  225.                                       MakePSTR("Spincube Sample"),
  226.                                       WS_VISIBLE,
  227.                                       NULLHANDLE, IDR_MAIN, hwndMain);
  228.  
  229.   IF hwndMainFrame = NULLHANDLE THEN RETURN NULLHANDLE END;
  230.  
  231.  (*
  232.   *  Create 4 SpinCube custom controls; we'll size them later
  233.   *  in the WM_SIZE message handler
  234.   *)
  235.   flStyle := WS_VISIBLE;
  236.   FOR i := 0 TO 3 DO
  237.     gahwndSpin[i] := WinCreateWindow(hwndMain,
  238.                                      MakePSTR(SPINCUBECLASS),
  239.                                      MakePSTR(""),
  240.                                      CAST(ULONG,CAST(BITSET,flStyle)
  241.                      + SS_ERASE + SS_INMOTION),
  242.                                      0, 0, 0, 0,
  243.                                      hwndMain, HWND_TOP, i,
  244.                                      NULL, NULL);
  245.   END;
  246.  
  247.   b := WinShowWindow(hwndMainFrame, TRUE);
  248.   RETURN hwndMain;
  249.  
  250. END CreateAppWindow;
  251.  
  252.  
  253. (******************************************************************************)
  254. BEGIN  (* SpinTest *)
  255.  
  256.   hab := WinInitialize(0);
  257.   hmq := WinCreateMsgQueue(hab, 0);
  258.   Assert(hmq <> NULLHANDLE, "WinCreateMsgQueue() failed");
  259.  
  260.  (* Add ExitProc to the exit list to handle the exit processing *)
  261.   Assert(DosExitList(EXLST_ADD, ExitProc) = 0, "DosExitList() failed");
  262.  
  263.   SpinCubeInit(hab);
  264.   hwnd := CreateAppWindow();
  265.   Assert(hwnd <> NULLHANDLE, "Failed to create application window");
  266.  
  267.  (*
  268.   * Delete the SS_ERASE to the 1st & 4th controls so we get the
  269.   *   trailing cubes effect.
  270.   *)
  271.   b := WinSetWindowULong(gahwndSpin[0], QWL_STYLE, CAST(ULONG,CAST(BITSET,
  272.                WinQueryWindowULong(gahwndSpin[0], QWL_STYLE)) - SS_ERASE));
  273.   b := WinSetWindowULong(gahwndSpin[3], QWL_STYLE, CAST(ULONG,CAST(BITSET,
  274.                WinQueryWindowULong(gahwndSpin[3], QWL_STYLE)) - SS_ERASE));
  275.  
  276.  (*
  277.   * Send ourself a WM_SIZE so the controls will get sized appropriately
  278.   *)
  279.   b  := WinQueryWindowRect(hwnd, rect);
  280.   mr := WinSendMsg(hwnd, WM_SIZE, NULL,
  281.                                   MPFROM2SHORT(rect.xRight, rect.yBottom));
  282.  
  283.  (* Get/Dispatch Message loop *)
  284.   WHILE WinGetMsg(hmq, qmsg, NULLHANDLE, 0, 0) DO
  285.     mr := WinDispatchMsg(hmq, qmsg);
  286.   END;
  287.  
  288. END SpinTest.
  289.