home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / pb / library4 / boxes-u.bas < prev    next >
Encoding:
BASIC Source File  |  1990-08-21  |  7.9 KB  |  226 lines
  1.  
  2.  
  3.  
  4. '==============================================================================
  5. '                    THE FOURTH UNIT -- BOXES-U.BAS
  6. '==============================================================================
  7. '                                                               -- 2-18-90
  8.                             $COMPILE UNIT
  9.                             $ERROR ALL OFF
  10.  
  11.  
  12.  DEFINT A-Z
  13.  
  14.  EXTERNAL RD$, ColorDisplay, NeedDCon
  15.  EXTERNAL BoxColor, FldColor, WinColor, CursorTop, CursorBottom, Ln, Col
  16.  EXTERNAL PressAKeyBeep$, OopsBeep$, TinyBeep$
  17.  EXTERNAL LocalAreaCode$, Record%
  18.  EXTERNAL BXScreenSaved, PMScreenSaved
  19.  EXTERNAL FieldName$(), FieldMask$(), FL(), FC(), Fields%
  20.  
  21. SUB BOXMESSAGE(CornerLin, CornerCol, Margin) PUBLIC
  22. '   ====                   Boxes and displays your message.
  23. '                          Top L. corner will be at the designated coordinates,
  24. '                          but errors are trapped so box will stay on the
  25. '                          screen regardless. The message line should appear
  26. '                          in your code as DATA statements, terminated by
  27. '                          "END". A RESTORE statement is needed, of course.
  28. '                          See HBDEMO.BAS for examples & comments.
  29.  
  30.  LOCAL I$(), Maxx, Items%, D$
  31.  
  32.   LOCATE ,,0 '                                           extinguish the cursor
  33. BReadlines:
  34.  DIM I$(23)                      ' each I$ is a msg line; # of lines is Items%
  35.  READ D$
  36.  WHILE D$ <> "END" AND Items% < 23 '                          (from data list)
  37.    INCR Items% '                                                 count 1 item
  38.    I$(Items%) = D$ '                                   plug the data into array
  39.    IF LEN(D$) > Maxx THEN Maxx = LEN(D$)  '         Maxx = length of longest I$()
  40.    READ D$ '                                                    ... and repeat.
  41.    WEND
  42.  
  43.           CALL BOXMESSAGE2 (CornerLin, CornerCol, Margin, I$(), Items%, Maxx)
  44.  
  45.  END SUB                                                         REM BOXMESSAGE
  46. '______________________________________________________________________________
  47.  
  48. SUB BOXMESSAGE2 (CornerLin, CornerCol, Margin, I$(1), Items%, Maxx) PUBLIC
  49. ' Use this call if you wish to set text lines -- I$() -- at runtime instead
  50. '  of using DATA statements ...
  51.  
  52.  LOCAL Wid, Height, I, P, Y, Z, F, Bar$
  53.  
  54. BSetVars:
  55.  Wid = Maxx + 4 + 4*Margin '                                  compute box size --
  56.  Height = Items%+2 + 2*Margin
  57.  IF Wid > 80 THEN Wid = 80
  58.  IF Height > 24 THEN Height = 24
  59.  
  60.  IF CornerCol = 0 THEN CornerCol = 41 - Wid \ 2
  61.  CornerCol = ABS(CornerCol): IF CornerCol > 80-Wid THEN CornerCol = 80-Wid
  62.  
  63.  IF CornerLin = 0 THEN CornerLin = 13 - Height \ 2
  64.  CornerLin = ABS(CornerLin):IF CornerLin > 25-Height THEN CornerLin = 25-Height
  65. '                                             error traps keep box on screen
  66.  
  67.  Bar$ = "\"+SPACE$(Wid-4)+"\" '                                 set a line mask
  68.  
  69. BPrint:
  70.  
  71.  LOCATE CornerLin, CornerCol
  72.  I = BoxColor MOD 16
  73.  P = BoxColor \ 16 '                 set local variables for colors and
  74.  IF P > 7 THEN
  75.    DECR P, 8: F = 16 '   if box is to flash, set I as nonflashing
  76.    BoxColor = BoxColor - %Flash
  77.  END IF
  78.  COLOR  I + F ,  P
  79.  '                                                                print top bar
  80.  PRINT CHR$(201);: PRINT STRING$((Wid-2),205);: PRINT CHR$(187);
  81.  Z = CornerLin+1
  82.  
  83. IF Margin > 0 THEN
  84.   FOR Y = 1 TO Margin
  85.     LOCATE Z ,CornerCol
  86.     COLOR  I + F ,  P : PRINT CHR$(186);: COLOR  I , P
  87.     PRINT USING Bar$;" ";
  88.     COLOR  I + F ,  P : PRINT CHR$(186);: COLOR  I , P
  89.     INCR Z
  90.   NEXT
  91. END IF
  92.  '
  93.                                       ' print message lines
  94.  FOR Y = 1 TO Items%
  95.    LOCATE Z,CornerCol
  96.    COLOR  I + F ,  P : PRINT CHR$(186);: COLOR  I , P '  print border char.
  97.    PRINT USING BAR$;SPACE$(2*Margin+(Maxx-Len(I$(Y)))/2+.9)+I$(Y);
  98. '          count off enough spaces to center the characters then print 'em ...
  99.    COLOR  I + F ,  P : PRINT CHR$(186); '    and print right hand border.
  100.    INCR Z
  101.  NEXT
  102.  
  103.  IF Margin THEN '                print appropriate # of blank lines for margin
  104.    FOR Y = 1 TO Margin
  105.     LOCATE Z,CornerCol
  106.     COLOR  I + F ,  P : PRINT CHR$(186);: COLOR  I , P
  107.     PRINT USING Bar$;" ";
  108.     INCR Z
  109.     COLOR  I + F ,  P : PRINT CHR$(186);
  110.    NEXT
  111.  END IF
  112.  '                                                             print bottom bar
  113.  LOCATE Z,CornerCol,1:PRINT CHR$(200);:PRINT STRING$((Wid-2),205);
  114.    PRINT CHR$(188);
  115.  COLOR  I ,  P
  116.  
  117.  
  118.  END SUB                                                        REM BOXMESSAGE2
  119.  
  120. ' =============================================================================
  121.  
  122.  
  123. SUB POPWINDOW  PUBLIC                         ' print a data entry window ...
  124. '                                                and set up its lookup table
  125.  
  126.  LOCAL X, Y, Z, Title$, CornerCol, CornerLin, Prompt$, Ht, A$
  127.  COLOR WinColor MOD 16, WinColor \ 16
  128.  READ A$: Wid = VAL(A$)
  129.  READ A$: CornerLin = VAL(A$)
  130.  READ A$: CornerCol = VAL(A$)
  131.  READ A$: Ht = VAL(A$)
  132. '                                                       print top of window ...
  133.  LOCATE CornerLin, CornerCol: PRINT CHR$(201);
  134.                 PRINT STRING$((Wid-2),205);: PRINT CHR$(187);
  135.  
  136.  FOR Z = CornerLin+1 TO CornerLin+Ht-2 '                              sides ...
  137.     LOCATE Z, CornerCol: PRINT CHR$(186);SPACE$(Wid-2); CHR$(186);
  138.  NEXT Z
  139.  '                                                  ... print bottom bar.
  140.  LOCATE Z, CornerCol:PRINT CHR$(200);
  141.                 PRINT STRING$((Wid-2),205);: PRINT CHR$(188);
  142.  
  143.   READ Prompt$, X, Y '               place prompts in window (you hope ...)
  144.  DO
  145.   LOCATE X, Y: PRINT Prompt$
  146.   READ Prompt$: IF Prompt$ <> "END" THEN READ X, Y
  147.  LOOP UNTIL Prompt$ = "END"
  148.  
  149.  COLOR FldColor MOD 16, FldColor \ 16
  150.  
  151.  Z=1
  152.  
  153.  READ FieldName$(Z),FieldMask$(Z),FL(Z),FC(Z) '      create the table for
  154. '                                                      this record data window
  155.  DO
  156.    LOCATE FL(Z),FC(Z)
  157.    PRINT SPACE$ (LEN(FieldMask$(Z))) '                 print a blank field ...
  158.   INCR Z
  159.   READ FieldName$(Z)
  160.   IF FieldName$(Z) <> "END" THEN READ FieldMask$(Z), FL(Z), FC(Z)
  161.  LOOP UNTIL FieldName$(Z) = "END"
  162.  
  163.  
  164.  Fields% = Z-1
  165.  
  166.  END SUB
  167.  
  168. ' ----------------------------------------------------------------------------
  169.  
  170.  
  171. SUB PWSetUp (Fld$,Z) PUBLIC    ' sets up to ENTER a record field at the right
  172. '                         location in a pop-up data record window using the
  173. '                         lookup table (FieldName$() etc.). When a match is
  174. '                         found the cursor is placed. The subscript # used
  175. '                         is returned as the parameter Z.
  176.  
  177.  Z = 1
  178.  
  179.  DO UNTIL FieldName$(Z) = Fld$                         'find fld name in table
  180.   INCR Z
  181.   IF Z > Fields% THEN
  182.      BEEP
  183.      LOCATE 25,1
  184.      PRINT "            PWSetUp error: window for "+Fld$+" not open !!!          "
  185.      DO: LOOP UNTIL INKEY$ <> ""
  186.      END 1
  187.   END IF
  188.  LOOP
  189.  
  190.  LOCATE FL(Z), FC(Z)
  191.  
  192.  END SUB                                                REM PWSetUp
  193.  
  194. ' =========================================================================
  195. SUB QBOX (L, C, Lines%, Message$, AnsFldLength) PUBLIC
  196.  
  197.   LOCAL I$(), AFCol, AFLin, Items, Maxx
  198.   DIM I$(4)
  199.  
  200.   IF Lines% > 1 THEN
  201.     IF C = %Center THEN C = 80 - (LEN (Message$) - AnsFldength - 4) / 2
  202.     I$(1) = Message$
  203.     Items% = 3
  204.     I$(2) = " "
  205.     I$(3) = " "
  206.     AFCol = C + 2
  207.     IF LEN (Message$) > AnsFldLength THEN _
  208.       INCR AFCol, (LEN(Message$)-AnsFldLength)/2
  209.     AFLin = L+3
  210.     Maxx = LEN(Message$)
  211.     IF AnsFldLength > Maxx THEN Maxx = AnsFldLength
  212.   ELSE
  213.     IF C = %Center THEN C = (76 - LEN (Message$)) / 2
  214.     I$(1) = Message$+SPACE$(AnsFldLength)
  215.     Items% = 1
  216.     AFCol = C + 2 + LEN (Message$)  '  or 6
  217.     AFLin = L+1
  218.     Maxx = LEN(Message$)+AnsFldLength
  219.   END IF
  220.   CALL BOXMESSAGE2 (L,C,0,I$(),Items%,Maxx)
  221.   LOCATE AFLin,AFCol,1
  222.   END SUB
  223.  
  224.     '  with L & C set correctly for and ENTER call -- Wowee !!!
  225.  
  226.