home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / OS2BAS.ZIP / CAPTURE.BAS < prev    next >
BASIC Source File  |  1989-09-05  |  50KB  |  1,271 lines
  1. '|***************************************************************************
  2. '|
  3. '| Program Name: Capture.BAS
  4. '|
  5. '| Description:    CAPTURE is a bitmap utility program.  It does not create
  6. '|               bitmaps in the sense of being able to draw them.  It
  7. '|               Creates bitmaps by capturing all or a portion of the entire
  8. '|               visible screen.  It can stretch bitmaps upto the size of
  9. '|               the visible screen, and can compress them to the minimum
  10. '|               size allowed for a Client window, which is determined by
  11. '|               the minimum size for a frame window.  This size will vary
  12. '|               from machine to machine depending on the video hardware.
  13. '|               bitmap format.  Existing bitmaps can be loaded from a disk
  14. '|               file or from the system clipboard, and can be saved to
  15. '|               disk file or to the system clipboard.  The clipborad can
  16. '|               either be loaded to be used as the current bitmap or can
  17. '|               be pasted over any portion of the existing bitmap and
  18. '|               and combined.  With a little imagination, utilizing the
  19. '|               system clipboard and running multiple copies of CAPTURE can
  20. '|               produce interesting bitmaps.
  21. '|                 The bitmap file can used by other PM programs utilizing
  22. '|               bitmaps.  The bitmap can be place in a programs resource or
  23. '|               loaded directly from the bitmap file and then displayed and
  24. '|               edited using the various bitmap GPI routines available.
  25. '|               Many of these routines are demonstrated in this program.
  26. '|
  27. '|                 This program also demonstrates the very useful
  28. '|               library OPENDLG.DLL.  The dialog box displayed
  29. '|               when the "Load" and "Save" menu items are selected is
  30. '|               completely controlled by routines in this Dynamic Linked
  31. '|               Library.  To use the routines in OPENDLG.DLL, the program
  32. '|               must include the file "OPENDLG.BI" and the library
  33. '|               OPENDLG.LIB must be linked into the program.
  34. '|
  35. '| Source files: Capture.BAS   main program
  36. '|               Scrolmod.BAS  support module to control scroll bars
  37. '|               Loadmod.BAS   support module to load a bitmap from disk
  38. '|               Savemod.BAS   support module to save a bitmap to disk
  39. '|               Dialgmod.BAS  support module to control dialog box used
  40. '|                             by the "SetFrameWindowSize" SUBprocedure
  41. '|               Capture.INC   include file cut & pasted from BI files
  42. '|               Capture.DEF   definition file
  43. '|               Capture.RC    resource file
  44. '|               Capture.ICO   icon file
  45. '|  
  46. '| Compiling and
  47. '| Linking:      BC capture/o;
  48. '|               BC scrolmod/o;
  49. '|               BC loadmod/o;
  50. '|               BC savemod/o;
  51. '|               BC dialgmod/o;
  52. '|
  53. '|               LINK /NOE capture+
  54. '|                         scrolmod+
  55. '|                         loadmod+
  56. '|                         savemod+
  57. '|                         dialgmod,,, OS2.LIB REGBAS.LIB OPENDLG.LIB, capture;
  58. '|
  59. '| Resourec:     RC capture  (compiles and adds resource to Capture.EXE)
  60. '|
  61. '|***************************************************************************
  62. '|
  63. '|********         Initialization section        ***********
  64. '|
  65. REM $INCLUDE: 'os2def.bi'
  66. REM $INCLUDE: 'pmbase.bi'
  67. REM $INCLUDE: 'opendlg.bi'
  68. REM $INCLUDE: 'winmisc.bi'
  69. REM $INCLUDE: 'wintrack.bi'
  70. REM $INCLUDE: 'gpibit.bi'
  71.  
  72. REM $INCLUDE: 'CAPTURE.INC'
  73.  
  74. DIM aqmsg AS QMSG
  75.  
  76. flFrameFlags& = FCFTITLEBAR      OR FCFSYSMENU    OR_
  77.                 FCFSIZEBORDER    OR FCFMINMAX     OR_
  78.                 FCFSHELLPOSITION OR FCFTASKLIST   OR_
  79.                 FCFHORZSCROLL    OR FCFVERTSCROLL OR_
  80.                 FCFMENU          OR FCFICON       OR_
  81.                 FCFNOBYTEALIGN
  82.  
  83. szClientClass$ = "ClassName" + CHR$(0)
  84. szTitle$ = ": PM-BASIC Bitmap utility" + CHR$(0)
  85. hab& = WinInitialize(0)
  86. hmq& = WinCreateMsgQueue(hab&, 0)
  87.  
  88. bool% = WinRegisterClass(_
  89.    hab&,_
  90.    MakeLong(VARSEG(szClientClass$), SADD(szClientClass$)),_
  91.    RegBas,_
  92.    CSSIZEREDRAW OR CSMOVENOTIFY,_
  93.    0)
  94.  
  95. hwndFrame& = WinCreateStdWindow (_
  96.    HWNDDESKTOP,_
  97.    WSVISIBLE,_
  98.    MakeLong (VARSEG(flFrameFlags&), VARPTR(flFrameFlags&)),_
  99.    MakeLong (VARSEG(szClientClass$), SADD(szClientClass$)),_
  100.    MakeLong (VARSEG(szTitle$), SADD(szTitle$)),_
  101.    0,_
  102.    0,_
  103.    IDRESOURCE,_
  104.    MakeLong (VARSEG(hwndClient&), VARPTR(hwndClient&)))
  105.  
  106. '|
  107. '|*************         Message loop         ***************
  108. '|
  109. WHILE WinGetMsg(hab&,_
  110.   MakeLong(VARSEG(aqmsg), VARPTR(aqmsg)), 0, 0, 0)
  111.   bool% = WinDispatchMsg(hab&,_
  112.                          MakeLong(VARSEG(aqmsg), VARPTR(aqmsg)))
  113. WEND
  114.  
  115. '|**********         Finalize section        ***************
  116.  
  117. bool% = WinDestroyWindow(hqd2wndFrame&)
  118. bool% = WinDestroyMsgQueue(hmq&)
  119. bool% = WinTerminate(hab&)
  120. END
  121.  
  122.  
  123. '|***************************************************************************
  124. '|      *************         Window procedure        ***************
  125. '|***************************************************************************
  126. '|
  127. FUNCTION ClientWndProc& (hwnd&, msg%, mp1&, mp2&) STATIC
  128. SHARED hab&, hwndFrame&, hbm&, hpsClient&, hpntr&
  129. SHARED hwndMenu&, hwndVertScroll&, hwndHorzScroll&
  130. SHARED seconds%, hideORshow%, displaysize%, maximizedClient%
  131. SHARED cxScreen%, cyScreen%, cxClient%, cyClient%, oldcxClient%, oldcyClient%
  132.  
  133.   SELECT CASE msg%
  134.   '|
  135.   '| Initialize variables to  default values, obtain handle to menu bar
  136.   '| to be used in "checking" and "unchecking" menu items, and obtain
  137.   '| resolution of the entire visible screen, and frame window border size.
  138.   '|
  139.     CASE WMCREATE
  140.       hideORshow%   = HIDEWINDOW
  141.       displaysize%  = ACTUALSIZE
  142.       delay%        = 1 'second
  143.       cxScreen% = WinQuerySysValue(HWNDDESKTOP, SVCXSCREEN)
  144.       cyScreen% = WinQuerySysValue(HWNDDESKTOP, SVCYSCREEN)
  145.       hpntr& = WinLoadPointer(HWNDDESKTOP, 0, IDPOINTER)
  146.       hwndMenu& = WinWindowFromID(_
  147.                                 WinQueryWindow(hwnd&, QWPARENT, FALSE),_
  148.                                 FIDMENU)
  149.       hwndHorzScroll& = WinWindowFromID(_
  150.                                 WinQueryWindow(hwnd&, QWPARENT, FALSE),_
  151.                                 FIDHORZSCROLL)
  152.       hwndVertScroll& = WinWindowFromID(_
  153.                                 WinQueryWindow(hwnd&, QWPARENT, FALSE),_
  154.                                 FIDVERTSCROLL)
  155.       ClientWndProc& = 0
  156.   '|
  157.   '| The SAVE, COPY, and PASTE Edit menu item must have a bitmap
  158.   '| captured or loaded before they can be used, so they are
  159.   '| enable or disabled depending on whether there is a bitmap
  160.   '| currently in memory
  161.   '|
  162.     CASE WMINITMENU
  163.       IF hbm& = 0 THEN attribute% = MIADISABLED ELSE attribute% = 0
  164.       CALL SetStatusOfEditMenuItems(attribute%)
  165.       ClientWndProc& = 0
  166.   '|
  167.   '| Obtain new Client window size
  168.   '|
  169.     CASE WMSIZE
  170.       CALL BreakLong(mp1&, oldcyClient%, oldcxClient%)
  171.       CALL BreakLong(mp2&, cyClient%, cxClient%)
  172.       CALL SetScrollBarStatus
  173.       IF maximizedClient% = 1 THEN CALL MaximizeTheClientWindow(hwnd&)
  174.       hidecontrolsflag% = 0
  175.     '|
  176.     '| To prevent a bitmap being created that is larger than the visible
  177.     '| screen, the SUBprogram CheckIfFrameIsGreaterThanMaximum is CALLed to
  178.     '| check for this.  If it is to large it is resized to a valid size.
  179.     '|
  180.       CALL CheckIfFrameIsGreaterThanMaximum
  181.       bool% = WinInvalidateRect(hwnd&, 0, 0)
  182.       ClientWndProc&=0
  183.  
  184.     CASE WMMOVE
  185.       IF useFrame% = 1 THEN bool% = WinPostMsg(hwnd&, WMPAINT, 0, 0)
  186.       ClientWndProc&=0
  187.   '|
  188.   '| Erase then redraw the current bitmap, if one has been created or loaded.
  189.   '| Since the Client window does not have physical size until the first
  190.   '| WMPAINT message, the minimum frame window size cannot be calculated
  191.   '| during the WMCREATE message, so it is calculated during the first
  192.   '| WMPAINT message which is actually sent before entering the message loop.
  193.   '|
  194.     CASE WMPAINT, WMUSER
  195.       IF firstpaint% = 0 THEN CALL CalculateMinimumFrameWindowSize(hwnd&)
  196.       IF maximizedClient% = 1 THEN bool% = WinInvalidateRect(hwnd&, 0, 0)
  197.       IF useFrame% = 1 THEN
  198.         bool% = WinShowWindow(hwndFrame&, 0)
  199.         FOR I = 1 TO 3500: NEXT
  200.         bool% = WinShowWindow(hwndFrame&, 1)
  201.       END IF
  202.       hpsClient& = WinBeginPaint(hwnd&, 0, 0)
  203.       IF useFrame% = 0 THEN bool% = GpiErase(hpsClient&)
  204.       IF hbm& <> 0 THEN CALL DisplayCapturedBitmap
  205.       bool% = WinEndPaint(hpsClient&)
  206.       firstpaint% = 1
  207.       ClientWndProc&=0
  208.   '|
  209.   '| Once the timer is started, the WMTIMER message is sent every 1000 ms,
  210.   '| or 1 second.  When a number of seconds passes equal to the current
  211.   '| delay setting, the timer is stopped.  If "Partial Screen" was selected,
  212.   '| the user then selects the portion of the screen to capture.  The
  213.   '| entire or portion of the screen is then captured to a bitmap.
  214.   '| If SHOWWINDOW was selected, the Client window is invalidated to cause
  215.   '| a WMPAINT message to be sent.  This is not neccessary when HIDEWINDOW
  216.   '| is selected since when the Client window is made visible after the
  217.   '| bitmap is captured, a WMPAINT message is automatically sent.
  218.   '|
  219.     CASE WMTIMER
  220.       seconds% = seconds% + 1
  221.       IF seconds% = delay% THEN
  222.       '|
  223.       '| If "delay" seconds has passed, capture or select portion of
  224.       '| screen to capture.
  225.       '|
  226.         bool% = DosBeep(1500,50)
  227.         StopCountDownToCapture(hwnd&)
  228.         IF useFrame% = 1 THEN
  229.           caption$ = CHR$(0)
  230.           message$ = "Once the Frame window reappears, position "+_
  231.                      "and/or resize viewing window until what "+_
  232.                      "you wish to capture is within the Viewing window, "+_
  233.                      "then select 'Capture Viewing Window contents' from "+_
  234.                      "'Capture menu'" + CHR$(0)
  235.           bool% = DisplayMessageBox(message$, caption$, 3)
  236.           bool% = WinSetFocus(HWNDDESKTOP, hwndFrame&)
  237.           bool% = WinPostMsg(hwnd&, WMUSER, 0, 0)
  238.         ELSE
  239.           IF screenpart% <> USINGTRACK THEN
  240.             CALL CaptureScreenToBitmap(hwnd&)
  241.           ELSEIF SelectPortionOfScreenToCapture = MBIDOK THEN
  242.             CALL CaptureScreenToBitmap(hwnd&)
  243.           END IF
  244.           bool% = WinInvalidateRect(hwnd&, 0, 0)
  245.         END IF
  246.         CALL SetScrollBarStatus
  247.       ELSE
  248.       '|
  249.       '| If time has not yet elapsed, BEEP, signaling a second has passed.
  250.       '|
  251.         bool% = DosBeep(1000,100)
  252.       END IF
  253.       ClientWndProc& = 0
  254.   '|
  255.   '| Reposition bitmap and scrollbar
  256.   '|
  257.     CASE WMHSCROLL, WMVSCROLL
  258.       CALL ControlScrollBars(hwnd&, msg%, mp2&)
  259.       ClientWndProc& = 0
  260.   '|
  261.   '| WMCOMMAND routine handles all menu selections.  The timer is stopped,
  262.   '| the menuID is obtained from the lowword of mp1&, and then the
  263.   '| appropriate routine is executed determined by the menuID stored in
  264.   '| menuSelection%.  Selecting any menu item will stop the countdown if
  265.   '| one is in progress
  266.   '|
  267.     CASE WMCOMMAND
  268.       CALL StopCountDownToCapture(hwnd&)
  269.       IF (hideORshow% = HIDEWINDOW) OR (useFrame% = 1)_
  270.                                     THEN bool% = WinShowWindow(hwndFrame&, 1)
  271.       useFrame% = 0
  272.       CALL BreakLong(mp1&, dummy%, menuSelection%)
  273.       lastcommand% = menuSelection%
  274.       SELECT CASE menuSelection%
  275.       '|
  276.       '| User selected capture menu.  Hides window depending on value
  277.       '| of "hideORshow%", and sets area to capture to entire screen
  278.       '| depending on menu selected.  The timer is then started to countdown
  279.       '| to bitmap capture, or time when user can select portion of screen
  280.       '| to capture, after which the screen is captured.
  281.       '|
  282.         CASE ENTIRESCREEN, USINGTRACK, USINGFRAME, CLIENTWINDOW
  283.           SELECT CASE menuSelection%
  284.             CASE ENTIRESCREEN
  285.               CALL SetCaptureRectToEntireScreen
  286.             CASE CLIENTWINDOW
  287.               CALL SetCaptureRectToClientWindow(hwnd&)
  288.             CASE USINGFRAME
  289.               IF maximizedClient% = 1 THEN
  290.                 caption$ = CHR$(0)
  291.                 message$ = "Cannot capture using Frame if Viewing Window "+_
  292.                            "is maximized." + CHR$(0)
  293.                 bool% = DisplayMessageBox(message$, caption$, 2)
  294.                 bool% = WinInvalidateRect(hwnd&, 0, 0)
  295.                 nostart% = 1
  296.               ELSE
  297.                 bool% = GpiDeleteBitmap(hbm&)
  298.                 hbm& = 0
  299.                 useFrame% = 1
  300.               END IF
  301.             CASE ELSE
  302.           END SELECT
  303.           IF (hideORshow% = HIDEWINDOW) AND (nostart% = 0) THEN_
  304.                                       bool% = WinShowWindow(hwndFrame&, 0)
  305.           screenpart% = menuselection%
  306.           bool% = DosBeep(1000, 100)
  307.           IF nostart% = 0 THEN bool% = WinStartTimer(hab&, hwnd&, IDTIMER, 1000)
  308.           nostart% = 0
  309.       '|
  310.       '| Calls SetTheFrameWindowSize to allow user to select a specific
  311.       '| window size, Maximize or Restore to original size
  312.       '|
  313.         CASE SETFRAMEWINDOWSIZE, MAXIMIZEFRAMEWINDOW, RESTOREWINDOW
  314.           CALL SetTheFrameWindowSize(hwnd&, menuSelection%)
  315.       '|
  316.       '| Maximize or Restore The ClientWindow to hide or reveal the menus and
  317.       '| controls.
  318.       '|
  319.         CASE MAXIMIZECLIENTWINDOW
  320.           useFrame% = 0
  321.           IF maximizedClient% = 0 THEN CALL MaximizeOrRestoreTheClientWindow(hwnd&)
  322.         CASE RESTORECLIENTWINDOW
  323.           IF maximizedClient% = 1 THEN CALL MaximizeOrRestoreTheClientWindow(hwnd&)
  324.       '|
  325.       '| Set flag to determine whether to hide of show window during
  326.       '| the capturing of the screen, then "check" corresponding menuitem
  327.       '|
  328.         CASE HIDEWINDOW, SHOWWINDOW
  329.           lastoption% = hideORshow%
  330.           hideORshow% = menuselection%
  331.           CALL ResetCheckedMenuItem(lastoption%, menuselection%)
  332.       '|
  333.       '| Set flag to determine whether to display captured bitmap actual size
  334.       '| or to stretch or compress bitmap to exactly fill the Client window,
  335.       '| then invalidate the Client window to cause a WMPAINT message to be
  336.       '| sent.  This will cause the bitmap to be displayed using the selected
  337.       '| display option.  The corresponding menuitem is also "checked"
  338.       '|
  339.         CASE ACTUALSIZE, STRETCH
  340.           lastoption% = displaysize%
  341.           displaysize% = menuselection%
  342.           CALL ResetCheckedMenuItem(lastoption%, menuselection%)
  343.           CALL SetScrollBarStatus
  344.           IF lastoption% <> displaysize% THEN bool% = WinInvalidateRect(hwnd&, 0, 0)
  345.       '|
  346.       '| Set delay to selected value, and the "check" corresponding menuitem.
  347.       '|
  348.         CASE IDMDELAY+1 TO IDMDELAY+60
  349.           lastdelay% = delay% + IDMDELAY
  350.           delay% = menuselection% - IDMDELAY
  351.           CALL ResetCheckedMenuItem(lastdelay%, menuselection%)
  352.      
  353.         CASE LOADBITMAPFILE
  354.           CALL LoadBitmapFromFile(hwndFrame&, hwnd&, hbm&)
  355.           
  356.         CASE SAVEBITMAP
  357.           CALL SaveBitmapToFile(hab&, hwndFrame&, hbm&)
  358.   
  359.         CASE COPYTOCLIPBOARD
  360.           CALL CopyBitmapToClipBoard(hab&, hwnd&, hbm&)
  361.  
  362.         CASE LOADCLIPBOARD
  363.           CALL LoadBitmapFromClipBoard(hab&, hbm&, hwnd&)
  364.           
  365.         CASE PASTECLIPBOARD
  366.           IF displaysize% = ACTUALSIZE THEN
  367.             CALL PasteClipboardOverCurrentBitmap(hwnd&)
  368.           ELSE
  369.             caption$ = CHR$(0)
  370.             message$ = "Bitmap must be displayed actual size before "+_
  371.                        "clipboard can be pasted over current bitmap" + CHR$(0)
  372.             bool% = DisplayMessageBox(message$, caption$, 2)
  373.           END IF
  374.  
  375.         CASE ERASEWINDOW
  376.           useFrame% = 0
  377.           bool% = GpiDeleteBitmap(hbm&)
  378.           hbm& = 0
  379.           CALL SetScrollBarStatus
  380.           bool% = WinInvalidateRect(hwnd&, 0, 0)
  381.                                            
  382.         CASE EXITPROGRAM
  383.         '|
  384.         '| Delete bitmap and post WMQUIT message to terminate program
  385.         '|
  386.           bool% = GpiDeleteBitmap(hbm&)
  387.           bool% = WinPostMsg(hwnd&, WMQUIT, 0, 0)
  388.  
  389.         CASE ELSE
  390.  
  391.       END SELECT
  392.       ClientWndProc&=0
  393.  
  394.     CASE ELSE
  395.       ClientWndProc& = WinDefWindowProc(hwnd&, msg%, mp1&, mp2&)
  396.  
  397.   END SELECT
  398. END FUNCTION
  399.  
  400.  
  401. '|***************************************************************************
  402. '| Since there is no system value for the minimum frame window size (not an
  403. '| icon, the minimum Frame window size is determined by setting the window
  404. '| to a size that is smaller than the minimum size, (i.e. width = 1, height = 1)
  405. '| It you attempt to set the window to a size smaller than the smallest
  406. '| size possible, the window will be set to the smallest window size.
  407. '| The resulting window size is then obtained and the width value is saved
  408. '| in the variable minFrame%.  Once the minimum value is obtained, the
  409. '| frame window is restored to its shell postion and size.
  410. '|
  411. '| To make a symetrical minimum frame window size, and since the minimum
  412. '| width is always greater than the minimum height, the minumum height is
  413. '| set equal to the minimum width, so only one value need be saved.
  414. '|***************************************************************************
  415. SUB CalculateMinimumFrameWindowSize(hwnd&)
  416. SHARED hwndFrame&, minFrame%, swpShell AS SWP
  417. DIM rect AS RECTL
  418.   bool% = WinQueryWindowPos(hwndFrame&,_
  419.                             MakeLong(VARSEG(swpShell), VARPTR(swpShell)))
  420.   bool% = WinSetWindowPos(hwndFrame&, 0, 0, 0, 1, 1,_
  421.                           SWPSIZE )
  422.   bool% = WinQueryWindowRect(hwndFrame&,_
  423.                              MakeLong(VARSEG(rect), VARPTR(rect)))
  424.   minFrame% = rect.xright
  425.   bool% = WinSetWindowPos(hwndFrame&, 0,_
  426.                           swpShell.x, swpShell.y,_
  427.                           swpShell.cx, swpShell.cy,_
  428.                           SWPSIZE OR SWPMOVE)
  429. END SUB
  430.  
  431.  
  432. '|***************************************************************************
  433. '| If The scroll bars are needed, this routine sets the range and initial
  434. '| position of both the horizontal and vertical scroll bars
  435. '|***************************************************************************
  436. '|
  437. SUB SetScrollBarStatus
  438. SHARED hbm&, hwndVertScroll&, hwndHorzScroll&
  439. SHARED cxClient%, cyClient%, oldcxClient%, oldcyClient%, displaysize%
  440. DIM bih AS BITMAPINFOHEADER
  441.   IF displaysize% = STRETCH THEN
  442.   '|
  443.   '| Scroll bars cannot be used if bitmap is STRETCHED
  444.   '|
  445.     bool% = WinEnableWindow(hwndHorzScroll&, FALSE)
  446.     bool% = WinEnableWindow(hwndVertScroll&, FALSE)
  447.   ELSE
  448.   '|
  449.   '| Get bitmap dimensions to be used in determining scroll bar ranges
  450.   '|
  451.     bool% = GpiQueryBitmapParameters(hbm&,_
  452.                                      MakeLong(VARSEG(bih), VARPTR(bih)))
  453.     IF bih.cx <= cxClient% THEN
  454.     '|
  455.     '| If bitmap is not as wide as Client window, horizontal scroll bar
  456.     '| is not needed, so disable it
  457.     '|
  458.       bool% = WinEnableWindow(hwndHorzScroll&, FALSE)
  459.     ELSEIF cxClient% <> oldcxClient% THEN
  460.     '|
  461.     '| Enable horizontal scroll bar and set range and initial position
  462.     '|
  463.       bool% = WinEnableWindow(hwndHorzScroll&, TRUE)
  464.       bool% = WinSendMsg(hwndHorzScroll&,_
  465.                          SBMSETSCROLLBAR,_
  466.                          MakeLong(0, 0),_
  467.                          MakeLong((bih.cx - cxClient%), 0))
  468.     END IF
  469.     IF bih.cy <= cyClient% THEN
  470.     '|
  471.     '| If bitmap is not as high as Client window, vertical scroll bar
  472.     '| is not needed, so disable it
  473.     '|
  474.  
  475.       bool% = WinEnableWindow(hwndVertScroll&, FALSE)
  476.     ELSEIF cyClient% <> oldcyClient% THEN
  477.     '|
  478.     '| Enable vertical scroll bar and set range and initial position
  479.     '|
  480.       bool% = WinEnableWindow(hwndVertScroll&, TRUE)
  481.       bool% = WinSendMsg(hwndVertScroll&,_
  482.                          SBMSETSCROLLBAR,_
  483.                          MakeLong(0, (bih.cy - cyClient%)),_
  484.                          MakeLong((bih.cy - cyClient%), 0))
  485.     END IF
  486.   END IF
  487. END SUB
  488.  
  489.  
  490. '|***************************************************************************
  491. '| Stops the timer and resets "seconds" to zero
  492. '|***************************************************************************
  493. '|
  494. SUB StopCountDownToCapture(hwnd&)
  495. SHARED hab&, seconds%
  496.   bool% = WinStopTimer(hab&, hwnd&, IDTIMER)
  497.   seconds% = 0
  498. END SUB
  499.  
  500.  
  501. '|***************************************************************************
  502. '| This routine removes the check from the menuitem with the ID corresponding
  503. '| to the menuID passed in "oldChecked%", and places a check on the menuitem
  504. '| corresponding the the menuID passed in "newChecked%".
  505. '|***************************************************************************
  506. '|
  507. SUB ResetCheckedMenuItem(oldChecked%, newChecked%)
  508. SHARED hwndMenu&
  509. '|
  510. '| Remove check from menu item
  511. '|
  512.   bool% = WinSendMsg(hwndMenu&, MMSETITEMATTR,_
  513.                      MakeLong(TRUE, oldChecked%),_
  514.                      MakeLong(0, MIACHECKED))
  515. '|
  516. '| Place a check on the menu item
  517. '|
  518.   bool% = WinSendMsg(hwndMenu&, MMSETITEMATTR,_
  519.                      MakeLong(TRUE, newChecked%),_
  520.                      MakeLong(MIACHECKED, MIACHECKED))
  521. END SUB
  522.  
  523.  
  524. '|***************************************************************************
  525. '| If either the width or height of the frame window is greater than the
  526. '| maximum size, the window is resized and postioned to the maximum size.
  527. '|***************************************************************************
  528. SUB CheckIfFrameIsGreaterThanMaximum
  529. SHARED hwndFrame&, cxScreen%, cyScreen%
  530. DIM swpFrame AS SWP
  531. '|
  532. '| Obtain current window size
  533. '|
  534.   bool% = WinQueryWindowPos(hwndFrame&,_
  535.                             MakeLong(VARSEG(swpFrame), VARPTR(swpFrame)))
  536. '|
  537. '| determine if either width or height is greater than maximum
  538. '|
  539.   IF swpFrame.cx > cxScreen% OR swpFrame.cy > cyScreen% THEN
  540.   '|
  541.   '| If width is greater than maximum reset size and postion
  542.   '|
  543.     IF swpFrame.cx > cxScreen% THEN
  544.       swpFrame.x = 0
  545.       swpFrame.cx = cxScreen%
  546.     END IF
  547.   '|
  548.   '| If height is greater than maximum reset size and postion
  549.   '|
  550.     IF swpFrame.cy > cyScreen% THEN
  551.       swpFrame.y = 0
  552.       swpFrame.cy = cyScreen%
  553.     END IF
  554.   '|
  555.   '| Set window to new size and postion
  556.   '|
  557.     bool% = WinSetWindowPos(hwndFrame&, 0,_
  558.                             swpFrame.x, swpFrame.y,_
  559.                             swpFrame.cx, swpFrame.cy,_
  560.                             SWPSIZE OR SWPMOVE)
  561.   END IF
  562. END SUB
  563.  
  564.  
  565. '|***************************************************************************
  566. '| Set area to capture to entire screen using the system values stored in
  567. '| cxScreen% and cyScreen%, which were obtained during program start up
  568. '| during the WMCREATE message.
  569. '|***************************************************************************
  570. '|
  571. SUB SetCaptureRectToEntireScreen
  572. SHARED cxScreen%, cyScreen%
  573. SHARED captureRect AS RECTL
  574.   captureRect.xLeft   = 0
  575.   captureRect.xRight  = cxScreen%
  576.   captureRect.yTop    = cyScreen%
  577.   captureRect.yBottom = 0
  578. END SUB
  579.  
  580.  
  581. '|***************************************************************************
  582. '| Set area to capture to contents of the Client Window.  The rectangle is
  583. '| calculated differently depending on whether the option "Maximize viewing
  584. '| window" has been selected or not.
  585. '|***************************************************************************
  586. SUB SetCaptureRectToClientWindow(hwnd&)
  587. SHARED hwndFrame&, maximizedClient%, captureRect AS RECTL
  588. DIM swpFrame AS SWP, swpClient AS SWP
  589. '|
  590. '| Obtain current Frame and Cleint window sizes and positions
  591. '|
  592.   bool% = WinQueryWindowPos(hwndFrame&,_
  593.                             MakeLong(VARSEG(swpFrame), VARPTR(swpFrame)))
  594.   bool% = WinQueryWindowPos(hwnd&,_
  595.                             MakeLong(VARSEG(swpClient), VARPTR(swpClient)))
  596. '|
  597. '| Calculate Screen coordinates of Client window
  598. '|
  599.   IF maximizedClient% = 1 THEN
  600.     captureRect.xLeft   = swpFrame.x
  601.     captureRect.xRight  = captureRect.xLeft + swpFrame.cx
  602.     captureRect.yBottom = swpFrame.y
  603.     captureRect.yTop    = captureRect.ybottom + swpFrame.cy
  604.   ELSE
  605.     captureRect.xLeft   = swpFrame.x + swpClient.x
  606.     captureRect.xRight  = captureRect.xLeft + swpClient.cx
  607.     captureRect.yBottom = swpFrame.y + swpClient.y
  608.     captureRect.yTop    = captureRect.ybottom + swpClient.cy
  609.   END IF
  610. END SUB
  611.  
  612.  
  613. '|***************************************************************************
  614. '| Maximizes or restores the Client window, depending on the current value
  615. '| of "maximizedClient".
  616. '|***************************************************************************
  617. SUB MaximizeOrRestoreTheClientWindow(hwnd&)
  618. SHARED hwndFrame&, hwndMenu&, maximizedClient%
  619. DIM swpFrame AS SWP
  620.   IF maximizedClient% = 1 THEN
  621.   '|
  622.   '| Restore the Client Window
  623.     maximizedClient% = 0
  624.   '|
  625.   '| Obtain current frame window size
  626.   '|
  627.     bool% = WinQueryWindowPos(hwndFrame&,_
  628.                               MakeLong(VARSEG(swpFrame), VARPTR(swpFrame)))
  629.   '|
  630.   '| Restore the Client window to within the frame windows frame and menus
  631.   '| by changing the frame window size by 1 pixel, then changing it back to
  632.   '| its original size.  A WinSetWindowPos will not cause a WMSIZE message
  633.   '| if the size of the window is not changed.  This is a sleezy way to
  634.   '| restore the Client window without having to save its orginal size and
  635.   '| position.
  636.   '|
  637.     bool% = WinSetWindowPos(hwndFrame&, 0, 0, 0,_
  638.                             swpFrame.cx + 1, swpFrame.cy,_
  639.                             SWPSIZE)
  640.     bool% = WinSetWindowPos(hwndFrame&, 0, 0, 0,_
  641.                             swpFrame.cx, swpFrame.cy,_
  642.                             SWPSIZE)
  643.     CALL ResetCheckedMenuItem(MAXIMIZECLIENTWINDOW, RESTORECLIENTWINDOW)
  644.   ELSE
  645.   '|
  646.   '| Maximize the Client Window
  647.   '|
  648.     CALL MaximizeTheClientWindow(hwnd&)
  649.     CALL ResetCheckedMenuItem(RESTORECLIENTWINDOW, MAXIMIZECLIENTWINDOW)
  650.   END IF
  651. END SUB
  652.  
  653. '|***************************************************************************
  654. '| Maximizes the Client window, hiding all of the frame window controls and
  655. '| menus.  The controls are still accessable by keyboard or mouse, but they
  656. '| simply cannot be seen.
  657. '|***************************************************************************
  658. SUB MaximizeTheClientWindow(hwnd&)
  659. SHARED hwndFrame&, hwndMenu&, maximizedClient%
  660. DIM swpFrame AS SWP
  661. '|
  662. '| Obtain current frame window size
  663. '|
  664.   bool% = WinQueryWindowPos(hwndFrame&,_
  665.                             MakeLong(VARSEG(swpFrame), VARPTR(swpFrame)))
  666. '|
  667. '| Set Client window size using width and height values of the frame window
  668. '|
  669.   bool% = WinSetWindowPos(hwnd&, 0, 0, 0,_
  670.                           swpFrame.cx, swpFrame.cy,_
  671.                           SWPSIZE OR SWPMOVE)
  672.   maximizedClient% = 1
  673. END SUB
  674.  
  675. '|***************************************************************************
  676. '| Sets the frame window size to a specific size, maximizes the window, or
  677. '| restores it to the orginal size and postion.  The Maximize and Restore
  678. '| options can be selected directly from the menu or from the dialog box
  679. '| displayed if SetFrameWindowSize was selected.
  680. '|***************************************************************************
  681. SUB SetTheFrameWindowSize(hwnd&, menuSelection%)
  682. SHARED hwndFrame&, newXFrame%, newYFrame%, cxScreen%, cyScreen%
  683. SHARED swpFrame AS SWP, swpShell AS SWP
  684.   IF menuSelection% = SETFRAMEWINDOWSIZE THEN
  685.   '|
  686.   '| Display dialog box and obtain new size for the frame window
  687.   '|
  688.     control% = WinDlgBox(HWNDDESKTOP, hwnd&, RegBas1, 0, IDRESOURCE, 0)
  689.   ELSE
  690.     control% = menuSelection%
  691.   END IF
  692.   SELECT CASE control%
  693.     CASE OKBUTTON
  694.     '|
  695.     '| Set frame window to new size selected by user; but first determine
  696.     '| if any portion of the window will extend off the visible screen.
  697.     '| If so, adjust position of window so that entire window is visible.
  698.     '|
  699.       bool% = WinQueryWindowPos(hwndFrame&,_
  700.                                 MakeLong(VARSEG(swpFrame), VARPTR(swpFrame)))
  701.       IF (swpFrame.x + newXFrame%) > cxScreen% THEN
  702.         swpFrame.x = cxScreen% - newXFrame%
  703.       END IF
  704.       IF (swpFrame.y + newYFrame%) > cyScreen% THEN
  705.         swpFrame.y = cyScreen% - newYFrame%
  706.       END IF
  707.       bool% = WinSetWindowPos(hwndFrame&, 0,_
  708.                               swpFrame.x, swpFrame.y,_
  709.                               newXFrame%, newYFrame%,_
  710.                               SWPSIZE OR SWPMOVE)
  711.     CASE MAXIMIZEBUTTON, MAXIMIZEFRAMEWINDOW
  712.     '|
  713.     '| If Maximize menu or Maximize button from dialog box is selected,
  714.     '| maximize the frame window.
  715.     '|
  716.       bool% = WinSetWindowPos(hwndFrame&, 0, 0, 0,_
  717.                               cxScreen%, cyScreen%,_
  718.                               SWPSIZE OR SWPMOVE)
  719.     CASE RESTOREBUTTON, RESTOREWINDOW
  720.     '|
  721.     '| If Restore menu or Restore button from dialog box is selected,
  722.     '| Restore the frame window to origianl size and position.
  723.     '|
  724.       bool% = WinSetWindowPos(hwndFrame&, 0,_
  725.                               swpShell.x,  swpShell.y,_
  726.                               swpShell.cx, swpShell.cy,_
  727.                               SWPSIZE OR SWPMOVE)
  728.     CASE ELSE
  729.   END SELECT
  730. END SUB
  731.  
  732.  
  733. '|***************************************************************************
  734. FUNCTION SelectPortionOfScreenToCapture%
  735. SHARED hbm&, hwndFrame&, hpntr&
  736. SHARED cxScreen%, cyScreen%, hideORshow%, captureRect AS RECTL
  737. DIM ti AS TRACKINFO
  738. '|
  739. '| Initialize "message$" to STRING containing instructions for selecting
  740. '| portion of screen, and then display message box.  If user selects "OK"
  741. '| continue and select portion of screen to capture.
  742. '|
  743.   message$="Position pointer to upper-left corner of area "+_
  744.            "to be captured, then click left mouse button.  "+_
  745.            "Stretch box around area to be captured, then "+_
  746.            "click left mouse button again." + CHR$(0)
  747.   caption$ = "PARTIAL SCREEN"+CHR$(0)
  748.  
  749.   IF DisplayMessageBox(message$, caption$, 1) = MBIDOK THEN
  750.   '|
  751.   '| Obtain handle to a screen presentation space
  752.   '|
  753.     hpsScreen& = WinGetScreenPS(HWNDDESKTOP)
  754.   '|
  755.   '| Set pointer to four point pointer
  756.   '|
  757.     bool% = WinSetPointer(HWNDDESKTOP, hpntr&)
  758.   '|
  759.   '| Initialize Tracking information. Pointer is initially displayed at
  760.   '| the center of the screen, and no rectangle is visible since the
  761.   '| rectangle size is initially set to 1x1, and all sides of the
  762.   '| tracking rectangle move.
  763.   '|
  764.     ti.cxBorder = 1
  765.     ti.cyBorder = 1
  766.     ti.cxGrid = 0
  767.     ti.cyGrid = 0
  768.     ti.cxKeyboard = 4
  769.     ti.cyKeyboard = 4
  770.     ti.rclBoundary.xleft = 0
  771.     ti.rclBoundary.ybottom = 0
  772.     ti.rclBoundary.xright = cxScreen%
  773.     ti.rclBoundary.ytop = cyScreen%
  774.     ti.ptlMinTrackSize.x = 1
  775.     ti.ptlMinTrackSize.y = 1
  776.     ti.ptlMaxTrackSize.x = ti.rclBoundary.xright
  777.     ti.ptlMaxTrackSize.y = ti.rclBoundary.ytop
  778.     ti.rclTrack.xleft = ti.rclBoundary.xright / 2
  779.     ti.rclTrack.yBottom = ti.rclBoundary.ytop / 2
  780.     ti.rclTrack.xRight = ti.rclBoundary.xright / 2
  781.     ti.rclTrack.ytop = ti.rclBoundary.ytop / 2
  782.     ti.fs = TFMOVE OR TFSTANDARD OR TFSETPOINTERPOS
  783.   '|
  784.   '| Obtain upper left hand corner of area to be captured.  The tracking
  785.   '| rectangle is simply a single pixel during this call to WinTrackRect
  786.   '| so only the pointer is visible.  When the left mouse button is
  787.   '| clicked, WinTractRect returns, new parameters are set which allow
  788.   '| the rectangle to be resized down and to the right of the selected
  789.   '| upper left hand corner of the the area to be captured.
  790.   '|
  791.     bool% = WinTrackRect(HWNDDESKTOP, 0,_
  792.                          MakeLong(VARSEG(ti), VARPTR(ti)))
  793.   '|
  794.   '| Set new parameters for tracking rectangle.  Can only expand
  795.   '| rectangle down or to the right.
  796.   '|
  797.     ti.fs = TFBOTTOM OR TFRIGHT OR TFSTANDARD OR TFSETPOINTERPOS
  798.   '|
  799.   '| Obtain area to be captured
  800.   '|
  801.     bool% = WinTrackRect(HWNDDESKTOP, 0,_
  802.                          MakeLong(VARSEG(ti), VARPTR(ti)))
  803.   '|
  804.   '| Set capture rectangle to rectangle returned from WinTrackRect
  805.   '|
  806.     captureRect.xLeft   = ti.rclTrack.xLeft
  807.     captureRect.xRight  = ti.rclTrack.xRight
  808.     captureRect.yTop    = ti.rclTrack.yTop
  809.     captureRect.yBottom = ti.rclTrack.yBottom
  810.     IF captureRect.yTop = cyScreen% THEN captureRect.yTop = captureRect.yTop - 1
  811.     bool% = WinReleasePS(hpsScreen&)
  812.     SelectPortionOfScreenToCapture% = MBIDOK
  813.   ELSE
  814.   '|
  815.   '| User selected CANCEL from message box, so no area is selected
  816.   '|
  817.     SelectPortionOfScreenToCapture% = MBIDCANCEL
  818.     IF hideORshow% = HIDEWINDOW THEN
  819.       bool% = WinShowWindow(hwndFrame&, 1)
  820.     '|
  821.     '| Must set focus back to CAPTURE since if CANCEL is selected, the
  822.     '| is not returned to CAPTURE from the message box
  823.     '|
  824.       bool% = WinSetFocus(HWNDDESKTOP, hwndFrame&)
  825.     END IF
  826.   END IF
  827. END FUNCTION
  828.  
  829.  
  830. '|***************************************************************************
  831. '| Captures the selected portion of the screen to a bitmap.
  832. '|***************************************************************************
  833. '|
  834. SUB CaptureScreenToBitmap(hwnd&)
  835. SHARED hbm&, hwndFrame&, hwndMenu&, hpsClient&, hideORshow%, captureRect AS RECTL
  836. DIM bih AS BITMAPINFOHEADER, aptl(2) AS POINTL
  837. '|
  838. '| Set system pointer to wait pointer since this can take a few seconds
  839. '|
  840.   CALL SetSystemPointerToWaitPointer
  841. '|
  842. '| Initialize bitmap information
  843. '|
  844.   bih.cbFix = LEN(bih)
  845.   bih.cx = captureRect.xright - captureRect.xleft
  846.   bih.cy = captureRect.ytop - captureRect.ybottom
  847.   bih.cPlanes = 1
  848.   bih.cBitCount = 4
  849. '|
  850. '| Create micro presentation space and device context.
  851. '| Delete current bitmap.
  852. '| Create a new bitmap using info in "bih" (bitmap info header)
  853. '| Set bitmap to presentation space.
  854. '| Get a screen presentation space to allow copying from entire screen
  855. '|
  856.   CALL CreateBitmapPSandDC(hpsBitmap&, hdc&)
  857.   bool% = GpiDeleteBitmap(hbm&)
  858.   hbm& = GpiCreateBitmap(hpsBitmap&,_
  859.                          MakeLong(VARSEG(bih), VARPTR(bih)),_
  860.                          0, 0, 0)
  861.   bool% = GpiSetBitmap(hpsBitmap&, hbm&)
  862.   hpsScreen& = WinGetScreenPS(HWNDDESKTOP)
  863. '|
  864. '| Set aptl() to source and target rectangles
  865. '|
  866.   aptl(0).x = 0
  867.   aptl(0).y = 0
  868.   aptl(1).x = bih.cx
  869.   aptl(1).y = bih.cy
  870.   aptl(2).x = captureRect.xleft
  871.   aptl(2).y = captureRect.ybottom
  872. '|
  873. '| Copy area defind by the rectangle returned by WinTractRect to the
  874. '| micro presentation space created above.
  875. '|
  876.   bool% = GpiBitBlt(hpsBitmap&, hpsScreen&, 3&,_
  877.                     MakeLong(VARSEG(aptl(0)), VARPTR(aptl(0))),_
  878.                     ROPSRCCOPY, BBOAND)
  879. '|
  880. '| Release screen presentation space, micro presentation space, and destroy
  881. '| device context used to create bitmap.
  882. '|
  883.   bool% = WinReleasePS(hpsScreen&)
  884.   bool% = GpiDestroyPS(hpsBitmap&)
  885.   bool% = DevCloseDC(hdc&)
  886. '|
  887. '| If window was hidden, show window, and set focus to Client window,
  888. '| since the Client window lost the focus during the creation of the bitmap
  889. '|
  890.   IF hideORshow% = HIDEWINDOW THEN
  891.     bool% = WinShowWindow(hwndFrame&, 1)
  892.     bool% = WinSetFocus(HWNDDESKTOP, hwndFrame&)
  893.   END IF
  894.   CALL SetSystemPointerToStandardArrow
  895. END SUB
  896.  
  897.  
  898. '|***************************************************************************
  899. '| Displays captured bitmap in Client window.  It is either displayed actual
  900. '| size, in which case some of the bitmap may not be visible depending on the
  901. '| current size of the Client window; or it is stretched or compressed to
  902. '| to the same size as the Client window, in which case the entire bitmap
  903. '| will always be visible.
  904. '|***************************************************************************
  905. '|
  906. SUB DisplayCapturedBitmap
  907. SHARED hbm&, hwndHorzScroll&, hwndVertScroll&, hpsClient&
  908. SHARED cxClient%, cyClient%, displaysize%
  909. DIM rect AS RECTL
  910.   CALL SetSystemPointerToWaitPointer
  911. '|
  912. '| Set drawing flag to STRETCH or NORMAL
  913. '|
  914.   IF displaysize% = STRETCH THEN
  915.     drawflag% = DBMSTRETCH
  916.   ELSE
  917.     drawflag% = DMBNORMAL
  918.   END IF
  919. '|
  920. '| Get scroll bar positions to determine portion of bitmap to display
  921. '|
  922.   Hpos% = WinSendMsg(hwndHorzScroll&, SBMQUERYPOS, 0, 0)
  923.   Vpos% = WinSendMsg(hwndVertScroll&, SBMQUERYPOS, 0, 0)
  924.   Vmax% = WinSendMsg(hwndVertScroll&, SBMQUERYRANGE, 0, 0) \ 2 ^ 16
  925. '|
  926. '| If scroll bars are enabled, calculate offset from scroll positions
  927. '|
  928.   IF WinIsWindowEnabled(hwndHorzScroll&) THEN rect.xleft = -Hpos%
  929.   IF WinIsWindowEnabled(hwndVertScroll&) THEN rect.ybottom = Vpos% - Vmax%
  930. '|
  931. '| Initialize rectangle to which bitmap will be drawn.
  932. '|
  933.   rect.xright  = cxClient%
  934.   rect.ytop    = cyClient%
  935.   bool% = WinDrawBitmap(hpsClient&, hbm&, 0,_
  936.                         MakeLong(VARSEG(rect), VARPTR(rect)),_
  937.                         CLRNEUTRAL, CLRBACKGROUND, drawflag%)
  938.   CALL SetSystemPointerToStandardArrow
  939. END SUB
  940.  
  941. '|***************************************************************************
  942. '| Make a copy of the current bitmap and set clipboard contents to copy of
  943. '| the bitmap.
  944. '|***************************************************************************
  945. SUB CopyBitmapToClipBoard(hab&, hwnd&, hbm&)
  946.   IF WinOpenClipBrd(hab&) THEN
  947.   '|
  948.   '| If Clipboard is avaiable, copy bitmap to clipboard
  949.   '|
  950.     hbmClip& = MakeCopyOfBitmap(hbm&)
  951.     bool% = WinEmptyClipBrd(hab&)
  952.     bool% = WinSetClipbrdData(hab&, hbmClip&, CFBITMAP, CFIHANDLE)
  953.     bool% = WinCloseClipbrd(hab&)
  954.   ELSE
  955.   '|
  956.   '| If clipboard is not avaiable, display message to prompt user
  957.   '|
  958.     caption$ = CHR$(0)
  959.     message$ = "ERROR opening Clipboard.  Another process might "+_
  960.                "be using system clipboard" + CHR$(0)
  961.     bool% = DisplayMessageBox(message$, caption$, 2)
  962.   END IF
  963. END SUB
  964.  
  965.  
  966. '|***************************************************************************
  967. '| Loads bitmap from system clibboard if clibboard contains a bitmap.
  968. '|***************************************************************************
  969. SUB LoadBitmapFromClipBoard(hab&, hbm&, hwnd&)
  970.   IF WinOpenClipBrd(hab&) THEN
  971.   '|
  972.   '| If clibboard contains a bitmap, make copy of bitmap
  973.   '|
  974.     hbmclip& = WinQueryClipBrdData(hab&, CFBITMAP)
  975.     IF hbmclip& <> 0 THEN
  976.       bool% = GpiDeleteBitmap(hbm&)
  977.       CALL SetSystemPointerToWaitPointer
  978.       hbm& = MakeCopyOfBitmap(hbmclip&)
  979.     '|
  980.     '| Invalidate Window to force the new bitmap to be displayed
  981.     '|
  982.       CALL SetScrollBarStatus
  983.       bool% = WinInvalidateRect(hwnd&, 0, 0)
  984.       CALL SetSystemPointerToStandardArrow
  985.     ELSE
  986.     '|
  987.     '| Display message to prompt user that clipboard does not contain a bitmap
  988.     '|
  989.       caption$ = CHR$(0)
  990.       message$ = "The Clipboard does not contain a bitmap" + CHR$(0)
  991.       bool% = DisplayMessageBox(message$, caption$, 2)
  992.     END IF
  993.     bool% = WinCloseClipbrd(hab&)
  994.   ELSE
  995.   '|
  996.   '| If clipboard is not avaiable, display message to prompt user
  997.   '|
  998.     caption$ = CHR$(0)
  999.     message$ = "ERROR opening Clipboard.  Another process might "+_
  1000.                "be using system clipboard" + CHR$(0)
  1001.     bool% = DisplayMessageBox(message$, caption$, 2)
  1002.   END IF
  1003. END SUB
  1004.  
  1005.  
  1006. '|***************************************************************************
  1007. SUB PasteClipboardOverCurrentBitmap(hwnd&)
  1008. SHARED hab&, hpsClient&, hbm&, hwndFrame&, hwndHorzScroll&, hwndVertScroll&
  1009. DIM ti AS TRACKINFO, aptl(2) AS POINTL
  1010. DIM bihCurrent AS BITMAPINFOHEADER, bihClip AS BITMAPINFOHEADER
  1011. '|
  1012. '| Check If clibboard is available
  1013. '|
  1014.   IF WinOpenClipBrd(hab&) THEN
  1015.   '|
  1016.   '| Check if clibboard contains a bitmap
  1017.   '|
  1018.     hbmClip& = WinQueryClipBrdData(hab&, CFBITMAP)
  1019.     IF hbmClip& <> 0 THEN
  1020.     '|
  1021.     '| Initialize "message$" to STRING containing instructions for positioning
  1022.     '| bitmap from Clipboard
  1023.     '|
  1024.       message$="Move rectangle to desired position and "+_
  1025.                 "Click the left Mouse Button" + CHR$(0)
  1026.       caption$ = "PASTE CLIPBOARD BITMAP" + CHR$(0)
  1027.     '|
  1028.     '| Display instructions for pasting clibboard bitmap, and give user
  1029.     '| options to cancel command.
  1030.     '|
  1031.       IF DisplayMessageBox(message$, caption$, 1) = MBIDOK THEN
  1032.         bool% = WinSetPointer(HWNDDESKTOP,_
  1033.                               WinQuerySysPointer(HWNDDESKTOP, SPTRMOVE, 0))
  1034.       '|
  1035.       '| Get Clipboard bitmap information
  1036.       '|
  1037.         bool% = GpiQueryBitmapParameters(_
  1038.                                 hbmClip&,_
  1039.                                 MakeLong(VARSEG(bihClip), VARPTR(bihClip)))
  1040.       '|
  1041.       '| Get current bitmap information
  1042.       '|
  1043.         bool% = GpiQueryBitmapParameters(_
  1044.                             hbm&,_
  1045.                             MakeLong(VARSEG(bihCurrent), VARPTR(bihCurrent)))
  1046.       '|
  1047.       '| Initialize Tracking information. Pointer is placed in center of
  1048.       '| rectangle.  Rectangle is set to size of Bitmap in Clipboard.
  1049.       '| Boundary for pasting bitmap is boundary of current bitmap.
  1050.       '|
  1051.         ti.cxBorder = 1
  1052.         ti.cyBorder = 1
  1053.         ti.cxKeyboard = 4
  1054.         ti.cyKeyboard = 4
  1055.         ti.rclBoundary.xleft = bihClip.cx - 1
  1056.         ti.rclBoundary.ybottom = bihClip.cy - 1
  1057.         ti.rclBoundary.xright = bihCurrent.cx - bihClip.cx + 1
  1058.         ti.rclBoundary.ytop = bihCurrent.cy - bihClip.cy + 1
  1059.         ti.ptlMinTrackSize.x = bihClip.cx
  1060.         ti.ptlMinTrackSize.y = bihClip.cy
  1061.         ti.ptlMaxTrackSize.x = bihClip.cx
  1062.         ti.ptlMaxTrackSize.y = bihClip.cy
  1063.         ti.rclTrack.xleft = 0
  1064.         ti.rclTrack.yBottom = 0
  1065.         ti.rclTrack.xRight = bihClip.cx
  1066.         ti.rclTrack.ytop = bihClip.cy
  1067.         ti.fs = TFMOVE OR TFSTANDARD OR TFSETPOINTERPOS
  1068.       '|
  1069.       '| Obtain postion within current bitmap to paste Clipboard bitmap
  1070.       '|
  1071.         bool% = WinTrackRect(hwnd&, 0,_
  1072.                              MakeLong(VARSEG(ti), VARPTR(ti)))
  1073.       '|
  1074.       '| Create presentation space, device context for Clibboard and
  1075.       '| current bitmap
  1076.       '|
  1077.         CALL CreateBitmapPSandDC(hpsCurrent&, hdcCurrent&)
  1078.         CALL CreateBitmapPSandDC(hpsClip&, hdcClip&)
  1079.         bool% = GpiSetBitmap(hpsCurrent&, hbm&)
  1080.         bool% = GpiSetBitmap(hpsClip&, hbmClip&)
  1081.       '|
  1082.       '| Get scroll bar positions and determine offset from scrollbar
  1083.       '| positions if scroll bar is enabled.
  1084.       '|
  1085.         Hpos% = WinSendMsg(hwndHorzScroll&, SBMQUERYPOS, 0, 0)
  1086.         Vpos% = WinSendMsg(hwndVertScroll&, SBMQUERYPOS, 0, 0)
  1087.         Vmax% = WinSendMsg(hwndVertScroll&, SBMQUERYRANGE, 0, 0) \ 2 ^ 16
  1088.         IF WinIsWindowEnabled(hwndHorzScroll&) THEN Hoffset% = Hpos%
  1089.         IF WinIsWindowEnabled(hwndVertScroll&) THEN Voffset% = Vmax% - Vpos%
  1090.       '|
  1091.       '| Set target rectangle to to size of clibboard bitmap and set position
  1092.       '| to location tracking rectangle
  1093.       '|
  1094.         aptl(0).x = ti.rclTrack.xleft + Hoffset%
  1095.         aptl(0).y = ti.rclTrack.yBottom + Voffset%
  1096.         aptl(1).x = ti.rclTrack.xright + Hoffset%
  1097.         aptl(1).y = ti.rclTrack.ytop + Voffset%
  1098.         aptl(2).x = 0
  1099.         aptl(2).y = 0
  1100.       '|
  1101.       '| Paste the clipboard bitmap onto the current bitmap
  1102.       '|
  1103.         bool% = GpiBitBlt(hpsCurrent&, hpsClip&, 3,_
  1104.                           MakeLong(VARSEG(aptl(0)), VARPTR(aptl(0))),_
  1105.                           ROPSRCCOPY, BBOAND)
  1106.       '|
  1107.       '| Release and destroy presentation spaces and device contexts of
  1108.       '| current and clibboard bitmap.
  1109.       '|
  1110.         bool% = GpiDestroyPS(hpsCurrent&)
  1111.         bool% = GpiDestroyPS(hpsClip&)
  1112.         bool% = DevCloseDC(hdcCurrent&)
  1113.         bool% = DevCloseDC(hdcClip&)
  1114.         CALL SetSystemPointerToStandardArrow
  1115.       '|
  1116.       '| Invalidate window to force new bitmap to be displayed.
  1117.       '|
  1118.         bool% = WinInvalidateRect(hwnd&, 0, 0)
  1119.       END IF
  1120.     ELSE
  1121.     '|
  1122.     '| Display message to prompt user that clipboard does not contain a bitmap
  1123.     '|
  1124.       caption$ = CHR$(0)
  1125.       message$ = "The Clipboard does not contain a bitmap" + CHR$(0)
  1126.       bool% = DisplayMessageBox(message$, caption$, 2)
  1127.     END IF
  1128.     bool% = WinCloseClipbrd(hab&)
  1129.   ELSE
  1130.   '|
  1131.   '| If clipboard is not avaiable, display message to prompt user
  1132.   '|
  1133.     caption$ = CHR$(0)
  1134.     message$ = "ERROR opening Clipboard.  Another process might "+_
  1135.                "be using system clipboard" + CHR$(0)
  1136.     bool% = DisplayMessageBox(message$, caption$, 2)
  1137.   END IF
  1138. END SUB
  1139.  
  1140.  
  1141. '|***************************************************************************
  1142. '| Makes a copy of bitmap reference by the bitmap handle passed in hbmSource&
  1143. '|***************************************************************************
  1144. FUNCTION MakeCopyOfBitmap&(hbmSource&)
  1145. DIM bih AS BITMAPINFOHEADER, aptl(2) AS POINTL
  1146. '|
  1147. '| Create presentation spaces and device contextes for source and target
  1148. '| bitmap
  1149. '|
  1150.   CALL CreateBitmapPSandDC(hpsSource&, hdcSource&)
  1151.   CALL CreateBitmapPSandDC(hpsTarget&, hdcTarget&)
  1152. '|
  1153. '| Get Bitmap info of Source bitmap
  1154. '|
  1155.   bool% = GpiQueryBitmapParameters(hbmSource&,_
  1156.                                    MakeLong(VARSEG(bih), VARPTR(bih)))
  1157. '|
  1158. '| Create a new bitmap using info from Source bitmap
  1159. '|                          
  1160.   hbmTarget& = GpiCreateBitmap(hpsTarget&,_
  1161.                                MakeLong(VARSEG(bih), VARPTR(bih)),_
  1162.                                0, 0, 0)
  1163. '|
  1164. '| Set source and target bitmaps to corresponing presentation spaces
  1165. '|                      
  1166.   bool% = GpiSetBitmap(hpsSource&, hbmSource&)
  1167.   bool% = GpiSetBitmap(hpsTarget&, hbmTarget&)
  1168. '|
  1169. '| Set rectangle of Source bitmap to be copied to entire bitmap
  1170. '|
  1171.   aptl(0).x = 0
  1172.   aptl(0).y = 0
  1173.   aptl(1).x = bih.cx
  1174.   aptl(1).y = bih.cy
  1175.   aptl(2).x = 0
  1176.   aptl(2).y = 0
  1177. '|
  1178. '| Copy bitmap
  1179. '|
  1180.   bool% = GpiBitBlt(hpsTarget&, hpsSource&, 3,_
  1181.                     MakeLong(VARSEG(aptl(0)), VARPTR(aptl(0))),_
  1182.                     ROPSRCCOPY, BBOAND)
  1183. '|
  1184. '| Release presentation spaces and device contextes used to create new bitmap
  1185. '|           
  1186.   bool% = GpiDestroyPS(hpsSource&)
  1187.   bool% = GpiDestroyPS(hpsTarget&)
  1188.   bool% = DevCloseDC(hdcSource&)
  1189.   bool% = DevCloseDC(hdcTarget&)
  1190.   MakeCopyOfBitmap& = hbmTarget&
  1191. END FUNCTION
  1192.  
  1193.  
  1194. '|***************************************************************************
  1195. '| Creates a micro presentation space and a memory device context and returns
  1196. '| the handles to the CALLing routine.
  1197. '|***************************************************************************
  1198. SUB CreateBitmapPSandDC(hps&, hdc&)
  1199. SHARED hab&
  1200. DIM sizl AS SIZEL
  1201. '|
  1202. '| Initialize information for Memory Device Context, then open
  1203. '| a memory device context.  Create same size as bitmap.
  1204. '|
  1205.   token$ = "*" + CHR$(0)
  1206.   sizl.cx = 0
  1207.   sizl.cy = 0
  1208.   hdc& = DevOpenDC(hab&, ODMEMORY,_
  1209.                    MakeLong(VARSEG(token$), SADD(token$)), 0, 0, 0)
  1210. '|
  1211. '| Create a micro presentation space and associate it with the memory
  1212. '| device context opened above.
  1213. '|
  1214.   hps& = GpiCreatePS(hab&, hdc&,_
  1215.                      MakeLong(VARSEG(sizl), VARPTR(sizl)),_
  1216.                      PUPELS OR GPIFDEFAULT OR GPITMICRO OR GPIAASSOC)
  1217. END SUB
  1218.  
  1219.  
  1220. '|***************************************************************************
  1221. '| Enables or disables the Paste Menu item depending on the value of
  1222. '| "attribute%"
  1223. '|***************************************************************************
  1224. SUB SetStatusOfEditMenuItems(attribute%)
  1225. SHARED hwndMenu&
  1226.   bool% = WinSendMsg(hwndMenu&, MMSETITEMATTR,_
  1227.                      MakeLong(TRUE, SAVEBITMAP),_
  1228.                      MakeLong(attribute%, MIADISABLED))
  1229.   bool% = WinSendMsg(hwndMenu&, MMSETITEMATTR,_
  1230.                      MakeLong(TRUE, COPYTOCLIPBOARD),_
  1231.                      MakeLong(attribute%, MIADISABLED))
  1232.   bool% = WinSendMsg(hwndMenu&, MMSETITEMATTR,_
  1233.                      MakeLong(TRUE, PASTECLIPBOARD),_
  1234.                      MakeLong(attribute%, MIADISABLED))
  1235. END SUB
  1236.  
  1237. '|***************************************************************************
  1238. '| Sets system pointer to the WAIT pointer for a routines that might take
  1239. '| a few seconds or more.
  1240. '|***************************************************************************
  1241. SUB SetSystemPointerToWaitPointer
  1242.   bool% = WinSetPointer(HWNDDESKTOP,_
  1243.                         WinQuerySysPointer(HWNDDESKTOP, SPTRWAIT, 0))
  1244. END SUB
  1245.  
  1246.  
  1247. '|***************************************************************************
  1248. '| Sets system pointer back to the standard system pointer
  1249. '|***************************************************************************
  1250. SUB SetSystemPointerToStandardArrow
  1251.   bool% = WinSetPointer(HWNDDESKTOP,_
  1252.                         WinQuerySysPointer(HWNDDESKTOP, SPTRARROW, 0))
  1253. END SUB
  1254.  
  1255.  
  1256. '|***************************************************************************
  1257. '| Displays message box using values passed in message$ and caption$.  Makes
  1258. '| displaying message boxes easier if used in various places in a program.
  1259. '|***************************************************************************
  1260. FUNCTION DisplayMessageBox%(message$, caption$, style%)
  1261. IF style% = 1 THEN styleflag% = MBOKCANCEL OR MBICONQUESTION OR MBAPPLMODAL
  1262. IF style% = 2 THEN styleflag% = MBICONHAND OR MBAPPLMODAL
  1263. IF style% = 3 THEN styleflag% = MBICONASTERISK OR MBAPPLMODAL
  1264. DisplayMessageBox% = WinMessageBox(_
  1265.        HWNDDESKTOP, HWNDDESKTOP,_
  1266.        MakeLong(VARSEG(message$), SADD(message$)),_
  1267.        MakeLong(VARSEG(caption$), SADD(caption$)),_
  1268.        0,_
  1269.        styleflag%)
  1270. END FUNCTION
  1271.