home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / OS2BAS.ZIP / WINSTDIO.BAS < prev    next >
BASIC Source File  |  1989-08-30  |  11KB  |  298 lines
  1. '***********************************************************
  2. '* 
  3. '* Program Name: WinStdio.BAS
  4. '*
  5. '* Functions   :
  6. '*               WinPrint/WinPrintS
  7. '*               WinCLS/WinResetStdIO
  8. '*               WinInput/WinInkey$/KeyMsg
  9. '*               WinLocate/WinPOS/WinCSRLIN
  10. '*
  11. '* Description : This file provides the routines that do a
  12. '*               partial emulation of BASIC's standard input
  13. '*               and output routines.  These are good for
  14. '*               text output, but input is accomplished much
  15. '*               easier with entryfields inside dialog boxes.
  16. '***********************************************************
  17.  
  18.  
  19. REM $INCLUDE: 'PMBase.BI'
  20. REM $INCLUDE: 'OS2Def.BI'
  21. REM $INCLUDE: 'GpiChar.BI'
  22. REM $INCLUDE: 'GpiCont.BI'
  23. REM $INCLUDE: 'GpiLine.BI'
  24. REM $INCLUDE: 'WinMan1.BI'
  25. REM $INCLUDE: 'WinInput.BI'
  26.  
  27. '*** WinResetStdIO resets the position to the upper left corner of the
  28. '*   window without erasing. (Reset with erase is WinCLS.) This is
  29. '*   particularly useful to eliminate flashing from WinInput.
  30.  
  31. SUB WinResetStdIO(hwnd AS LONG, hps AS LONG)
  32.      DIM prcl AS RECTL
  33.      DIM ppointl AS POINTL
  34.  
  35.      bool% = WinQueryWindowRect(hwnd, MakeLong(VARSEG(prcl), VARPTR(prcl)))
  36.      ppointl.y = prcl.yTop
  37.      ppointl.x = 0
  38.      bool% = GpiMove(hps, MakeLong(VARSEG(ppointl), VARPTR(ppointl)))
  39.  
  40. END SUB
  41.  
  42. ' *** WinCLS clears the screen and uses WinResetStdIO to reset the cursor
  43. ' *   position to the "home" position.
  44.  
  45. SUB WinCLS(hwnd AS LONG, hps AS LONG)
  46.  
  47.      bool% = GpiErase(hps)
  48.      CALL WinResetStdIO(hwnd, hps)
  49.  
  50. END SUB
  51.  
  52. ' *** Used like the BASIC LOCATE statement, WinLocate will go to a row
  53. ' *   and column based upon the current character size.  This is mainly
  54. ' *   used when converting old BASIC programs, for exact pixel positioning
  55. ' *   GpiMove should be used.
  56.  
  57. SUB WinLocate(hwnd AS LONG, hps AS LONG, row AS INTEGER, col AS INTEGER)
  58.      DIM prcl AS RECTL
  59.      DIM ppointl AS POINTL
  60.      DIM psizfxBox AS SIZEF
  61.  
  62.      bool% = WinQueryWindowRect(hwnd, MakeLong(VARSEG(prcl), VARPTR(prcl)))
  63.      bool% = GpiQueryCharBox(hps,_
  64.                  MakeLong&(VARSEG(psizfxBox), VARPTR(psizfxBox)))
  65.      ppointl.y = prcl.yTop - (row - 1) * (psizfxBox.cy / &H10000)
  66.      ppointl.x = 0 + (col - 1) * (psizfxBox.cx / &H10000)
  67.      bool% = GpiMove(hps, MakeLong(VARSEG(ppointl), VARPTR(ppointl)))
  68. END SUB
  69.  
  70. ' *** WinPos can replace BASIC's POS function.  It returns the current
  71. ' *   horizonal position of the cursor, based upon the current character
  72. ' *   size.
  73.  
  74. FUNCTION WinPos%(hps AS LONG)
  75.       DIM ptl AS POINTL
  76.       DIM psizfxBox AS SIZEF
  77.       bool% = GpiQueryCurrentPosition(hps, MakeLong(VARSEG(ptl), VARPTR(ptl)))
  78.       bool% = GpiQueryCharBox(hps,_
  79.                               MakeLong&(VARSEG(psizfxBox), VARPTR(psizfxBox)))
  80.       WinPos% = 1 + ptl.x \ (psizfxBox.cx / &H10000)
  81. END FUNCTION
  82.  
  83. ' *** Replaces CSRLIN function in BASIC.  Returns the current line (row)
  84. ' *   position of the cursor, based on the current character size.
  85.  
  86. FUNCTION WinCSRLIN%(hwnd AS LONG, hps AS LONG)
  87.       DIM prcl AS RECTL
  88.       DIM ptl AS POINTL
  89.       DIM psizfxBox AS SIZEF
  90.  
  91.       bool% = WinQueryWindowRect(hwnd, MakeLong(VARSEG(prcl), VARPTR(prcl)))
  92.       bool% = GpiQueryCurrentPosition(hps, MakeLong(VARSEG(ptl), VARPTR(ptl)))
  93.       bool% = GpiQueryCharBox(hps,_
  94.                               MakeLong&(VARSEG(psizfxBox), VARPTR(psizfxBox)))
  95.       WinCSRLIN% = 1 + (prcl.yTop - ptl.y) \ (psizfxBox.cy / &H10000)
  96. END FUNCTION
  97.  
  98. ' *** WinPrintS functions like BASIC's PRINT statement, followed by a
  99. ' *   semicolon (but only string values may be printed):
  100. ' *       PRINT A$;  = WinPrintS(hps&, A$)
  101. ' *   Prints out a string without doing a CR/LF after it.
  102. ' *   To print out a numeric value, it must first be converted to a string
  103.  
  104. SUB WinPrintS(hps AS LONG, PString AS String)
  105.      DIM pptl AS POINTL
  106.      DIM psizfxBox AS SIZEF
  107.      DIM PtlStart AS POINTL
  108.  
  109.      bool% = GpiQueryCurrentPosition(hps,_
  110.                      MakeLong&(VARSEG(pptl), VARPTR(pptl)))
  111.      savey% = pptl.y
  112.      bool% = GpiQueryCharBox(hps,_
  113.                  MakeLong&(VARSEG(psizfxBox), VARPTR(psizfxBox)))
  114.      pptl.y = pptl.y - (psizfxBox.cy / 65536)
  115.      bool% = GpiCharStringAt(hps, MakeLong&(VARSEG(pptl), VARPTR(pptl)),_
  116.                  len(PString),_
  117.                  MakeLong&(VARSEG(PString), SADD(PString)))
  118.      bool% = GpiQueryCurrentPosition(hps,_
  119.                      MakeLong&(VARSEG(pptl), VARPTR(pptl)))
  120.      pptl.y = savey%
  121.      bool% = GpiMove(hps, MakeLong&(VARSEG(pptl), VARPTR(pptl)))
  122.  
  123. END SUB
  124.  
  125. ' *** WinPrint functions like a BASIC PRINT statement, but for string
  126. ' *   values only.  All numeric values must be converted to strings
  127. ' *   before being printed with this function.
  128.  
  129. SUB WinPrint(hps AS LONG, PString AS String)
  130.      DIM pptl AS POINTL
  131.      DIM psizfxBox AS SIZEF
  132.      DIM PtlStart AS POINTL
  133.  
  134.      bool% = GpiQueryCurrentPosition(hps,_
  135.                      MakeLong&(VARSEG(pptl), VARPTR(pptl)))
  136.      pptl.x = 0
  137.      bool% = GpiQueryCharBox(hps,_
  138.                  MakeLong&(VARSEG(psizfxBox), VARPTR(psizfxBox)))
  139.      pptl.y = pptl.y - (psizfxBox.cy / 65536)
  140.      CALL WinPrintS(hps, PString)
  141.      bool% = GpiMove(hps, MakeLong&(VARSEG(pptl), VARPTR(pptl)))
  142.  
  143. END SUB
  144.  
  145. '*** KeyMsg is a simple SUB program to be used in for a WMCHAR to
  146. '*   place keystrokes in a keyboard buffer. The characters placed
  147. '*   here are retrievable using WinInkey$ or WinInput% FUNCTIONs.
  148. '*   This SUB sends a WMPAINT message to trigger any active WinInput's.
  149. '*
  150. '*   USAGE:    (in ClientWndProc)
  151. '*             SELECT CASE msg%
  152. '*               ...
  153. '*               CASE WMCHAR
  154. '*                 CALL KeyMsg(hwnd&, mp1&, mp2&)
  155. '*               CASE ...
  156.  
  157. SUB KeyMsg(hwnd&, mp1&, mp2&)
  158.   SHARED KbdBuffer$
  159.   ascii% = mp2& AND 255
  160.  
  161.   'Ignore messages with Ctrl or Alt, or when key is released.
  162.   IF ((mp1& AND (KCKEYUP OR KCCTRL OR KCALT)) = 0) AND (ascii% <> 0) THEN
  163.     KbdBuffer$ = KbdBuffer$ + CHR$(ascii%)
  164.     bool% = WinInvalidateRect(hwnd&, 0, 0)    'InvalidateRect and PAINT to
  165.     bool% = WinSendMsg(hwnd&, WMPAINT, 0, 0)  'inform WinInput to check.
  166.   END IF
  167. END SUB
  168.  
  169. '*** WinInkey$ works essentially like the standard INKEY$ function.
  170. '*   The characters must first be buffered with KeyMsg.
  171.  
  172. FUNCTION WinInkey$
  173.   SHARED KbdBuffer$
  174.   IF KbdBuffer$ <> "" THEN
  175.     WinInkey$  = LEFT$ (KbdBuffer$, 1)          'Return/remove first
  176.     KbdBuffer$ = RIGHT$(KbdBuffer$, LEN(KbdBuffer$) - 1)
  177.   ELSE
  178.     WinInkey$  = ""    'Buffer empty, return empty string
  179.   END IF
  180. END FUNCTION
  181.  
  182. '*****************************************************************************
  183. '*  WinInput displays the prompt$ & inputs characters until a carriage return
  184. '*  and stores these in var$.
  185. '*
  186. '*  If there is no CR in the current buffer, the function will return 0. This
  187. '*  means the input is still active. The next time this WinInput is called
  188. '*  the input is concatenated onto the previous input. This should be used in
  189. '*  a WMPAINT message.
  190. '*
  191. '*  USAGE:   (in ClientWndProc)
  192. '*           SELECT CASE msg%
  193. '*             ...
  194. '*             CASE WMCHAR
  195. '*               CALL KeyMsg(hwnd&, mp1&,mp2&)
  196. '*               KeyPressed% = -1
  197. '*             CASE WMPAINT
  198. '*               hps&=WinBeginPaint(...)
  199. '*               IF KeyPressed% THEN
  200. '*                 CALL WinResetStdIO(hwnd&, hps&)
  201. '*                 KeyPressed% = 0
  202. '*               ELSE
  203. '*                 CALL WinCLS(hwnd&, hps&)
  204. '*               END IF
  205. '*               bool% = WinInput(hps&, prompt$, var$)
  206. '*               IF bool% THEN
  207. '*                 ... (process input)
  208. '*****************************************************************************
  209.  
  210. FUNCTION WinInput%(hps AS LONG, prompt AS STRING, var AS STRING)
  211.  
  212. '******************** DIMension variables for:
  213.   DIM pptl AS POINTL                 'GpiQueryCurrentPosition, GpiMove
  214.   DIM prectl AS RECTL                 'WinFillRect
  215.   DIM psizfxBox AS SIZEF             'GpiQueryCharBox
  216.  
  217.   WinInput% = -1                 'Default (MEANING: Input done)
  218.   IF var = "" THEN var = CHR$(0)           'Initialize with continuation (nul)
  219.   CALL WinPrintS(hps, prompt)              'Always display prompt
  220.  
  221.   IF INSTR(var, CHR$(0)) <> 0 THEN          'If Input is still active
  222.                          '(no continuation character [nul])
  223.  
  224.     var = LEFT$(var, LEN(var) - 1)        'Strip continuation character
  225.  
  226. '***** Loop to clear keyboard buffer using WinInkey.
  227. 'NOTE: Can NOT just wait in this loop for CR!
  228. '      MUST transfer control back to Message Loop
  229. '      to receive WMCHAR messages.
  230.  
  231.     a$ = WinInkey$
  232.     WHILE (a$ <> "") AND (a$ <> CHR$(13))    'Continue until buffer empty or CR
  233.       IF a$ <> CHR$(8) THEN             'Add key if not backspace
  234.         var = var + a$
  235.  
  236. '***** Backspace is a tricky character. Stringwise,
  237. '      the operation is simple (Strip last character).
  238. '      For display, must fill rect with background color.
  239. '      To get the rectangle to fill, several steps:
  240. '           1. Get current position (Left, Top)
  241. '           2. Get Final position   (Right,Top)
  242. '           3. Get character size   (GpiQueryCharBox)
  243. '           4. Shift top to allow for tails on previous line (1/4 height)
  244. '           5. Calculate Bottom by subtracting height from Top
  245. '           6. WinFillRect
  246. '           7. Move to initial position
  247. '           8. Strip last character
  248.  
  249.       ELSEIF var <> "" THEN
  250.  
  251.     '*** 1. Get initial position (after prompt)
  252.         bool% = GpiQueryCurrentPosition(hps,_
  253.                     MakeLong(VARSEG(pptl), VARPTR(pptl)))
  254.     prectl.xLeft = pptl.x
  255.     prectl.yTop  = pptl.y
  256.  
  257.     '*** 2. Display string to move to and get final position
  258.         CALL WinPrintS(hps, var)
  259.         bool% = GpiQueryCurrentPosition(hps,_
  260.                     MakeLong(VARSEG(pptl), VARPTR(pptl)))
  261.     prectl.xRight = pptl.x
  262.  
  263.     '*** 3. Get character size
  264.         bool% = GpiQueryCharBox(hps,_
  265.                 MakeLong(VARSEG(psizfxBox), VARPTR(psizfxBox)))
  266.  
  267.     '*** 4. Shift top by height/4
  268.     deltaY& = (psizfxBox.cy / 65536) * .25
  269.     prectl.yTop = prectl.yTop - deltaY&
  270.  
  271.     '*** 5. Calculate bottom
  272.     prectl.yBottom = prectl.yTop - deltaY& * 4
  273.  
  274.     '*** 6. WinFillRect
  275.         bool% = WinFillRect(hps,_
  276.                 MakeLong(VARSEG(prectl), VARPTR(prectl)),_
  277.                 CLRBACKGROUND)
  278.  
  279.     '*** 7. Locate back at initial position (after position)
  280.     pptl.x = prectl.xLeft
  281.     pptl.y = prectl.yTop + deltaY&       'Shift back
  282.         bool% = GpiMove(hps, MakeLong(VARSEG(pptl), VARPTR(pptl)))
  283.  
  284.     '*** 8. Strip last character
  285.         var = LEFT$(var, LEN(var) - 1)
  286.  
  287.       END IF
  288.       a$ = WinInkey$
  289.     WEND              'End of FlushBuffer loop
  290.  
  291.     IF a$ = "" THEN          'If end of buffer reached without CR [13]
  292.       WinInput% = 0          'WinInput fails (returns 0=FALSE)
  293.       var = var + CHR$(0)       'concatenate continuation character
  294.     END IF
  295.   END IF
  296.   CALL WinPrint(hps, var)       'Always print current variable string
  297. END FUNCTION
  298.