home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / PRONTDEM.ZIP / PRONTO.ZIP / DEMO / PRO.BAS < prev    next >
BASIC Source File  |  1990-11-29  |  12KB  |  479 lines
  1. ' PRONTO! PM demonstration program
  2. '
  3. ' This source code is provided for documentation scope only
  4. ' use it as a reference for the demo program included
  5. '
  6. ' (C) 1990 Artel Informatica Corp.
  7. '
  8. DECLARE SUB StringAssign(BYVAL SrcAdd&, BYVAL SrcLen%, BYVAL DstSeg%, BYVAL DstOff%, BYVAL DstLen%)
  9. DECLARE FUNCTION StrMake$ (stradd&, strlen%)
  10. DECLARE FUNCTION BasWndProc% (msg%, mp1&, mp2&)
  11. DECLARE FUNCTION Dialog00& (hdlg&, msg%, mp1&, mp2&)
  12. DECLARE FUNCTION Dialog01& (hdlg&, msg%, mp1&, mp2&)
  13. DECLARE FUNCTION Dialog02& (hdlg&, msg%, mp1&, mp2&)
  14. DECLARE SUB TestMenus ()
  15. DECLARE SUB TestFile ()
  16. DECLARE SUB TestXqprint ()
  17. DECLARE SUB TestXqline ()
  18. DECLARE SUB TextBox ()
  19. DECLARE SUB ProcessCommand (c%)
  20.  
  21. '
  22. ' this file contains functions declaration
  23. ' for PRONTO! PM
  24. ' Also include are the Basic translations for
  25. ' various PM constant as in OS/2 PM SDK
  26. '
  27. REM $INCLUDE: 'PRONTO.INC'
  28.  
  29. DEFINT A-Z
  30. '
  31. ' Initializations
  32. '
  33. DIM mallocbuf%(8192)
  34.  
  35. COMMON SHARED /NMALLOC/ mallocbuf%()
  36. COMMON SHARED CursState%, ViewCoord%, Panel1%, Panel2%, vClock%, CurPointer
  37. b% = 0
  38. CursState% = 0
  39. ViewCoord% = 0
  40. Panel1 = 0
  41. Panel2 = 0
  42. vClock = 0
  43. CurPointer = 0
  44. x& = 0!
  45. '
  46. b% = ProntoPM
  47. ' Initialize work with Presentation Manager
  48. b% = BStartPMWork
  49. ' Lets the dance begin
  50. q% = BCreateWindow
  51. ' Terminate work with Presentation Manager
  52. b% = BStopPMWork%
  53. ' That'all folks!
  54. END
  55.  
  56. '
  57. ' Window Procedure
  58. '
  59. FUNCTION BasWndProc% (msg%, mp1&, mp2&) STATIC
  60. BasWndProc% = 0
  61.   SELECT CASE msg%
  62.     CASE WMCREATE
  63.       b% = BSetAccelTable(701)
  64.       b% = BSetAppIcon(801)
  65.       ' creation: set window title
  66.       Titolo$ = "Artel PRONTO! PM Demo Program" + CHR$(0)
  67.       b% = BSetWindowTitle%(SSEGADD(Titolo$))
  68.       eb& = BMenu&(501, SSEGADD(Titolo$))
  69.       b% = BCheckMenuItem(509, vClock)
  70.  
  71.     CASE WMMOUSEMOVE
  72.     ' intercept mouse movements
  73.       IF ViewCoord THEN
  74.     CALL BreakLong(mp1&, x%, y%)
  75.     text$ = "[" + STR$(x%) + " - " + STR$(y%) + "]" + CHR$(0)
  76.     b = BXQprint(SSEGADD(text$), 3, 23, 0)
  77.       END IF
  78.  
  79.     CASE MCENDWP
  80.        ' this message is received when
  81.        ' the user exit from the memo editor
  82.        ' to read the content of the memo buffer you should
  83.        ' use:
  84.        b% = BGetWpBuffer%(StAdd&, StLen%)
  85.        text$ = StrMake$(StAdd&, StLen%)
  86.  
  87.     CASE MCENDSINPT
  88.       ' this message is received when the user
  89.       ' exit from an input field operation
  90.       b% = BGetSinpt%(StAdd&, StLen%)
  91.       text$ = StrMake$(StAdd&, StLen%)
  92.       text$ = text$ + CHR$(0)
  93.       b = BXQprint(SSEGADD(text$), 10, 15, 0)
  94.       CALL BreakLong(mp1&, hi%, lo%)
  95.       ' loword contains the exit code as specified
  96.       ' in pmbtool.cfg
  97.       text$ = "1Exit code from input field: "+str$(lo%)+chr$(0)
  98.       b% = BMessage(0, SSEGADD(text$), 1)
  99.  
  100.     CASE WMCOMMAND
  101.       CALL BreakLong(mp1&, hiword%, loword%)
  102.       Call ProcessCommand(loword%)
  103.  
  104.     CASE WMBUTTON1DOWN
  105.       CALL BreakLong(mp1&, hiword%, loword%)
  106.  
  107.     CASE ELSE
  108.       ' Default processing
  109.       BasWndProc% = 0
  110.   END SELECT
  111. END FUNCTION
  112.  
  113.  
  114. FUNCTION Dialog00& (hdlg&, msg%, mp1&, mp2&) STATIC
  115. Dialog00& = 0
  116.   SELECT CASE msg%
  117.     CASE WMINITDLG
  118.       text$ = "Jones & Jones inc." + CHR$(0)
  119.       b = BWriteEditControl(hdlg&, 257, SSEGADD(text$))
  120.       ' check box set
  121.       b = BCheckCBox(hdlg&, 264)
  122.       ' set focus on address field
  123.       b = BSetFocusOnItem%(hdlg&, 258)
  124.       Dialog00& = 1
  125.     CASE WMCOMMAND
  126.       CALL BreakLong(mp1&, hiword%, loword%)
  127.       SELECT CASE loword%
  128.     CASE 1
  129.       ' Ok pressed, closing dialog
  130.       b% = BReadEditControl(hdlg&, 257, StAdd&, StLen%)
  131.       text$ = StrMake$(StAdd&, StLen%)
  132.       ' read which radio button is selected
  133.       text$ = ""
  134.       IF BGetButtonState(hdlg&, 265) = 1 THEN
  135.         text$ = "3 months ?"
  136.       END IF
  137.       IF BGetButtonState(hdlg&, 266) = 1 THEN
  138.         text$ = "6 months ?"
  139.       END IF
  140.       IF BGetButtonState(hdlg&, 267) = 1 THEN
  141.         text$ = "12 months ?"
  142.       END IF
  143.       IF LEN(text$) = 0 THEN
  144.         text$ = "You don't select any contract"
  145.       END IF
  146.       text$ = "1" + text$ + CHR$(0)
  147.       b = BMessage(0, SSEGADD(text$), 5)
  148.       b = BWinBeep(2)
  149.       b = BEndDialog%(hdlg&, 1)
  150.       Dialog00& = 1
  151.     CASE 2
  152.       ' Cancel dialog
  153.       b = BEndDialog%(hdlg&, 1)
  154.       Dialog00& = 1
  155.     CASE 275
  156.       ' Pushed the "Next" Button
  157.       b = BDialog(279, 1)
  158.       Dialog00& = 1
  159.     CASE ELSE
  160.       Dialog00& = 1
  161.     END SELECT
  162.     CASE ELSE
  163.       ' Dont't bother about messages
  164.       Dialog00& = 0
  165.   END SELECT
  166. END FUNCTION
  167.  
  168. FUNCTION Dialog01& (hdlg&, msg%, mp1&, mp2&) STATIC
  169. Dialog01& = 0
  170.   SELECT CASE msg%
  171.     CASE WMINITDLG
  172.       ' load list box with elements name
  173.       a$ = "Hydrogen\Carbon\Oxygen\Nitrogen\Phosphor\Calcium\Uranium\Tecnetium"
  174.       DO
  175.     q = INSTR(a$, "\"): IF q = 0 THEN q = LEN(a$) + 1
  176.     text$ = LEFT$(a$, q - 1) + CHR$(0): a$ = MID$(a$, q + 1)
  177.     b = BAddListBoxEntry(hdlg&, 280, -1, SSEGADD(text$))
  178.       LOOP UNTIL a$ = ""
  179.       b = BSetFocusOnItem%(hdlg&, 280)
  180.       Dialog01& = 1
  181.     CASE WMCOMMAND
  182.       CALL BreakLong(mp1&, hiword%, loword%)
  183.       SELECT CASE loword%
  184.     CASE 1
  185.       ' pushed on Ok
  186.       b = BWinBeep(2)
  187.       b = BEndDialog%(hdlg&, 1)
  188.      Dialog01& = 1
  189.       CASE ELSE
  190.      Dialog01& = 1
  191.       END SELECT
  192.   CASE ELSE
  193.     ' Dont't bother about messages
  194.     Dialog01& = 0
  195.   END SELECT
  196. END FUNCTION
  197.  
  198. FUNCTION Dialog02& (hdlg&, msg%, mp1&, mp2&) STATIC
  199. Dialog02& = 0
  200.   SELECT CASE msg%
  201.     CASE WMINITDLG
  202.       Dialog02& = 1
  203.       b = BSetFocusOnItem%(hdlg&, 1)
  204.     CASE WMCOMMAND
  205.       CALL BreakLong(mp1&, hiword%, loword%)
  206.       SELECT CASE loword%
  207.     CASE 1
  208.       b = BWinBeep(3)
  209.       b = BEndDialog%(hdlg&, 1)
  210.       Dialog02& = 1
  211.     CASE ELSE
  212.       Dialog02& = 1
  213.       END SELECT
  214.   CASE ELSE
  215.     Dialog02& = 0
  216.   END SELECT
  217. END FUNCTION
  218.  
  219.  
  220. SUB TestFile
  221. ' This SUB test the directory function
  222. '
  223. ' N.B. the double backslash
  224. ' in the path$ string
  225. ' is necessary because
  226. ' the single backslash is the
  227. ' start character of an escape sequence in C
  228. path$ = "C:\\" + CHR$(0)
  229. extext$ = "*.*" + CHR$(0)
  230. b% = BGetDir(0, SSEGADD(path$), SSEGADD(extext$), StAdd&, StLen%)
  231. szFile$ = StrMake$(StAdd&, StLen%)
  232. IF LEN(szFile$) > 0 THEN
  233.   Conf$ = "1File selected\" + szFile$ + CHR$(0)
  234. ELSE
  235.   Conf$ = "1No file selected" + CHR$(0)
  236. END IF
  237. b% = BMessage%(0, SSEGADD(Conf$), 4)
  238. END SUB
  239.  
  240. SUB TestMenus
  241. '
  242. ' This SUB loads a user menu with the string text$
  243. ' then waits for a selection and display the result
  244. '
  245. text$ = "One\Two\Three\Four\Five\Six\Seven\Eight\Nine\Ten\Eleven\Twelve" + CHR$(0)
  246. q = BMenuSelect(SSEGADD(text$), 10, 10)
  247. text$ = "1Choosed: " + STR$(q) + CHR$(0)
  248. b% = BMessage%(0, SSEGADD(text$), 2)
  249. END SUB
  250.  
  251. SUB TestXqline
  252. '
  253. ' This SUB draw a series of lines using the first six colors
  254. ' from pmbtool.cfg (see)
  255. '
  256. b = BCls
  257. b = BChangePointer(1)
  258. for i = 1 to 39
  259.    b = BXLine(2*i,  2, 40, 12, 1, (i MOD 6)+1, 0)
  260.    b = BXLine(2*i, 23, 40, 12, 1, (i MOD 6)+1, 0)
  261. next
  262. b = BXLine(2, 2, 78, 23, 128, 1, 0)
  263. text$ = "PRONTO! PM"+CHR$(0)
  264. b = BXQprint(SSEGADD(text$), 35, 12, 1)
  265. text$ = "is the faster way to PM for Basic..."+CHR$(0)
  266. b = BXQprint(SSEGADD(text$), 35, 13, 3)
  267. b = BChangePointer(1)
  268. END SUB
  269.  
  270. SUB TestXqprint
  271. '
  272. ' This SUB reads the first 22 lines of text from the file
  273. ' PRONTO.TXT and writes them to the screen
  274. ' file format is as follows:
  275. ' "text", column, row, color index
  276. '
  277. b = BCls
  278. f = freefile
  279. j = 0
  280. open "PRONTO.TXT" for input as f
  281. do while not eof(f) and j < 22
  282.     input #f, text$, x, y, c
  283.     j = j+1
  284.     text$ = text$+chr$(0)
  285.     b = BXqprint(SSEGADD(text$), x, y, c)
  286. loop
  287. close f
  288. END SUB
  289.  
  290. SUB TestBox
  291. '
  292. ' This SUB draws some box on the screen using colors 1 - 6
  293. ' then after a delay, clears them and beeps.
  294. ' Note the pointer change during the delay phase.
  295. '
  296. b = BCls
  297. for i = 1 to 19
  298.    b = BXLine(2*i,  i, (2*i)+12, i+3, 1, (i MOD 6)+1, 1)
  299. next
  300. text$ = "PRONTO! PM"+CHR$(0)
  301. b = BXQprint(SSEGADD(text$), 39, 20, 1)
  302. Call Delay(500)
  303. for i = 1 to 19
  304.    b = BWinBeep(2)
  305.    b = BXqClear(2*i, i)
  306.    Call Delay(50)
  307. next
  308. b = BXQClear(39, 20)
  309. b = BWinBeep(3)
  310. END SUB
  311.  
  312. SUB Delay(HowMuch)
  313. '
  314. ' This SUB creates a delay proportional to the
  315. ' "HowMuch" value
  316. ' During delay phase, the pointer is changed to hourglass
  317. ' and the restored as an arrow
  318. '
  319. b = BChangePointer(1)
  320. for j = 0 to HowMuch
  321.    q# = sin(j)+cos(j)
  322. next j
  323. b = BChangePointer(0)
  324. END SUB
  325.  
  326. SUB ProcessCommand(cmd%)
  327. '
  328. ' This SUB processes commands received
  329. ' from the user's menu selection
  330. SELECT CASE cmd%
  331.    CASE 503
  332.       ' File...
  333.       CALL TestFile
  334.    CASE 504
  335.       ' User menu
  336.       CALL TestMenus
  337.    CASE 505
  338.       ' Other menu
  339.       e& = BMenu&(601, SSEGADD(Titolo$))
  340.    CASE 506
  341.       ' Print Test
  342.       CALL TestXqprint
  343.    CASE 507
  344.       ' Line test
  345.       CALL TestXqline
  346.    CASE 527
  347.       'Box Test
  348.       CALL TestBox
  349.    CASE 508
  350.       ' Clear screen
  351.       b% = BCls
  352.    CASE 509
  353.       ' Clock
  354.       IF vClock = 0 THEN
  355.      vClock = 1
  356.       ELSE
  357.      vClock = 0
  358.       END IF
  359.       b% = BShowTime(vClock)
  360.       b% = BCheckMenuItem(509, vClock)
  361.    CASE 512
  362.       ' First dialog box
  363.       b% = BDialog(256, 0)
  364.    CASE 513
  365.       ' Second dialog box
  366.       b% = BDialog(279, 1)
  367.    CASE 517
  368.       ' third dialog box
  369.       b% = BDialog(400, 2)
  370.    CASE 514
  371.       ' Cursor
  372.       b% = BLocate(10, 10)
  373.       IF CursState = 0 THEN
  374.      CursState = 1
  375.       ELSE
  376.      CursState = 0
  377.       END IF
  378.       b% = BSetCursor(CursState)
  379.       b% = BCheckMenuItem(514, CursState)
  380.    CASE 528
  381.       ' Input field
  382.       text$ = "Input Test" + CHR$(0)
  383.       b% = BSinpt(SSEGADD(text$), 10, 15, 10, 20)
  384.    CASE 515
  385.       ' Memo editor
  386.       text$ = "To invoke the memo editor use the bCreateWp call."+chr$(13)
  387.       text$ = text$+"You can easily set and read the contents of the "
  388.       text$ = text$+"memo buffer with bSetWpBuffer and bGetWpBuffer "
  389.       text$ = text$+"functions."+chr$(13)
  390.       text$ = text$+"Remember that input field and memo functions allows "
  391.       text$ = text$+"your application to exchange data to and from other "
  392.       text$ = text$+"applications using the Clipboard!"+chr$(0)
  393.       b% = BSetWpBuffer(SSEGADD(text$))
  394.       b% = BCreateWp
  395.    CASE 516
  396.       ' Change pointer
  397.       IF CurPointer = 0 THEN
  398.      CurPointer = 1
  399.       ELSE
  400.      CurPointer = 0
  401.       END IF
  402.       b% = BChangePointer(CurPointer)
  403.       b% = BCheckMenuItem(516, CurPointer)
  404.    CASE 522
  405.       ' Coordinates
  406.       IF ViewCoord = 0 THEN
  407.      ViewCoord = 1
  408.       ELSE
  409.      ViewCoord = 0
  410.       END IF
  411.       b = BCheckMenuItem(515, ViewCoord)
  412.    CASE 523
  413.       ' Text output
  414.       b% = BCls%
  415.       text$ = "Hello" + CHR$(0)
  416.       FOR i = 4 TO 22
  417.     b% = BXLine(50, i, 55, i + 1, 129, 0, 0)
  418.     b% = BXQprint(SSEGADD(text$), 51, i, 1)
  419.       NEXT i
  420.       b% = BXLine(30, 10, 36, 12, 129, 0, 0)
  421.       b% = BXQprint(SSEGADD(text$), 31, 11, 1)
  422.    CASE 524
  423.       ' Torture test
  424.       text$ = "Start Torture Test" + CHR$(0)
  425.       b% = BXQprint(SSEGADD(text$), 0, 1, 1)
  426.       FOR i% = 1 TO 1000
  427.      text$ = "Torture #. " + STR$(i%) + CHR$(0)
  428.      xcol% = (i% MOD 6) + 1
  429.      b% = BXQprint(SSEGADD(text$), 60, (i% MOD 15) + 1, xcol%)
  430.       NEXT i%
  431.       text$ = "End Torture Test" + CHR$(0)
  432.       b% = BXQprint(SSEGADD(text$), 60, 23, 0)
  433.       b% = BWinBeep(1)
  434.    CASE 525
  435.       ' Panel 1
  436.       IF Panel1% = 0 THEN
  437.      b% = BChildBox(10, 10, 50, 15, 0, 1)
  438.      text$ = "This is a panel" + CHR$(0)
  439.      b% = BXQprint(SSEGADD(text$), 11, 11, 0)
  440.      Panel1% = 1
  441.       ELSE
  442.      b% = BPopDList
  443.      Panel1% = 0
  444.       END IF
  445.       b% = BCheckMenuItem(525, Panel1%)
  446.    CASE 526
  447.       ' Panel 2
  448.       IF Panel2% = 0 THEN
  449.      b% = BChildBox(14, 12, 60, 18, 7, 1)
  450.      text$ = "This is a panel" + CHR$(0)
  451.      b = BXQprint(SSEGADD(text$), 15, 13, 0)
  452.      Panel2% = 1
  453.       ELSE
  454.      b% = BPopDList
  455.      Panel2% = 0
  456.      END IF
  457.      b% = BCheckMenuItem(526, Panel2)
  458.    '
  459.    ' second menu
  460.    '
  461.    CASE 603
  462.       ' Confirm
  463.       Conf$ = "3There are 3 buttons." + CHR$(0)
  464.       b% = BMessage%(0, SSEGADD(Conf$), 3)
  465.    CASE 604
  466.       ' Error
  467.       text$ = "Musk presence in drive C:" + CHR$(0)
  468.       b% = BError(SSEGADD(text$), 4242, 1)
  469.    CASE 605
  470.       ' Back to first menu
  471.       e& = BMenu&(501, SSEGADD(text$))
  472. END SELECT
  473. END SUB
  474.  
  475. FUNCTION StrMake$(stradd&, strlen%)
  476.     Call StringAssign(stradd&, strlen%, VARSEG(S$), VARPTR(S$), 0)
  477.     StrMake$ = S$
  478. END FUNCTION
  479.