home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / OS2BAS.ZIP / WINCLIP.BAS < prev    next >
BASIC Source File  |  1989-08-27  |  7KB  |  202 lines
  1. '*******************************************************************
  2. '* 
  3. '* Program Name: WinClip.BAS
  4. '*
  5. '* Include File: WinClip.BI
  6. '*
  7. '* Functions   :
  8. '*               WinOpenClipbrd
  9. '*               WinSetClipbrdOwner
  10. '*               WinQueryClipbrdOwner
  11. '*               WinSetClipbrdViewer
  12. '*               WinQueryClipbrdViewer
  13. '*               WinSetClipbrdData
  14. '*               WinQueryClipbrdData
  15. '*               WinQueryClipbrdFmtInfo
  16. '*               WinEmptyClipbrd
  17. '*               WinEnumClipbrdFmts
  18. '*               WinCloseClipbrd
  19. '*
  20. '* Description : This program demonstrates the clipboard functions.
  21. '*               Each function is used in the section before the
  22. '*               message loop and the resulting info is written
  23. '*               to WinClip.OUT. In ClientWndProc, the clipboard
  24. '*               is monitored. Using this with a PM text or graphics
  25. '*               editor (such as NotePad or PMDraw), you can see
  26. '*               the clipboard change.
  27. '******************************************************************
  28.  
  29. '*********         Initialization section        ***********
  30.  
  31. REM $INCLUDE: 'PMBase.BI'
  32. REM $INCLUDE: 'WinClip.BI'
  33. REM $INCLUDE: 'OS2Def.BI'      Needed for POINTL type
  34. REM $INCLUDE: 'WinMan1.BI'     Needed for WinGet/ReleasePS, WinDrawText
  35. REM $INCLUDE: 'WinMan2.BI'     Needed for WinValidateRect
  36. REM $INCLUDE: 'WinPoint.BI'    Needed for WinGetSysBitmap
  37. REM $INCLUDE: 'GpiColor.BI'    Needed for color constants
  38.  
  39. COMMON SHARED /handles/ hab&
  40. DIM aqmsg AS QMSG
  41.  
  42. flFrameFlags& =  FCFTITLEBAR      OR FCFSYSMENU OR _
  43.                  FCFSIZEBORDER    OR FCFMINMAX  OR _
  44.                  FCFSHELLPOSITION OR FCFTASKLIST
  45.  
  46. szClientClass$ = "ClassName" + CHR$(0)
  47.  
  48. hab&  = WinInitialize    (0)
  49. hmq&  = WinCreateMsgQueue(hab&, 0)
  50.  
  51. bool% = WinRegisterClass(_
  52.         hab&,_
  53.         MakeLong(VARSEG(szClientClass$), SADD(szClientClass$)),_
  54.         RegBas,_
  55.         0,_
  56.         0)
  57.  
  58. hwndFrame& = WinCreateStdWindow (_
  59.              HWNDDESKTOP,_
  60.              WSVISIBLE,_
  61.              MakeLong (VARSEG(flFrameFlags&),  VARPTR(flFrameFlags&)),_
  62.              MakeLong (VARSEG(szClientClass$), SADD(szClientClass$)),_
  63.              0,_
  64.              0,_
  65.              0,_
  66.              0,_
  67.              MakeLong (VARSEG(hwndClient&), VARPTR(hwndClient&)))
  68.  
  69. '**************   Clipboard Calls   ***************
  70.  
  71. OPEN "WinClip.OUT" FOR OUTPUT AS #1
  72.  
  73. bool% = WinOpenClipbrd (hab&)
  74.  
  75.   'Query before and after SetOwner
  76.  
  77.   before& = WinQueryClipbrdOwner (hab&, 0)
  78.   bool%   = WinSetClipbrdOwner   (hab&, hwndClient&)
  79.   after&  = WinQueryClipbrdOwner (hab&, 0)
  80.   PRINT #1, "Owner before: ";HEX$(before&),"...after: ";HEX$(after&)
  81.  
  82.   'Query before and after SetViewer
  83.  
  84.   before& = WinQueryClipbrdViewer (hab&, 0)
  85.   bool%   = WinSetClipbrdViewer   (hab&, hwndClient&)
  86.   after&  = WinQueryClipbrdViewer (hab&, 0)
  87.   PRINT #1, "Viewer before: ";HEX$(before&),"...after: ";HEX$(after&)
  88.  
  89.   'Put bitmap in clipboard
  90.  
  91.   hbmp& = WinGetSysBitmap   (HWNDDESKTOP, SBMPCHECKBOXES)
  92.   bool% = WinSetClipbrdData (hab&, 0, CFBITMAP, CFIHANDLE)
  93.   bool% = WinSetClipbrdData (hab&, hbmp&, CFBITMAP, CFIHANDLE)
  94.  
  95.   'Check format of bitmap in clipboard
  96.  
  97.   bool%   = WinQueryClipbrdFmtInfo (hab&, CFBITMAP,_
  98.             MakeLong(VARSEG(format&), VARPTR(format&)))
  99.   hcheck& = WinQueryClipbrdData    (hab&, CFBITMAP)
  100.   PRINT #1, "Clipboard data:"
  101.   PRINT #1, "Format: ",HEX$(format&)
  102.   PRINT #1, "Handle:",HEX$(hcheck&)
  103.  
  104.   'Add another item to the clipboard (for enumeration)
  105.  
  106.   theString$ = "This is the clipboard data." + CHR$(0)
  107.   bool% = WinSetClipbrdData (hab&, 0, CFTEXT, CFISELECTOR)
  108.   bool% = WinSetClipbrdData (hab&,_
  109.           MakeLong(VARSEG(theString$), SADD(theString$)),_
  110.           CFTEXT, CFISELECTOR)
  111.  
  112.   'loop through formats in clipboard (should be 2)
  113.  
  114.   PRINT #1, "Two items added to be enumerated."
  115.   enum% = 0
  116.   DO
  117.     enum% = WinEnumClipbrdFmts (hab&, enum%)
  118.     PRINT #1, "Enumerate: ",enum%
  119.   LOOP UNTIL enum% = 0
  120.  
  121.   'Empty clipboard and check to see if data is there
  122.  
  123.   bool%  = WinEmptyClipbrd     (hab&)
  124.   nullh& = WinQueryClipbrdData (hab&, CFBITMAP)
  125.   PRINT #1, "Handle of data after Empty (should be NULL)",HEX$(nullh&)
  126.  
  127. bool% = WinCloseClipbrd (hab&)
  128. CLOSE #1
  129.  
  130. '**************         Message loop         ***************
  131.  
  132. WHILE WinGetMsg(hab&, MakeLong(VARSEG(aqmsg), VARPTR(aqmsg)), 0, 0, 0)
  133.   bool% = WinDispatchMsg(hab&, MakeLong(VARSEG(aqmsg), VARPTR(aqmsg)))
  134. WEND
  135.  
  136. '***********         Finalize section        ***************
  137.  
  138. bool% = WinDestroyWindow   (hwndFrame&)
  139. bool% = WinDestroyMsgQueue (hmq&)
  140. bool% = WinTerminate       (hab&)
  141.  
  142. END
  143.  
  144. '***********         Window procedure        ***************
  145.  
  146. '****
  147. '** The WMDRAWCLIPBOARD case monitors text and bitmap clipboard changes.
  148. '** The contents are centered in the window. This code is taken from
  149. '** OS/2 Programmer's Reference Volume 1, page 338.
  150.  
  151. FUNCTION ClientWndProc& (hwnd&, msg%, mp1&, mp2&) STATIC
  152.      DIM ClientRect AS RECTL
  153.      DIM ptlDest AS POINTL
  154.      ClientWndProc& = 0
  155.      SELECT CASE msg%
  156.      CASE WMDRAWCLIPBOARD          'Monitor clipboard changes
  157.         bool%    = WinOpenClipbrd      (hab&)
  158.         hText&   = WinQueryClipbrdData (hab&, CFTEXT)
  159.         hBitmap& = WinQueryClipbrdData (hab&, CFBITMAP)
  160.         IF hText& THEN       ' If handle is valid, center it in window
  161.  
  162.           'Change text handle to pointer
  163.           CALL BreakLong (hText&, nothing%, selector%)
  164.           pszText& = MakeLong(selector%, 0)
  165.  
  166.           'Center string
  167.           hps&  = WinGetPS           (hwnd&)
  168.           bool% = WinQueryWindowRect (hwnd&,_
  169.                   MakeLong(VARSEG(ClientRect), VARPTR(ClientRect)))
  170.           bool% = WinDrawText        (hps&, &HFFFF, pszText&,_
  171.                   MakeLong(VARSEG(ClientRect), VARPTR(ClientRect)),_
  172.                   CLRBLACK, CLRWHITE,_
  173.                   DTCENTER OR DTVCENTER OR DTERASERECT)
  174.           bool% = WinValidateRect    (hwnd&, 0, 0)
  175.           bool% = WinReleasePS       (hps&)
  176.  
  177.         ELSEIF hBitmap& THEN
  178.           ptlDest.x = 0 : ptlDest.y = 0
  179.           hps&  = WinGetPS           (hwnd&)
  180.           bool% = WinQueryWindowRect (hwnd&,_
  181.                   MakeLong(VARSEG(ClientRect), VARPTR(ClientRect)))
  182.           bool% = WinFillRect        (hps&,_
  183.                   MakeLong(VARSEG(ClientRect), VARPTR(ClientRect)),CLRWHITE)
  184.           bool% = WinDrawBitmap(hps&, hBitmap&, 0,_
  185.                   MakeLong(VARSEG(ptlDest), VARPTR(ptlDest)),_
  186.                   CLRBLACK, CLRWHITE, DBMNORMAL)
  187.           bool% = WinValidateRect    (hwnd&, 0, 0)
  188.           bool% = WinReleasePS       (hps&)
  189.         END IF
  190.         bool% = WinCloseClipbrd (hab&)
  191.  
  192.      CASE WMPAINT     'Paint the window with background color
  193.         hps&  = WinBeginPaint(hwnd&, 0,_
  194.                 MakeLong(VARSEG(ClientRect), VARPTR(ClientRect)))
  195.         bool% = WinFillRect(hps&,_
  196.                 MakeLong(VARSEG(ClientRect), VARPTR(ClientRect)),0)
  197.         bool% = WinEndPaint(hps&)
  198.      CASE ELSE        'Pass control to system for other messages
  199.         ClientWndProc& = WinDefWindowProc(hwnd&, msg%, mp1&, mp2&)
  200.      END SELECT
  201. END FUNCTION
  202.