home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / OS2BAS.ZIP / FLING.BAS < prev    next >
BASIC Source File  |  1989-09-07  |  26KB  |  705 lines
  1. '|***************************************************************************
  2. '|
  3. '| Program Name: Fling.BAS
  4. '|
  5. '| Description:  Fling is a fun program that demonstrates many
  6. '|               of the Presentation Manager GPI calls for
  7. '|               manipulating and using bitmaps.  The following
  8. '|               are the major areas demonstrated in this program:
  9. '|      
  10. '|               - Passing a bitmap from one program to another
  11. '|                 using the System Clipboard.
  12. '|               - Using mouse control to move and manipulate
  13. '|                 bitmaps
  14. '|               - Using bitmaps in menus
  15. '|               - Executing menuselections before the menu item is
  16. '|                 actually selected. (WMMENUSELECT)
  17. '|               - Difference between 1 bit per pixel bitmaps
  18. '|                 and 4 bits per pixel bitmaps. (The bitmap
  19. '|                 titled "BITMAP" is the only 1 bit per pixel
  20. '|                 bitmap used in this program, and is the only
  21. '|                 bitmap the color can be changed using the color
  22. '|                 menu selection).
  23. '|
  24. '|               Fling displays a bitmap moving and bouncing of
  25. '|               the boundaries of the Client window.  The speed
  26. '|               and direction are determined by the user through
  27. '|               the use of the mouse.  Clicking and holding the
  28. '|               Left mouse button down within the boundaries of
  29. '|               the bitmap will "CATCH" the bitmap.  The bitmap
  30. '|               can then be sent off in another direction and
  31. '|               speed by "Flinging" it in the desired direction
  32. '|               speed and releasing the mouse button.  Clicking
  33. '|               the Left mouse button anywhere within the Client
  34. '|               Window other than on the bitmap will pause the
  35. '|               bitmap, allowing the user to click on the bitmap.
  36. '|               Clicking it againg will restart the bitmap using
  37. '|               the last direction and speed.  The right mouse
  38. '|               button clears the Client window user.
  39. '|      
  40. '|               There are four predfined bitmaps which appear and
  41. '|               are selected from the "Bitmaps" and "More bitmaps"
  42. '|               menus.  If the System clipboard contains a bitmap
  43. '|               the "Clipboard" menu selection will display that
  44. '|               bitmap.  A bitmap can be place in the clipboard
  45. '|               using the program CAPTURE.BAS.
  46. '|
  47. '| Source Files: FLING.BAS   Source
  48. '|               FLING.DEF   definition file
  49. '|               FLING.INC   Include file cut & pasted from BI files
  50. '|               FLING.RC    Resouce file
  51. '|               FLING.ICO   Icon
  52. '|               FLING1.BMP  bitmap
  53. '|               FLING2.BMP  OS/2 symbol
  54. '|               FLING3.BMP  Jack of diamonds face
  55. '|               FLING4.BMP  Bug face
  56. '|
  57. '| To Compile
  58. '| and Link:     Use PMBC ->  PMBC fling
  59. '|               or the following can be used
  60. '|
  61. '| Compiling:    BC fling /o;
  62. '|
  63. '| Linking:      Link /noe fling,,, os2.lib regbas.lib, fling.def
  64. '|
  65. '| Resource:     RC fling   (compiles and adds resource to FLING.EXE)
  66. '|***************************************************************************
  67. '|********         Initialization section        ***********
  68.  
  69. REM $INCLUDE: 'os2def.bi'
  70. REM $INCLUDE: 'PMBase.bi'
  71. REM $INCLUDE: 'winmisc.bi'
  72. REM $INCLUDE: 'winman1.bi'
  73. REM $INCLUDE: 'gpibit.bi'
  74.  
  75. REM $INCLUDE: 'FLING.INC'
  76.  
  77. DIM aqmsg AS QMSG
  78.  
  79. flFrameFlags& = FCFTITLEBAR      OR FCFSYSMENU  OR_
  80.                 FCFSIZEBORDER    OR FCFMINMAX   OR_
  81.                 FCFSHELLPOSITION OR FCFTASKLIST OR_
  82.                 FCFMENU          OR FCFICON     OR_
  83.                 FCFNOBYTEALIGN
  84.  
  85. szClientClass$ = "ClassName" + CHR$(0)
  86.  
  87. hab& = WinInitialize(0)
  88. hmq& = WinCreateMsgQueue(hab&, 0)
  89.  
  90. bool% = WinRegisterClass(_
  91.       hab&,_
  92.       MakeLong(VARSEG(szClientClass$), SADD(szClientClass$)),_
  93.       RegBas,_
  94.       0,_
  95.       0)
  96.  
  97. hwndFrame& = WinCreateStdWindow (_
  98.       HWNDDESKTOP,_
  99.       WSVISIBLE,_
  100.       MakeLong (VARSEG(flFrameFlags&), VARPTR(flFrameFlags&)),_
  101.       MakeLong (VARSEG(szClientClass$), SADD(szClientClass$)),_
  102.       0,_
  103.       0,_
  104.       0,_
  105.       1,_
  106.       MakeLong (VARSEG(hwndClient&), VARPTR(hwndClient&)))
  107.  
  108. '**************         Message loop         ***************
  109.  
  110. WHILE WinGetMsg(hab&,_
  111.               MakeLong(VARSEG(aqmsg), VARPTR(aqmsg)), 0, 0, 0)
  112.     bool% = WinDispatchMsg(hab&,_
  113.               MakeLong(VARSEG(aqmsg), VARPTR(aqmsg)))
  114. WEND
  115.  
  116. '***********         Finalize section        ***************
  117.  
  118. bool% = WinDestroyWindow(hwndFrame&)
  119. bool% = WinDestroyMsgQueue(hmq&)
  120. bool% = WinTerminate(hab&)
  121. END
  122.  
  123. '***********         Window procedure        ***************
  124.  
  125. FUNCTION ClientWndProc& (hwnd&, msg%, mp1&, mp2&) STATIC
  126. SHARED hab&, hbm&, hpsClient&, hwndMenu&, colorflag%
  127. SHARED cxClient%, cyClient%, fcolor%, randomc%, index%, xsize%, ysize%
  128. SHARED maximizedClient%
  129. SHARED ptl AS POINTL, bmpinfo AS BITMAPINFO
  130. DIM bitmaps&(4,4), mirror AS POINTL
  131.  
  132.   SELECT CASE msg%
  133.  
  134.     CASE WMCREATE
  135.     '|
  136.     '| Set default values for color, speed, direction, and sound.
  137.     '|
  138.       fcolor% = 7
  139.       tcolor% = 7
  140.       colorflag% = 1
  141.       sounds% = -1
  142.       movex% = 3
  143.       movey% = 3
  144.       cxicon% = WinQuerySysValue(HWNDDESKTOP, SVCXICON)
  145.     '|
  146.     '| Load bitmaps from resource.  Query bitmap information for each
  147.     '| bitmap and store bitmap handle, width, heigth, and bits per pixel
  148.     '| in the array bitmaps&()
  149.     '|
  150.       hpsClient& = WinGetPS(hwnd&)
  151.       FOR I% = 1 TO 4
  152.         bitmaps&(I%,1) = GpiLoadBitmap(hpsClient&, 0, I%, 0, 0)
  153.         bool% = GpiQueryBitmapParameters(bitmaps&(I%,1),_
  154.                               MakeLong(VARSEG(bmpinfo), VARPTR(bmpinfo)))
  155.         bitmaps&(I%,2) = bmpinfo.cx - 1
  156.         bitmaps&(I%,3) = bmpinfo.cy - 1
  157.         bitmaps&(I%,4) = bmpinfo.cBitCount
  158.       NEXT I%
  159.     '|
  160.     '| Initialize values for initial bitmap displayed when FLING is
  161.     '| loaded.
  162.     '|
  163.       hbm& = bitmaps&(1, 1)
  164.       xsize% = bitmaps&(1, 2) - 1
  165.       ysize% = bitmaps&(1, 3) - 1
  166.     '|
  167.     '| Obtain handle to programs menu.  To be used to enable, disable,
  168.     '| check, and uncheck color selections.
  169.     '|
  170.       hwndMenu& = WinWindowFromID(WinQueryWindow(hwnd&, QWPARENT, FALSE),_
  171.                                   FIDMENU)
  172.     '|
  173.     '| Start timer which will cause a bitmap to be displayed approximately
  174.     '| every 1 millisecond.
  175.     '|
  176.       ClientWndProc& = 0
  177.   '|
  178.   '| Obtain new Client Window size
  179.   '|
  180.     CASE WMSIZE
  181.       CALL BreakLong(mp2&, cyClient%, cxClient%)
  182.       IF maximizedClient% = 1 THEN CALL MaximizeTheClientWindow(hwnd&)
  183.       IF cxClient% = cxicon% THEN
  184.         bool% = WinStopTimer(hab&, hwnd&, 1)
  185.       ELSE
  186.         bool% = WinStartTimer(hab&, hwnd&, 1, 1)
  187.       END IF
  188.       ClientWndProc&=0
  189.   '|
  190.   '| Clears Client Window, and redraws the current bitmap only
  191.   '| if it is currently paused.
  192.   '|
  193.     CASE WMPAINT
  194.       hps&  = WinBeginPaint(hwnd&, 0, 0)
  195.       CALL ClearTheClientWindow(hps&)
  196.       IF pause% = 1 THEN CALL MoveBitmap(hwnd&, 0, 0)
  197.       bool% = WinEndPaint(hps&)
  198.       ClientWndProc& = 0
  199.   '|
  200.   '| A WMTIMER message is sent every 1 millisecond, if the timer is started,
  201.   '| which invokes this routine.  The timer is stopped before this routine
  202.   '| is executed since once the WMTIMER message dispatched from the
  203.   '| message loop, another WMTIMER can be posted in the message cue.  If
  204.   '| a WMTIMER message is posted before this routine is complete, depending
  205.   '| on the size of the current bitmap, the WMTIMER messages continuously
  206.   '| being placed in the cue can make it difficult for other messages
  207.   '| to get processed.  The timer is started upon exiting this routine.
  208.     CASE WMTIMER
  209.       bool% = WinStopTimer(hab&, hwnd&, 1)
  210.     '|
  211.     '| Obtain current direction (SIGN), both horizontal and vertical
  212.       xsgn% = SGN(movex%)
  213.       ysgn% = SGN(movey%)
  214.     '|
  215.     '| Change direction if at boundary of Client Window
  216.     '|
  217.       IF ptl.x = 0 THEN movex% = ABS(movex%)
  218.       IF ptl.x = (cxClient% - xsize%) THEN movex% = -ABS(movex%)
  219.       IF ptl.y = 0 THEN movey% = ABS(movey%)
  220.       IF ptl.y = (cyClient% - ysize%) THEN movey% = -ABS(movey%)
  221.     '|
  222.     '| If out boundary and sound is turned on, BEEP
  223.     '|
  224.       IF sounds% = 1 THEN
  225.         IF (xsgn% * movex%) < 0 OR (ysgn% * movey%) < 0 THEN
  226.           bool% = DosBeep(250, 5)
  227.         ENDIF
  228.       END IF
  229.     '|
  230.     '| CALL MoveBitmap to draw bitmap in next location
  231.     '|
  232.       CALL MoveBitmap(hwnd&, movex%, movey%)
  233.       bool% = WinStartTimer(hab&, hwnd&, 1, 1)
  234.       ClientWndProc& = 0
  235.   '|
  236.   '| The WMMENUSELECT message is sent as each submenu item is selected
  237.   '| from a menu, but prior to the WMCOMMAND message being sent for a
  238.   '| selected menu item.  Both color and bitmap menu selections are
  239.   '| processed before the menu is dismissed.
  240.   '|
  241.     CASE WMMENUSELECT
  242.       CALL BreakLong(mp1&, dummy%, menuSelection%)
  243.       SELECT CASE menuSelection%
  244.       '|
  245.       '| Get color selection.  Color 16 is random colors
  246.       '|
  247.         CASE IDMCOLOR+1 TO IDMCOLOR+16
  248.           IF colorflag% = 1 THEN
  249.             fcolor% = menuSelection% - IDMCOLOR
  250.             IF fcolor% = 16 THEN randomc% = 1 ELSE randomc% = 0
  251.           END IF
  252.             
  253.         CASE IDMBITMAPS+1 TO IDMBITMAPS+5
  254.         '|
  255.         '| If Clipboard was selected, get bitmap from System Clipboard
  256.         '|
  257.           IF menuSelection% = IDMCLIPBRD THEN
  258.             CALL FlingBitmapFromClipBoard(hwnd&, hbmClip&)
  259.             IF hbmClip& <> 0 THEN
  260.               hbm& = hbmClip&
  261.               bool% = GpiQueryBitmapParameters(hbm&,_
  262.                                   MakeLong(VARSEG(bmpinfo), VARPTR(bmpinfo)))
  263.               xsize% = bmpinfo.cx - 1
  264.               ysize% = bmpinfo.cy - 1
  265.               colorflag% = bmpinfo.cBitCount
  266.             END IF
  267.           ELSE
  268.         '|
  269.         '| Get a predefined bitmap was selected, get bitmap info from
  270.         '| bitmaps&() array
  271.         '|
  272.             index% = menuSelection% - IDMBITMAPS
  273.             hbm& = bitmaps&(index%, 1)
  274.             xsize% = bitmaps&(index%, 2)
  275.             ysize% = bitmaps&(index%, 3)
  276.             colorflag% = bitmaps&(index%, 4)
  277.           END IF
  278.         '|
  279.         '| Disable color selection if selected bitmap is a 4 bit per
  280.         '| pixel bitmap
  281.         '|
  282.           IF colorflag% = 4 THEN
  283.             attribute% = MIADISABLED
  284.           ELSE
  285.             attribute% = 0
  286.           END IF
  287.           bool% = WinSendMsg(hwndMenu&, MMSETITEMATTR,_
  288.                              MakeLong(TRUE, IDMCOLOR),_
  289.                              MakeLong(attribute%, MIADISABLED))
  290.           IF pause% = 1 THEN CALL MoveBitmap(hwnd&, 0, 0)
  291.         CASE ELSE
  292.       END SELECT
  293.       ClientWndProc& = 1
  294.    
  295.     CASE WMCOMMAND
  296.       CALL BreakLong(mp1&, dummy%, menuSelection%)
  297.       SELECT CASE menuSelection%
  298.  
  299.         CASE IDMEXIT
  300.           bool% = WinReleasePS(hpsClient&)
  301.           bool% = WinPostMsg(hwnd&, WMQUIT, 0, 0)
  302.  
  303.         CASE IDMSOUND
  304.           sounds% = -sounds%
  305.  
  306.         CASE IDMMAXIMIZECLIENTWINDOW
  307.           CALL MaximizeOrRestoreTheClientWindow(hwnd&)
  308.       '|
  309.       '| The color has already been selected during the WMMENUSELECT
  310.       '| message.  The routine is used to recheck the new color
  311.       '| selection.
  312.       '|
  313.         CASE IDMCOLOR+1 TO IDMCOLOR+16
  314.         '|
  315.         '| Calculate handle of last color selection menu item
  316.         '|
  317.           IF randomc% = 1 THEN
  318.             lastcolor% = 16 + IDMCOLOR
  319.           ELSE
  320.             lastcolor% = tcolor% + IDMCOLOR
  321.           ENDIF
  322.           CALL ResetCheckedMenuItem(lastcolor%, menuSelection%)
  323.           tcolor% = fcolor%
  324.         CASE ELSE
  325.       END SELECT
  326.       ClientWndProc& = 0
  327.   '|
  328.   '| Clear the Client window
  329.   '|
  330.     CASE WMBUTTON2UP
  331.       ClearTheClientWindow(hpsClient&)
  332.       IF pause% = 1 THEN CALL MoveBitmap(hwnd&, 0, 0)
  333.       ClientWndProc& = 1
  334.   '|
  335.   '| If mouse cursor is within the boundaryies of the bitmap,
  336.   '| pause the bitmap and set the flag "mouse%" to one.  This
  337.   '| will cause the WMMOUSEMOVE message to redraw the bitmap
  338.   '| where ever the mouse is moved, as long as the left mouse
  339.   '| button is held down.  Once released, the difference between
  340.   '| the last two mouse locations are used to determine bitmap
  341.   '| direction and speed.
  342.   '|
  343.     CASE WMBUTTON1DOWN
  344.       CALL BreakLong(mp1&, my%, mx%)
  345.       IF (mx% >= ptl.x) AND (mx% =< (ptl.x + xsize%)) THEN
  346.         IF (my% >= ptl.y) AND (my% =< (ptl.y + ysize%)) THEN
  347.           bool% = WinStopTimer(hab&, hwnd&, 1)
  348.           mouse% = 1
  349.           lastmx% = mx%
  350.           lastmy% = my%
  351.           fling% = 1
  352.         END IF
  353.       END IF
  354.       ClientWndProc& = WinDefWindowProc(hwnd&, msg%, mp1&, mp2&)
  355.   '|
  356.   '| If the left mouse button has just been released and it was within
  357.   '| the boundaries of the bitmap, the timer is started which will
  358.   '| then cause the bitmap to continue in the direction and speed
  359.   '| determined from the the mouse coordinates.  If the mouse
  360.   '| was not within the bitmap boundaries, and the bitmap was moving,
  361.   '| the bitmap is then paused.  If it was paused, it is restarting
  362.   '|
  363.     CASE WMBUTTON1UP
  364.       mouse% = 0
  365.       IF fling% THEN
  366.         bool% = WinStartTimer(hab&, hwnd&, 1, 1)
  367.         fling% = 0
  368.         pause% = 0
  369.       ELSEIF pause% = 0 THEN
  370.         bool% = WinStopTimer(hab&, hwnd&, 1)
  371.         pause% = 1
  372.       ELSE
  373.         bool% = WinStartTimer(hab&, hwnd&, 1, 1)
  374.         pause% = 0
  375.       END IF
  376.       ClientWndProc& = WinDefWindowProc(hwnd&, msg%, mp1&, mp2&)
  377.   '|
  378.   '| If the left mouse button is currently down, redraw bitmap at
  379.   '| the new location of the mouse.
  380.   '|
  381.     CASE WMMOUSEMOVE
  382.       IF mouse% = 1 THEN
  383.         CALL BreakLong(mp1&, my%, mx%)
  384.         movex% = mx% - lastmx%
  385.         movey% = my% - lastmy%
  386.         lastmx% = mx%
  387.         lastmy% = my%
  388.         CALL MoveBitmap(hwnd&, movex%, movey%)
  389.       END IF
  390.       ClientWndProc& = 1
  391.  
  392.     CASE WMHELP
  393.       CALL DisplayHelp
  394.  
  395.     CASE ELSE
  396.       ClientWndProc& = WinDefWindowProc(hwnd&, msg%, mp1&, mp2&)
  397.  
  398.   END SELECT
  399. END FUNCTION
  400.  
  401.  
  402. '|***************************************************************************
  403. '| MoveBitmap redraws the current bitmap at its new location which is
  404. '| determined by adding the horizontal "movex%" and vertical "movey%"
  405. '| values to the current location.  If the new location would place part
  406. '| of the bitmap outside the Client window, then the bitmap is drawn
  407. '| at the boundary, recalculating "movex%" and "movey%" as neccessary.
  408. '|***************************************************************************
  409. SUB MoveBitmap(hwnd&, movemx%, movemy%) STATIC
  410. SHARED hbm&, hpsClient&, fcolor%, randomc%, cxClient%, cyClient%, colorflag%
  411. SHARED xsize%, ysize%, ptl AS POINTL
  412.  
  413. '|
  414. '| Add movement values to current location. (lower left hand corner)
  415. '|
  416.   ptl.x = ptl.x + movemx%
  417.   ptl.y = ptl.y + movemy%
  418. '|
  419. '| Determine if new location would place part of the bitmap outside
  420. '| the Client window.  Recalculate if neccessary.
  421. '|
  422.   IF ptl.x > (cxClient% - xsize%) THEN ptl.x = cxClient% - xsize%
  423.   IF ptl.x < 0 THEN ptl.x = 0
  424.   IF ptl.y > (cyClient% - ysize%) THEN ptl.y = cyClient% - ysize%
  425.   IF ptl.y < 0 THEN ptl.y = 0
  426. '|
  427. '| If random color is selected, and current bitmap is a 1 bit per pixel
  428. '| bitmap, select a random color
  429. '|
  430.   IF randomc% = 1 AND colorflag% = 1 THEN
  431.     RANDOMIZE TIMER
  432.     fcolor% = INT (15 * RND + 1)
  433.   END IF
  434. '|
  435. '| Draw bitmap at new location
  436. '|
  437.   bool% = WinDrawBitmap(hpsClient&, hbm&, 0,_
  438.                         MakeLong(VARSEG(ptl), VARPTR(ptl)),_
  439.                         fcolor%, CLRWHITE, DBMNORMAL)
  440. END SUB
  441.  
  442.  
  443. '|***************************************************************************
  444. '| Retrieves bitmap from the System Clipboard, if the Clipboard contains one.
  445. '| If there is not a bitmap in the Clipboard, a message is displayed to
  446. '| prompt the user.
  447. '|***************************************************************************
  448. SUB FlingBitmapFromClipBoard(hwnd&, hbm&)
  449. SHARED hab&
  450.   bool% = GpiDeleteBitmap(hbm&)
  451. '|
  452. '| Open Clipboard and determine if it contains a bitmap
  453. '|
  454.   bool% = WinOpenClipBrd(hab&)
  455.   hbmClip& = WinQueryClipBrdData(hab&, CFBITMAP)
  456. '|
  457. '| If the Clipboard contains a bitmap, make a copy of the bitmap
  458. '|
  459.   IF hbmClip& <> 0 THEN
  460.     hbm& = MakeCopyOfBitmap(hbmClip&)
  461.   ELSE
  462.   '|
  463.   '| If the Clipboard does not contain a bitmap, let the user know
  464.   '|
  465.     caption$ = CHR$(0)
  466.     message$ = "The Clipboard does not contain a bitmap" + CHR$(0)
  467.     bool% = WinMessageBox(HWNDDESKTOP, HWNDDESKTOP,_
  468.                           MakeLong(VARSEG(message$), SADD(message$)),_
  469.                           MakeLong(VARSEG(caption$), SADD(caption$)),_
  470.                           0,_
  471.                           MBICONHAND OR MBAPPLMODAL)
  472.     hbm& = 0
  473.   END IF
  474.   bool% = WinCloseClipbrd(hab&)
  475. END SUB
  476.  
  477.  
  478. '|***************************************************************************
  479. '| This FUNCTION takes a bitmap handle as a paramater, and makes a copy of
  480. '| the bitmap referenced by "hbmSource&".  The handle of the bitmap copy
  481. '| is returned by the FUNCTION.
  482. '|***************************************************************************
  483. FUNCTION MakeCopyOfBitmap&(hbmSource&)
  484. DIM bih AS BITMAPINFOHEADER, aptl(2) AS POINTL
  485. '|
  486. '| Create a presentation space and device context for both the source bitmap
  487. '| and the target bitmap.
  488. '|
  489.   CALL CreateBitmapPSandDC(hpsSource&, hdcSource&)
  490.   CALL CreateBitmapPSandDC(hpsTarget&, hdcTarget&)
  491. '|
  492. '| Get source bitmap information.
  493. '|
  494.   bool% = GpiQueryBitmapParameters(hbmSource&,_
  495.                                    MakeLong(VARSEG(bih), VARPTR(bih)))
  496. '|
  497. '| Create a new bitmap using info from source bitmap
  498. '|
  499.   hbmTarget& = GpiCreateBitmap(hpsTarget&,_
  500.                                MakeLong(VARSEG(bih), VARPTR(bih)),_
  501.                                0, 0, 0)
  502. '|
  503. '| Associate source and target bitmaps with their respective presentation
  504. '| space so a copy can be made using GpiBitBlt
  505. '|
  506.   bool% = GpiSetBitmap(hpsSource&, hbmSource&)
  507.   bool% = GpiSetBitmap(hpsTarget&, hbmTarget&)
  508. '|
  509. '| Initialize rectangle of source bitmap to be copied to entire bitmap
  510. '|
  511.   aptl(0).x = 0
  512.   aptl(0).y = 0
  513.   aptl(1).x = bih.cx
  514.   aptl(1).y = bih.cy
  515.   aptl(2).x = 0
  516.   aptl(2).y = 0
  517. '|
  518. '| Copy bitmap
  519. '|
  520.   bool% = GpiBitBlt(hpsTarget&, hpsSource&, 3,_
  521.                     MakeLong(VARSEG(aptl(0)), VARPTR(aptl(0))),_
  522.                     ROPSRCCOPY, BBOAND)
  523. '|
  524. '| Destroy presentation spaces and device contexts used to create bitmap
  525. '|
  526.   bool% = GpiDestroyPS(hpsSource&)
  527.   bool% = GpiDestroyPS(hpsTarget&)
  528.   bool% = DevCloseDC(hdcSource&)
  529.   bool% = DevCloseDC(hdcTarget&)
  530. '|
  531. '| Return handle to copy of bitmap
  532. '|
  533.   MakeCopyOfBitmap& = hbmTarget&
  534. END FUNCTION
  535.  
  536.  
  537. '|***************************************************************************
  538. '| Creates a Micro presentation space and device context to be used to store
  539. '| bitmap in memory, which can be referenced by a handle.
  540. '|***************************************************************************
  541. SUB CreateBitmapPSandDC(hps&, hdc&)
  542. SHARED hab&
  543. DIM sizl AS POINTL
  544. '|
  545. '| Initialize information for Memory Device Context, then open
  546. '| a memory device context.  Create same size as bitmap.
  547. '|
  548.   token$ = "*" + CHR$(0)
  549.   sizl.x = 0
  550.   sizl.y = 0
  551.   hdc& = DevOpenDC(hab&, ODMEMORY,_
  552.                    MakeLong(VARSEG(token$), SADD(token$)), 0, 0, 0)
  553. '|
  554. '| Create a micro presentation space and associate it with the memory
  555. '| device context opened above.
  556. '|
  557.   hps& = GpiCreatePS(hab&, hdc&,_
  558.                      MakeLong(VARSEG(sizl), VARPTR(sizl)),_
  559.                      PUPELS OR GPIFDEFAULT OR GPITMICRO OR GPIAASSOC)
  560. END SUB
  561.  
  562.  
  563. '|***************************************************************************
  564. '| Maximizes or restores the Client window, depending on the current value
  565. '| of "maximizedClient".
  566. '|***************************************************************************
  567. SUB MaximizeOrRestoreTheClientWindow(hwnd&)
  568. SHARED hwndFrame&, hwndMenu&, maximizedClient%
  569. DIM swpFrame AS SWP
  570.   IF maximizedClient% = 1 THEN
  571.   '|
  572.   '| Restore the Client Window
  573.     maximizedClient% = 0
  574.   '|
  575.   '| Obtain current frame window size
  576.   '|
  577.     bool% = WinQueryWindowPos(hwndFrame&,_
  578.                               MakeLong(VARSEG(swpFrame), VARPTR(swpFrame)))
  579.   '|
  580.   '| Restore the Client window to within the frame windows frame and menus
  581.   '| by changing the frame window size by 1 pixel, then changing it back to
  582.   '| its original size.  A WinSetWindowPos will not cause a WMSIZE message
  583.   '| if the size of the window is not changed.  This is a sleezy way to
  584.   '| restore the Client window without having to save its orginal size and
  585.   '| position.
  586.   '|
  587.     bool% = WinSetWindowPos(hwndFrame&, 0, 0, 0,_
  588.                             swpFrame.cx + 1, swpFrame.cy,_
  589.                             SWPSIZE)
  590.     bool% = WinSetWindowPos(hwndFrame&, 0, 0, 0,_
  591.                             swpFrame.cx, swpFrame.cy,_
  592.                             SWPSIZE)
  593.     CALL ResetCheckedMenuItem(IDMMAXIMIZECLIENTWINDOW, 0)
  594.   ELSE
  595.   '|
  596.   '| Maximize the Client Window
  597.   '|
  598.     CALL MaximizeTheClientWindow(hwnd&)
  599.     CALL ResetCheckedMenuItem(0, IDMMAXIMIZECLIENTWINDOW)
  600.   END IF
  601. END SUB
  602.  
  603.  
  604. '|***************************************************************************
  605. '| Maximizes the Client window, hiding all of the frame window controls and
  606. '| menus.  The controls are still accessable by keyboard or mouse, but they
  607. '| simply cannot be seen.
  608. '|***************************************************************************
  609. SUB MaximizeTheClientWindow(hwnd&)
  610. SHARED hwndFrame&, hwndMenu&, maximizedClient%
  611. DIM swpFrame AS SWP
  612. '|
  613. '| Obtain current frame window size
  614. '|
  615.   bool% = WinQueryWindowPos(hwndFrame&,_
  616.                             MakeLong(VARSEG(swpFrame), VARPTR(swpFrame)))
  617. '|
  618. '| Hide Menus
  619. '|
  620.   bool% = WinShowWindow(hwndMenu&, 0)
  621. '|
  622. '| Set Client window size using width and height values of the frame window
  623. '|
  624.   bool% = WinSetWindowPos(hwnd&, 0, 0, 0,_
  625.                           swpFrame.cx, swpFrame.cy,_
  626.                           SWPSIZE OR SWPMOVE)
  627.   maximizedClient% = 1
  628. END SUB
  629.  
  630.  
  631. '|***************************************************************************
  632. '| Removes CHECK from menu item pointed to by "oldChecked%" and places a
  633. '| check on the menu item pointed to by "newChecked%".
  634. '|***************************************************************************
  635. SUB ResetCheckedMenuItem(oldChecked%, newChecked%)
  636. SHARED hwndMenu&
  637. '|
  638. '| Remove check from menu item
  639. '|
  640.   bool% = WinSendMsg(hwndMenu&, MMSETITEMATTR,_
  641.                      MakeLong(TRUE, oldChecked%),_
  642.                      MakeLong(0, MIACHECKED))
  643. '|
  644. '| Place a check on menu item
  645. '|
  646.   bool% = WinSendMsg(hwndMenu&, MMSETITEMATTR,_
  647.                      MakeLong(TRUE, newChecked%),_
  648.                      MakeLong(MIACHECKED, MIACHECKED))
  649. END SUB
  650.  
  651.  
  652. '|***************************************************************************
  653. '| The Client Window is Cleared to the current background color or the Client
  654. '| window is filled with the color blue, depending on the predefined bitmap
  655. '| selected.  Bitmaps 2 and 4, the OS/2 symbol and the Bug face, have blue
  656. '| backgrounds therefore the Client window is cleared to blue.
  657. '|***************************************************************************
  658. SUB ClearTheClientWindow(hps&)
  659. SHARED hab&, index%, cxClient%, cyClient%
  660. DIM rect AS RECTL
  661.  IF index% = 2 OR index% = 4 THEN
  662.  '|
  663.  '| Fill Client window with blue
  664.  '|
  665.    rect.xright = cxClient%
  666.    rect.ytop   = cyClient%
  667.    bool% = WinFillRect(hps&,_
  668.                        MakeLong(VARSEG(rect), VARPTR(rect)),_
  669.                        1) '*** 1 is CLRBLUE
  670.  ELSE
  671.  '|
  672.  '| Clear Client window to current background color.
  673.  '|
  674.    bool% = GpiErase(hps&)
  675.  END IF
  676. END SUB
  677.  
  678.  
  679. '|***************************************************************************
  680. '| Using the MessageBox routine, a short help screen is displayed, using
  681. '| the text contianed in the variable length STRING message$.  The CHR$(13)
  682. '| and CHR$(10) characters force carriage returns and line feeds in the
  683. '| displayed help text.
  684. '|***************************************************************************
  685. SUB DisplayHelp
  686.   caption$ = CHR$(0)
  687.   message$ = "1.) To change speed and direction of bitmap, click and hold "+_
  688.              "Left mouse button on bitmap, then push bitmap in new direction "+_
  689.              "and speed and release button." + CHR$(13) +_
  690.              "2.) To pause bitmap, Click and release Left mouse button "+_
  691.              "anywhere within viewing window, execpt on bitmap." + CHR$(13) +_
  692.              "3.) To clear viewing window, click right mouse button "+_
  693.              "anywhere within the viewing window." + CHR$(13) + CHR$(10)+_
  694.              "CLIPBOARD:" + CHR$(13) +_
  695.              "- Selecting the Clipboard menu will Fling the contents of "+_
  696.              "the Clipboard if it is a bitmap.  A bitmap can be placed "+_
  697.              "in the clipboard using the program CAPTURE.BAS" + CHR$(0)
  698.   bool% = WinMessageBox(HWNDDESKTOP, HWNDDESKTOP,_
  699.                         MakeLong(VARSEG(message$), SADD(message$)),_
  700.                         MakeLong(VARSEG(caption$), SADD(caption$)),_
  701.                         0,_
  702.                         MBICONASTERISK OR MBAPPLMODAL)
  703. END SUB
  704.  
  705.