home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / OS2BAS.ZIP / GPIBIT.BAS < prev    next >
Encoding:
BASIC Source File  |  1989-09-12  |  14.2 KB  |  413 lines
  1. '**************************************************************************
  2. '*
  3. '* Program Name: GpiBit.BAS
  4. '*
  5. '* Include File: GpiBit.BI
  6. '*
  7. '* Functions   : GpiLoadBitmap
  8. '*               GpiDeleteBitmap
  9. '*               GpiSetBitmap
  10. '*               GpiBitBlt
  11. '*               GpiWCBitBlt
  12. '*               GpiCreateBitmap
  13. '*               GpiQueryDeviceBitmapFormats
  14. '*               GpiQueryBitmapParameters
  15. '*               GpiQueryBitmapBits
  16. '*               GpiSetBitmapBits
  17. '*               GpiSetPel
  18. '*               GpiQueryPel
  19. '*               GpiSetBitmapID
  20. '*               GpiQueryBitmapHandle
  21. '*               GpiImage
  22. '*
  23. '*  Description: This program demonstrates all functions in GpiBit.BI
  24. '*               except for GpiSetBitmapBits and GpiQueryBitmapBits.
  25. '*               These routines are demonstrated in the demo program
  26. '*               Capture.BAS.  Return values from functions that do not
  27. '*               have a visual affect, are written out to the file
  28. '*               GpiBit.OUT.
  29. '*
  30. '*               The program sequence is as follows:
  31. '*
  32. '*               - An 8x8 bitmap is loaded from the programs resource
  33. '*                 and used as a fill pattern to fill the entire window.
  34. '*               - A 99x99 bitmap is then loaded from the programs resource
  35. '*                 and displayed in the lower left hand corner of the
  36. '*                 Client window, actual size.
  37. '*               - It is then copied and magnified to the upper left hand
  38. '*                 quarter of the Client Window.
  39. '*               - The image data at the end of the module level code is
  40. '*                 then read in to an array which is used to display
  41. '*                 10 copies of the image (a cat) at random locations
  42. '*                 in the upper right hand quarter of the Client window.
  43. '*               - 1000 random pixels in the lower right hand quarter of
  44. '*                 the Client window are then set to the color Blue.
  45. '*               - A bitmap is then created in a presentation space
  46. '*                 associated with a memory device context, consisting
  47. '*                 of the entire contents of the Client window.
  48. '*               - This bitmap is then copied to the lower right hand
  49. '*                 quarter of the Client window.
  50. '*
  51. '***************************************************************************
  52.  
  53. '*********         Initialization section        ***********
  54.  
  55. REM $INCLUDE: 'OS2Def.BI'
  56. REM $INCLUDE: 'PMBase.BI'
  57. REM $INCLUDE: 'WinMsgs.BI'
  58. REM $INCLUDE: 'GpiCont.BI'
  59. REM $INCLUDE: 'GpiArea.BI'
  60. REM $INCLUDE: 'GpiColor.BI'
  61. REM $INCLUDE: 'GpiBit.BI'
  62. DECLARE FUNCTION GpiMove% (BYVAL HPS AS LONG, BYVAL PPOINTL AS LONG)
  63. DECLARE FUNCTION GpiBox& (BYVAL HPS AS LONG, BYVAL along AS LONG, BYVAL PPOINTL AS LONG, BYVAL blong AS LONG, BYVAL CLONG AS LONG)
  64. DECLARE FUNCTION DevOpenDC& (BYVAL HAB AS LONG, BYVAL along AS LONG, BYVAL PSZ AS LONG, BYVAL blong AS LONG, BYVAL PDEVOPENDATA AS LONG, BYVAL HDC AS LONG)
  65. DECLARE FUNCTION DevCloseDC& (BYVAL HDC AS LONG)
  66.  
  67. DECLARE SUB ScreenPaint (hwnd&)
  68. DECLARE FUNCTION DosAllocSeg%( _
  69.         BYVAL P1 AS INTEGER,_
  70.         BYVAL P2 AS LONG,_
  71.         BYVAL P3 AS INTEGER)
  72.  
  73. CONST IDBITMAP1 = 1
  74. CONST IDBITMAP2 = 2
  75. CONST ODMEMORY = 8&
  76.  
  77. TYPE BitMapFormats
  78.   Planes AS LONG
  79.   BitCount AS LONG
  80. END TYPE
  81.  
  82. TYPE MyBITMAPINFO
  83.     cbFix AS LONG
  84.     cx AS INTEGER
  85.     cy AS INTEGER
  86.     cPlanes AS INTEGER
  87.     cBitCount AS INTEGER
  88.     argbColor AS STRING * 48
  89. END TYPE
  90.  
  91.  
  92. DIM aqmsg AS QMSG
  93.  
  94. OPEN "GpiBit.OUT" FOR OUTPUT AS #1
  95.  
  96. flFrameFlags& =  FCFTITLEBAR      OR FCFSYSMENU  OR_
  97.                  FCFSIZEBORDER    OR FCFMINMAX   OR_
  98.                  FCFSHELLPOSITION OR FCFTASKLIST
  99.  
  100. szClientClass$ = "ClassName" + CHR$(0)
  101.  
  102. hab&  = WinInitialize(0)
  103. hmq&  = WinCreateMsgQueue(hab&, 0)
  104.  
  105. retn% = WinRegisterClass(_
  106.         hab&,_
  107.         MakeLong(VARSEG(szClientClass$), SADD(szClientClass$)),_
  108.         RegBas,_
  109.         CSSIZEREDRAW,_
  110.         0)
  111.  
  112. hwndFrame& = WinCreateStdWindow (_
  113.              HWNDDESKTOP,_
  114.              WSVISIBLE,_
  115.              MakeLong(VARSEG(flFrameFlags&),  VARPTR(flFrameFlags&)),_
  116.              MakeLong(VARSEG(szClientClass$), SADD(szClientClass$)),_
  117.              0,_
  118.              0,_
  119.              0,_
  120.              0,_
  121.              MakeLong(VARSEG(hwndClient&), VARPTR(hwndClient&)))
  122.  
  123. '**************         Message loop         ***************
  124.  
  125. WHILE WinGetMsg(hab&, MakeLong(VARSEG(aqmsg), VARPTR(aqmsg)), 0, 0, 0)
  126.     bool% = WinDispatchMsg(hab&, MakeLong(VARSEG(aqmsg), VARPTR(aqmsg)))
  127. WEND
  128.  
  129. '***********         Finalize section        ***************
  130.  
  131. retn% = WinDestroyWindow(hwndFrame&)
  132. retn% = WinDestroyMsgQueue(hmq&)
  133. retn% = WinTerminate(hab&)
  134. CLOSE #1
  135.  
  136. END
  137.  
  138. '***********         Window procedure        ***************
  139.  
  140. FUNCTION ClientWndProc& (hwnd&, msg%, mp1&, mp2&) STATIC
  141. SHARED cxClient%, cyClient%
  142.  
  143.   ClientWndProc& = 0
  144.   SELECT CASE msg%
  145.   '*
  146.   '* Get current size of Client Window
  147.   '*
  148.     CASE WMSIZE
  149.       CALL BreakLong(mp2&, cyClient%, cxClient%)
  150.  
  151.     CASE WMPAINT
  152.       CALL ScreenPaint(hwnd&)
  153.  
  154.     CASE ELSE
  155.       ClientWndProc& = WinDefWindowProc(hwnd&, msg%, mp1&, mp2&)
  156.  
  157.   END SELECT
  158.  
  159. END FUNCTION
  160.  
  161. '*
  162. '* Data to be used by GpiImage.  Below data will display a small cat.
  163. '*
  164. '* Taken from "Programming the OS/2 Presentation Manager" by Charles Petzold
  165. '*
  166. DATA &H01, &HF8, &H1F, &H80, &H01, &H04, &H20, &H80
  167. DATA &H00, &H8F, &HF1, &H00, &H00, &H48, &H12, &H00
  168. DATA &H00, &H28, &H14, &H00, &H00, &H1A, &H58, &H00
  169. DATA &H00, &H08, &H10, &H00, &H00, &HFC, &H3F, &H00
  170. DATA &H00, &H09, &H90, &H00, &H00, &HFC, &H3F, &H00
  171. DATA &H00, &H08, &H10, &H00, &H00, &H07, &HE0, &H00
  172. DATA &H00, &H08, &H10, &H00, &H00, &H08, &H10, &HC0
  173. DATA &H00, &H08, &H10, &H20, &H00, &H10, &H08, &H10
  174. DATA &H00, &H10, &H08, &H08, &H00, &H10, &H08, &H04
  175. DATA &H00, &H20, &H04, &H04, &H00, &H20, &H04, &H04
  176. DATA &H00, &H20, &H04, &H04, &H00, &H40, &H02, &H04
  177. DATA &H00, &H40, &H02, &H04, &H00, &H40, &H02, &H04
  178. DATA &H00, &HC0, &H03, &H04, &H00, &H9C, &H39, &H08
  179. DATA &H00, &HA2, &H45, &H08, &H00, &HA2, &H45, &H10
  180. DATA &H00, &HA2, &H45, &HE0, &H00, &HA2, &H45, &H00
  181. DATA &H00, &HA2, &H45, &H00, &H00, &HFF, &HFF, &H00
  182.  
  183. '************************************************************************
  184. '*
  185. '* SUBprogram ScreenPaint:  Called from ClientWndProc& when a WMPAINT
  186. '*                          message is received.
  187. '*
  188. SUB ScreenPaint(hwnd&)
  189. SHARED cxClient%, cyClient%, hab&
  190. DIM aptl(3)       AS POINTL
  191. DIM rect          AS RECTL
  192. DIM sizl          AS SIZEL
  193. DIM bi            AS BITMAPINFOHEADER
  194. DIM bihdr         AS BITMAPINFOHEADER
  195. DIM fmts(1)       AS BitMapFormats
  196. DIM catimage(128) AS STRING * 1
  197.  
  198.   hps&  = WinBeginPaint(hwnd&, 0, 0)
  199.   bool% = GpiErase     (hps&)
  200. '*
  201. '* Load an 8x8 bitmap to used to be used as a fill pattern.  GpiBox
  202. '* is used to fill the Client window with the fill pattern.  The
  203. '* bitmap is loaded, the bitmap is set to ID 254, the pattern set
  204. '* is set to ID 254 which is the bitmap, then the current fill pattern
  205. '* is set using GpiSetPattern, using ID 254, the bitmap.  After the
  206. '* screen is filled, the bitmap handle is released.
  207. '*
  208.   aptl(0).x = 0
  209.   aptl(0).y = 0
  210.   aptl(1).x = cxClient%
  211.   aptl(1).y = cyClient%
  212.   bool% = GpiSetColor     (hps&, CLRRED)
  213.   hbm&  = GpiLoadBitmap   (hps&, 0, IDBITMAP2, 0, 0)
  214.   bool% = GpiSetBitmapId  (hps&, hbm&, 254)
  215.   bool% = GpiSetPatternSet(hps&, 254)
  216.   bool% = GpiSetPattern   (hps&, 254)
  217.   bool% = GpiMove         (hps&, MakeLong(VARSEG(aptl(0)), VARPTR(aptl(0))))
  218.   bool% = GpiBox          (hps&, DROOUTLINEFILL,_
  219.           MakeLong(VARSEG(aptl(1)), VARPTR(aptl(1))), 0, 0)
  220.   bool% = GpiDeleteBitmap (hbm&)
  221.   bool% = GpiSetColor     (hps&, CLRBLACK)
  222. '*
  223. '* Get handle of bitmap set to ID of 254 in above GpiSetBitmapID
  224. '*
  225.   Bhandle& = GpiQueryBitmapHandle(hps&, 254)
  226.   PRINT #1, "GpiQueryBitmapHandle:", HEX$(Bhandle&)
  227. '*
  228. '* Load bitmap from resource
  229. '*
  230.   hbm& = GpiLoadBitmap(hps&, 0, IDBITMAP1, 0, 0)
  231.  
  232.   aptl(0).x = 0              'lower left corner of target
  233.   aptl(0).y = 0
  234.   aptl(1).x = 98             'upper right corner of target
  235.   aptl(1).y = 98
  236.   aptl(2).x = 1              'lower left corner of source
  237.   aptl(2).y = 1
  238.   aptl(3).x = 99             'upper right corner of source
  239.   aptl(3).y = 99
  240. '*
  241. '* Draws bitmap in lower left of Client window, actual size
  242. '*
  243.   bool% = GpiWCBitBlt(hps&, hbm&, 3,_
  244.           MakeLong(VARSEG(aptl(0)), VARPTR(aptl(0))),_
  245.           ROPSRCCOPY, BBOAND)
  246. '*
  247. '* Copy bitmap from current location, and stretch bitmap to fill
  248. '* top half of Client window
  249. '*
  250.   aptl(0).x = 0              'lower left corner of target
  251.   aptl(0).y = cyClient% / 2
  252.   aptl(1).x = cxClient% / 2  'upper right corner of target
  253.   aptl(1).y = cyClient%
  254.   aptl(2).x = 0              'lower left corner of source
  255.   aptl(2).y = 0
  256.   aptl(3).x = 98             'upper right corner of source
  257.   aptl(3).y = 98
  258.   bool% = GpiBitBlt(hps&, hps&, 4,_
  259.           MakeLong(VARSEG(aptl(0)), VARPTR(aptl(0))),_
  260.           ROPSRCCOPY, BBOAND)
  261.   bool% = GpiDeleteBitmap(hbm&)
  262. '*
  263. '* The Image DATA at the module level is read into the array CATIMAGE
  264. '* and then GpiImage is used to display the image defined by the DATA.
  265. '* 10 cat images are displayed at random positions in the upper right
  266. '* hand corner of the Client Window
  267. '*
  268.   FOR I% = 1 TO 128
  269.     READ byte%
  270.     catimage(I%) = CHR$(byte%)
  271.   NEXT
  272.   RESTORE
  273.   aptl(0).x = 32
  274.   aptl(0).y = 32
  275.   FOR I% = 1 TO 10
  276.     xlowerbound% = cxClient% / 2
  277.     xupperbound% = cxClient% - 32
  278.     ylowerbound% = cyClient% / 2 + 32
  279.     yupperbound% = cyClient%
  280.  
  281.     aptl(1).x = INT ((xupperbound% - xlowerbound% + 1) * RND + xlowerbound%)
  282.     aptl(1).y = INT ((yupperbound% - ylowerbound% + 1) * RND + ylowerbound%)
  283.  
  284.     bool% = GpiMove (hps&, MakeLong(VARSEG(aptl(1)), VARPTR(aptl(1))))
  285.     bool% = GpiImage(hps&, 0,_
  286.             MakeLong(VARSEG(aptl(0)),     VARPTR(aptl(0))), 128,_
  287.             MakeLong(VARSEG(catimage(1)), VARPTR(catimage(1))))
  288.   NEXT I%
  289. '*
  290. '* Set 1000 random pixels in the lower right corner of the Client window
  291. '* to the color Blue.  The pixels set will appear blue and purple since
  292. '* blue pixels next to red pixels appear purple.
  293. '*
  294.   rect.xLeft   = cxClient% \ 2
  295.   rect.xRight  = cxClient%
  296.   rect.yTop    = cyClient% \ 2
  297.   rect.yBottom = 0
  298.   bool% = WinFillRect(hps&, MakeLong(VARSEG(rect), VARPTR(rect)), 0)
  299.   bool% = GpiSetColor(hps&, CLRBLUE)
  300.  
  301.   FOR I% = 1 TO 1000
  302.     xlowerbound% = rect.xLeft
  303.     xupperbound% = rect.xRight
  304.     ylowerbound% = rect.yBottom
  305.     yupperbound% = rect.yTop
  306.  
  307.     aptl(0).x = INT ((xupperbound% - xlowerbound% + 1) * RND + xlowerbound%)
  308.     aptl(0).y = INT ((yupperbound% - ylowerbound% + 1) * RND + ylowerbound%)
  309.  
  310.     bool% = GpiSetPel(hps&, MakeLong(VARSEG(aptl(0)), VARPTR(aptl(0))))
  311.   NEXT I%
  312. '*
  313. '* Obtain color of last pixel set by GpiSetPel above, which should be Blue (1)
  314. '*
  315.   pixelcolor& = GpiQueryPel(hps&, MakeLong(VARSEG(aptl(0)), VARPTR(aptl(0))))
  316.   PRINT #1,"GpiQueryPel: (";aptl(0).x;",";aptl(0).y;") is color";pixelcolor&
  317. '*
  318. '* Initialize bitmap info to be used in GpiCreateBitmap
  319. '*
  320.   bi.cbFix     = LEN(bi)
  321.   bi.cx        = cxClient%
  322.   bi.cy        = cyClient%
  323.   bi.cPlanes   = 1
  324.   bi.cBitCount = 4
  325. '*
  326. '* Initialize info to be used in DevOpenDC
  327. '*
  328.   token$  = "*" + CHR$(0)
  329.   sizl.cx = bi.cx
  330.   sizl.cy = bi.cy
  331. '*
  332. '* Create a Device Context and and a Micro Presentation space,
  333. '* associate the presentation space with the Device Context,
  334. '* Create a bitmap using the bitmap info initialized above,
  335. '* associate the bitmap with the memory presentation space.
  336. '*
  337.   hdc&  = DevOpenDC      (hab&, ODMEMORY,_
  338.           MakeLong(VARSEG(token$), SADD(token$)), 0, 0, 0)
  339.   hps2& = GpiCreatePS    (hab&, hdc&,_
  340.           MakeLong(VARSEG(sizl), VARPTR(sizl)),_
  341.           PUPELS OR GPIFDEFAULT OR GPITMICRO OR GPIAASSOC)
  342.   hbm&  = GpiCreateBitmap(hps2&,_
  343.           MakeLong(VARSEG(bi), VARPTR(bi)), 0, 0, 0)
  344.   bool% = GpiSetBitmap   (hps2&, hbm&)
  345. '*
  346. '* Copy Entire contents of Client window to bitmap created above
  347. '*
  348.   aptl(0).x = 0
  349.   aptl(0).y = 0
  350.   aptl(1).x = cxClient%
  351.   aptl(1).y = cyClient%
  352.   aptl(2).x = 0
  353.   aptl(2).y = 0
  354.   aptl(3).x = cxClient%
  355.   aptl(3).y = cyClient%
  356.   bool% = GpiBitBlt(hps2&, hps&, 4,_
  357.           MakeLong(VARSEG(aptl(0)), VARPTR(aptl(0))),_
  358.           ROPSRCCOPY, BBOAND)
  359. '*
  360. '* Copy bitmap created above, which is the current Client Window
  361. '* display, to the lower right hand quarter of the Client Window.
  362. '* Change the last parameter in GpiBitBlt for varying results when
  363. '* the bitmap is compressed: BBOIGNORE, BBOAND, and BBOOR.
  364. '*
  365.   aptl(0).x = cxClient% / 2
  366.   aptl(0).y = 0
  367.   aptl(1).x = cxClient%
  368.   aptl(1).y = cyClient% / 2
  369.   aptl(2).x = 0
  370.   aptl(2).y = 0
  371.   aptl(3).x = bi.cx
  372.   aptl(3).y = bi.cy
  373.   bool% = GpiBitBlt(hps&, hps2&, 4,_
  374.           MakeLong(VARSEG(aptl(0)), VARPTR(aptl(0))),_
  375.           ROPSRCCOPY, BBOIGNORE)
  376.  
  377. '*
  378. '* The following routines have now visual effect so their return
  379. '* values are written out to GpiBit.OUT
  380. '*
  381.   bool% = GpiQueryBitmapParameters(hbm&, MakeLong(VARSEG(bihdr), VARPTR(bihdr)))
  382.   PRINT #1,"GpiQueryBitmapParameters:  cbFix = ";bihdr.cbFix
  383.   PRINT #1,"                              cx = ";bihdr.cx
  384.   PRINT #1,"                              cy = ";bihdr.cy
  385.   PRINT #1,"                         cPlanes = ";bihdr.cPlanes
  386.   PRINT #1,"                       cBitCount = ";bihdr.cBitCount
  387.  
  388.   bool% = GpiQueryDeviceBitmapFormats(hps&, 2,_
  389.           MakeLong(VARSEG(fmts(0)), VARPTR(fmts(0))))
  390.   PRINT #1,"GpiQueryDeviceBitmapFormats: Format #1-> Planes = ";fmts(0).Planes
  391.   PRINT #1,"                                       BitCount = ";fmts(0).BItcount
  392.   PRINT #1,"                             Format #2-> Planes = ";fmts(1).Planes
  393.   PRINT #1,"                                       BitCount = ";fmts(1).BItcount
  394.  
  395.   aptl(0).x = 100
  396.   aptl(0).y = 100
  397.   bool% = GpiSetBitmapDimension  (hbm&,_
  398.           MakeLong(VARSEG(aptl(0)), VARPTR(aptl(0))))
  399.   bool% = GpiQueryBitmapDimension(hbm&,_
  400.           MakeLong(VARSEG(aptl(1)), VARPTR(aptl(1))))
  401.   PRINT #1,"GpiQueryBitmapDimension: (";aptl(1).x;",";aptl(1).y;")"
  402.  
  403. '*
  404. '* Release all handles
  405. '*
  406.     bool% = GpiDeleteBitmap(hbm&)
  407.     bool% = GpiDestroyPS   (hps2&)
  408.     bool% = DevCloseDC     (hdc&)
  409.  
  410.     bool% = WinEndPaint    (hps&)
  411.  
  412. END SUB
  413.