home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / OS2BAS.ZIP / GPIDEMO.BAS < prev    next >
BASIC Source File  |  1989-09-14  |  11KB  |  318 lines
  1. '│**********************************************************
  2. '│
  3. '│ Program Name: GpiDemo.BAS
  4. '│
  5. '│ Description:  This programs combineds most of the example
  6. '│               programs for the Gpi include files into one.
  7. '│               Each menu item essentially executes the Gpi
  8. '│               example program for that area, however, in this
  9. '│               program, each of the example programs included
  10. '│               were converted to OBJect which contain no module
  11. '│               level code.  The OBject are then LINKed together
  12. '│               into one EXE file.
  13. '│                 A description of what each module does is
  14. '│               in the documentation contained in the source of
  15. '│               each module.
  16. '│
  17. '│ Source Files: GpiDemo.BAS  --  Main Module    
  18. '│               ArcMod.BAS   --  Routines from GpiArc.BAS
  19. '│               LineMod.BAS  --  Routines from GpiLine.BAS
  20. '│               AreaMod.BAS  --  These three modules Demonstrate
  21. '│               MarkMod.BAS      the same CALLs as the example     
  22. '│               BitMod.BAS       programs for their include file,
  23. '│                                but are completely different programs.
  24. '│
  25. '│ Data files:   GpiDemo.RC   --  Resouce file containing all menu,
  26. '│                                icon, bitmap, and dialogbox definitions.
  27. '│               GpiDemo.ICO  --  Icon file created with ICONEDIT.EXE.
  28. '│               GpiDemo1.BMP --  Bitmap file used in several routines
  29. '│                                in the BitMod module.  File was
  30. '│                                created with ICONEDIT.EXE
  31. '│               GpiDemo2.BMP --  Bitmap file used in the "4 Plane Bitmap"
  32. '│                                routine in the BitMod module.  Bitmap was
  33. '│                                created with a program that uses the same
  34. '│                                method as the "Capture Bitmap" routine
  35. '│                                in the BitMod module, with the exception
  36. '│                                of the Bitmap being written to a file.
  37. '│               GpiDemo3.BMP --  Bitmap file used in the "Custom Fill..."
  38. '│                                routine in the BitMod module.
  39. '│
  40. '│ This program is Compiled and Linked as follows:
  41. '│
  42. '│   BC Gpidemo /o;
  43. '│   BC ArcMod  /o;
  44. '│   BC LineMod /o;
  45. '│   BC AreaMod /o;
  46. '│   BC MarkMod /o;
  47. '│   BC BitMod  /o;
  48. '│
  49. '│   LINK Gpidemo ArcMod LineMod AreaMod MarkMod BitMod,,, Regbas.LIB OS2.LIB, Gpidemo.def;
  50. '│
  51. '│   RC GpiDemo     -- Compiles and adds resource file to EXE
  52. '│   RC -r GpiDemo  -- Compile resouce file but does not add to EXE
  53. '│   RC GpiDemo.RES -- Adds or replaces Compiled resouce to EXE
  54. '│
  55. '│**********************************************************
  56.  
  57. '│********         Initialization section        ***********
  58.  
  59. REM $INCLUDE: 'os2def.bi'
  60. REM $INCLUDE: 'pmbase.bi'
  61. REM $INCLUDE: 'winman1.bi'
  62. REM $INCLUDE: 'wininput.bi'
  63. REM $INCLUDE: 'windialg.bi'
  64. REM $INCLUDE: 'winmsgs.bi'
  65. REM $INCLUDE: 'winmenu.bi'
  66. REM $INCLUDE: 'winframe.bi'
  67. REM $INCLUDE: 'winpoint.bi'
  68.  
  69. REM $INCLUDE: 'GpiDemo.INC'
  70.  
  71. DIM aqmsg AS QMSG
  72. DIM mi AS MENUITEM
  73.  
  74. flFrameFlags& = FCFTITLEBAR      OR FCFSYSMENU OR _
  75.                 FCFSIZEBORDER    OR FCFMINMAX  OR _
  76.                 FCFSHELLPOSITION OR FCFTASKLIST OR_
  77.                 FCFMENU          OR FCFICON
  78.  
  79. szClientClass$ = "ClassName" + CHR$(0)
  80.  
  81. hab& = WinInitialize(0)
  82. hmq& = WinCreateMsgQueue(hab&, 0)
  83.  
  84. bool% = WinRegisterClass(_
  85.    hab&,_
  86.    MakeLong(VARSEG(szClientClass$), SADD(szClientClass$)),_
  87.    RegBas,_
  88.    0,_
  89.    0)
  90.  
  91. hwndFrame& = WinCreateStdWindow (_
  92.    HWNDDESKTOP,_
  93.    WSINVISIBLE,_
  94.    MakeLong (VARSEG(flFrameFlags&), VARPTR(flFrameFlags&)),_
  95.    MakeLong (VARSEG(szClientClass$), SADD(szClientClass$)),_
  96.    0,_
  97.    0,_
  98.    0,_
  99.    IDRESOURCE,_
  100.    MakeLong (VARSEG(hwndClient&), VARPTR(hwndClient&)))
  101.  
  102. bool% = WinSetWindowPos(hwndFrame&, 0,0,0,0,0, SWPSHOW OR SWPMAXIMIZE)
  103. '│
  104. '│*************         Message loop         ***************
  105. '│
  106. WHILE WinGetMsg(hab&,_
  107.   MakeLong(VARSEG(aqmsg), VARPTR(aqmsg)), 0, 0, 0)
  108.   bool% = WinDispatchMsg(hab&,_
  109.                          MakeLong(VARSEG(aqmsg), VARPTR(aqmsg)))
  110. WEND
  111.  
  112. '│**********         Finalize section        ***************
  113.  
  114. bool% = WinDestroyWindow(hwndFrame&)
  115. bool% = WinDestroyMsgQueue(hmq&)
  116. bool% = WinTerminate(hab&)
  117. END
  118.  
  119. '│**********         Window procedure        ***************
  120. '
  121. FUNCTION ClientWndProc& (hwnd&, msg%, mp1&, mp2&) STATIC
  122. SHARED cxClient%, cyClient%, lastgpi%, dclicked%, hwndFrame&
  123.  
  124.   SELECT CASE msg%
  125.     '│
  126.     '│ Obtain new size of Client window
  127.     '│
  128.     CASE WMSIZE
  129.       CALL BreakLong(mp2&, cyClient%, cxClient%)
  130.       ClientWndProc&=0
  131.     '│
  132.     '│ Ivalidate entire Client window so entire window is repainted.
  133.     '│ Do not erase Client window if last item selected was "Capture Bitmap"
  134.     '│ CALL DisplayChoice to execute currently selected item.
  135.     '│
  136.     CASE WMPAINT
  137.       bool% = WinInvalidateRect(hwnd&, 0, 0)
  138.       hps& = WinBeginPaint(hwnd&, 0, 0)
  139.       IF lastgpi% <> IDMBIT+4 THEN bool% = GpiErase(hps&)
  140.       CALL DisplayChoice(-hwnd&, hps&)
  141.       bool% = WinEndPaint(hps&)
  142.       ClientWndProc&=0
  143.     '│
  144.     '│ Obtain ID of menuitem selected and place in "lastgpi%"
  145.     '│ Do not erase Client window if last item selected was "Capture Bitmap"
  146.     '│ "dclicked%" is a flag used in the "Begin/End Area" routine in the
  147.     '│ Area/Colors module to determine if the routine is being called due
  148.     '│ to a WMPAINT (dclicked% = 0) or a WMCOMMAND (dclicked% = 0) message.
  149.     '│
  150.     CASE WMCOMMAND
  151.       hps& = WinGetPS(hwnd&)
  152.       CALL BreakLong(mp1&, dummy%, lastgpi%)
  153.       IF lastgpi% <> IDMBIT+4 THEN bool% = GpiErase(hps&)
  154.       dclicked% = 1
  155.       CALL DisplayChoice(hwnd&, hps&)
  156.       dclicked% = 0
  157.       bool% = WinReleasePS(hps&)
  158.       ClientWndProc&=0
  159.     '│
  160.     '│ The message is processed only if the currently selected menuitem
  161.     '│ is "Begin/End Area" in the "Area/Colors" module.  Clicking the
  162.     '│ If "Begin/End Area" is the currently selected menuitem, clicking
  163.     '│ the left mouse button will display a new picture without having
  164.     '│ to go through the menu again.
  165.     '│
  166.     CASE WMBUTTON1UP
  167.       IF lastgpi% = IDMAREA+3 OR_
  168.          lastgpi% = IDMAREA+4 OR_
  169.          lastgpi% = IDMAREA+5 THEN
  170.         hps& = WinGetPS(hwnd&)
  171.         bool% = GpiErase(hps&)
  172.         dclicked% = 1
  173.         CALL DisplayChoice(hwnd&, hps&)
  174.         dclicked% = 0
  175.         bool% = WinReleasePS(hps&)
  176.         ClientWndProc& = 0
  177.       ELSE
  178.         ClientWndProc& = WinDefWindowProc(hwnd&, msg%, mp1&, mp2&)
  179.       ENDIF
  180.  
  181.     CASE WMCLOSE
  182.       DoYouReallyWantToQuit(hwnd&)
  183.       ClientWndProc&=0
  184.  
  185.     CASE ELSE        'Pass control to system for other messages
  186.       ClientWndProc& = WinDefWindowProc(hwnd&, msg%, mp1&, mp2&)
  187.   END SELECT
  188.  
  189. END FUNCTION
  190.  
  191.  
  192. '│**************************************************************
  193. '│ This routine simply passes control to the routine coresponding to the
  194. '│ selected menuitem, passing appropriate parameters.  The statement
  195. '│ "hwnd& = ABS(shwnd&)" takes the absolute value of shwnd& since some
  196. '│ of the routines use a negative "hwnd&" (shwnd&) as a flag to determine
  197. '│ exactly what is to be done.  Routines using this flag are passed shwnd&
  198. '│ instead of hwnd&.  The routines using "shwnd&" always convert it to
  199. '│ a positive value before passing the local variable "hwnd" to any
  200. '│ of the Presentation Manager routines.  A additional paramater could be
  201. '│ passed to these routines to be used as the flag.  The decision to use
  202. '│ a negative "hwnd&" is purely arbitrary.
  203. '│
  204. SUB DisplayChoice(shwnd&, hps&)
  205. SHARED lastgpi%, dclicked%, hwndFrame&, hab&
  206.  
  207.   hwnd& = ABS(shwnd&)
  208.   SELECT CASE lastgpi%
  209.     CASE IDMEXIT
  210.       DoYouReallyWantToQuit(hwnd&)
  211.     '│
  212.     '│ Submenu items under the "Arcs" top level menuitem
  213.     '│
  214.     CASE IDMARC+1                      
  215.       CALL DemoGpiPointArc(hps&,1)
  216.     CASE IDMARC+2
  217.       CALL DemoGpiFullArc(hps&,1)
  218.     CASE IDMARC+3
  219.       CALL DemoGpiPartialArc(hps&,1)
  220.     CASE IDMARC+4
  221.       CALL DemoGpiPolyFilletSharp(hps&,1)
  222.     CASE IDMARC+5
  223.       CALL DemoGpiPolySpline(hps&,1)
  224.     CASE IDMARC+6
  225.       CALL DemoGpiPolyFillet(hps&,1)
  226.     CASE IDMARC+7
  227.       CALL DemoGpiPointArc(hps&,0)
  228.       CALL DemoGpiFullArc(hps&,0)
  229.       CALL DemoGpiPartialArc(hps&,0)
  230.       CALL DemoGpiPolySpline(hps&,0)
  231.       CALL DemoGpiPolyFillet(hps&,0)
  232.       CALL DemoGpiPolyFilletSharp(hps&,0)
  233.     '│
  234.     '│ Top level menuitem "Lines"
  235.     '│
  236.     CASE IDMLINE
  237.       CALL DemoLine(hps&)
  238.     '│
  239.     '│ Submenu items under the "Area/Colors" top level menuitem
  240.     '│
  241.     CASE IDMAREA+1
  242.       CALL DemoPatterns(hps&)
  243.     CASE IDMAREA+3, IDMAREA+4, IDMAREA+5
  244.       CALL DemoBeginEndArea(shwnd&, hps&, lastgpi%, dclicked%)
  245.     '│
  246.     '│ Top level Menuitem "GraphMarkers"
  247.     '│
  248.     CASE IDMMARK+1 TO IDMMARK+10
  249.       CALL DemoMark(hps&, lastgpi%)
  250.     '│
  251.     '│ Submenu items under the "Bitmaps" top level menuitem
  252.     '│
  253.     CASE IDMBIT+1
  254.       CALL Demo1PlaneBitmap(hps&)
  255.     CASE IDMBIT+2
  256.       CALL Demo4PlaneBitmap(hps&)
  257.     CASE IDMBIT+3
  258.       CALL DemoResizeBitmap(hwnd&, hps&)
  259.     CASE IDMBIT+4
  260.       CALL DemoCaptureAndMagnify(hab&, hwndFrame&, shwnd&, hps&)
  261.     CASE IDMBIT+5
  262.       CALL DemoFillWithBitmap(hps&)
  263.     CASE IDMBIT+10 TO IDMBIT+34
  264.       CALL DemoSystemBitmaps(hps&, lastgpi%)
  265.     CASE ELSE
  266.   END SELECT
  267. END SUB
  268.  
  269.  
  270. '│**************************************************************
  271. '│ Displays message boxes to determine if the user really wants to quit
  272. '│ The box is displayed a maximum of three times with a slightly different
  273. '│ message every time "YES" is selected from the message box.  If "YES"
  274. '│ is selected on the third message box, the program is terminated.
  275. '│
  276. SUB DoYouReallyWantToQuit(hwnd&)
  277. message$ = "Are you sure you want to QUIT?" + chr$(0)
  278. caption$ = " " + chr$(0)
  279. IF DisplayMessageBox%(message$, caption$) = MBIDYES THEN
  280.   message$ = "Are you positive?" + chr$(0)
  281.   caption$ = " " + chr$(0)
  282.   IF DisplayMessageBox%(message$, caption$) = MBIDYES THEN
  283.     message$ = "Are you absolutely positively sure you really want to QUIT?" + chr$(0)
  284.     caption$ = " " + chr$(0)
  285.     IF DisplayMessageBox%(message$, caption$) = MBIDYES THEN
  286.       bool% = WinPostMsg(hwnd&, WMQUIT, 0&, 0&)
  287.     END IF
  288.   END IF
  289. END IF
  290. END SUB
  291.  
  292.  
  293. '│**************************************************************
  294. '│ Using WinMessageBox, this routine displays a message box using the
  295. '│ message and caption contained in "message$" and "caption$"
  296. '│ The message box contains a question mark icon, and a "YES" and "NO"
  297. '│ pushbutton.
  298. '│
  299. FUNCTION DisplayMessageBox%(message$, caption$)
  300. DisplayMessageBox% = WinMessageBox(_
  301.        HWNDDESKTOP, HWNDDESKTOP,_
  302.        MakeLong(VARSEG(message$), SADD(message$)),_
  303.        MakeLong(VARSEG(caption$), SADD(caption$)),_
  304.        0,_
  305.        MBYESNO OR_
  306.        MBICONQUESTION OR_
  307.        MBAPPLMODAL)
  308. END FUNCTION
  309.  
  310.  
  311. '│**************************************************************
  312. '│ Simply converts a double precision value to a fixed point 32 bit value,
  313. '│ used by several routines in the various modules.
  314. '│
  315. FUNCTION MakeFixed&(realnum#)
  316.   MakeFixed& = realnum# * 2 ^ 16
  317. END FUNCTION
  318.