home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / qb_pds / window / mask10 / maskdemo.bas < prev    next >
Encoding:
BASIC Source File  |  1988-01-02  |  8.0 KB  |  149 lines
  1. '                              MASKINPUT
  2. '                       (C) 1987 By Kevin L. Curtis
  3. '                              12/30/87
  4. '
  5. '     Routine Name:  MASKINPUT
  6. '          Version:  1.0
  7. '       Written by:  Kevin L. Curtis
  8. '         Language:  QuickBASIC 3.0
  9. '
  10. '          Purpose:  A highly versatile user input routine that uses
  11. '                    a mask$ value passed much like the picture function
  12. '                    in some popular Data Base products.
  13. '
  14. '******************** NOTE ** NOTE ** NOTE ** NOTE ** NOTE ** NOTE ***********
  15. '
  16. '     MASKDEMO.EXE:  Demo file for maskinput.  For Green/Amber Graphics
  17. '                    monitors such as Compaq, AT&T, use the command line
  18. '                    MASKDEMO BW.  This will make default colors black &
  19. '                    white so you can read the screen without sunglasses.
  20. '*****************************************************************************
  21. '
  22. '          Example:  mask$ = "(   )   -    "   for phone number or
  23. '                    mask$ = space$(40)        for blank field.
  24. '
  25. 'Parameters passed:  row%,col%,FieldTextAttr%,mask$,DefaultVal$,ReturnVal$,
  26. '                     ftype% = 0
  27. '            Where:  row% = Row for field input.
  28. '                    col% = Column for field input.
  29. '                    FieldTextAttr% = Use ADVBAS CALL CALCATTR(foreground%,_
  30. '                            background%,FieldTextAttr%) to get FieldTextAttr% value or
  31. '                            (BACKGROUND * 16) + FOREGROUND = Attr%.
  32. '                    mask$ = What ever you want your field to look like.
  33. '                            "   -  -   " or "  /  /  "
  34. '                    DefaultVal$ = the default value for the field.  This
  35. '                                  text will be left justified so use spaces
  36. '                                  if you want it in a special postion.
  37. '                    ReturnVal$ = the return value form user input
  38. '                    ftype% = 0 for alphanumeric, -1 for numeric values only
  39. '                    Exitkey% = the ASC number of the key that exited the
  40. '                               routine.  Use this to verify special functions.
  41. '
  42. 'NEXT VERSION IMPROVEMENTS: Minimum and maximum value validation with
  43. '                           automatic maximum validation from lenth of
  44. '                           mask$ if no maximum value is passed.  Will
  45. '                           also allow for commas and decimal places so
  46. '                           you can use the data returned with the PRINT
  47. '                           USING statement.
  48. '
  49. '   NOTES:  When I use this routine I define a global array for special
  50. '           keys.  This will let you to check for HELP of Allowable ENTER
  51. '           or EXIT keys like: F1 - F10; TAB; CURSOR UP/DOWN PGUP/DN ect.
  52. '           This allows you to exit the routine and take care of a request-
  53. '           ed function like HELP and then return the ReturnVal$ as the
  54. '           DefaultVal$ putting the user back where they left via the
  55. '           ReturnCurrentPOS% value.
  56. '
  57. 'This is a Shareware product.  If you find it useful a donation of your
  58. 'choice 1$-10$ would be appreciated. I will be upgrading the product in
  59. 'the near future.  How soon depends on your response.
  60. '
  61. 'If you upload this file to your favorite BBS, please leave these comments
  62. 'and instructions complete and intact.  As for yourself, go ahead and delete
  63. 'all of the comments so you don't have to page down 20 times everytime you
  64. 'want to look at the source code.
  65. '
  66. 'SEND DONATIONS AND/OR COMMENTS TO:
  67. '
  68. '                      SoftwareValue FLAP  ->(For Little As Possible)
  69. '                      7710 Swiss
  70. '                      Rowlett, TX 75088
  71. '                      (214)475-7586
  72. '
  73.  
  74.  
  75.  
  76.  
  77. '════════════════ These variables are a MUST for using MASKINPUT ══════════
  78. '************** DECLARE SOME COMMON VARIABLES **************
  79. COMMON SLColor%,StatRow%,StatCol%,LastKey%,NormAttr%,SkColor%,FieldChar%
  80. COMMON ReturnCurrentPOS%,FGColor%,BGColor%
  81. '*************** DIM GLOBAL ARRAYS ****************
  82. DIM SHARED maskpos%(40,1), COLPOS%(80), FieldPos%(80)
  83. '*************** INCLUDE FILES NEEDED ********************
  84. REM $INCLUDE : 'STATLIN.INC'    ' Contains routine for CAPS INS SCRL NUM
  85. REM $INCLUDE : 'GETKEY.INC'     ' Loop for getting a key and updateing statlin
  86. REM $INCLUDE : 'STATUS.INC'     ' Routine for displaying Status Line Messages
  87. REM $INCLUDE : 'GETVIDMO.INC'   ' Returns the Video Mode
  88. REM $INCLUDE : 'MASK.INC'       ' MaskInput Routine
  89. '*********************************************************
  90. '═══════════════════════════ END OF MUST variables ══════════════════════
  91.  
  92. '************************ MASKDEMO.EXE PROGRAM ********************
  93. CALL GetVidMode(Vmode%)
  94. IF COMMAND$ = "BW" OR LEFT$(command$,1) = "M" THEN vmode%=2
  95. IF vmode% = 7  OR vmode% = 2 THEN    'IF it's MONO Monitor or B&W
  96.     call calcattr(0,7,SkColor%):CALL CALCATTR(0,7,SLColor%)
  97.     call calcattr(15,0,NormTextAttr%): call calcattr(7,0,NormAttr%)
  98.     call calcattr(0,7,FieldTextAttr%) : FGColor% = 7 : BGColor% = 0
  99. ELSE
  100.     call calcattr(1,7,SkColor%):CALL CALCATTR(1,7,SLColor%)
  101.     call calcattr(15,1,NormTextAttr%): call calcattr(7,1,NormAttr%)
  102.     call calcattr(1,7,FieldTextAttr%) : FGColor% = 7 : BGColor% = 1
  103. END IF
  104.  
  105. row% = 5: col% = 10:FieldChar% = 32:StatRow%= 25: StatCol%=60: LastKey% = 1
  106. '******************** DEFINE THE MASK AND DEFAULT VALUE ********************
  107. mask$ = "(   )   -    "    ' Our mask template for user input
  108. 'mask$ = space$(40)        ' Example of a blank field
  109. DefaultVal$ = "214"               ' This gives us a default area code for phone number
  110. ReturnVal$ = ""                  ' NULL new value
  111. COLOR 15,BGColor%,BGColor%:cls           ' Set colors and clear screen
  112. CALL XQPRINT("F1 FOR MORE INFORMATION - ESC TO QUIT DEMO",1,1,15,0)
  113. call xqprint(space$(80),25,1,SkColor%,0)    'Make sure the status line is clear
  114.  
  115. '********************** SOME TEXT FOR THE DEMO *********************
  116. call xqprint("Parameters Passed :  mask$ = "+chr$(34)+"(  )   -    "+chr$(34),2,26,NormTextAttr%,0)
  117. call xqprint("default_value$ = "+chr$(34)+"214"+chr$(34),3,47,NormTextAttr%,0)
  118. call xqprint("Notice the 214 default and the cursor positioned at the",5,25,NormTextAttr%,0)
  119. call xqprint("first available space on the field ready for your input",6,25,NormTextAttr%,0)
  120. call xqprint("This is the status line for INS CAPS NUM & SCRL",23,33,NormTextAttr%,0)
  121. call xqprint(chr$(25)+"    "+chr$(25)+"    "+chr$(25)+"    "+chr$(25),24,62,NormTextAttr%,0)
  122. call xqprint("PHONE",5,4,NormTextAttr%,0)
  123.  
  124. '******************** CALL THE MASKINPUT ROUTINE ********************
  125. call MASKINPUT(row%,col%,FieldTextAttr%,mask$,DefaultVal$,ReturnVal$,-1,Exitkey%)  'CALL MASKINPUT ROUTINE
  126. lnth% = LEN(ReturnVal$)
  127. call xqprint("The length of the value phone is "+STR$(lnth%),8,25,NormTextAttr%,0)
  128. call xqprint("The returned value for phone is "+ReturnVal$,9,25,NormTextAttr%,0)
  129. LOCATE 15,1,0 : COLOR FGColor%,BGColor%,BGColor%
  130. m1$ = "Notice how the returned value of phone is only the raw"
  131. m2$ = "data that you typed in and not any part of the mask$"
  132. m3$ = "value that you pased to the routine."
  133. call xqprint(m1$,11,25,NormTextAttr%,0) : call xqprint(m2$,12,25,NormTextAttr%,0)
  134. call xqprint(m3$,13,25,NormTextAttr%,0)
  135. call xqprint("Try Ctrl "+chr$(27)+" and Ctrl "+chr$(26)+" for next and previous word",16,1,NormTextAttr%,0)
  136. call xqprint("Try BACKSPACE with INSERT ON and INSERT OFF.  ALT-B will blank the field.",17,1,NormTextAttr%,0)
  137. '******************** DEFINE THE MASK AND DEFAULT VALUE ********************
  138. mask$ = space$(60)          'Use space$(n%) function for blank mask values
  139. DefaultVal$ = "Very good customer.  Expect large sales volume in 1988." 'default value
  140. call xqprint("COMMENT:",19,1,NormTextAttr%,0)
  141. '******************** CALL THE MASKINPUT ROUTINE ********************
  142. call MASKINPUT(19,10,FieldTextAttr%,mask$,DefaultVal$,ReturnVal$,0,Exitkey%)
  143. LOCATE ,,0
  144. call delay(2)       'delay 1 second
  145. COLOR 7,0,0 : CLS:LOCATE ,,1
  146. end                 'bye bye - end of demo
  147. '********************* END OF MASKDEMO PROGRAM **************************
  148.  
  149.