home *** CD-ROM | disk | FTP | other *** search
/ Inside Multimedia 1995 August / IMM0895.ISO01.iso / magazin / optix / disk1 / optxppac.set / DEMOBANK.OPT < prev    next >
Text File  |  1995-05-05  |  7KB  |  234 lines
  1.  
  2. def(i)
  3. def(j)
  4. def(k)
  5. def(l)
  6. def(satz)
  7. def(x0)
  8. def(y0)
  9. def(dum1)
  10. def(dum2)
  11. def(dum3)
  12.  
  13. defs(i$)
  14. defs(j$)
  15. defs(dum1$)
  16. defs(dum2$)
  17.  
  18. defas(arr$,80,10)
  19.  
  20. procedure dither(flg,x,y,c,d,r)
  21.   rem   *** zeichnet eine Dither-Block auf Hintergrund 4*(64*l)
  22.   rem   *** flg = verlauf v.oben nach unten (0) oder umgekehrt (1)
  23.   rem   *** x,y = X-/Y-Koord. f.linke, obere BoxEcke
  24.   rem   *** c   = Dither-Farbe       d   = Verlaufshöhe
  25.   rem   *** r   = Höhen-Raster (Ditherhöhe=64 * r)
  26.   rem   *** erwartet die glob.Var's  'DUM1$','DUM2$','DUM1','DUM2' u.'DUM3'
  27.   locals(i,j)
  28.   dum1$:='00 22 20 02 11 33 31 13 10 32 30 12 01 23 21 03 '
  29.   for i:=0 to d*r-1 do
  30.     for j:=0 to i/r do
  31.      dum2$:=dum1$
  32.      mid(dum2$,j*3+1,1)
  33.      val(dum2$,dum1,dum3)
  34.      dum2$:=dum1$
  35.      mid(dum2$,j*3+2,1)
  36.      val(dum2$,dum2,dum3)
  37.      if flg<>0
  38.        plotc(x+dum1,y+dum2+i*4,c)
  39.      else
  40.        plotc(x+dum1,y+d*r*4-1-dum2-i*4,c)
  41.      endif
  42.     next(j)
  43.   next(i)
  44. return
  45.  
  46. rem include('dither.inc')
  47.  
  48. begin
  49.  
  50.   break(off)
  51.   new(arr$)                                  Textfeld öffnen
  52.  
  53.   readfont(1,'BIT16X32.FNT')
  54.   readfont(2,'TRI22N.FNT')
  55.  
  56.   font(1)
  57.   textcolor(255)
  58.   font(2)
  59.   textcolor(255)
  60.  
  61.   opendbank('demobank.DBF')                 Datenbank öffnen
  62.  
  63.   rem *****************************************************************
  64.   rem Dieser Bildaufbau erfolgt hier nur einmal zum Programmanfang.
  65.   rem Später wird der erzeugte Verlauf aus dem Hintergrund-Bildpuffer
  66.   rem durch LOADPIC(1,0) restauriert.
  67.   rem
  68.   gradation(224,232,12,12,12,63,63,63)        Farbverlauf
  69.   for i:=0 to 7 do
  70.     viewport(0,i*64,3,i*64+63)                Hintergrundbox...
  71.     cbox(0,225+i,0)                           ... zeichnen...
  72.     dither(0,0,i*64,224+i,16,1)               ... und Dither-Verlauf zeichnen
  73.   next(i)
  74.   copywin(0,0,3,ymax)                         ersten Streifen in Win-Puffer
  75.   for i:=0 to 3 do                            Vier Streifen...
  76.     loadwin(i*4,0,0,0)                        ...zeichnen
  77.   next(i)
  78.   copywin(0,0,15,ymax)                        breiteren Streifen in Win-Puffer
  79.   for i:=0 to 47 do                           ...und Rest...
  80.     loadwin(i*16,0,0,0)                       ...zeichnen
  81.   next(i)
  82.   scrtobuf                                    ab in den Hintergrund-Puffer
  83.   rem *****************************************************************
  84.  
  85. :start
  86.  
  87.   font(2)
  88.   writestyle(3)
  89.   textshadow(2,2)
  90.   textcofs(3)
  91.   textcolor(230)
  92.   setpstd
  93.   gradation(224,232,12,12,12,63,63,63)
  94.   getpal(14)
  95.   getpal(15)
  96.   loadpic(0,0)
  97.   setcolor(255)
  98.   for i:=0 TO 7 DO
  99.     viewport(92+i*10,10,92+i*10+6,470)
  100.     cbox(0,225+i,0)
  101.     plateau(255,0)
  102.   next(i)
  103.   printc(400,300,'OPTIX-DBase')
  104.   printc(400,340,'Verwaltung')
  105.   setcolor(0)
  106.   font(0)
  107.   sysfont(1,1)
  108.  
  109.   rem *****************************************************************
  110.   rem
  111.   rem Statt der DEFBUTTON-Abfrage wäre hier eine direkte Indexabfrage
  112.   rem des gewünschten Datenbankeintrags zu plazieren. Im effektivsten
  113.   rem Falle wäre dies ein komplexe 'UND/ODER'-Attribut-Abfrage zur
  114.   rem Analyse der jeweils zutreffenden 'Karten'-Attribute.
  115.  
  116.   defbutton(100,200,60,30,15,1,0,1,#49,'page1')
  117.   defbutton(100,250,60,30,15,1,0,1,#50,'page2')
  118.   defbutton(100,300,60,30,15,1,0,1,esc,'exit')
  119.   printc(130,216,'1')
  120.   printc(130,266,'2')
  121.   printc(130,316,'ESC')
  122.  
  123.   checkbutton('start',30,0)
  124.  
  125. :page1
  126.   satz:=1
  127.   goto('viewset')
  128.  
  129. :page2
  130.   satz:=2
  131.   goto('viewset')
  132.  
  133.   rem *****************************************************************
  134.  
  135. :viewset
  136.  
  137.   readdbentry(satz)                           Datensatz öffnen
  138.  
  139.   if dbvalid<>true
  140.     goto('start')                             Zurück, wenn Eintrag ungültig
  141.   endif
  142.  
  143.   setcolor(244)
  144.   loadpic(1,0)
  145.   readdbpic(3,i)
  146.   getdbvar(2,k)                               Index-Eintrag lesen
  147.   str(k,3,i$)
  148.   printat(10,10,'Katalog-Nr.:'+i$)
  149.  
  150.   if i=true
  151.     getdbvar(4,x0)                            Bild-X-Koord. lesen
  152.     getdbvar(5,y0)                            Bild-Y-Koord. lesen
  153.     getdbvar(6,k)                             Keycolor-Farbe lesen
  154.     viewport(x0-2,y0-2,x0+winx+2,y0+winy+2)
  155.     rectangle
  156.     keycol(k)
  157.     key(on)
  158.     setallpal
  159.     k:=winx-1
  160.     l:=winy-1
  161.     for i:= 0 TO k step 32 DO
  162.       for j:= 0 TO l step 32 DO
  163.         loadsprite(i,j,x0+i,y0+j,16,16)
  164.         loadsprite(i+16,j+16,x0+i+16,y0+j+16,16,16)
  165.       next(j)
  166.     next(i)
  167.     loadwin(x0,y0,8,0)
  168.   endif
  169.  
  170.   getdbline(8,i$)                             Text-Filename lesen
  171.   printat(x0,y0+winy+15,i$)                   ...Filename ausgeben
  172.   readtext(i$,1,5)                            Textblock lesen
  173.   printtext(x0,y0+winy+30,1,5,0)              ...und schreiben
  174.  
  175.   getdbline(9,i$)                             Sound-Filename lesen
  176.   readsound(i$)                               Sound laden
  177.   startsound                                  Sound starten
  178.  
  179.   getdbline(1,i$)                             Einzeleinträge lesen
  180.   printat(x0+10+winx+10,100,'TITEL: '+i$)
  181.   getdbline(3,i$)                                   "          "
  182.   printat(x0+10+winx+10,116,'BILD : '+i$)
  183.   getdbline(7,i$)                                   "          "
  184.   printat(x0+10+winx+10,132,'VIDEO: '+i$)
  185.   getdbline(8,i$)                                   "          "
  186.   printat(x0+10+winx+10,148,'TEXT : '+i$)
  187.   getdbline(9,i$)                                   "          "
  188.   printat(x0+10+winx+10,164,'SOUND: '+i$)
  189.   getdbline(10,i$)                                  "          "
  190.   printat(x0+10+winx+10,180,'PFAD : '+i$)
  191.  
  192.   setpstd
  193.   setsubpal(15)
  194.  
  195.   defbutton(x0-70,y0   ,65,30,15,1,0,1,#86,'show')
  196.   defbutton(x0-70,y0+40,65,30,15,1,0,1,#27,'start')
  197.   printc(x0-38,y0+15,'(V)IDEO')
  198.   printc(x0-38,y0+55,'ESC')
  199.  
  200.   checkbutton('start',30,0)
  201.  
  202. :show
  203.   getdbline(7,i$)                    Film-Filename holen
  204.   trim(i$)                           evtl. DBase-Füllblanks löschen
  205.   clearscreen(0)
  206.  
  207.   j$:='mollefem.mvi'
  208.   if i$ = j$
  209.     readfilm(i$)                     Film laden
  210.     readpal('mollefem.pal')          'MOLLEFEM.MVI' hat keine eigenen Palette
  211.     fadein(1)
  212.     showfilm(100,100,30,0)           Film starten
  213.   else
  214.     fullscreen(on)
  215.     initavi(i$)
  216.     fadein(1)
  217.     startavi(10,10,1,1,0,1,1,1)      Film starten
  218.     closeavi
  219.     fullscreen(off)
  220.   endif
  221.   readfont(1,'BIT16X32.FNT')         Fonts neu laden
  222.   readfont(2,'TRI22N.FNT')             "    "    "
  223.   font(0)                            Sysfont wieder anschalten
  224.   sysfont(1,1)
  225.   fadeout(1)
  226.   goto('viewset')
  227.  
  228. :exit
  229.  
  230. end
  231.  
  232.  
  233.  
  234.