home *** CD-ROM | disk | FTP | other *** search
/ Inside Multimedia 1995 August / IMM0895.BIN / magazin / optix / disk1 / optxppac.set / FEINSTEN.OPT < prev    next >
Text File  |  1995-05-05  |  7KB  |  307 lines
  1.  
  2. defs(dk0,'Multimedia vom Feinsten...')
  3. defs(dk1,'Dürfen es vielleicht ein')
  4. defs(dk2,'paar Kilobyte mehr sein ???')
  5. defs(dum$)
  6.  
  7. def(i)
  8. def(j)
  9. def(k)
  10.  
  11. procedure pbox(xl,yo,xr,yu,col,mod,verz)
  12.  
  13.   rem  *** CBOX incl. Koord.-angabe
  14.   rem  *** ----------------------------
  15.   rem  *** 'col'  = Farbe der Fläche
  16.   rem  *** 'mod'  = workmode    (s.cbox)
  17.   rem  *** 'verz' = Verzögerung ( -"-  )
  18.  
  19.   viewport(xl,yo,xr,yu)
  20.   cbox(mod,col,verz)
  21.  
  22. return
  23.  
  24. procedure sbox(xl,yo,xr,yu,thick,col1,col2)
  25.  
  26.   rem  *** PLATEAU incl. Koord.-angabe
  27.   rem  *** ----------------------------
  28.   rem  *** 'col1' = Farbe f. links/oben
  29.   rem  *** 'col2' = Farbe f. rechts/unten
  30.   rem  *** 'thick'= Rahmendicke
  31.  
  32.   viewport(xl,yo,xr,yu)
  33.   do
  34.     incviewport
  35.     plateau(col1,col2)
  36.   loop(thick)
  37.  
  38. return
  39.  
  40. procedure rubberline(x1,y1,x2,y2,col,t1,t2)
  41.  
  42.   rem  *** erzeugt Gummiband-'Flutsch'-Effekt
  43.   rem  *** ----------------------------
  44.   rem  *** x1,y1  = 'von' -Koord.
  45.   rem  *** x2,y2  = 'nach'-Koord.
  46.   rem  *** 'col'  = Farbe der Linie
  47.   rem  *** 't1'   = Verzögerung der line
  48.   rem  *** 't2'   = Verzögerung der RESTORELINE
  49.  
  50.   setcolor(col)
  51.   line(x1,y1,x2,y2,t1)
  52.   restoreline(x1,y1,x2,y2,t2)
  53.  
  54. return
  55.  
  56. procedure fbox(xl,yo,xr,yu,cnt,col,mod,verz)
  57.  
  58.   rem  *** Vert.Verlauf hell=oben/dunkel=unten
  59.   rem  *** -----------------------------------
  60.   rem  *** 'xl,yo,xr,yu'= innere Eckkoordinaten
  61.   rem  *** 'cnt'        = Anzahl der Stufen
  62.   rem  *** 'col'        = Index der Startfarbe
  63.   rem  *** 'mod'        = CBOX-Modus
  64.   rem  *** 'verz'       = Verzögerungsfaktor
  65.   rem  *** '
  66.  
  67.   locals(pi)
  68.   inc(col,cnt)
  69.   pi:=((yu-yo)/cnt)-1
  70.   do
  71.     yu:=yo
  72.     inc(yu,pi)
  73.     viewport(xl,yo,xr,yu)
  74.     inc(yo,pi)
  75.     cbox(mod,col,verz)
  76.     dec(col,1)
  77.   loop(cnt)
  78.  
  79. return
  80.  
  81. procedure frame(xl,yo,xr,yu,col,dick)
  82.  
  83.   rem ***  Erzeugt einen Rahmen m. den inneren Eckkoordinaten xl,yo,xr,yu
  84.   rem ***  und der Dicke 'dick'. Dabei wird bis zur halben Dicke
  85.   rem ***  des Rahmens jeder Linie fortlaufend ab der Farbe 'col' die
  86.   rem ***  jeweils folgende Farbe zugeordnet. Ab der halben Rahmendicke
  87.   rem ***  läuft die Farbzuordnung umgekehrt. Bei geeigneter Farbpalette
  88.   rem ***  kann so ein 'Rohrrahmen' erzeugt werden.
  89.   rem ***
  90.   rem ***  z.B.:  GRADATION(240,249,12,24,15,24,48,30)
  91.   rem ***         FRAME(100,100,200,200,240,20)
  92.   rem ***
  93.   rem ***  nach Rückkehr ist SETCOLOR und VIEWPORT verändert.
  94.  
  95.   locals(i,j)
  96.   viewport(xl,yo,xr,yu)
  97.   for i:=1 to dick/2 do
  98.     setcolor(col+i-1)
  99.     rectangle
  100.     incviewport
  101.   next(i)
  102.   if (dick/2)*2<>dick
  103.     incviewport
  104.   endif
  105.   for j:=1 to dick/2 do
  106.     setcolor(col+i-j)
  107.     rectangle
  108.     incviewport
  109.   next(j)
  110. return
  111.  
  112.  
  113. procedure cmd(xl,yo,dm,rot,blau,grau)
  114.  
  115.    rem ****************************************************
  116.    rem zeichnet ein CMD-Logo
  117.    rem xl,yo           = obere, linke Ecke
  118.    rem dm              = Durchmesser (Höhe) des Logos
  119.    rem rot, blau, grau = die drei Systemfarben aus der aktuellen Palette
  120.    rem der 'WIN'-Puffer ist anschließend verändert
  121.    rem ****************************************************
  122.  
  123.    locals(rad,lin,i,j,k,l)
  124.    rad := dm/2
  125.    lin := dm/30
  126.    copywin(xl+rad-lin-1,yo,xl+dm+(rad/2)+lin,yo+dm+1)
  127.    disk(xl+rad,yo+rad,rad,rot)
  128.    disk(xl+dm+(rad/2),yo+rad,rad,rot)
  129.    loadwin(xl+rad-lin-1,yo,0,0)
  130.    j := ((dm-(rad/2))/2+lin)*880/1000
  131.    k := dm+(rad/2)-2
  132.    setcolor(blau)
  133.    for i:= 0 to j-1 do
  134.      inc(l,4)
  135.      line(xl+rad+i+1,yo+(l/5),xl+rad+i+1,yo+dm-1,0)
  136.      line(xl+k-i+1,yo+(l/5),xl+k-i+1,yo+dm-1,0)
  137.    next(i)
  138.    disk(xl+rad-lin,yo+rad,dm*2/9,grau)
  139.    disk(xl+dm+(rad/2)+lin,yo+rad,dm*2/9,grau)
  140.  
  141. return
  142.  
  143. begin
  144.  
  145.   readpic('clementi.bmp')
  146.   readfont(1,'tri22n.fnt')
  147.   font(1)
  148.   fadeout(0)
  149.   loadwin(218, 68,8,40)
  150.   i:=winx
  151.   j:=winx
  152.   cmd(256,114,16,255,255,255)
  153.   cmd(258,116,16,0,0,0)
  154.   cmd(257,115,16,252,253,254)
  155.   copywin(218,68,218+i-1,68+j-8)
  156.   clearscreen(2)
  157.   setallpal
  158.  
  159.   setrgbcolor(56, 0, 0,252)
  160.   setrgbcolor( 0, 0,56,253)
  161.   setrgbcolor(32,32,32,254)
  162.  
  163.   key(on)
  164.   keycol(232)
  165.   scrtobuf
  166.  
  167.   readsound('capumusi.snd')
  168.   startsound
  169.  
  170.   for i:=0 to 12 do
  171.     for j:=0 to 16 do
  172.       sbox(2+j*40,5+i*40,2+j*40+30,5+i*40+30,1,228,52)
  173.     next(j)
  174.   next(i)
  175.  
  176.   loadwin(218, 68,8,40)
  177.   loadwin(160,138,8,40)
  178.   loadwin(241,136,8,40)
  179.   loadwin(109,208,8,40)
  180.   loadwin(209,212,8,40)
  181.   loadwin(302,206,8,40)
  182.  
  183.   k:=60
  184.   for i:=0 to 3 do
  185.     setcolor(0)
  186.     for j:=0 to 14 do
  187.       line(k,0,0,k,0)
  188.       inc(k,1)
  189.     next(j)
  190.     setcolor(81)
  191.     for j:=0 to 14 do
  192.       line(k,0,0,k,0)
  193.       inc(k,1)
  194.     next(j)
  195.     setcolor(191)
  196.     for j:=0 to 14 do
  197.       line(k,0,0,k,0)
  198.       inc(k,1)
  199.     next(j)
  200.     inc(k,18)
  201.   next(i)
  202.  
  203.   gradation(240,248,10,15,3,33,55,15)
  204.   fbox(90,360,570,480,7,241,0,0)
  205.  
  206.   textcofs(-2)
  207.   textcolor(0)
  208.   printat(102,362,dk0)
  209.   textcolor(228)
  210.   for i:=-1 to 1 do
  211.     printat(101+i,395+i,dk1)
  212.     printat(101+i,423+i,dk2)
  213.   next(i)
  214.   textcolor(64)
  215.   printat(100,360,dk0)
  216.   textcolor(2)
  217.   printat(101,395,dk1)
  218.   printat(101,423,dk2)
  219.  
  220.   sbox(90,360,570,460,3,183,61)
  221.   frame(90,360,570,460,242,12)
  222.  
  223.   font(0)
  224.   sysfont(3,1)
  225.  
  226.   for i:=0 to 3 do
  227.     pbox(528,51+i*40,546,69+i*40,177,15,10)
  228.     frame(528,51+i*40,546,69+i*40,243,10)
  229.   next(i)
  230.  
  231.   for i:=0 to 1 do
  232.     setcolor(i*232+1)
  233.     printat(367-i*2, 55-i*2,'Angebot der Woche:')
  234.     printat(367-i*2, 95-i*2,'Neu auf dem Markt:')
  235.     printat(367-i*2,135-i*2,'Interessantes    :')
  236.     printat(367-i*2,175-i*2,'Für die Hausfrau :')
  237.   next(i)
  238.  
  239.  
  240.   for i:=0 to 1 do
  241.     rubberline( 90,360,570,360,232,50,20)
  242.     rubberline(570,360, 90,360,232,50,20)
  243.     rubberline( 90,360,570,360,232,50,20)
  244.     rubberline(570,360,570,460,232,50,20)
  245.     rubberline(570,460, 90,460,232,50,20)
  246.     rubberline( 90,460, 90,360,232,50,20)
  247.   next(i)
  248.  
  249.   scrtobuf
  250.  
  251. :start
  252.  
  253.   setcolor(0)
  254.  
  255.   defbutton(527, 50,20,20,15,1,0,1,'1','lab1')
  256.   defbutton(527, 90,20,20,15,1,0,1,'2','lab2')
  257.   defbutton(527,130,20,20,15,1,0,1,'3','lab3')
  258.   defbutton(527,170,20,20,15,1,0,1,'4','lab4')
  259.   defbutton(0,0,0,0,0,0,0,0,esc,'exit')
  260.  
  261.   printat(534, 54,'1')
  262.   printat(534, 94,'2')
  263.   printat(534,134,'3')
  264.   printat(534,174,'4')
  265.  
  266.   checkbutton('exit',30,0)
  267.  
  268. :lab1
  269.   viewport(520, 43,556, 77)
  270.   restorebox(8,20)
  271.   dum$:='1'
  272.   goto('weiter')
  273. :lab2
  274.   viewport(520, 83,556,117)
  275.   restorebox(8,20)
  276.   dum$:='2'
  277.   goto('weiter')
  278. :lab3
  279.   viewport(520,123,556,157)
  280.   restorebox(8,20)
  281.   dum$:='3'
  282.   goto('weiter')
  283. :lab4
  284.   viewport(520,163,556,197)
  285.   restorebox(8,20)
  286.   dum$:='4'
  287.   goto('weiter')
  288.  
  289. :weiter
  290.   pause(500)
  291.   font(1)
  292.   writestyle(3)
  293.   textshadow(2,2)
  294.   clearscreen(100)
  295.   textcolor(255)
  296.   printc(320,220,'Weitere Informationen')
  297.   printc(320,260,'zum Menüpunkt '+dum$)
  298.   font(0)
  299.   pause(1000)
  300.   loadpic(5,0)
  301.   goto('start')
  302.  
  303. :exit
  304.  
  305. end
  306.  
  307.