home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / magazine / msysjour / ms / s12519 / pmbasic.bas < prev    next >
BASIC Source File  |  1989-12-11  |  7KB  |  203 lines
  1.  
  2. '+----------------------------------------------------------
  3. -------------
  4. '| Program Name: PMBasic.BAS
  5. '|
  6. '| Description:  This program gives a simple demo of a
  7. Presentation
  8. '|               Manager program written with BASIC Compiler
  9. Version
  10. '|               6.00 and the BASIC OS/2 Presentation
  11. Manager Toolkit
  12. '|               Supplement.  This supplement is available
  13. from
  14. '|               Microsoft Product Support at (206) 454-
  15. 2030.
  16. '|
  17. '|               This program draws a figure with
  18. GpiBegin/EndArea and
  19. '|               GpiPolyFillet.  It allows the user to
  20. choose -- with
  21. '|               a menu defined in the resource script file,
  22. '|               PMBasic.RC -- the number of random points
  23. used in the
  24. '|               area drawn.
  25. '+----------------------------------------------------------
  26. -------------
  27. '***** Type definitions
  28. TYPE POINTL
  29.      x AS LONG
  30.      y AS LONG
  31. END TYPE
  32.  
  33. TYPE QMSG
  34.      hwnd AS LONG
  35.      msg  AS INTEGER
  36.      mp1  AS LONG
  37.      mp2  AS LONG
  38.      time AS LONG
  39.      ptl  AS LONG
  40. END TYPE
  41.  
  42. '***** CONSTant definitions
  43. CONST FCFTITLEBAR = &H00000001 : CONST FCFSYSMENU       =
  44. &H00000002
  45. CONST FCFMENU     = &H00000004 : CONST FCFSIZEBORDER    =
  46. &H00000008
  47. CONST FCFMINMAX   = &H00000030 : CONST FCFSHELLPOSITION =
  48. &H00000400
  49. CONST FCFTASKLIST = &H00000800 : CONST CSSIZEREDRAW     =
  50. &H00000004
  51. CONST HWNDDESKTOP = &H00000001 : CONST WSVISIBLE =
  52. &H80000000
  53. CONST WMSIZE  = &H0007 : CONST WMPAINT = &H0023 : CONST
  54. WMCOMMAND = &H0020
  55. CONST BANOBOUNDARY = 0 : CONST BAALTERNATE  = 0
  56.  
  57. '***** FUNCTION declarations
  58. DECLARE FUNCTION WinInitialize&   (BYVAL ushort AS INTEGER)
  59. DECLARE FUNCTION WinCreateMsgQueue&(BYVAL hab AS LONG,_
  60.                                     BYVAL cmsg AS INTEGER)
  61. DECLARE FUNCTION WinRegisterClass%(BYVAL hab AS LONG, BYVAL
  62. pszCN AS LONG,_
  63.               BYVAL pfnWP AS LONG, BYVAL flSty  AS LONG,_
  64.               BYVAL cbWD AS INTEGER)
  65. DECLARE FUNCTION MakeLong&(BYVAL hiword AS INTEGER,_
  66.                            BYVAL loword AS INTEGER)
  67. DECLARE FUNCTION RegBas&
  68. DECLARE FUNCTION WinCreateStdWindow&(BYVAL hwndP AS LONG,_
  69.              BYVAL flS AS LONG, BYVAL pflCF AS LONG, BYVAL
  70. pszC AS LONG,_
  71.              BYVAL pszT AS LONG, BYVAL styC AS LONG,_
  72.              BYVAL hmod AS INTEGER, BYVAL idRes AS INTEGER,_
  73.              BYVAL phwnd AS LONG)
  74. DECLARE FUNCTION WinGetMsg%(BYVAL hab AS LONG, BYVAL pqmsg
  75. AS LONG,_
  76.             BYVAL hwndF AS LONG, BYVAL msgFF AS INTEGER,_
  77.             BYVAL msgFL AS INTEGER)
  78. DECLARE FUNCTION WinDispatchMsg&(BYVAL hab AS LONG, BYVAL
  79. pqmsg AS LONG)
  80. DECLARE FUNCTION WinDestroyWindow%(BYVAL hwnd AS LONG)
  81. DECLARE FUNCTION WinDestroyMsgQueue%(BYVAL hmq AS LONG)
  82. DECLARE FUNCTION WinTerminate%(BYVAL hab AS LONG)
  83. DECLARE SUB BreakLong(BYVAL along AS LONG, hiword AS
  84. INTEGER,_
  85.                       loword AS INTEGER)
  86. DECLARE FUNCTION WinInvalidateRect%(BYVAL hwnd AS LONG,_
  87.                                     BYVAL pwrc AS LONG,_
  88.                                     BYVAL fIC AS INTEGER)
  89. DECLARE FUNCTION WinBeginPaint&(BYVAL hwnd AS LONG, BYVAL
  90. hps AS LONG,_
  91.                                 BYVAL prcl AS LONG)
  92. DECLARE FUNCTION GpiErase%(BYVAL HPS AS LONG)
  93. DECLARE FUNCTION GpiBeginArea%(BYVAL HPS AS LONG, BYVAL
  94. ULONG AS LONG)
  95. DECLARE FUNCTION GpiMove%(BYVAL HPS AS LONG, BYVAL PPTL AS
  96. LONG)
  97. DECLARE FUNCTION GpiPolyFillet&(BYVAL HPS AS LONG, BYVAL
  98. ALONG AS LONG,_
  99.                                 BYVAL PPTL AS LONG)
  100. DECLARE FUNCTION GpiEndArea&(BYVAL HPS AS LONG)
  101. DECLARE FUNCTION WinEndPaint%(BYVAL hps AS LONG)
  102. DECLARE FUNCTION WinSendMsg&(BYVAL hwnd AS LONG, BYVAL msg
  103. AS INTEGER,_
  104.                              BYVAL mp1 AS LONG, BYVAL mp2 AS
  105. LONG)
  106. DECLARE FUNCTION WinDefWindowProc&(BYVAL hwnd AS LONG,_
  107.                                    BYVAL msg AS INTEGER,_
  108.                                    BYVAL mp1 AS LONG, BYVAL
  109. mp2 AS LONG)
  110.  
  111. '*********         Initialization section        ***********
  112.  
  113. DIM aqmsg AS QMSG
  114.  
  115. flFrameFlags& = FCFTITLEBAR OR FCFSYSMENU OR FCFSIZEBORDER
  116. OR FCFMENU OR_
  117.                 FCFMINMAX OR FCFTASKLIST OR FCFSHELLPOSITION
  118.  
  119. Class$ = "ClassName" + CHR$(0)
  120.  
  121. hab& = WinInitialize(0)
  122. hmq& = WinCreateMsgQueue(hab&, 0)
  123.  
  124. bool% = WinRegisterClass(hab&,_
  125.         MakeLong(VARSEG(Class$), SADD(Class$)), RegBas,
  126. CSSIZEREDRAW, 0)
  127.  
  128. hwndFrame& = WinCreateStdWindow(HWNDDESKTOP, WSVISIBLE,_
  129.              MakeLong(VARSEG(flFrameFlags&),
  130. VARPTR(flFrameFlags&)),_
  131.              MakeLong(VARSEG(Class$), SADD(Class$)), 0, 0,
  132. 0, 1,_
  133.              MakeLong(VARSEG(hwndClient&),
  134. VARPTR(hwndClient&)))
  135.  
  136. '*************         Message loop         ***************
  137.  
  138. WHILE WinGetMsg(hab&, MakeLong(VARSEG(aqmsg),
  139. VARPTR(aqmsg)), 0, 0, 0)
  140.    bool% = WinDispatchMsg(hab&, MakeLong(VARSEG(aqmsg),
  141. VARPTR(aqmsg)))
  142. WEND
  143.  
  144. '***********         Finalize section        ***************
  145.  
  146. bool% = WinDestroyWindow(hwndFrame&)
  147. bool% = WinDestroyMsgQueue(hmq&)
  148. bool% = WinTerminate(hab&)
  149. END
  150.  
  151. '***********         Window procedure        ***************
  152.  
  153. FUNCTION ClientWndProc&(hwnd&, msg%, mp1&, mp2&) STATIC
  154.   ClientWndProc& = 0
  155.  
  156.   SELECT CASE msg%
  157.   CASE WMSIZE           'Store size to make area
  158. proportional to window
  159.     CALL BreakLong(mp2&, cyClient%, cxClient%)
  160.  
  161.   CASE WMPAINT          'Paint window with PolyFillet with
  162. (pts%) rand pts
  163.     ' Invalidate to paint whole window
  164.     bool% = WinInvalidateRect(hwnd&, 0, 0)
  165.     hps&  = WinBeginPaint(hwnd&, 0, 0)   'Begin painting
  166.     bool% = GpiErase(hps&)               'Erase window
  167.  
  168.     '*** Set up array of random points. Number of points is
  169. set with menu.
  170.     IF pts% = 0 THEN pts% = 50
  171.     REDIM aptl(pts%) AS POINTL
  172.     FOR I% = 0 to pts%
  173.       aptl(I%).x = cxClient% * RND : aptl(I%).y = cyClient%
  174. * RND
  175.     NEXT I%
  176.  
  177.     '*** Start at last pt and draw PolyFillet through all
  178. pts
  179.     '    alternating fill
  180.     bool% = GpiMove(hps&, MakeLong(VARSEG(aptl(pts%)),
  181. VARPTR(aptl(pts%))))
  182.     bool% = GpiBeginArea (hps&, BAALTERNATE OR BANOBOUNDARY)
  183.     bool% = GpiPolyFillet(hps&, pts% + 1,_
  184.                           MakeLong(VARSEG(aptl(0)),
  185. VARPTR(aptl(0))))
  186.     bool% = GpiEndArea(hps&)
  187.     bool% = WinEndPaint(hps&)
  188.  
  189.   CASE WMCOMMAND          'Menu item sets number of pts to
  190. use in drawing.
  191.     CALL BreakLong(mp1&, hiword%, pts%)
  192.     bool% = WinSendMsg(hwnd&, WMPAINT, 0, 0)      'Send
  193. WMPAINT to draw
  194.  
  195.   CASE ELSE                 'Pass control to system for
  196. other messages
  197.     ClientWndProc& = WinDefWindowProc(hwnd&, msg%, mp1&,
  198. mp2&)
  199.   END SELECT
  200.  
  201. END FUNCTION
  202.  
  203.