Programmer 7500

home *** CD-ROM | disk | FTP | other *** search

/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / MISC / VPI1_330.ZIP / DEMO.PRG < prev next >

Wrap

Text File | 1991-12-30 | 16.3 KB | 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 ***