home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / qb_pds / screen / qbscreen / demo.bas < prev    next >
Encoding:
BASIC Source File  |  1986-12-16  |  3.1 KB  |  118 lines
  1.       REM INCLUDE$: 'LISTING.BAS'
  2.       DEFINT A-Z
  3.       REM $INCLUDE: 'COMDIM.BAS'
  4.       REM $INCLUDE: 'SHARED.BAS'
  5.       REM $INCLUDE: 'COMDEF.BAS'
  6.  
  7. REM   Define screen field headings.
  8.  
  9.       DIS$(10)="05,03,REV,ACCOUNT #"
  10.       DIS$(11)="05,14,REV,  P.O. #  "
  11.       DIS$(12)="05,26,REV,SHIP TO #"
  12.       DIS$(13)="08,02,REV,ITEM #"
  13.       DIS$(14)="08,09,REV,  CATALOG  #  "
  14.       DIS$(15)="08,24,REV,VENDOR"
  15.       DIS$(16)="08,31,REV,   DESCRIPTION/COMMENT    "
  16.       DIS$(17)="08,58,REV,UM"
  17.       DIS$(18)="08,61,REV, ORD QTY "
  18.       DIS$(19)="08,71,REV,  PRICE  "
  19.  
  20. REM   Define screen input fields.
  21.  
  22.       INP$(1)="06,05,NUM,5,NO,ACCT"
  23.       INP$(2)="06,14,ALP,10,YES,PO"
  24.       INP$(3)="06,29,NUM,3,YES,SHIPTO"
  25.       INP$(4)="09,02,NUM!NODEF,6,NO,ITEM"
  26.       INP$(5)="09,09,ALP,14,NO,CAT"
  27.       INP$(6)="09,24,ALP,6,NO,VEND"
  28.       INP$(7)="09,31,ALP,26,YES,DESC"
  29.       INP$(8)="09,58,ALP!FIX,2,YES,UM"
  30.       INP$(9)="09,61,NUM!DEC,9,NO,QTY"
  31.       INP$(10)="09,71,NUM!DEC,9,YES,PRICE"
  32.  
  33.  
  34.  
  35.  
  36. REM   Display field headings.
  37.  
  38.       HEADS$="10,11,12,13,14,15,16,17,18,19"
  39.       CALL DISHEADS (HEADS$)
  40.  
  41.       EDITMODE=NO
  42.  
  43. ADD.HEADER:
  44.       EXITSUB=NO
  45.  
  46. REM   Display function key definitions.
  47.  
  48.       FUNC$=",,,Exit"
  49.       CALL FUNCTIONS (FUNC$)
  50.  
  51. ADD.HEADER.LOOP:
  52.  
  53.       CLRF$="1,2,3"
  54.       INPS$="1,2,3"
  55.       FLDS$="1,2,3"
  56.       VOID$="6,5,31"
  57.       CALL GETFIELDS (CLRF$,INPS$,FLDS$,VOID$)
  58.       IF EXITSUB  = YES THEN END
  59.       IF KY       = ESC THEN GOTO ADD.HEADER.LOOP
  60.  
  61. REM   Display function key definitions.
  62.  
  63.       FUNC$=",,,End order"
  64.       CALL FUNCTIONS (FUNC$)
  65.  
  66. ADD.DETAIL:
  67.       CLRF$="4,5,6,7,8,9,10"
  68.       INPS$="4,5,6,7,8,9,10"
  69.       FLDS$="4,5,6,7,8,9,10"
  70.       VOID$="9,2,79"
  71.       CALL GETFIELDS (CLRF$,INPS$,FLDS$,VOID$)
  72.       IF EXITSUB  = YES THEN GOTO ADD.HEADER
  73.       IF KY       = ESC THEN GOTO ADD.DETAIL
  74.  
  75.       GOTO ADD.DETAIL
  76.  
  77.  
  78.  
  79. SUB GETFIELDS (CLRF$,INPS$,FLDS$,VOID$) STATIC
  80.       EXITSUB=NO
  81.       IF CLRF$<>"" THEN CALL CLEARFIELDS (CLRF$)
  82.       CALL LODWK1 (INPS$,I)
  83.       CALL LODWK2 (FLDS$,F)
  84.       IF I > F THEN N=WRK1%(I) : I=I-1 ELSE N=1
  85.       WHILE N<=I
  86.       F$=ORFLD$(WRK2%(N))
  87.       CALL ACCEPT (INP$((WRK1%(N))),F$)
  88.       IF KY = F4                     THEN EXITSUB=YES : EXIT SUB
  89.       IF KY = F5                     THEN DATSW=YES
  90.       IF KY = CTRL.LF                THEN N=N+(N>1)
  91.       IF KY = CTRL.RT                THEN N=N-(N<I)
  92.       IF KY = ESC AND VOID$<>""      THEN EN=106 : CALL DISERR (EN,ER$) : CALL CLRLIN (VOID$) : EXIT SUB
  93.       IF KY = 0                      THEN LSET ORFLD$(WRK2%(N)) = F$ : N=N+1
  94.       WEND
  95. END SUB
  96.  
  97. SUB CLRLIN (LIN$) STATIC
  98.       CALL LODWK2 (LIN$,F)
  99.       LOCATE WRK2%(1),WRK2%(2) : COLOR 7,0 : PRINT SPC((WRK2%(3)-WRK2%(2))+1);
  100. END SUB
  101.  
  102. SUB CLEARFIELDS (FLDS$) STATIC
  103.       CALL LODWK2 (FLDS$,F)
  104.       FOR N = 1 TO F
  105.       LSET ORFLD$(WRK2%(N))=""
  106.       NEXT N
  107. END SUB
  108.  
  109. SUB DISHEADS (HEADS$) STATIC
  110.       CALL LODWK1 (HEADS$,I)
  111.       BUMP=0
  112.       N=1
  113.       WHILE N<=I
  114.       CALL DISPLAY (DIS$((WRK1%(N))),NULL$,BUMP)
  115.       N=N+1
  116.       WEND
  117. END SUB
  118.