'╔══════════════════════════════════════════════════════════════════════════╗
'║ VIDEO INVOER PROGRAMMA VI140929.BAS @JH ║
'╚══════════════════════════════════════════════════════════════════════════╝
' Pagina 2 : INIT:'toets definities 'gemeenschappelijke variabelen
' Pagina 3 : 'sprite definities
' Pagina 4 : 'openen / lezen files FILEOPEN: 'veld definities VELD:
' Pagina 5 : INVOER:
' Pagina 6 :
' Pagina 7 :
' Pagina 8 : MENUNR: up: dn:
' Pagina 9 : DATANUMMER: sub datanummernr (a$,src$) sub gegwis
' Pagina 10 : DATUM: DATUMSELECT: sub datumwissel (a$,b$)
' Pagina 11 : TAPENR: TAPENRSELECT: TAPETYPE:
' Pagina 12 : sub tapetyperead sub tapetypenr (a$)
' Pagina 13 : sub tapetypewrite (i%,hlp1$,cmd$)
' Pagina 14 : TAPETYPESELECT:
' Pagina 15 : STARTTELLER: STOPTELLER:
' Pagina 16 : TIJDSELECT:
' Pagina 17 : sub secnaartyd (m$,t$)
' def fnREKEN (n1,n2,n3) def fnLENGTE (n1,n2,l%)
' Pagina 18 : SUBJECT: sub subjectread sub subjectnr (a$)
' Pagina 19 : sub subjectwrite (i%,hlp1$,cmd$)
' Pagina 20 : SUBJECTSELECT:
' Pagina 21 : TITEL: sub titelnr (a$)
' Pagina 22 : TITELSELECT:
' Pagina 23 : MAKER: sub makernr (a$)
' Pagina 24 : MAKERSELECT:
' Pagina 25 : OPMERKING: sub opmerkingnr (a$)
' Pagina 26 : OPMERKINGSELECT:
' Pagina 27 : SPOELEN: SPOELENSELECT: sub datumwissel
' Pagina 28 : sub invulpagina (r%,k%,l%,w%,cmd$,a$)
' Pagina 29 : sub tempmake
' Pagina 30 : sub tempnr (a$) sub tempset (a%,b%,c%,d%) sub tempprn (a$)
' Pagina 31 : sub tempshow sub tempnaarTXTbestand
' Pagina 32 : sub tempnaarHTMbestand
' Pagina 33 : sub toets (onoff%)
' Pagina 34 : sub tekst
' Pagina 35 :
' Pagina 36 :
' Pagina 37 : sub tekstkeuze (hlp1$,hlp2$,k%,b2$,k2%,b3$,k3%)
' Pagina 38 : sub tekstnaarTXTbestand
' Pagina 39 : sub tekstnaarHTMbestand
' Pagina 40 : def fnSPRITEBYTE (x%,y%) sub spriteload (spt%(),hlp$)
' sub bandteken sub bandwis sub funtoets
' Pagina 41 : sub layout 'VIDEO CASSETTE
' Pagina 42 : 'VIDEO RECORDER
' Pagina 43 : sub gegsave (a$) sub indexsave
' Pagina 44 : sub bandvrij sub info Modified 20080414
' Pagina 45 : 'KLEUREN
' Pagina 46 :
' Pagina 47 :
' Pagina 48 :
' Pagina 49 :
' Pagina 50 :
'
Pagina 2
'-----------------------------------------------------
INIT:
'toets definities
keyENT$=chr$(13)
keyESC$=chr$(27)
keyBSP$=chr$(8)
keyTAB$=chr$(9)
keyUP$=chr$(0)+chr$(72)
keyDN$=chr$(0)+chr$(80)
keyLE$=chr$(0)+chr$(75)
keyRI$=chr$(0)+chr$(77)
keyINS$=chr$(0)+chr$(82)
keyDEL$=chr$(0)+chr$(83)
keyHOM$=chr$(0)+chr$(71)
keyEND$=chr$(0)+chr$(79)
keyPGU$=chr$(0)+chr$(73)
keyPGD$=chr$(0)+chr$(81)
keyF1$=chr$(0)+chr$(59)
keyF2$=chr$(0)+chr$(60)
keyF3$=chr$(0)+chr$(61)
keyF4$=chr$(0)+chr$(62)
keyF5$=chr$(0)+chr$(63)
keyF6$=chr$(0)+chr$(64)
keyF7$=chr$(0)+chr$(65)
keyF8$=chr$(0)+chr$(66)
keyF9$=chr$(0)+chr$(67)
keyF10$=chr$(0)+chr$(68)
keyF11$=chr$(0)+chr$(133)
keyF12$=chr$(0)+chr$(134)
qm$=chr$(34)
'gemeenschappelijke variabelen
shared n%,hn%,dat$,tpn$,ttp$,pass%,font%,font$,size%,size$,qm$
shared stt$,stp$,sjt$,ttl$,mkr$,opm$
shared htn%,tdtn$,tstp$,tttp$,spl$
shared ttpi%,ttpi$,tl0$,tl1$,tl2$,tn1$,tn2$
shared l0%,l1%,l2%,n1,n2,l3%,l4%,l5%,ttpm%
shared sjti%,sjti$,sjtm%
shared ttli%,ttli$,ttlm%
shared mkri%,mkri$,mkrm%
shared opmi%,opmi$,opmm%
shared ttsp0%(),ttsp1%(),ttss0%(),ttss1%()
shared ttsf0%(),ttsf1%(),ttsr0%(),ttsr1%()
shared ttso0%(),ttso1%(),ttso2%()
shared ttst0%(),ttst1%(),ttsm0%(),ttsm1%(),ttsn0%(),ttsn1%()
shared vld4%(),vld4a%(),vld8%(),vld10%(),vld20%(),vld20a%()
shared deg#,cel%,ncel%,dtm$,ttsd,mnu%,tmd%,l5%
shared sdat1$,sdat2$,sdtm1$,sdtm2$,sdtn1$,sdtn2$,skri$
shared stpn$,sttp$,ssjt$,sttl$,smkr$,sopm$
shared sstt1%,sstt2%,sstp1%,sstp2%
shared tmp1$,tmp2$,tmp3$,tmp4$,tmpi%,tmpm%,tmpk%
shared jpg%,jpeg$()
shared keyENT$,keyESC$,keyBSP$,keyTAB$,keyUP$,keyDN$,keyLE$,keyRI$
shared keyINS$,keyDEL$,keyHOM$,keyEND$,keyPGU$,keyPGD$
shared keyF1$,keyF2$,keyF3$,keyF4$,keyF5$,keyF6$
shared keyF7$,keyF8$,keyF9$,keyF10$,keyF11$,keyF12$
'
Pagina 3
'-----------------------------------------------------
'sprite definities
d%=fnSPRITEBYTE (45,25)
dim ttsp0%(d%)
call spriteload (ttsp0%(),"VI-PICS\VITTSP0.PIC")
dim ttsp1%(d%)
call spriteload (ttsp1%(),"VI-PICS\VITTSP1.PIC")
dim ttss0%(d%)
call spriteload (ttss0%(),"VI-PICS\VITTSS0.PIC")
dim ttss1%(d%)
call spriteload (ttss1%(),"VI-PICS\VITTSS1.PIC")
dim ttsr0%(d%)
call spriteload (ttsr0%(),"VI-PICS\VITTSR0.PIC")
dim ttsr1%(d%)
call spriteload (ttsr1%(),"VI-PICS\VITTSR1.PIC")
dim ttsf0%(d%)
call spriteload (ttsf0%(),"VI-PICS\VITTSF0.PIC")
dim ttsf1%(d%)
call spriteload (ttsf1%(),"VI-PICS\VITTSF1.PIC")
dim ttso0%(d%)
call spriteload (ttso0%(),"VI-PICS\VITTSO0.PIC")
dim ttso1%(d%)
call spriteload (ttso1%(),"VI-PICS\VITTSO1.PIC")
dim ttso2%(d%)
call spriteload (ttso2%(),"VI-PICS\VITTSO2.PIC")
d%=fnSPRITEBYTE (45,23)
dim vld4%(d%)
call spriteload (vld4%(),"VI-PICS\VIVLD4.PIC")
dim vld4a%(d%)
call spriteload (vld4a%(),"VI-PICS\VIVLD4A.PIC")
d%=fnSPRITEBYTE (69,23)
dim vld8%(d%)
call spriteload (vld8%(),"VI-PICS\VIVLD8.PIC")
d%=fnSPRITEBYTE (85,23)
dim vld10%(d%)
call spriteload (vld10%(),"VI-PICS\VIVLD10.PIC"):'=H85V23.077
d%=fnSPRITEBYTE (168,24)
dim vld20%(d%)
call spriteload (vld20%(),"VI-PICS\VIVLD20.PIC"):'=H168V24.0??
dim vld20a%(d%)
call spriteload (vld20a%(),"VI-PICS\VIVLD20A.PIC")
d%=fnSPRITEBYTE (16,16)
dim ttst0%(d%)
call spriteload (ttst0%(),"VI-PICS\VITTST0.PIC")
dim ttst1%(d%)
call spriteload (ttst1%(),"VI-PICS\VITTST1.PIC")
dim ttsm0%(d%)
call spriteload (ttsm0%(),"VI-PICS\VITTSM0.PIC")
dim ttsm1%(d%)
call spriteload (ttsm1%(),"VI-PICS\VITTSM1.PIC")
dim ttsn0%(d%)
call spriteload (ttsn0%(),"VI-PICS\VITTSN0.PIC")
dim ttsn1%(d%)
call spriteload (ttsn1%(),"VI-PICS\VITTSN1.PIC")
'
Pagina 4
'-----------------------------------------------------
'openen / lezen files
FILEOPEN:
close
open "R",#1,"VI-DATA\VIDEO.FL1",184
open "R",#2,"VI-DATA\VIDEO.FL2",80
open "R",#3,"VI-DATA\VIDEO.TTP",37
open "R",#4,"VI-DATA\VIDEO.SJT",20
open "R",#5,"VI-DATA\VIDEO.TME",10
open "I",#6,"VI-DATA\VIDEO.IND"
input #6,hn%: '───────hoogste datanummer
input #6,htn%: '───────hoogste tapenummer
input #6,ttpm%:'───────tapetypemax
input #6,sjtm%:'───────subjectmax
input #6,ttlm%:'───────titelmax
input #6,mkrm%:'───────makermax
input #6,opmm%:'───────opmerkingmax
input #6,pass%:'───────password
input #6,size%:'───────lettergrootte
input #6,font%:'───────lettertype
close #6
ttpi%=1:sjti%=1
call titelnr (ltrim$(str$(ttlm%)))
call makernr (ltrim$(str$(mkrm%)))
call opmerkingnr (ltrim$(str$(opmm%)))
ttsd=0.1:mnu%=1
open "R",#7,"VI-DATA\VIDEO.TTL",80
open "R",#8,"VI-DATA\VIDEO.MKR",80
open "R",#9,"VI-DATA\VIDEO.OPM",80
open "R",#10,"VI-DATA\VIDEO.TMP",16
open "R",#11,"VI-DATA\VIDEO.SPL",6
call jpegnaartabel
'veld definities
VELD:
'───────n%=datanummer / dat$=uitzenddatum / tpn$=tapenummer
'───────ttp$=tapetype / stt$=start / stp$=stop /
'───────sjt$=onderwerp / ttl$=titel / mkr$=maker
'───────spl$=spoeldatum
field #1,8 as dat$,4 as tpn$,2 as ttp$,4 as stt$,4 as stp$,_
2 as sjt$,80 as ttl$,80 as mkr$
field #2,80 as opm$
field #3,20 as ttpi$,3 as tl0$,3 as tl1$,4 as tn1$,3 as tl2$,4 as tn2$
field #4,20 as sjti$
field #5,4 as tdtn$,4 as tstp$,2 as tttp$
field #7,80 as ttli$
field #8,80 as mkri$
field #9,80 as opmi$
field #10,4 as tmp1$,4 as tmp2$,4 as tmp3$,4 as tmp4$
field #11,6 as spl$
select case font%
case 0:font$="Terminal "
case 1:font$="Verdana "
case 2:font$="Garamond "
case 3:font$="Times New Roman"
case 4:font$="Courier New "
case 5:font$="Arial "
end select
size$=ltrim$(str$(size%))
deg#=atn(1)/45
n%=1:'───────datanummer
'$SEGMENT
'
Pagina 5
'-----------------------------------------------------
INVOER:
'───────======
call layout
if pass%=0 then gosub menunr
'───────ZOEK LEEG RECORD
for n%=1 to hn%
get #1,n%
get #2,n%
locate 25,37
color 10
b$=using$("####",n%)
replace " " with "0" in b$
print b$
if tpn$="****" then exit for
next n%
cmd$=""
cel%=0
if n%>hn% then call gegwis
if hn%=0 then lset ttp$="01"
call toets (1)
call funtoets
call tekst
call bandteken
gosub MENUNR
'───────do 1
do until cmd$=keyESC$
'───────do 2
do
'───────do 3
do until cmd$<>""
cmd$=inkey$
loop
'───────loop 3
'
Pagina 6
'-----------------------------------------------------
select case cmd$
case keyUP$:gosub up
case keyDN$:gosub dn
case keyBSP$,keyTAB$
case keyF1$:if mnu%=1 then get #1,n%:get #2,n%:call tekst
case keyF2$:call info
case keyF3$,keyF4$,keyF5$,keyF6$,keyF8$,keyF9$:if mnu%=2 then exit loop
case keyF10$:if pass%>0 then gosub MENUNR
case keyF11$:call lettersize
case keyF12$:call lettertype
case else
select case cel%
case 0,3,6
select case cmd$
case keyDEL$
case keyENT$
case keyF7$
if mnu%=1 then
if cel%=0 then
call gegsave (cmd$)
exit loop
else
call indexsave
end if
end if
case keyF9$:tmd%=tmd% xor 1:call funtoets
case else:exit loop
end select
case 1,2,4,5
select case cmd$
case keyLE$,keyRI$,keyHOM$,keyEND$:if mnu%=2 then exit loop
case keyDEL$
case keyENT$,keyPGU$,keyPGD$
case keyF7$:if mnu%=1 then call gegsave (cmd$)
case keyF9$
call toets (0)
tmd%=tmd% xor 1
call toets (1)
call funtoets
case else:exit loop
end select
case 7,8,9
select case cmd$
case keyPGU$,keyPGD$
case keyF7$:if mnu%=1 then call gegsave (cmd$)
case keyF9$:tmd%=tmd% xor 1:call funtoets
case else:exit loop
end select
end select
end select
cmd$=""
loop
'───────loop 2
'
Pagina 7
'-----------------------------------------------------
if cmd$<>keyESC$ then
while inkey$<>"":wend
select case mnu%
case 1
select case cel%
case 0:gosub DATANUMMER
case 1:gosub DATUM
case 2:gosub TAPENR
case 3:gosub TAPETYPE
case 4:gosub STARTTELLER
case 5:gosub STOPTELLER
case 6:gosub SUBJECT
case 7:gosub TITEL
case 8:gosub MAKER
case 9:gosub OPMERKING
case 10:'gosub SPOELEN
case else
end select
case 2
select case cel%
case 0:gosub DATANUMMER
case 1:gosub DATUMSELECT
case 2:gosub TAPENRSELECT
case 3:gosub TAPETYPESELECT
case 4,5:gosub TIJDSELECT
case 6:gosub SUBJECTSELECT
case 7:gosub TITELSELECT
case 8:gosub MAKERSELECT
case 9:gosub OPMERKINGSELECT
case else
end select
end select
call tekst
call bandwis
call bandteken
cmd$=""
src$=""
end if
loop
'───────loop 1
'shell "del video.tmp"
end
'
Pagina 8
'-----------------------------------------------------
MENUNR:
incr mnu%
if mnu%>2 then mnu%=1
color 14
locate 27,61
select case mnu%
case 1:palette 1,15:print "INVOER"
case 2:palette 1,39:print "KEUZE "
end select
RETURN
up:
call toets (0)
decr cel%:if cel%<0 then cel%=10
call toets (1)
return
dn:
call toets (0)
incr cel%:if cel%>10 then cel%=0
call toets (1)
return
'
Pagina 9
'-----------------------------------------------------
DATANUMMER:
select case cmd$
case keyLE$: call datanummernr ("L",src$)
case keyRI$: call datanummernr ("R",src$)
case keyHOM$: call datanummernr ("H",src$)
case keyEND$: call datanummernr ("E",src$)
case keyPGU$:sdtn1$=using$("####",n%):replace " " with "0" in sdtn1$
case keyPGD$:sdtn2$=using$("####",n%):replace " " with "0" in sdtn2$
case keyINS$:call tempmake
case keyF3$,keyF4$: call tempprn (cmd$)
case keyF5$: call tempnaarTXTbestand
case keyF6$: call tempnaarHTMbestand
case keyF8$: call allesnaarTXTbestand:call allesnaarHTMbestand
case keyF11$:call lettersize
case keyF12$:call lettertype
case ""
case else
call invulpagina (25,37,4,4,cmd$,src$)
end select
if src$<>"" then
n%=val(src$):if n%<1 then n%=1
select case n%
case >hn%:n%=hn%+1:call gegwis
case >0: get #1,n%:get #2,n%
end select
end if
return
sub datanummernr (a$,src$)
select case a$
case "L"
if n%>1 then
put (166,408),ttsr1%,pset
delay ttsd
decr n%
put (166,408),ttsr0%,pset
end if
case "R"
if n%<hn%+1 then
put (222,408),ttsf1%,pset
delay ttsd
incr n%
put (222,408),ttsf0%,pset
end if
case "H"
put (166,408),ttsr1%,pset
delay ttsd
n%=1
put (166,408),ttsr0%,pset
case "E"
put (222,408),ttsf1%,pset
delay ttsd
n%=hn%+1
put (222,408),ttsf0%,pset
end select
src$=str$(n%)
end sub
sub gegwis
rset dat$=right$(date$,4)+left$(date$,2)+mid$(date$,4,2)
rset stt$=stp$
lset ttl$=string$(80,".")
lset mkr$=string$(80,".")
lset opm$=string$(80,".")
end sub
'
Pagina 10
'-----------------------------------------------------
DATUM:
call invulpagina (23,61,8,10,cmd$,src$)
if src$<>"" then
l%=len(src$)
if l%<>8 then
locate 23,61:color 12:print "ddmmjjjj"
delay .5:color 15:return
end if
rset dat$=right$(src$,4)+mid$(src$,3,2)+left$(src$,2)
end if
return
DATUMSELECT:
select case cmd$
case keyLE$: call tempnr ("L")
case keyRI$: call tempnr ("R")
case keyHOM$: call tempnr ("H")
case keyEND$: call tempnr ("E")
case keyF3$,keyF4$:call tempprn (cmd$)
case keyF5$: call tempnaarTXTbestand
case keyF6$: call tempnaarHTMbestand
case ""
case else
call invulpagina (23,61,6,8,cmd$,src$)
if src$<>"" then
l%=len(src$)
if l%<>6 then
locate 23,61:color 12:print "ddmmjjjj"
delay .5:color 15:return
end if
sdat1$=right$(src$,4)+mid$(src$,3,2)+left$(src$,2)
r%=23:k%=61:kl%=10
call datumwissel (sdat1$,sdtm1$)
color 10:locate r%,k%:print sdtm1$
end if
call toets (2)
call invulpagina (25,61,6,8,"",src$)
if src$<>"" then
l%=len(src$)
if l%<>6 then
locate 25,61:color 12:print "ddmmjjjj"
delay .5:color 15:return
end if
sdat2$=right$(src$,4)+mid$(src$,3,2)+left$(src$,2)
r%=25:k%=61:kl%=10
call datumwissel (sdat2$,sdtm2$)
color 10:locate r%,k%:print sdtm2$
end if
call toets (2)
call tempmake
end select
call tempshow
return
'
Pagina 11
'-----------------------------------------------------
TAPENR:
call invulpagina (20,8,4,4,cmd$,src$)
if src$<>"" then
l%=len(src$)
hlp$="0000"
mid$(hlp$,5-l%)=src$
rset tpn$=hlp$:mm2$=tpn$
end if
return
TAPENRSELECT:
select case cmd$
case keyLE$: call tempnr ("L")
case keyRI$: call tempnr ("R")
case keyHOM$: call tempnr ("H")
case keyEND$: call tempnr ("E")
case keyF3$,keyF4$:call tempprn (cmd$)
case keyF5$: call tempnaarTXTbestand
case keyF6$: call tempnaarHTMbestand
case ""
case else
call invulpagina (20,8,4,4,cmd$,src$)
if src$<>"" then
l%=len(src$)
hlp$="0000"
mid$(hlp$,5-l%)=src$
stpn$=hlp$
r%=20:k%=8:kl%=15
b$=using$("\ \",stpn$)
color 15:locate r%,k%:print b$
end if
call tempmake
end select
call tempshow
return
TAPETYPE:
select case cmd$
case keyLE$,keyPGU$:call tapetypenr ("L")
case keyRI$,keyPGD$:call tapetypenr ("R")
case keyINS$ :call tapetypenr ("I")
case keyHOM$ :call tapetypenr ("H")
case keyEND$ :call tapetypenr ("E")
case else :call tapetypewrite (ttpm%+1,src$,cmd$)
end select
call tapetyperead
locate 4,19:color 14:print ttpi$
return
'
Pagina 12
'-----------------------------------------------------
sub tapetyperead
i%=val(ttp$)
if i%>0 then get #3,i%
l0%=val(tl0$):l1%=val(tl1$):l2%=val(tl2$)
n1=val(tn1$):n2=val(tn2$)
end sub
sub tapetypenr (a$)
static i1%
select case a$
case "L"
if i1%>0 then
put (166,408),ttsr1%,pset:delay ttsd:decr i1%
put (166,408),ttsr0%,pset
end if
case "R"
if i1%<ttpm%-1 then
put (222,408),ttsf1%,pset:delay ttsd:incr i1%
put (222,408),ttsf0%,pset
end if
case "I"
case "H"
put (166,408),ttsr1%,pset:delay ttsd:i1%=0
put (166,408),ttsr0%,pset
case "E"
put (222,408),ttsf1%,pset:delay ttsd:i1%=ttpm%-1
put (222,408),ttsf0%,pset
end select
rset ttp$=ltrim$(str$(i1%+1))
end sub
'
Pagina 13
'-----------------------------------------------------
sub tapetypewrite (i%,hlp1$,cmd$)
locate 4,41:print "type"
call invulpagina (4,19,16,16,cmd$,hlp1$)
if hlp1$="" then exit sub
locate 4,19:print hlp1$+" min"
call invulpagina (4,41,3,4,"",hlp$)
if hlp$="" then exit sub
lset ttpi$=ucase$(hlp1$+" "+hlp$)
rset tl0$=hlp$
locate 4,19:print ttpi$
b$=using$("####",i%)
replace " " with "0" in b$
locate 4,41:print b$
'put (190,348),vld8%
hlp$=str$(60*val(hlp$))
call secnaartyd (hlp$,b$)
locate 23,25:color 12:print b$
put (54,408),ttsp1%,pset
put (30,348),vld8%
locate 25,9:color 11:print "u m "
call invulpagina (23,5,2,2,"",hlp1$)
if hlp1$="" then exit sub
hlp2$=str$(3600*val(hlp1$))
call secnaartyd (hlp2$,b$)
locate 23,5:color 12:print b$
call invulpagina (23,8,2,2,"",hlp$)
if hlp$="" then exit sub
hlp2$=str$(3600*val(hlp1$)+60*val(hlp$))
rset tl1$=ltrim$(str$(val(hlp1$)*60+val(hlp$)))
call secnaartyd (hlp2$,b$)
locate 23,5:color 12:print b$
put (30,348),vld8%
put (54,380),vld4%
locate 23,5:color 11:print "teller "
call invulpagina (25,9,4,4,"",hlp$)
if hlp$="" then exit sub
put (54,408),ttsp0%,pset
put (54,380),vld4%
rset tn1$=ltrim$(str$(val(hlp$)))
put (110,408),ttss1%,pset
locate 23,5:color 12:print b$
put (110,348),vld8%
locate 25,16:color 11:print "u m "
call invulpagina (23,15,2,2,"",hlp1$)
if hlp1$="" then exit sub
hlp2$=str$(3600*val(hlp1$))
call secnaartyd (hlp2$,b$)
locate 23,15:color 12:print b$
call invulpagina (23,18,2,2,"",hlp$)
if hlp$="" then exit sub
hlp2$=str$(3600*val(hlp1$)+60*val(hlp$))
rset tl2$=ltrim$(str$(val(hlp1$)*60+val(hlp$)))
call secnaartyd (hlp2$,b$)
locate 23,15:color 12:print b$
put (110,348),vld8%
put (110,380),vld4%
locate 23,15:color 11:print "teller "
call invulpagina (25,16,4,4,"",hlp$)
if hlp$="" then exit sub
put (110,408),ttss0%,pset
put (110,380),vld4%
rset tn2$=ltrim$(str$(val(hlp$)))
locate 23,15:color 12:print b$
color 14:locate 29,35:print "F7"
cel%=0:call toets (1)
'
Pagina 14
'-----------------------------------------------------
do
cmd$=""
do until cmd$<>""
cmd$=inkey$
loop
select case cmd$
case keyENT$
case keyESC$:exit loop
case (keyF7$)
put #3,i%
rset ttp$=ltrim$(str$(i%))
ttpm%=i%
call indexsave
exit loop
end select
loop
color 12:locate 29,35:print "F7"
call toets (0):cel%=3
end sub
TAPETYPESELECT:
select case cmd$
case keyPGU$
tmpi%=0
call tapetypenr ("L")
call tapetyperead
locate 4,19:color 14:print ttpi$
case keyPGD$
tmpi%=0
call tapetypenr ("R")
call tapetyperead
locate 4,19:color 14:print ttpi$
case keyLE$: call tempnr ("L")
case keyRI$: call tempnr ("R")
case keyINS$:sttp$=ttp$:call tempmake
case keyHOM$: call tempnr ("H")
case keyEND$: call tempnr ("E")
case keyF3$,keyF4$: call tempprn (cmd$)
case keyF5$: call tempnaarTXTbestand
case keyF6$: call tempnaarHTMbestand
case else
end select
call tempshow
return
'
Pagina 15
'-----------------------------------------------------
STARTTELLER:
select case tmd%
case 0
call invulpagina (25,9,4,4,cmd$,src$)
if src$<>"" then
l%=len(src$)
hlp$="0000"
mid$(hlp$,5-l%)=src$:lset stt$=hlp$
end if
l3%=fnREKEN (n1,n2,val(stp$))
l4%=l3%:l3%=fnREKEN (n1,n2,val(stt$))
case 1
call invulpagina (23,5,2,2,cmd$,src$)
if src$<>"" then s1%=val(src$)
call invulpagina (23,8,2,2,"",src$)
if src$<>"" then s2%=val(src$)
call invulpagina (23,11,2,2,"",src$)
if src$<>"" then s3%=val(src$)
l3%=s1%*3600+s2%*60+s3%
hlp$=using$("####",fnLENGTE (n1,n2,l3%))
replace " " with "0" in hlp$
lset stt$=hlp$
end select
return
STOPTELLER:
select case tmd%
case 0
call invulpagina (25,16,4,4,cmd$,src$)
if src$<>"" then
l%=len(src$)
hlp$="0000"
mid$(hlp$,5-l%)=src$:lset stp$=hlp$:mm3$=hlp$
end if
l3%=fnREKEN (n1,n2,val(stp$))
l4%=l3%:l3%=fnREKEN (n1,n2,val(stt$))
case 1
call invulpagina (23,15,2,2,cmd$,src$)
if src$<>"" then s1%=val(src$)
call invulpagina (23,18,2,2,"",src$)
if src$<>"" then s2%=val(src$)
call invulpagina (23,21,2,2,"",src$)
if src$<>"" then s3%=val(src$)
l4%=s1%*3600+s2%*60+s3%
hlp$=using$("####",fnLENGTE (n1,n2,l4%))
replace " " with "0" in hlp$
lset stp$=hlp$
end select
return
'
Pagina 16
'-----------------------------------------------------
TIJDSELECT:
select case cmd$
case keyLE$: call tempnr ("L")
case keyRI$: call tempnr ("R")
case keyHOM$: call tempnr ("H")
case keyEND$: call tempnr ("E")
case keyF3$,keyF4$:call tempprn (cmd$)
case keyF5$: call tempnaarTXTbestand
case keyF6$: call tempnaarHTMbestand
case ""
case else
call invulpagina (23,5,2,2,cmd$,src$)
if src$<>"" then
sstt1%=val(src$)
end if
call invulpagina (23,8,2,2,"",src$)
if src$<>"" then
sstt2%=val(src$)
end if
call invulpagina (23,11,2,2,"",src$)
if src$<>"" then
sstt3%=val(src$)
end if
if sstt1%+sstt2%+sstt3%<>0 then
r%=23:k%=5:kl%=14
b$=using$("##",sstt1%)+":"+using$("##",sstt2%)+":"+using$("##",sstt3%)
replace " " with "0" in b$
color kl%:locate r%,k%:print b$
end if
gosub dn
call invulpagina (23,15,2,2,"",src$)
if src$<>"" then
sstp1%=val(src$)
end if
call invulpagina (23,18,2,2,"",src$)
if src$<>"" then
sstp2%=val(src$)
end if
call invulpagina (23,21,2,2,"",src$)
if src$<>"" then
sstp3%=val(src$)
end if
if sstp1%+sstp2%+sstp3%<>0 then
r%=23:k%=15:kl%=14
b$=using$("##",sstp1%)+":"+using$("##",sstp2%)+":"+using$("##",sstp3%)
replace " " with "0" in b$
color kl%:locate r%,k%:print b$
end if
if sstp3%<sstt3% then sstp3%=sstp3%+60:sstp2%=sstp2%-1
if sstp2%<sstt2% then sstp2%=sstp2%+60:sstp1%=sstp1%-1
if sstp1%<sstt1% then sstp1%=sstp1%+24
l4%=(sstp1%-sstt1%)*3600+(sstp2%-sstt2%)*60+sstp3%-sstt3%
l5%=l4%
call tempmake
end select
locate 25,8:print " "
locate 25,15:print " "
call tempshow
return
'
Pagina 17
'-----------------------------------------------------
sub secnaartyd (m$,t$)
hlp%=val(m$)
b2$=using$("##",hlp%\3600)
b1$=using$("##",(hlp% mod 3600)\60)
b0$=using$("##",(hlp% mod 3600) mod 60)
t$=b2$+":"+b1$+":"+b0$
replace " " with "0" in t$
end sub
def fnREKEN (n1,n2,n3)
x1=n3/n1:x2=n3/n2
f%=n2-n1
g1=(n2-n3)/f%:g2=(n3-n1)/f%:g3=(5*x1*g1+180*x2*g2)*60
fnREKEN=int(round(g3,0))
end def
def fnLENGTE (n1,n2,l%)
g1=(180*n1-5*n2)*60
g2=(5*n2^2-180*n1^2)*60
f=l%*n1*n2*(n1-n2)
g3=(-g2+sqr(g2^2-4*g1*f))/g1/2
if g3<0 then g3=(-g2-sqr(g2^2-4*g1*f))/g1/2
fnLENGTE=g3
end def
'
Pagina 18
'-----------------------------------------------------
SUBJECT:
select case cmd$
case keyLE$,keyPGU$:call subjectnr ("L")
case keyRI$,keyPGD$:call subjectnr ("R")
case keyINS$: call subjectnr ("I")
case keyHOM$: call subjectnr ("H")
case keyEND$: call subjectnr ("E")
case else
call subjectwrite (sjtm%+1,src$,cmd$)
end select
call subjectread
locate 20,19:color 15:print sjti$
return
sub subjectread
i%=val(sjt$)
if i%>0 then
get #4,i%
else
lset sjti$="***LEGE*TAPE***"
end if
end sub
sub subjectnr (a$)
static i1%
select case a$
case "L"
if i1%>0 then
put (166,408),ttsr1%,pset:delay ttsd:decr i1%
put (166,408),ttsr0%,pset
end if
case "R"
if i1%<sjtm%-1 then
put (222,408),ttsf1%,pset:delay ttsd:incr i1%
put (222,408),ttsf0%,pset
end if
case "I"
case "H"
put (166,408),ttsr1%,pset:delay ttsd:i1%=0
put (166,408),ttsr0%,pset
case "E"
put (222,408),ttsf1%,pset:delay ttsd:i1%=sjtm%-1
put (222,408),ttsf0%,pset
end select
rset sjt$=ltrim$(str$(i1%+1))
end sub
'
Pagina 19
'-----------------------------------------------------
sub subjectwrite (i%,hlp1$,cmd$)
color 15
call invulpagina (20,19,20,20,cmd$,hlp1$)
if hlp1$="" then exit sub
put (166,348),vld4%
lset sjti$=ucase$(hlp1$)
locate 20,19:print sjti$
b$=using$("####",i%)
replace " " with "0" in b$
locate 25,37:print b$
put (166,348),vld4%
color 15:locate 29,35:print "F7"
cel%=0:call toets (1)
do
cmd$=""
do until cmd$<>""
cmd$=inkey$
loop
select case cmd$
case keyENT$
case keyESC$:exit loop
case (keyF7$)
put #4,i%
rset sjt$=ltrim$(str$(i%))
sjtm%=i%
call indexsave
exit loop
end select
loop
color 12:locate 29,35:print "F7"
call toets (0):cel%=6
end sub
'
Pagina 20
'-----------------------------------------------------
SUBJECTSELECT:
select case cmd$
case keyPGU$
tmpi%=0
call subjectnr ("L")
call subjectread
locate 4,19:color 14:print sjti$
case keyPGD$
tmpi%=0
call subjectnr ("R")
call subjectread
locate 4,19:color 14:print sjti$
case keyLE$: call tempnr ("L")
case keyRI$: call tempnr ("R")
case keyHOM$: call tempnr ("H")
case keyEND$: call tempnr ("E")
case keyINS$:ssjt$=sjt$:call tempmake
case keyF3$,keyF4$: call tempprn (cmd$)
case keyF5$: call tempnaarTXTbestand
case keyF6$: call tempnaarHTMbestand
case else
end select
call tempshow
return
'
Pagina 21
'-----------------------------------------------------
TITEL:
select case cmd$
case keyLE$: call titelnr ("L")
case keyRI$: call titelnr ("R")
case keyINS$:call titelnr ("I")
case keyENT$
cmd$=rtrim$(ttl$)
call invulpagina (8,19,80,80,cmd$,src$)
if src$<>"" then
lset ttl$=src$
end if
case keyDEL$:lset ttl$=""
case keyHOM$:call titelnr ("H")
case keyEND$:call titelnr ("E")
case else
if cmd$<>"" then call invulpagina (8,19,80,80,cmd$,src$)
if src$<>"" then
lset ttl$=src$
end if
end select
return
sub titelnr (a$)
static i1%
if val(a$)>0 then i1%=val(a$):ttli%=i1%:exit sub
select case a$
case "L"
if i1%>1 then
put (166,408),ttsr1%,pset:delay ttsd:decr i1%
put (166,408),ttsr0%,pset
end if
case "R"
if i1%<ttlm% then
put (222,408),ttsf1%,pset:delay ttsd:incr i1%
put (222,408),ttsf0%,pset
end if
case "H"
put (166,408),ttsr1%,pset:delay ttsd:if ttlm%>0 then i1%=1 else i1%=0
put (166,408),ttsr0%,pset
case "E"
put (222,408),ttsf1%,pset:delay ttsd:i1%=ttlm%
put (222,408),ttsf0%,pset
case "I"
end select
if i1%>0 then
get #7,i1%
rset ttl$=ttli$
end if
ttli%=i1%
end sub
'
Pagina 22
'-----------------------------------------------------
TITELSELECT:
select case cmd$
case keyLE$: call tempnr ("L")
case keyRI$: call tempnr ("R")
case keyDEL$
case keyHOM$: call tempnr ("H")
case keyEND$: call tempnr ("E")
case keyF3$,keyF4$:call tempprn (cmd$)
case keyF5$: call tempnaarTXTbestand
case keyF6$: call tempnaarHTMbestand
case ""
case else
call invulpagina (8,19,80,80,cmd$,src$)
if src$<>"" then
sttl$=src$
call tempmake
end if
end select
call tempshow
return
'
Pagina 23
'-----------------------------------------------------
MAKER:
select case cmd$
case keyLE$: call makernr ("L")
case keyRI$: call makernr ("R")
case keyINS$:call makernr ("I")
case keyENT$
cmd$=rtrim$(mkr$)
call invulpagina (11,19,80,80,cmd$,src$)
if src$<>"" then
lset mkr$=src$
end if
case keyDEL$:lset mkr$=""
case keyHOM$:call makernr ("H")
case keyEND$:call makernr ("E")
case else
if cmd$<>"" then call invulpagina (11,19,80,80,cmd$,src$)
if src$<>"" then
lset mkr$=src$
end if
end select
return
sub makernr (a$)
static i1%
if val(a$)>0 then i1%=val(a$):mkri%=i1%:exit sub
select case a$
case "L"
if i1%>1 then
put (166,408),ttsr1%,pset:delay ttsd:decr i1%
put (166,408),ttsr0%,pset
end if
case "R"
if i1%<mkrm% then
put (222,408),ttsf1%,pset:delay ttsd:incr i1%
put (222,408),ttsf0%,pset
end if
case "H"
put (166,408),ttsr1%,pset:delay ttsd:if mkrm%>0 then i1%=1 else i1%=0
put (166,408),ttsr0%,pset
case "E"
put (166,408),ttsf1%,pset:delay ttsd:i1%=mkrm%
put (166,408),ttsf0%,pset
case "I"
end select
if i1%>0 then
get #8,i1%
rset mkr$=mkri$
end if
mkri%=i1%
end sub
'
Pagina 24
'-----------------------------------------------------
MAKERSELECT:
select case cmd$
case keyLE$: call tempnr ("L")
case keyRI$: call tempnr ("R")
case keyDEL$
case keyHOM$: call tempnr ("H")
case keyEND$: call tempnr ("E")
case keyF3$,keyF4$:call tempprn (cmd$)
case keyF5$: call tempnaarTXTbestand
case keyF6$: call tempnaarHTMbestand
case ""
case else
call invulpagina (11,19,80,80,cmd$,src$)
if src$<>"" then
smkr$=src$
call tempmake
end if
end select
call tempshow
return
'
Pagina 25
'-----------------------------------------------------
OPMERKING:
select case cmd$
case keyLE$: call opmerkingnr ("L")
case keyRI$: call opmerkingnr ("R")
case keyINS$:call opmerkingnr ("I")
case keyENT$
cmd$=rtrim$(opm$)
call invulpagina (14,19,80,80,cmd$,src$)
if src$<>"" then
lset opm$=src$
end if
case keyDEL$:lset opm$=""
case keyHOM$:call opmerkingnr ("H")
case keyEND$:call opmerkingnr ("E")
case else
if cmd$<>"" then call invulpagina (14,19,80,80,cmd$,src$)
if src$<>"" then
lset opm$=src$
end if
end select
return
sub opmerkingnr (a$)
static i1%
if val(a$)>0 then i1%=val(a$):opmi%=i1%:exit sub
select case a$
case "L"
if i1%>1 then
put (166,408),ttsr1%,pset:delay ttsd:decr i1%
put (166,408),ttsr0%,pset
end if
case "R"
if i1%<opmm% then
put (222,408),ttsf1%,pset:delay ttsd:incr i1%
put (222,408),ttsf0%,pset
end if
case "H"
put (166,408),ttsr1%,pset:delay ttsd:if opmm%>0 then i1%=1 else i1%=0
put (166,408),ttsr0%,pset
case "E"
put (222,408),ttsf1%,pset:delay ttsd:i1%=opmm%
put (222,408),ttsf0%,pset
case "I"
end select
if i1%>0 then
get #9,i1%
rset opm$=opmi$
end if
opmi%=i1%
end sub
'
Pagina 26
'-----------------------------------------------------
OPMERKINGSELECT:
select case cmd$
case keyLE$: call tempnr ("L")
case keyRI$: call tempnr ("R")
case keyDEL$
case keyHOM$: call tempnr ("H")
case keyEND$: call tempnr ("E")
case keyF3$,keyF4$:call tempprn (cmd$)
case keyF5$: call tempnaarTXTbestand
case keyF6$: call tempnaarHTMbestand
case ""
case else
call invulpagina (14,19,80,80,cmd$,src$)
if src$<>"" then
sopm$=src$
call tempmake
end if
end select
call tempshow
return
'
Pagina 27
'-----------------------------------------------------
SPOELEN:
call invulpagina (23,61,8,10,cmd$,src$)
if src$<>"" then
l%=len(src$)
if l%<>8 then
locate 23,61:color 12:print "ddmmjjjj"
delay .5:color 15:return
end if
rset spl$=right$(src$,4)+mid$(src$,3,2)+left$(src$,2)
end if
return
SPOELENSELECT:
select case cmd$
case keyLE$: call tempnr ("L")
case keyRI$: call tempnr ("R")
case keyHOM$: call tempnr ("H")
case keyEND$: call tempnr ("E")
case keyF3$,keyF4$:call tempprn (cmd$)
case keyF5$: call tempnaarTXTbestand
case keyF6$: call tempnaarHTMbestand
case ""
case else
call invulpagina (23,61,6,8,cmd$,src$)
if src$<>"" then
l%=len(src$)
if l%<>6 then
locate 23,61:color 12:print "ddmmjjjj"
delay .5:color 15:return
end if
sspl1$=right$(src$,4)+mid$(src$,3,2)+left$(src$,2)
r%=23:k%=61:kl%=10
call datumwissel (sspl1$,sspo1$)
color 10:locate r%,k%:print sspo1$
end if
call toets (2)
call invulpagina (25,61,6,8,"",src$)
if src$<>"" then
l%=len(src$)
if l%<>6 then
locate 25,61:color 12:print "ddmmjjjj"
delay .5:color 15:return
end if
sspl2$=right$(src$,4)+mid$(src$,3,2)+left$(src$,2)
r%=25:k%=61:kl%=10
call datumwissel (sspl2$,sspo2$)
color 10:locate r%,k%:print sspo2$
end if
call toets (2)
call tempmake
end select
call tempshow
return
sub datumwissel (a$,b$)
b$=right$(a$,2)+"-"+mid$(a$,5,2)+"-"+left$(a$,4)
end sub
'
Pagina 28
'-----------------------------------------------------
sub invulpagina (r%,k%,l%,w%,cmd$,a$)
color 11
if w%<41 then
locate r%,k%:print space$(w%)
else
locate r%,k%:print space$(40)
locate r%+1,k%:print space$(w%-40)
end if
a$=cmd$
if len(cmd$)=80 then l%=81
if ascii(cmd$)=0 then exit sub
if len(cmd$)<41 then
locate r%,k%:print cmd$
else
locate r%,k%:print left$(cmd$,40)
locate r%+1,k%:print mid$(cmd$,41,40)
end if
for j%=len(cmd$)+1 to l%
do until hlp$<>""
hlp$=inkey$
loop
select case hlp$
case chr$(0)
if a$<>"" then a$=""
j%=0
case keyESC$:a$="":exit for
case keyENT$,keyUP$,keyDN$:exit for
case keyTAB$,keyRI$:decr j%:hlp$="":iterate
case keyBSP$
if a$<>"" then a$=left$(a$,len(a$)-1)
j%=len(a$)
end select
if hlp$<>keyBSP$ and hlp$<>chr$(0) then a$=a$+hlp$
if l%<41 then
locate r%,k%:print space$(l%)
locate r%,k%:print a$
else
locate r%,k%:print space$(40)
locate r%+1,k%:print space$(40)
locate r%,k%:print left$(a$,40)
locate r%+1,k%:print mid$(a$,41,40)
end if
hlp$=""
next j%
end sub
'
Pagina 29
'-----------------------------------------------------
sub tempmake
tmpm%=0
select case cel%
case 0,1,2,3,6,7,8,9,10:jm%=hn%
case 4,5: jm%=htn%
end select
for j%=1 to jm%
b$=using$("####",j%):replace " " with "0" in b$:locate 25,37:print b$
b$=using$("####",tmpm%):replace " " with "0" in b$:locate 25,44:print b$
select case cel%
case 1,2,3,6,7,8:get #1,j%
case 9: get #2,j%
case 4,5: get #5,j%
end select
select case cel%
case 0
skri$="Datanummer:"+sdtn1$+" t/m "+sdtn2$
if j%>=val(sdtn1$) and j%<=val(sdtn2$) then call tempset (j%,0,0,1)
case 1
skri$=sdtm1$+" t/m "+sdtm2$
if dat$>=sdat1$ and dat$<=sdat2$ then call tempset (j%,0,0,1)
case 2
skri$=stpn$:if tpn$=stpn$ then call tempset (j%,0,0,1)
case 3
skri$=sttp$+ttpi$:if ttp$=sttp$ then call tempset (j%,0,0,1)
case 4,5
skri$="Start "+using$("##",sstt1%)+":"+using$("##",sstt2%)_
+":"+using$("##",sstt3%)+" Stop "+using$("##",sstp1%)_
+":"+using$("##",sstp2%)+":"+using$("##",sstp3%)_
+" Duur "+using$("###",l4%)+" min"
rset ttp$=tttp$
call tapetyperead
l3%=fnREKEN (n1,n2,val(tstp$))
if (l0%*60-l3%)>=l4% then call tempset (val(tdtn$),j%,val(tttp$),1)
case 6
skri$=ssjt$+sjti$:if sjt$=ssjt$ then call tempset (j%,0,0,1)
case 7
skri$=sttl$:hlp$=ucase$(ttl$):hlp1$=ucase$(sttl$):d0%=1
while d0%<>0
d5%=instr(d0%,hlp$,hlp1$)
if d5%<>0 then call tempset (j%,d5%,0,1):incr d5%
d0%=d5%
wend
case 8
skri$=smkr$:hlp$=ucase$(mkr$):hlp1$=ucase$(smkr$):d0%=1
while d0%<>0
d5%=instr(d0%,hlp$,hlp1$)
if d5%<>0 then call tempset (j%,d5%,0,1):incr d5%
d0%=d5%
wend
case 9
skri$=sopm$:hlp$=ucase$(opm$):hlp1$=ucase$(sopm$):d0%=1
while d0%<>0
d5%=instr(d0%,hlp$,hlp1$)
if d5%<>0 then call tempset (j%,d5%,0,1):incr d5%
d0%=d5%
wend
case else
end select
next j%
tmpi%=tmpm%
call tempnr ("I")
end sub
'
Pagina 30
'-----------------------------------------------------
sub tempnr (a$)
static i1%
select case a$
case "L"
if i1%>1 then
put (166,408),ttsr1%,pset:delay ttsd:decr i1%
put (166,408),ttsr0%,pset
end if
case "R"
if i1%<tmpm% then
put (222,408),ttsf1%,pset:delay ttsd:incr i1%
put (222,408),ttsf0%,pset
end if
case "H"
put (166,408),ttsr1%,pset:delay ttsd:i1%=1
put (166,408),ttsr0%,pset
case "E"
put (222,408),ttsf1%,pset:delay ttsd:i1%=tmpm%
put (222,408),ttsf0%,pset
case "I"
i1%=tmpi%
end select
tmpi%=i1%
end sub
sub tempset (a%,b%,c%,d%)
hlp$=using$("####",a%):replace " " with "0" in hlp$
rset tmp1$=hlp$
hlp$=using$("####",b%):replace " " with "0" in hlp$
rset tmp2$=hlp$
hlp$=using$("####",c%):replace " " with "0" in hlp$
rset tmp3$=hlp$
hlp$=using$("####",d%):replace " " with "0" in hlp$
rset tmp4$=hlp$
incr tmpm%:put #10,tmpm%:ncel%=cel%
end sub
sub tempprn (a$)
static tmps%
select case a$
case keyF3$
for i%=1 to tmpm%
get #10,i%
if tmps%=0 then rset tmp4$="0000" else rset tmp4$="0001"
put #10,i%
next i%
tmps%=tmps% xor 1
case keyF4$
if tmpi%>0 then
get #10,tmpi%:tmpk%=val(tmp4$):tmpk%=tmpk% xor 1
hlp$=using$("####",tmpk%):replace " " with "0" in hlp$
rset tmp4$=hlp$
put #10,tmpi%
end if
end select
end sub
'
Pagina 31
'-----------------------------------------------------
sub tempshow
if tmpi%>0 then
get #10,tmpi%
n%=val(tmp1$)
if n%>0 then
get #1,n%:get #2,n%
else
rset dat$="********"
rset tpn$=tmp2$
rset ttp$=right$(tmp3$,2)
rset stp$="0000"
rset sjt$=""
lset ttl$="***LEGE*TAPE***"
lset mkr$="***LEGE*TAPE***"
lset opm$="***LEGE*TAPE***"
end if
call tekst
end if
end sub
sub tempnaarTXTbestand
b$=mid$(date$,4,3)+left$(date$,3)+right$(date$,4)
open "O",#12,"VISELECT.TXT"
print #12,"VIDEO selectie d.d. "+b$+" zoekkriterium : "+skri$
print #12,chr$(13)
for i%=1 to tmpm%
get #10,i%
if val(tmp4$)=1 then
n%=val(tmp1$)
if n%>0 then
get #1,n%
get #2,n%
else
rset dat$="********"
rset tpn$=tmp2$
rset ttp$=right$(tmp3$,2)
rset stp$="0000"
rset sjt$=""
lset ttl$="***LEGE*TAPE***"
lset mkr$="***LEGE*TAPE***"
lset opm$="***LEGE*TAPE***"
end if
call tekstnaarTXTbestand
end if
next i%
if tmpm%<1 then print #12,"Geen gegevens overeenkomstig kriterium gevonden"
print #12,chr$(13)
close #12
end sub
'
Pagina 32
'-----------------------------------------------------
sub tempnaarHTMbestand
b$=mid$(date$,4,3)+left$(date$,3)+right$(date$,4)
open "O",#12,"VISELECT.HTM"
print #12,"<HTML><HEAD><TITLE>VI140908-selectie</TITLE></HEAD>"
'-----Achtergond, lettertype/kleur/grootte, gecentreerd
print #12,"<BODY>"
print #12,"<FONT FACE=";qm$;"Verdana";qm$;" COLOR=";qm$;"fuchsia";qm$;" SIZE=8>"
print #12,"<CENTER>"
'-----Opschrift pagina, opmaak
print #12,"<P>Video Data Base 2014</P>"
print #12,"<HR COLOR=";qm$;"fuchsia";qm$;" SIZE=10>"
print #12,"</CENTER></FONT>"
print #12,"<P>
print #12,"<FONT FACE=";qm$;"Verdana";qm$;" COLOR=";qm$;"navy";qm$;" SIZE=4>"
print #12,"VIDEO selectie d.d. "+b$+" zoekkriterium : "+skri$
print #12,"</FONT></P>"
for i%=1 to tmpm%
get #10,i%
if val(tmp4$)=1 then
n%=val(tmp1$)
if n%>0 then
get #1,n%
get #2,n%
else
rset dat$="********"
rset tpn$=tmp2$
rset ttp$=right$(tmp3$,2)
rset stp$="0000"
rset sjt$=""
lset ttl$="***LEGE*TAPE***"
lset mkr$="***LEGE*TAPE***"
lset opm$="***LEGE*TAPE***"
end if
call tekstnaarHTMbestand
call jpegnaarHTMbestand
end if
next i%
if tmpm%<1 then print #12,"Geen gegevens overeenkomstig kriterium gevonden"
print #12,chr$(13)
print #12,"</BODY>"
print #12,"</HTML>"
close #12
end sub
'
Pagina 33
'-----------------------------------------------------
sub toets (onoff%)
select case cel%
case 0
if onoff%=1 then
put (278,408),ttso2%,pset
else
put (278,408),ttso0%,pset
end if
put (278,380),vld4%
case 1
if onoff%=2 then
put (478,380),vld10%
else
put (478,348),vld10%
end if
case 2:put (50,300),vld4a%
case 3:put (140,44),vld20%:put (314,44),vld4%
case 4
if onoff%=1 then
put (54,408),ttsp1%,pset
else
put (54,408),ttsp0%,pset
end if
if tmd%=0 and mnu%=1 then
put (54,380),vld4%
else
put (30,348),vld8%
end if
case 5
if onoff%=1 then
put (110,408),ttss1%,pset
else
put (110,408),ttss0%,pset
end if
if tmd%=0 and mnu%=1 then
put (110,380),vld4%
else
put (110,348),vld8%
end if
case 6:put (140,300),vld20a%:put (314,300),vld4a%
case 7
if onoff%=1 then
put (143,96),ttst1%,pset
else
put (143,96),ttst0%,pset
end if
case 8
if onoff%=1 then
put (143,144),ttsm1%,pset
else
put (143,144),ttsm0%,pset
end if
case 9
if onoff%=1 then
put (143,192),ttsn1%,pset
else
put (143,192),ttsn0%,pset
end if
end select
end sub
'
Pagina 34
'-----------------------------------------------------
sub tekst
call tapetyperead:call subjectread
l3%=fnREKEN (n1,n2,val(stp$)):l4%=l3%:l3%=fnREKEN (n1,n2,val(stt$))
for j%=0 to 10
select case j%
case 0
r%=25:k%=37
if val(tmp4$)=1 then kl%=15 else kl%=10:'───────wit / groen
b$=using$("####",n%): replace " " with "0" in b$
b1$=using$("####",tmpi%):replace " " with "0" in b1$
case 1
r%=23:k%=61:kl%=10
call datumwissel (dat$,dtm$)
b$=dtm$
b1$=mid$(date$,4,3)+left$(date$,3)+right$(date$,4)
case 2
r%=20:k%=8:kl%=15
b$=using$("####",val(tpn$)):replace " " with "0" in b$
b1$=using$("####",htn%):replace " " with "0" in b1$
case 3
r%=4:k%=19:kl%=14
b$=ttpi$
b1$=using$("####",val(ttp$)):replace " " with "0" in b1$
case 4
r%=25:k%=9:kl%=10
if mnu%=2 and (cel%=4 or cel%=5) then
b$=using$("\ \",stp$)
b2$=using$("##",l4%\3600)
b1$=using$("##",(l4% mod 3600)\60)
b0$=using$("##",(l4% mod 3600) mod 60)
b1$=b2$+":"+b1$+":"+b0$:replace " " with "0" in b1$
else
b$=using$("\ \",stt$)
b2$=using$("##",l3%\3600)
b1$=using$("##",(l3% mod 3600)\60)
b0$=using$("##",(l3% mod 3600) mod 60)
b1$=b2$+":"+b1$+":"+b0$:replace " " with "0" in b1$
end if
'
Pagina 35
'-----------------------------------------------------
case 5
r%=25:k%=16:kl%=10
if mnu%=2 and (cel%=4 or cel%=5) then
b$=using$("####",fnLENGTE (n1,n2,l4%+l5%)):replace " " with "0" in b$
b2$=using$("##",(l4%+l5%)\3600)
b1$=using$("##",((l4%+l5%) mod 3600)\60)
b0$=using$("##",((l4%+l5%) mod 3600) mod 60)
b1$=b2$+":"+b1$+":"+b0$:replace " " with "0" in b1$
else
b$=using$("\ \",stp$)
b2$=using$("##",l4%\3600)
b1$=using$("##",(l4% mod 3600)\60)
b0$=using$("##",(l4% mod 3600) mod 60)
b1$=b2$+":"+b1$+":"+b0$:replace " " with "0" in b1$
end if
case 6
r%=23:k%=25
if mnu%=2 and (cel%=4 or cel%=5) then
if l5%>=0 then kl%=14 else kl%=12
b2$=using$("##",l5%\3600)
b1$=using$("##",(l5% mod 3600)\60)
b0$=using$("##",(l5% mod 3600) mod 60)
b$=b2$+":"+b1$+":"+b0$:replace " " with "0" in b$
else
if (l4%-l3%)>=0 then kl%=14 else kl%=12
b2$=using$("##",abs((l4%-l3%)\3600))
b1$=using$("##",abs((l4%-l3%) mod 3600)\60)
b0$=using$("##",abs((l4%-l3%) mod 3600) mod 60)
b$=b2$+":"+b1$+":"+b0$:replace " " with "0" in b$
end if
case 7
r%=20:k%=19:kl%=15
b$=sjti$
b1$=using$("####",val(sjt$)):replace " " with "0" in b1$
case 8
r%=8:k%=19:kl%=15
b$=left$(ttl$,40):b1$=right$(ttl$,40)
nrm$=using$("###",ttlm%):nri$=using$("###",ttli%)
case 9
r%=11:k%=19:kl%=15
b$=left$(mkr$,40):b1$=right$(mkr$,40)
nrm$=using$("###",mkrm%):nri$=using$("###",mkri%)
case 10
r%=14:k%=19:kl%=15
b$=left$(opm$,40):b1$=right$(opm$,40)
nrm$=using$("###",opmm%):nri$=using$("###",opmi%)
case else
end select
'
Pagina 36
'-----------------------------------------------------
color kl%:locate r%,k%:print b$
select case j%
case 0: color kl%:locate r%,k%+7:print b1$
case 1: color kl%:locate r%+2,k%:print b1$
case 2: color 12:locate r%,k%+5:print b1$
case 3,7:color kl%:locate r%,k%+22:print b1$
case 4: color 14:locate r%-2,k%-4:print b1$
case 5: color 14:locate r%-2,k%-1:print b1$
case 8,9,10
color 1:locate 17,42:print " kopieer geheugen"
color kl%:locate r%+1,k%:print b1$
color 1:locate r%-1,k%+32-len(nri$):print nri$
color 1:locate r%-1,k%+36-len(nrm$):print "van ";nrm$
case else
end select
next j%
if mnu%=2 and cel%<>0 then
select case ncel%
case 7
call tekstkeuze (sttl$,ttl$,19,b2$,k2%,b3$,k3%)
color 12:locate 8,k2%:print b2$
color 12:locate 9,k3%:print b3$
case 8
call tekstkeuze (smkr$,mkr$,19,b2$,k2%,b3$,k3%)
color 12:locate 11,k2%:print b2$
color 12:locate 12,k3%:print b3$
case 9
call tekstkeuze (sopm$,opm$,19,b2$,k2%,b3$,k3%)
color 12:locate 14,k2%:print b2$
color 12:locate 15,k3%:print b3$
case else
end select
end if
end sub
'
Pagina 37
'-----------------------------------------------------
sub tekstkeuze (hlp1$,hlp2$,k%,b2$,k2%,b3$,k3%)
k1%=val(tmp2$)
if k1%>0 then
l%=len(hlp1$)
select case k1%
case <42-l%
b2$=mid$(hlp2$,k1%,l%):b3$=""
k2%=k1%+k%-1:k3%=k%
case <41
b2$=mid$(hlp2$,k1%,41-k1%):b3$=mid$(hlp2$,41,k1%+l%-41)
k2%=k1%+k%-1:k3%=k%
case else
b2$="":b3$=mid$(hlp2$,k1%,l%)
k2%=k%:k3%=k1%-41+k%
end select
else
b2$="":b3$="":k2%=k%:k3%=k%
end if
end sub
'
Pagina 38
'-----------------------------------------------------
sub tekstnaarTXTbestand
call tapetyperead:call subjectread
l3%=fnREKEN (n1,n2,val(stp$)):l4%=l3%:l3%=fnREKEN (n1,n2,val(stt$))
b0$=using$("####",n%):replace " " with "0" in b0$
call datumwissel (dat$,dtm$)
b1$=dtm$
b2$=using$("####",val(tpn$)):replace " " with "0" in b2$
b3$=ttpi$
b31$=using$("####",val(ttp$)):replace " " with "0" in b31$
b4$=using$("\ \",stt$)
b42$=using$("##",l3%\3600)
b41$=using$("##",(l3% mod 3600)\60)
b40$=using$("##",(l3% mod 3600) mod 60)
b41$=b42$+":"+b41$+":"+b40$:replace " " with "0" in b41$
b5$=using$("\ \",stp$)
b52$=using$("##",l4%\3600)
b51$=using$("##",(l4% mod 3600)\60)
b50$=using$("##",(l4%mod 3600) mod 60)
b51$=b52$+":"+b51$+":"+b50$:replace " " with "0" in b51$
b62$=using$("##",abs((l4%-l3%)\3600))
b61$=using$("##",abs(((l4%-l3%) mod 3600)\60))
b60$=using$("##",abs(((l4%-l3%) mod 3600) mod 60))
b6$=b62$+":"+b61$+":"+b60$:replace " " with "0" in b6$
b7$=sjti$
b71$=using$("####",val(sjt$)):replace " " with "0" in b71$
b8$=left$(ttl$,40):b81$=right$(ttl$,40)
b9$=left$(mkr$,40):b91$=right$(mkr$,40)
b10$=left$(opm$,40):b101$=right$(opm$,40)
print #12,string$(75,"-")
print #12,"Datanr:"+b0$+" Datum:"+b1$+" Tapenr:"+b2$+_
" Tapetype:"+b31$+" "+b3$
print #12,"Start "+b41$+"("+b4$+") Stop "+b51$+"("+b5$+") Duur "+_
b6$+" Cat.:"+b71$+" "+b7$
print #12,"Titel: "+b8$+rtrim$(b81$)
print #12,"Maker: "+b9$+rtrim$(b91$)
print #12,"Opm. : "+b10$+rtrim$(b101$)
print #12,chr$(13)
end sub
'
Pagina 39
'-----------------------------------------------------
sub tekstnaarHTMbestand
call tapetyperead:call subjectread
l3%=fnREKEN (n1,n2,val(stp$)):l4%=l3%:l3%=fnREKEN (n1,n2,val(stt$))
b0$=using$("####",n%):replace " " with "0" in b0$
call datumwissel (dat$,dtm$)
b1$=dtm$
b2$=using$("####",val(tpn$)):replace " " with "0" in b2$
b3$=ttpi$
b31$=using$("####",val(ttp$)):replace " " with "0" in b31$
b4$=using$("\ \",stt$)
b42$=using$("##",l3%\3600)
b41$=using$("##",(l3% mod 3600)\60)
b40$=using$("##",(l3% mod 3600) mod 60)
b41$=b42$+":"+b41$+":"+b40$:replace " " with "0" in b41$
b5$=using$("\ \",stp$)
b52$=using$("##",l4%\3600)
b51$=using$("##",(l4% mod 3600)\60)
b50$=using$("##",(l4%mod 3600) mod 60)
b51$=b52$+":"+b51$+":"+b50$:replace " " with "0" in b51$
b62$=using$("##",abs((l4%-l3%)\3600))
b61$=using$("##",abs(((l4%-l3%) mod 3600)\60))
b60$=using$("##",abs(((l4%-l3%) mod 3600) mod 60))
b6$=b62$+":"+b61$+":"+b60$:replace " " with "0" in b6$
b7$=sjti$
b71$=using$("####",val(sjt$)):replace " " with "0" in b71$
b8$=left$(ttl$,40):b81$=right$(ttl$,40)
b9$=left$(mkr$,40):b91$=right$(mkr$,40)
b10$=left$(opm$,40):b101$=right$(opm$,40)
print #12,"<P>
print #12,"<FONT FACE=";qm$;font$;qm$;" COLOR=";qm$;"navy";qm$;" SIZE=";size$;">"
print #12,"<HR><BR>"
print #12,"Datanr:"+b0$+" Datum:"+b1$+" Tapenr:"+b2$+_
" Tapetype:"+b31$+" "+b3$+"<BR>"
print #12,"Start "+b41$+"("+b4$+") Stop "+b51$+"("+b5$+") Duur "+_
b6$+" Cat.:"+b71$+" "+b7$+"<BR>"
print #12,"Titel: "+b8$+rtrim$(b81$)+"<BR>"
print #12,"Maker: "+b9$+rtrim$(b91$)+"<BR>"
print #12,"Opm. : "+b10$+rtrim$(b101$)
print #12,"</FONT></P>"
end sub
'
Pagina 40
'-----------------------------------------------------
def fnSPRITEBYTE (x%,y%)
fnSPRITEBYTE=2*y%*ceil(x%/8)+1
end def
sub spriteload (spt%(),hlp$)
def seg =varseg(spt%(0)):bload hlp$,varptr(spt%(0))
end sub
sub bandteken
br%=60*val(stp$)/n2:if br%>80 then br%=80
bl%=l0%/3-br%:if bl%<0 then bl%=0
rr%=28+br%:pr%=498+br%\2:rl%=28+bl%:pl%=110-bl%\2
circle (138,163),28,6,90*deg#,270*deg#
circle (470,163),28,6,270*deg#,90*deg#
circle (138,163),rl%,6,90*deg#,270*deg#
circle (470,163),rr%,6,270*deg#,90*deg#
line (137,135-bl%)-(137,135),6:line (137,191+bl%)-(137,191),6
line (471,135-br%)-(471,135),6:line (471,191+br%)-(471,191),6
paint (pl%,163),6:paint (pr%,163),6
line (138-rl%,41)-(138-rl%,163),6
line (470+rr%,41)-(470+rr%,163),6
end sub
sub bandwis
f1$=chr$(240)+chr$(240)+chr$(240)+chr$(0)
f2$=chr$(15)+chr$(15)+chr$(15)+chr$(0)
f$=f1$+f1$+f1$+f1$+f2$+f2$+f2$+f2$
line (23,41)-(138,285),8,bf:line (585,41)-(470,285),8,bf
circle (138,163),114,7,90*deg#,270*deg#
circle (470,163),114,7,270*deg#,90*deg#
circle (138,163),28,7,90*deg#,270*deg#
circle (470,163),28,7,270*deg#,90*deg#
paint (121,155),f$,7:paint (487,155),f$,7
end sub
sub funtoets
if tmd%=0 then
color 10:locate 29,10:print "teller ";:color 7:print "tijd"
else
color 7:locate 29,10:print "teller ";:color 14:print "tijd"
end if
end sub
'
Pagina 41
'-----------------------------------------------------
sub layout
screen 12:cls:palette 1,15
f1$=chr$(240)+chr$(240)+chr$(240)+chr$(0)
f2$=chr$(15)+chr$(15)+chr$(15)+chr$(0)
f$=f1$+f1$+f1$+f1$+f2$+f2$+f2$+f2$
'───────Achtergrond
line (0,0)-(639,479),1,bf
'───────===============
'VIDEO CASSETTE
'───────===============
'───────Cassettehuis
circle (26,18),10,8:circle (582,18),10,8
circle (26,286),10,8:circle (582,286),10,8
paint (26,18),8:paint (582,18),8
paint (26,286),8:paint (582,286),8
line (26,8)-(582,296),8,bf
line (16,18)-(25,286),8,bf
line (592,18)-(583,286),8,bf
'───────Haspelvensters
line (22,40)-(139,286),7,b:line (586,40)-(469,286),7,b
'───────Haspels
circle (138,163),114,7,90*deg#,270*deg#
circle (470,163),114,7,270*deg#,90*deg#
circle (138,163),28,7,90*deg#,270*deg#
circle (470,163),28,7,270*deg#,90*deg#
paint (121,155),f$,7:paint (487,155),f$,7
'───────Etiket
line (142,88)-(466,248),7,bf:line (142,88)-(466,248),12,b
'───────Bandrichtingspijl
line (288,10)-(320,14),15:line (288,18)-(320,14),15
line (288,10)-(288,18),15:paint (304,14),7,15
'───────bandrug
circle (26,286),10,8,225*deg#,270*deg#
circle (582,286),10,8,270*deg#,0*deg#
circle (582,18),10,8,0*deg#,45*deg#
circle (54,314),10,8,225*deg#,270*deg#
circle (610,314),10,8,270*deg#,0*deg#
circle (610,46),10,8,0*deg#,45*deg#
line (19,293)-(47,321),8:line (26,296)-(582,296),8
line (54,324)-(610,324),8:line (592,286)-(592,18),8
line (620,314)-(620,46),8:line (589,11)-(617,39),8
paint (304,314),7,8
'───────Tape Merk en Type
color 14:locate 4,19:print "TAPE MERK EN TYPE "
color 15:locate 8,19:print "Titel"+string$(35,".")
locate 9,19:print string$(40,".")
put (143,96),ttst0%,pset
locate 11,19:print "Maker"+string$(35,".")
locate 12,19:print string$(40,".")
put (143,144),ttsm0%,pset
locate 14,19:print "Opmerking"+string$(31,".")
locate 15,19:print string$(40,".")
put (143,192),ttsn0%,pset
locate 20,8:print "nnnn"
locate 20,19:print "CATEGORIE "
'
Pagina 42
'-----------------------------------------------------
'───────===============
'VIDEO RECORDER
'───────===============
'───────Recorderhuis
line (16,340)-(592,440),8,bf
line (16,440)-(48,472),8:line (16,440)-(592,440),8
line (48,472)-(624,472),8:line (592,440)-(592,340),8
line (624,472)-(624,372),8:line (592,340)-(624,372),8
paint(320,456),7,8
'───────Tijdvensters
line (30,348)-(98,370),7,b
color 14:locate 23,5:print "uu:mm:ss"
line (110,348)-(178,370),7,b
color 14:locate 23,15:print "uu:mm:ss"
line (190,348)-(258,370),7,b
color 14:locate 23,25:print "uu:mm:ss"
'───────Tellervensters
line (54,380)-(98,402),7,b
color 10:locate 25,9:print "nnnn"
line (110,380)-(154,402),7,b
color 10:locate 25,16:print "nnnn"
line (278,380)-(322,402),7,b
color 10:locate 25,37:print "nnnn"
line (334,380)-(378,402),7,b
color 2:locate 25,44:print "nnnn"
color 7:locate 23,49:print "F3"
color 10:locate 23,52:print chr$(176)+chr$(176)+chr$(176)
color 7:locate 25,49:print "F4"
locate 25,52:color 15:print chr$(219);
color 7:print chr$(26);:color 10:print chr$(176);
locate 26,52:color 10:print chr$(176);
color 7:print chr$(26);:color 15:print chr$(219);
color 7:locate 27,43:print "F5"
color 15:locate 27,46:print "TXT"
color 3:locate 29,43:print "F6"
color 11:locate 29,46:print "HTM"
color 7:locate 23,35:print "F8"
color 10:locate 23,38:print "ALL";
color 15:print "TXT";:color 7:print"+";:color 11:print "HTM"
color 7:locate 29,52:print "F11"
color 15:locate 29,56:print size$
color 7:locate 29,58:print "F12"
color 15:locate 29,62:print font$
'───────Datumvenster
'───────Spoeldatum
line (174,380)-(258,402),7,b
color 2:locate 25,23:print "dd-mm-jjjj"
'───────Opnamedatum
'line (478,348)-(562,370),7,b
color 10:locate 23,61:print "dd-mm-jjjj"
'───────Huidige datum
line (478,380)-(562,402),7,b
color 2:locate 25,61:print "dd-mm-jjjj"
'───────Menukeuze
line (478,412)-(546,434),7,b
color 14:locate 27,61:print "INVOER"
if pass%>0 then color 14 else color 8
locate 27,70:print "F10"
'───────Starttoets
line (54,408)-(98,432),7,bf:put (54,408),ttsp0%,pset
color 7:locate 29,7:print "F9"
'───────Stoptoets
line (110,408)-(154,432),7,bf:put (110,408),ttss0%,pset
color 10:locate 29,10:print "teller ";:color 14:print "tijd"
'───────Rewindtoets
line (166,408)-(210,432),7,bf:put (166,408),ttsr0%,pset
'───────FastForwardtoets
line (222,408)-(266,432),7,bf:put (222,408),ttsf0%,pset
'───────Opnametoets
line (278,408)-(322,432),4,bf:put (278,408),ttso0%,pset
color 4:locate 29,35:print "F7"
color 12:locate 29,38:print "SAVE"
end sub
'
Pagina 43
'-----------------------------------------------------
sub gegsave (a$)
a$=""
do until cmd$<>""
cmd$=inkey$
color 12:locate 29,35:print "F7"
put (278,408),ttso1%,pset:delay 0.1
color 4:locate 29,35:print "F7"
put (278,408),ttso2%,pset:delay 0.1
loop
if cmd$<>keyF7$ then
color 7:locate 29,35:print "F7"
if cel%=0 then
put (278,408),ttso2%,pset
else
put (278,408),ttso0%,pset
end if
exit sub
end if
color 12:locate 29,35:print "F7"
put (278,408),ttso1%,pset
select case cel%
case 0
put #1,n%:put #2,n%
call bandvrij
if n%>hn% then incr hn%:a$=keyRI$
if val(tpn$)>htn% then htn%=val(tpn$)
put (278,408),ttso2%,pset
case 7
lset ttli$=ttl$
incr ttlm%:put #7,ttlm%
put (278,408),ttso0%,pset
case 8
lset mkri$=mkr$
incr mkrm%:put #8,mkrm%
put (278,408),ttso0%,pset
case 9
lset opmi$=opm$:incr opmm%:put #9,opmm%
put (278,408),ttso0%,pset
end select
call indexsave
call tekst
color 7:locate 29,35:print "F7"
end sub
sub indexsave
open "O",#6,"VI-DATA\VIDEO.IND"
print #6,hn%: '───────hoogste datanummer
print #6,htn%: '───────hoogste tapenummer
print #6,ttpm%:'───────tapetypemax
print #6,sjtm%:'───────subjectmax
print #6,ttlm%:'───────titelmax
print #6,mkrm%:'───────makermax
print #6,opmm%:'───────opmerkingmax
print #6,pass%:'───────password
print #6,size%:'───────HTML lettergrootte
print #6,font%:'───────HTML lettertype
close #6
end sub
'
Pagina 44
'-----------------------------------------------------
sub bandvrij
p%=val(tpn$):get #5,p%
x%=val(stp$):y%=val(tstp$)
if x%>y% then
hlp$=using$("####",n%):replace " " with "0" in hlp$
rset tdtn$=hlp$
hlp$=using$("####",x%):replace " " with "0" in hlp$
rset tstp$=hlp$
hlp$=using$("##",val(ttp$)):replace " " with "0" in hlp$
rset tttp$=hlp$
put #5,p%
end if
end sub
sub info
'BEELDSPT.BAS
'Deze subroutine neemt het beeld over in 3 arrays
'en slaat deze op in de files "BLD1SPT", "BLD2SPT" en "BLD3SPT
dim bld%(25601)
get (0,0)-(639,159),bld%()
def seg =varseg(bld%(0)):bsave "BLD1SPT.PIC",varptr(bld%(0)),51204
get (0,160)-(639,319),bld%()
def seg =varseg(bld%(0)):bsave "BLD2SPT.PIC",varptr(bld%(0)),51204
get (0,320)-(639,479),bld%()
def seg =varseg(bld%(0)):bsave "BLD3SPT.PIC",varptr(bld%(0)),51204
erase bld%
cls
'Laad de infotext
on error goto fout53
infofile$="VI-INFO\"+ltrim$(str$(n%)+".TXT")
open "I",#6,infofile$
do until eof(6)
line input #6,infoline$
if csrlin>29 then
print "..... next page .....(CR)";
a$=input$(1)
cls
end if
print infoline$
loop
call command (cmd$)
fout53:
pech%=err
if pech%= 53 then resume vervolg
vervolg:
close #6
cmd$=""
cls
'Deze subroutine leest de files "BLD1SPT", "BLD2SPT" en "BLD3SPT
'en zet de beeldinformatie in 3 arrays
'en plaatst de beeldinformatie op het scherm
dim bld%(25601)
def seg =varseg(bld%(0)):bload "BLD1SPT.PIC",varptr(bld%(0))
put (0,0),bld%,PSET
def seg =varseg(bld%(0)):bload "BLD2SPT.PIC",varptr(bld%(0))
put (0,160),bld%,PSET
def seg =varseg(bld%(0)):bload "BLD3SPT.PIC",varptr(bld%(0))
put (0,320),bld%,PSET
erase bld%
end sub
sub command (cmd$)
cmd$=""
do until cmd$<>""
cmd$=inkey$
loop
end sub
'
Pagina 45
'-----------------------------------------------------
sub allesnaarTXTbestand
b$=mid$(date$,4,3)+left$(date$,3)+right$(date$,4)
open "O",#12,"VI-ALLES.TXT"
print #12,"VIDEO op datanummer d.d. "+b$+" zoekkriterium : "+skri$
print #12,chr$(13)
for n%=1 to hn%
get #1,n%
get #2,n%
call tekstnaarTXTbestand
next n%
print #12,chr$(13)
close #12
end sub
sub lettertype
incr font%:if font%>5 then font%=0
select case font%
case 0:font$="Terminal "
case 1:font$="Verdana "
case 2:font$="Garamond "
case 3:font$="Times New Roman"
case 4:font$="Courier New "
case 5:font$="Arial "
end select
color 15:locate 29,62:print font$
end sub
sub lettersize
incr size%:if size%>7 then size%=1
size$=ltrim$(str$(size%))
color 15:locate 29,56:print size$
end sub
'
Pagina 46
'-----------------------------------------------------
sub allesnaarHTMbestand
b$=mid$(date$,4,3)+left$(date$,3)+right$(date$,4)
open "O",#12,"VI-ALLES.HTM"
print #12,"<HTML><HEAD><TITLE>VI140908-selectie</TITLE></HEAD>"
'-----Achtergond, lettertype/kleur/grootte, gecentreerd
print #12,"<BODY>"
print #12,"<FONT FACE=";qm$;"Verdana";qm$;" COLOR=";qm$;"fuchsia";qm$;" SIZE=8>"
print #12,"<CENTER>"
'-----Opschrift pagina, opmaak
print #12,"<P>Video Data Base 2014</P>"
print #12,"<HR COLOR=";qm$;"fuchsia";qm$;" SIZE=10>"
print #12,"</CENTER></FONT>"
print #12,"<P>
print #12,"<FONT FACE=";qm$;"Verdana";qm$;" COLOR=";qm$;"navy";qm$;" SIZE=4>"
print #12,"VIDEO op datanummer d.d. "+b$+" zoekkriterium : "+skri$
print #12,"</FONT></P>"
for n%=1 to hn%
get #1,n%
get #2,n%
call tekstnaarHTMbestand
call hrefnaarHTMbestand
next i%
print #12,chr$(13)
print #12,"</BODY>"
print #12,"</HTML>"
close #12
end sub
'
Pagina 47
'-----------------------------------------------------
sub jpegnaartabel
open "I",#13,"VI_JPEG.TXT"
do until eof(13)
input #13,hlp$
incr jpg%
loop
close #13
print "Aantal records is";jpg%
redim jpeg$(jpg%)
open "I",#13,"VI_JPEG.TXT"
for i%=1 to jpg%
input #13,hlp$
jpeg$(i%)=hlp$
next i%
close #13
end sub
sub jpegnaarHTMbestand
b0$=using$("####",n%):replace " " with "0" in b0$
for i%=1 to jpg%
hlp$=jpeg$(i%):hlp%=len(hlp$)
j%=instr(hlp$,b0$)
if j%>0 then
fl1$=left$(hlp$,10)
select case hlp%
case <19
fl2$=right$(hlp$,hlp%-10)
case else
fl2$=right$(hlp$,((hlp%-14) mod 5)+4)
end select
fl$=fl1$+fl2$
print #12,"<P>
print #12,"<IMG SRC="+qm$+"VI-JPEG/"+fl$+qm$;
print #12," WIDTH="+qm$+"60%"+qm$+" HEIGT="+qm$+"60%"+qm$+">"
print #12,"</P>"
end if
next i%
end sub
sub hrefnaarHTMbestand
b0$=using$("####",n%):replace " " with "0" in b0$
for i%=1 to jpg%
hlp$=jpeg$(i%):hlp%=len(hlp$)
j%=instr(hlp$,b0$)
if j%>0 then
fl1$=left$(hlp$,10)
select case hlp%
case <19
fl2$=right$(hlp$,hlp%-10)
case else
fl2$=right$(hlp$,((hlp%-14) mod 5)+4)
end select
fl$=fl1$+fl2$
print #12,"<P>
' print #12,"<A HREF="+qm$+"VI-JPEG/"+fl$+qm$;
' print #12," WIDTH="+qm$+"90%"+qm$+" HEIGT="+qm$+"90%"+qm$+">";
print #12,"<A HREF="+qm$+"VI-JPEG/"+fl$+qm$+" TARGET="+qm$+"_blanc"+qm$+">";
print #12,rtrim$(fl$,".jpg")+"</A>"
print #12,"</P>"
end if
next i%
end sub
'
Pagina 48
'-----------------------------------------------------
'KLEUREN
data 1 '─────── 1 donker blauw
data 2 '─────── 2 donker groen
data 3 '─────── 3 donker cyaan
data 4 '─────── 4 donker rood
data 5 '─────── 5 paars
data 20 '─────── 6 bruin
data 7 '─────── 7 licht grijs
data 56 '─────── 8 donker grijs
data 25 '─────── 9 licht blauw
data 26 '───────10 licht groen
data 27 '───────11 licht cyaan
data 60 '───────12 licht rood
data 61 '───────13 rose
data 62 '───────14 geel
data 63 '───────15 wit