home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Share Gallery 1
/
share_gal_1.zip
/
share_gal_1
/
DB
/
DB012A.ZIP
/
VPI1_330.ZIP
/
DEMO.PRG
< prev
next >
Wrap
Text File
|
1991-12-30
|
17KB
|
692 lines
**********************************************************************
* DEMO.PRG VP-Info demo program...selfrunning with delay factor
* escape re-starts
* ┌──────────────────┐
* │ Version 3.30 │
* └──────────────────┘
* NOTES to USER: Tue 12-24-1991 15:28:26
* subroutines required: DEMOLOAD.PRG,DEMO2.PRG,DEMODISP.PRG
* data files required: DEMOINV.DBF, DEMOCUST.DBF, DEMOTEMP.DBF,
* DEMOGL.DBF and DEMOTRN.DBF
* index files required: DEMOGL1.DBF, DEMOTRN1.DBF
* library file required: DEMO.LIB ┌────────────────┐
* text file required: DEMO.TXT,NEW.TXT │ always compile │
* report form required: DEMO.FRM └────────────────┘
* Always works from menu...self-running selection is timed in seconds
* other options ding bell + require key to proceed
* If you want to change text in list of features, edit DEMO.TXT and NEW.TXT
* \+ means new screen with color change, \\ means same screen + new color
* fields on \+ line: 4-9 is screen num, 10-19 is offset from column 25
* (C) Copyright 1986-1991 Sub Rosa International Inc.
* Sid Bursten and Bernie Melman
**********************************************************************
GLOBAL graph
DIM char 50 flash[12]
DIM num d[4],b2[11],menus[4,2],
DIM char texts[2]
DO DEMOLOAD
SET TALK OFF
SCREEN 1,2
menuset=1
SCREEN 1,3
DO WHILE t
ON error
SCREEN 1
WINDOW
:color=:serial
COLOR 7 0 0 24 79
? 'Execution terminated on error:',:message
CANCEL
ENDON
ON escape
SCREEN 1
PERFORM fullerase
SET function on
COLOR RED 0 0 24 79
ERASE
@ 10,10 say 'Demonstration interrupted . . . '
@ 12,10 say 'Press <ENTER> key to continue . . . spacebar to quit.'
RING
signal=inkey()
IF signal=13
CHAIN demo
ELSE
ok=close()
:color=:serial
WINDOW
ERASE
CANCEL
ENDIF
ENDON
delay=4
delay2=delay
pause=t
junk=0
SCREEN 2
PERFORM fullerase
:color=:serial
COLOR 96 0 0 24 79
COLOR bold 1 1 23 78
COLOR ruby 13,7,19,70
WINDOW 1,1,23,78 blank
?
TEXT .5 ;menu
SCREEN 2,1
SCREEN 1
* SCREEN tear
CURSOR 15,33*menuset-25
:color=ruby
menuchoice=menu(5,30)
IF menuchoice=0 .or. :key=335 .or. :key=327 ;home or end keys
SET function on
COLOR lightblue 0 0 24 79
:color=:serial
WINDOW
CLS
ok=close()
CANCEL
ENDIF
menuchoice=menuchoice+5*menuset-5
:color=0
IF :key=331 .or. :key=333
menuset=iff(menuset=1,2,1)
LOOP
ENDIF
menuset=1
DO CASE
CASE menuchoice=1
DO WHILE t
PERFORM features
IF graphics
PERFORM graphics
ENDIF
PERFORM menus
PERFORM reports
PERFORM screens
PERFORM flash
repeating=f
PERFORM dates
PERFORM speed
ENDDO
CASE menuchoice=2 .or. menuchoice=3
PERFORM features
CASE menuchoice=4
PERFORM graphics
CASE menuchoice=5
PERFORM menus
CASE menuchoice=6
DO DEMODISP
CASE menuchoice=7
PERFORM reports
CASE menuchoice=8
PERFORM screens
PERFORM flash
PERFORM dates
CASE menuchoice=9
PERFORM speed
CASE menuchoice=10
CHAIN samples
ENDCASE
:color=:serial
ENDDO
*
************************ procedures ****************************
*
PROCEDURE features
ok=close()
textfile=iff(menuchoice=3,2,1)
WINDOW
IF .not. ropen(texts[textfile])
? !(trim(texts[textfile])),'not found'
CANCEL
ENDIF
ii=4
PERFORM fullerase
COLOR 96 0 0 24 79
COLOR white 0 3 24 76
WINDOW 1,5,23,74 double
ok=sseek(1)
DO WHILE read(data)
DO CASE
CASE data='\+'
IF val($(data,4,7))>0
PERFORM delay2
DELAY 1
offset=val($(data,10,10))
WINDOW 7,26+offset,22,51+offset double
ii=ii+1
COLOR b2[mod(ii,10)+1] 6,25+offset,23,52+offset
scr=val($(data,4,7))
TEXT .scr
WINDOW
PERFORM DELAY
WINDOW 1,5,23,74 double
ELSE
IF .not. (data='\+\' .or. data='\++') ;top or end of file
PERFORM DELAY
ENDIF
ENDIF
ii=ii+1
IF data<>'\++\' ;end of file
COLOR b2[mod(ii,10)+1],0,3,24,76
ERASE
ENDIF
row1=1
CASE data='\\'
?
PERFORM delay2
ii=ii+1
COLOR b2[mod(ii,10)+1],row1,6,row(),73
row1=row()+1
OTHERWISE
:color=b2[mod(ii+4,10)+1]
? data
ENDCASE
ENDDO
PERFORM delay
WINDOW
:color=0
ENDPROCEDURE features
*
PROCEDURE graphics
DO DEMO2
ENDPROCEDURE graphics
*
PROCEDURE screens
SCREEN 2
PERFORM fullerase
COLOR white 0 0 24 79
@ 10,5 say cen('VP-Info gives you complete control of your computer...',70)
SCREEN 1
SCREEN 2,1 ;left
PERFORM delay
PERFORM fullerase
WINDOW 3,3,23,75 blank
COLOR blue 3 3 23 75
COLOR gold 8 3 13 77
COLOR yellow 17 3 22 77
:color=ruby
@ 2,3 say cen('VP-Info can scroll windows',72)
PERFORM delay3
:color=black
@ 5,3 say cen('Windows can scroll up!',72)
PERFORM delay2
@ 24,80
SELECT 1
GOTO TOP
:color=blue
@ 7,3 say 'CUSTN NAME ADDRESS RECORD'
:color=gold
WINDOW 8,3,12,73 blank
REPEAT 5 times vary i
? custn,name,add:1,i
SKIP
PERFORM delay5
ENDREPEAT
REPEAT 5 times
SCROLL up
i=i+1
?? custn,name,add:1,i
SKIP
PERFORM delay5
ENDREPEAT
:color=bold
@ 14,3 say cen('. . . and windows can scroll DOWN!',72)
PERFORM delay2
:color=red
@ 16,3 SAY 'STYLE COL DESCRIPTION QUANT COST RECORD'
PERFORM delay3
SELECT 2
GOTO TOP
:color=yellow
WINDOW 17,3,21,55 blank
REPEAT 5 times vary i
? style,color,descript,quant,cost,i
SKIP
PERFORM delay5
ENDREPEAT
REPEAT 5 times
SCROLL down
i=i+1
?? style,color,descript,quant,cost,i
SKIP
PERFORM delay5
ENDREPEAT
PERFORM delay
ENDPROCEDURE screens
*
PROCEDURE dates
SCREEN 2
PERFORM fullerase
COLOR white 0 0 24 79
@ 10,5 say cen('VP-Info gives you complete control of dates and time...',70)
SCREEN 1
SCREEN 2,1 ;right
PERFORM delay
PERFORM FULLERASE
offset=10
:color=bold
@ 2,5 say cen("VP-Info PROVIDES EVERY DATE AND TIME FUNCTION YOU'LL EVER NEED",70)
PERFORM delay2
:color=blue
@ 4,offset+02 say 'Date formats:'
PERFORM delay2
:color=blue
@ ROW(),offset+20 say '1. '+date(1)
PERFORM delay3
:color=magenta
@ ROW()+1,offset+22 say '2. '+date(2)
PERFORM delay3
:color=gold
@ ROW()+1,offset+24 say '3. '+date(3)
PERFORM delay3
:color=lightblue
@ ROW()+1,offset+26 say '4. '+date(4)
PERFORM delay3
:color=yellow
@ ROW()+1,offset+28 say '5. '+date(5)
PERFORM delay3
:color=bold
@ ROW()+1,offset+30 say '6. '+date(6)
PERFORM delay3
:color=blue
@ ROW()+1,offset+32 say '7. '+date(7)
PERFORM delay3
:color=red
@ ROW()+1,offset+34 say '8. '+date(8)
PERFORM delay3
:color=white
@ ROW()+1,offset+36 say '9. '+date(9)
PERFORM delay2
offset=5
:color=ruby
@ 14,offset+02 say 'Time formats:'
PERFORM delay2
:color=gold
@ 14,offset+20 say '1. '+time(1)
PERFORM delay3
:color=blue
@ 14,offset+35 say '2. '+time(2)
PERFORM delay3
:color=yellow
@ 14,offset+50 say '3. '+time(3)+' seconds'
:color=black
PERFORM delay2
offset=5
@ 16,offset+10 say 'This date is 30 days from today ........ '+date(6,days( date(1),30))
PERFORM delay3
@ 17,offset+10 say 'and this date is 60 days in the past ... '+date(6,days( date(1),-60))
PERFORM delay3
@ 19,5 say cen('The number of days to Christmas ...... '+str(days( date(1),thisyr+'1225'),6),70)
PERFORM delay3
@ 21,5 say cen('Dates in data files may use any of the date formats',70)
PERFORM delay2
COLOR ruby+64,4,4,12,75
PERFORM delay3
COLOR bold+64, 14 4 14 75
PERFORM delay3
COLOR blue+64 16,4 17,75
PERFORM delay
ENDPROCEDURE dates
*
PROCEDURE flash
SCREEN 2
PERFORM fullerase
@ 10,5 say cen('VP-Info gives you complete control of colors and grahics...',70)
SCREEN 1
SCREEN 2,1 ;up
PERFORM delay
PERFORM fullerase
COLOR white 0 0 24 79
COLOR bold+64 0 0 24 79
COLOR ruby+64 00 00 5 79
COLOR yellow+64 06 00 20 09
COLOR black+64 06 70 20 79
COLOR gold+64 20 00 24 79
BOX 01 01 04 78 double
BOX 07 01 19 08 double
BOX 07 71 19 78 double
BOX 21 01 24 78 double
:color=133
BOX 02 02 03 77
:color=134
BOX 08 02 18 07
:color=131
BOX 08 72 18 77
:color=132
BOX 22 02 23 77
:color=blue
@ 6,32 say ' VP-Info Features '
WINDOW 08,11,20,68
COLOR bold 10 10 14 69
PERFORM delay2
REPEAT 10 times varying i
:color=b2[i]
? flash[i]
PERFORM delay4
ENDREPEAT
REPEAT 10 times vary i
COLOR b2[i]+128 i+09 12 i+09 67
PERFORM delay3
COLOR b2[i] i+09 12 i+09 67
ENDREPEAT
PERFORM delay
ENDPROCEDURE flash
*
PROCEDURE reports
firm=cen(:company,45)
rdate=date(4)
SCREEN 1,2
SCREEN 2
PERFORM fullerase
*********************************introduction, fields keyword only
:color=blue
WINDOW 1,1,23,78 double
TEXT .9
SCREEN 1
SCREEN 2,1 ;down
PERFORM delay
*********************************output of fields keyword only
SCREEN 1,2
SCREEN 2
:color=ruby+64
COLOR ruby+64 10 20 23 78
WINDOW 10,20,23,78 double
TEXT .13
SCREEN 2,1
SCREEN 1
PERFORM delay
*********************************salary report specs
SCREEN 1,2
SCREEN 2
PERFORM fullerase
COLOR blue 0 0 24 79
:color=blue
WINDOW 1,1,14,68 double
TEXT .15
* SCREEN 2,1
SCREEN 1
delay2=1.5*delay
SCREEN 2,1 ;open
PERFORM delay
*********************************salary report, page 1
SCREEN 1,2
SCREEN 2
:color=black+64
COLOR black+64 4 17 20 63
WINDOW 4,17,20,63 double
TEXT .18
SCREEN 2,1
SCREEN 1
delay2=1.5*delay
PERFORM delay
*********************************salary report page 2
SCREEN 1,2
SCREEN 2
:color=red
COLOR red 6 31 24 79
WINDOW 7,32,23,78
TEXT .21
SCREEN 2,1
SCREEN 1
PERFORM delay
*********************************intro relations, 2 subtotals
SCREEN 1,2
SCREEN 2
PERFORM fullerase
COLOR red 0 0 24 79
WINDOW 1,1,23,78 double
:color=red
TEXT .22
* SCREEN 2,1
SCREEN 1
delay2=1.5*delay
SCREEN 2,1 ;close
PERFORM delay
*********************************sales rept, pg 1
SCREEN 1,2
SCREEN 2
:color=black+64
COLOR black+64 1 27 23 63
WINDOW 1,17,23,63
TEXT .27
SCREEN 2,1
SCREEN 1
delay2=1.5*delay
PERFORM delay
*********************************sales rept, pg 2
SCREEN 1,2
SCREEN 2
:color=blue
COLOR blue 0 31 24 79
WINDOW 1,32,23,78
TEXT .30
SCREEN 2,1
SCREEN 1
delay2=1.5*delay
PERFORM delay
ENDPROCEDURE reports
*
PROCEDURE menus
SCREEN 1,2
SCREEN 2
PERFORM fullerase
COLOR blue 0,0,24,79
CURSOR 2,0
GO#1 top
LIST#1 next 18 pic(custn'xx-xx-xx'),name,add:1 off
CURSOR 0,0
SET function off
TEXT
FIRST MENU SECOND MENU THIRD MENU FOURTH MENU
ENDTEXT
go_up=t
count=0
menuset=1
lastset=0
SCREEN 2,3
DO WHILE t
IF menuset<>lastset
SCREEN 2
SCREEN 3,2
offset=(menuset-1)*18
COLOR b2[menuset]+64,1,offset+3,1,offset+14
:color=b2[menuset+2]+64
WINDOW 3,offset+3,4+menus[menuset,2],offset+23 double
:color=b2[menuset+4]
row1=menus[menuset,1]
TEXT .row1
SCREEN 2,1
SCREEN 1
ENDIF
IF menuchoice=1 .or. menuchoice=9
count=count+1
PERFORM switch
PERFORM delay3
IF count>8
BREAK
ENDIF
LOOP
ENDIF
:key=0
CURSOR 5,offset+3
ans=menu(menus[menuset,2],20)
RING
DO CASE
CASE :key=331 .and. menuset>1
menuset=menuset-1
CASE :key=333 .and. menuset<4
menuset=menuset+1
CASE :key=331
@ 22,5 say insert(blank(70),cen('No menu to left...try again',70),1)
PERFORM delay2
@ 22,5
CASE :key=333
@ 22,5 say insert(blank(70),cen('No menu to right...try again',70),1)
PERFORM delay2
@ 22,5
CASE ans=0
BREAK
OTHERWISE
@ 22,10 say str(ans,2)+' is what you have selected...it would now be performed'
PERFORM delay2
@ 22,0
ENDCASE
ENDDO
menuset=1
SET function on
ENDPROCEDURE menus
*
PROCEDURE switch
limit=menus[menuset,2]
menuch2=mod(count,limit)+1
COLOR b2[mod(count,10)+1],menuch2+4,offset+3,menuch2+4,offset+21
@ 22,10 say str(menuch2,2)+' is what has been selected...it would now be performed'
PERFORM delay2
@ 22,0
DO CASE
CASE go_up .and. menuset>3
go_up=f
menuset=3
CASE go_up
menuset=menuset+1
CASE .not. go_up .and. menuset<2
menuset=2
go_up=t
CASE .not. go_up
menuset=menuset-1
ENDCASE
ENDPROCEDURE switch
*
*PROCEDURE files
* DO DEMODISP
*ENDPROCEDURE files
*
PROCEDURE speed
* PERFORM fullerase
* COLOR white 0 0 24 79
* :color=white
* ERASE 10,11
* @ 1,0 say date(4)
* :color=bold
* @ 3,0 say cen('COMPARING 4 DATABASE LANGUAGES',75)
* :color=ruby
* @ 4,0 say cen("Number of records that can be indexed in THREE minutes",70)
* PERFORM delay3
* :color=white
* BOX 7 5 7 75
* BOX 10 5 10 75
* BOX 13 5 13 75
* BOX 16 5 16 75
* BOX 19 5 19 75
* BOX 4 5 19 5
* BOX 20 5 20 75
* @ 20,5 say chr(192)
* PERFORM delay3
* @ 7,0 say '20000'
* @ 10,0 say '15000'
* @ 13,0 say '10000'
* @ 16,0 say ' 5000'
* @ 19,0 say ' -0- '
* PERFORM delay3
* :color=yellow
* @ 21,10 say 'dBASE II'
* @ 21,25 say 'dBASE III'
* @ 21,40 say 'dBASE III+'
* :color=ruby
* @ 21,55 say 'VP-Info!'
* @ 24,80
* PERFORM delay2
* IF graphics
* COLOR 111 18 10 19 20
* PERFORM delay3
* COLOR 31 18 25 19 35
* PERFORM delay3
* COLOR 79 11 40 19 50
* PERFORM delay3
* COLOR 47 3 55 19 65
* ELSE
* BOX 18 10 19 20
* PERFORM delay3
* BOX 18 25 19 35
* PERFORM delay3
* BOX 11 40 19 50
* PERFORM delay3
* BOX 3 55 19 65
* ENDIF
* :color=gold
* @ 23,03 say 'Tested on IBM AT, key of 6, record of 7'
* :color=magenta
* PERFORM delay
PERFORM fullerase
WINDOW 9,10,14,69 double
COLOR blue+64 8 8 15 71
TEXT .43
PERFORM delay
pause=f
PERFORM features
IF graphics
PERFORM graphics
ENDIF
PERFORM menus
PERFORM reports
PERFORM screens
repeating=t
PERFORM features
repeating=f
PERFORM flash
PERFORM dates
pause=t
ENDPROCEDURE speed
*
PROCEDURE fullerase
WINDOW
:color=0
ERASE
ENDPROCEDURE fullerase
*
PROCEDURE delay
IF pause
IF menuchoice=1
RING
DELAY delay2
ELSE
@ 23,50 say 'Press spacebar'
RING
ok=inkey()
@ 23,50 say blank(15)
ENDIF
delay2=delay
ENDIF
ENDPROCEDURE delay
*
PROCEDURE delay2
IF pause
RING
DELAY 2
ENDIF
ENDPROCEDURE delay2
*
PROCEDURE delay3
IF pause
RING
DELAY 1
ENDIF
ENDPROCEDURE delay3
*
PROCEDURE delay4
IF pause
RING
DELAY 1
ENDIF
ENDPROCEDURE delay4
*
PROCEDURE delay5
IF pause
RING
DELAY .5
ENDIF
ENDPROCEDURE delay5
*
* *** end of program DEMO.PRG ***