home *** CD-ROM | disk | FTP | other *** search
/ Inside Multimedia 1995 August / IMM0895.BIN / magazin / optix / disk1 / optxppac.set / OP_STAGE.OPT < prev    next >
Text File  |  1995-05-08  |  10KB  |  374 lines

  1. rem*********************************************************************
  2. rem
  3. rem  z.B. folgendes in NC.EXT im Norton-Verzeichnis eintragen
  4. rem
  5. rem    gif: d:\optix28\OP_STAGE !.!
  6. rem    bmp: d:\optix28\OP_STAGE !.!
  7. rem    pcx: d:\optix28\OP_STAGE !.!
  8. rem    tga: d:\optix28\OP_STAGE !.!
  9. rem 
  10. rem    voc: d:\optix28\OP_STAGE !.!
  11. rem    wav: d:\optix28\OP_STAGE !.!
  12. rem    snd: d:\optix28\OP_STAGE !.!
  13. rem 
  14. rem    inc: d:\optix28\OP_STAGE !.!
  15. rem    bak: d:\optix28\OP_STAGE !.!
  16. rem    txt: d:\optix28\OP_STAGE !.!
  17. rem 
  18. rem    doc: d:\optix28\OP_STAGE !.!
  19. rem    ini: d:\optix28\OP_STAGE !.!
  20. rem 
  21. rem    avi: d:\optix28\OP_STAGE !.!
  22. rem 
  23. rem    fli: d:\optix28\OP_STAGE !.!
  24. rem    flc: d:\optix28\OP_STAGE !.!
  25. rem 
  26. rem  dann, OP_STAGE.OPT compilieren, EXE draus machen und dieses dann
  27. rem  in (hier:) 'D:\OPTIX28' ablegen. Anschließend werden (fast) alle
  28. rem  OPTIX-kompatiblen Formate durch Auswahl im Norton-Commander angezeigt
  29. rem  bzw. gestartet.
  30. rem 
  31. rem
  32. rem*********************************************************************
  33. rem  Achtung Schnellschuß!! Nicht optimiert!
  34. rem  Die reine Programmierzeit betrug (ohne Prozedur-Module) ca. 90 Minuten
  35. rem*********************************************************************
  36.  
  37. def(i)
  38. def(j)
  39. def(k)
  40. def(l)
  41. def(back)
  42. def(typ)
  43. def(bild,1)
  44. def(ton,2)
  45. def(text,3)
  46. def(video,4)
  47. def(fli,5)
  48. def(cnt,30)
  49. def(taste)
  50. defs(dat$)
  51. defs(dum$)
  52. defs(dum1$)
  53. defs(dum2$)
  54. defs(dum3$)
  55. defs(upper$)
  56. defs(path$)
  57.  
  58. defai(GP,32)
  59. defas(text$,128,5000)
  60.  
  61.  
  62.  
  63. procedure cornerbox(x,y,xx,yy,p)
  64.   rem *** wird von 'gsbox' benötigt
  65.   locals(tl)
  66.   tl:=4
  67.   vline(x,y,x+(xx-x)/tl,y,p)
  68.   vline(x,y,x,y+(yy-y)/tl,p)
  69.   vline(xx-(xx-x)/tl,y,xx,y,p)
  70.   vline(xx,y,xx,y+(yy-y)/tl,p)
  71.   vline(x,yy,x+(xx-x)/tl,yy,p)
  72.   vline(x,yy-(yy-y)/tl,x,yy,p)
  73.   vline(xx-(xx-x)/tl,yy,xx,yy,p)
  74.   vline(xx,yy-(yy-y)/tl,xx,yy,p)
  75. return
  76. procedure gsbox(flag,stp,qx,qy,qb,qh,zx,zy,zb,zh,xb,yh,p)
  77.   rem produziert eine 'GROW'- und/oder 'SHRINK'- und/oder 'MOVE'-Box
  78.   rem
  79.   rem flag: Arbeitsmodus (3Bit-Vektor)
  80.   rem        Bit 0 gesetzt (+1) = Quellbox wird 'geshrinkt'
  81.   rem        Bit 1 gesetzt (+2) = Bewegungseffekt (Move) wird ausgeführt
  82.   rem        Bit 2 gesetzt (+4) = Zielbox wird 'gegrowt'
  83.   rem
  84.   rem stp : gibt die Anzahl der Bewegungsschritte an (beliebig)
  85.   rem
  86.   rem qx,qy,qb,qh = Xpos, Ypos, Breite und Höhe der Quellbox
  87.   rem zx,zy,zb,zh = Xpos, Ypos, Breite und Höhe der Zielbox
  88.   rem
  89.   rem xb,yh : Breite und Höhe der Bewegungsbox (MOVE)
  90.   rem p      : Verzögerungsfaktor
  91.   rem
  92.   locals(i,btst)
  93.   btst:=flag
  94.   and(btst,1)
  95.   if btst<>0
  96.     for i:=0 to stp/2 do
  97.       cornerbox(qx+i*((qb/2)/stp),qy+i*((qh/2)/stp),qx+qb-i*((qb/2)/stp),qy+qh-i*((qh/2)/stp),p)
  98.     next(i)
  99.     for i:=0 to stp/2 do
  100.       cornerbox(qx+i*((qb/2)/stp),qy+i*((qh/2)/stp),qx+qb-i*((qb/2)/stp),qy+qh-i*((qh/2)/stp),p)
  101.     next(i)
  102.   endif
  103.   btst:=flag
  104.   and(btst,2)
  105.   if btst<>0
  106.     for i:=0 to stp do
  107.       cornerbox(qx+qb/2+i*((zx+zb/2)-(qx+qb/2))/stp-xb/2,qy+qh/2+i*((zy+zh/2)-(qy+qh/2))/stp-yh/2,qx+qb/2+i*((zx+zb/2)-(qx+qb/2))/stp+xb/2,qy+qh/2+i*((zy+zh/2)-(qy+qh/2))/stp+yh/2,p)
  108.     next(i)
  109.     for i:=0 to stp do
  110.       cornerbox(qx+qb/2+i*((zx+zb/2)-(qx+qb/2))/stp-xb/2,qy+qh/2+i*((zy+zh/2)-(qy+qh/2))/stp-yh/2,qx+qb/2+i*((zx+zb/2)-(qx+qb/2))/stp+xb/2,qy+qh/2+i*((zy+zh/2)-(qy+qh/2))/stp+yh/2,p)
  111.     next(i)
  112.   endif
  113.   btst:=flag
  114.   and(btst,4)
  115.   if btst<>0
  116.     for i:=stp/2 to stp do
  117.       cornerbox(zx+zb/2-i*((zb/2)/stp),zy+zh/2-i*((zh/2)/stp),zx+zb/2+i*((zb/2)/stp),zy+zh/2+i*((zh/2)/stp),p)
  118.     next(i)
  119.     for i:=stp/2 to stp do
  120.       cornerbox(zx+zb/2-i*((zb/2)/stp),zy+zh/2-i*((zh/2)/stp),zx+zb/2+i*((zb/2)/stp),zy+zh/2+i*((zh/2)/stp),p)
  121.     next(i)
  122.   endif
  123. return
  124.  
  125. procedure upper(s,l)
  126.  
  127.   rem *** wandelt in der vorzubelegenden globalen Stringvariable 'upper$'
  128.   rem *** ab Position 's' soviele Zeichen in Großbuchstaben um, wie in
  129.   rem *** 'l' angegeben wurden. Ist 'l'=0, so wird automatisch ab 's' bis
  130.   rem *** zum Stringende gewandelt. (Erwartet außerdem globale Var 'dum$')
  131.  
  132.   locals(i,j,k)
  133.   if s:=0
  134.     s:=1
  135.   endif
  136.   if l=0
  137.     len(upper$,l)
  138.   endif
  139.   for i:=s to l do
  140.     dum$:=upper$[i]
  141.     instr(dum$,'abcdefghijklmnopqrstuvwxyzäöü',j)
  142.     if j<>0
  143.       delete(upper$,i,1)
  144.       asc(dum$,k)
  145.       dec(k,32)
  146.       chr(dum$,k)
  147.       insert(dum$,upper$,i)
  148.     endif
  149.   next(i)
  150. return
  151.  
  152.  
  153. procedure cmd(xl,yo,dm,rot,blau,grau)
  154.  
  155.    rem ****************************************************
  156.    rem zeichnet ein CMD-Logo
  157.    rem xl,yo           = obere, linke Ecke
  158.    rem dm              = Durchmesser (Höhe) des Logos
  159.    rem rot, blau, grau = die drei Systemfarben aus der aktuellen Palette
  160.    rem der 'WIN'-Puffer ist anschließend verändert
  161.    rem ****************************************************
  162.  
  163.    locals(rad,lin,i,j,k,l)
  164.    rad := dm/2
  165.    lin := dm/30
  166.    copywin(xl+rad-lin-1,yo,xl+dm+(rad/2)+lin,yo+dm+1)
  167.    disk(xl+rad,yo+rad,rad,rot)
  168.    disk(xl+dm+(rad/2),yo+rad,rad,rot)
  169.    loadwin(xl+rad-lin-1,yo,0,0)
  170.    j := ((dm-(rad/2))/2+lin)*880/1000
  171.    k := dm+(rad/2)-2
  172.    setcolor(blau)
  173.    for i:= 0 to j-1 do
  174.      inc(l,4)
  175.      line(xl+rad+i+1,yo+(l/5),xl+rad+i+1,yo+dm-1,0)
  176.      line(xl+k-i+1,yo+(l/5),xl+k-i+1,yo+dm-1,0)
  177.    next(i)
  178.    disk(xl+rad-lin,yo+rad,dm*2/9,grau)
  179.    disk(xl+dm+(rad/2)+lin,yo+rad,dm*2/9,grau)
  180.  
  181. return
  182.  
  183. INCLUDE('listbox.inc')
  184.  
  185. begin
  186.  
  187.   cmd(10,10,70,12,9,7)
  188.   sysfont(3,1)
  189.   setcolor(14)
  190.   PRINTc(xmax-80,ymax-35,'OPTIX-STAGE')
  191.   PRINTc(xmax-80,ymax-20,'***********')
  192.   dat$:=paramstr(1)
  193.   len(dat$,i)
  194.   if i>3
  195.     dum1$:=dat$
  196.     delete(dum1$,1,i-4)
  197.     dum2$:=dum1$
  198.     mid(dum2$,1,1)
  199.     if dum2$='.'
  200.       mid(dum1$,2,3)
  201.       upper$:=dum1$
  202.       upper(1,0)
  203.  
  204.       Typ:=0
  205.  
  206.       if upper$='BMP'
  207.         Typ:=Bild
  208.       endif
  209.       if upper$='TGA'
  210.         Typ:=Bild
  211.       endif
  212.       if upper$='PCX'
  213.         Typ:=Bild
  214.       endif
  215.       if upper$='GIF'
  216.         Typ:=Bild
  217.       endif
  218.  
  219.       if upper$='WAV'
  220.         Typ:=ton
  221.       endif
  222.       if upper$='VOC'
  223.         Typ:=ton
  224.       endif
  225.       if upper$='SND'
  226.         Typ:=ton
  227.       endif
  228.  
  229.       if upper$='TXT'
  230.         Typ:=text
  231.       endif
  232.       if upper$='DOC'
  233.         Typ:=text
  234.       endif
  235.       if upper$='INC'
  236.         Typ:=text
  237.       endif
  238.       if upper$='BAK'
  239.         Typ:=text
  240.       endif
  241.       if upper$='OPT'
  242.         Typ:=text
  243.       endif
  244.       if upper$='CFG'
  245.         Typ:=text
  246.       endif
  247.       if upper$='INI'
  248.         Typ:=text
  249.       endif
  250.  
  251.       if upper$='AVI'
  252.         Typ:=video
  253.       endif
  254.       if upper$='MVI'
  255.         Typ:=video
  256.       endif
  257.  
  258.       if upper$='FLI'
  259.         Typ:=fli
  260.       endif
  261.       if upper$='FLC'
  262.         Typ:=fli
  263.       endif
  264.  
  265.  
  266.       if typ<>0
  267.  
  268.         if typ=bild
  269.           :bild
  270.           readwin(dat$)
  271.           clearscreen(0)
  272.           gsbox( 7   , 6  ,20,20,50,50,0 ,0,winx,winy,10 ,10 ,2)
  273.           setallpal
  274.           loadwin(0,0,0,0)
  275.           repeat
  276.             taste:=readkey
  277.             if taste=right
  278.               inc(cnt,1)
  279.               if cnt=40
  280.                 cnt:=30
  281.               endif
  282.               clearscreen(0)
  283.               loadwin(0,0,cnt,0)
  284.             endif
  285.             if taste=left
  286.               dec(cnt,1)
  287.               if cnt=29
  288.                 cnt:=39
  289.               endif
  290.               clearscreen(0)
  291.               loadwin(0,0,cnt,0)
  292.             endif
  293.           until taste=27
  294.         endif
  295.  
  296.         if typ=ton
  297.           sound(dat$)
  298.         endif
  299.  
  300.         if typ=text
  301.           new(text$)
  302.           new(gp)
  303.           readtext(dat$,1,5000)
  304.           back:=1
  305.  
  306.           rem ***************Listbox-Parameter*******************************
  307.           rem     (xl,yo ,zeich,zeil,fnt,txsta,pos,lines,rcol,tcol,bcol)
  308.           rem      |   |   |     |   |    |    |    |     |    |    |
  309.  
  310.           listbox(10 ,30 ,76   ,-46 ,-1 , 1   ,1  ,linctr*(-1) , 0  , 0  , 15)
  311.           gsbox( 7   , 6  ,20,20,50,50,20 ,20,600,440,10 ,10 ,5)
  312.           viewport(20,20,gp[17]+10,gp[18]+10)
  313.           cbox(9,0,0)
  314.           viewport(10,5,gp[17],gp[18])
  315.           cbox(0,8,0)
  316.           plateau(0,15)
  317.           viewport(10,5,gp[17],29)
  318.           plateau(0,15)
  319.           sysfont(2,1)
  320.           printc((gp[17]-20)/2,18,'...OPTIX-Textbetrachter...')
  321.           listbox(10 ,30 ,76   ,46  ,-1 , 1   ,1  ,linctr*(-1) ,0   ,0   ,15)
  322.           dispose(text$)
  323.           dispose(gp)
  324.         endif
  325.  
  326.         if typ=video
  327.           if upper$='MVI'
  328.             readfilm(dat$)
  329.             showfilm(0,0,0,0)
  330.           else
  331.             initavi(dat$)
  332.             gsbox( 7   , 6  ,(xmax-avix)/2,(ymax-aviy)/2,50,50,20 ,20,avix,aviy,10 ,10 ,5)
  333.             setallpal
  334.             startavi(xmax/2-avix/2,ymax/2-aviy/2,1,1,0,1,1,1)
  335.             closeavi
  336.           endif
  337.         endif
  338.  
  339.  
  340.         if typ=fli
  341.           rem                *****    readsound(Paramstr(2)???)
  342.           initfli(dat$)
  343.           gsbox( 7   , 6  ,160,120,50,50,160,120,320,200,10 ,10 ,5)
  344.           setallpal
  345.           startfli(160,120,0,1,1)
  346.           closefli
  347.         endif
  348.  
  349.       else
  350.         sysfont(3,1)
  351.         setcolor(14)
  352.         clearscreen(0)
  353.         PRINTc(0,ymax-35,'keine gültige Typ-Extension')
  354.         pause(1000)
  355.       endif
  356.     else
  357.       sysfont(3,1)
  358.       setcolor(14)
  359.       clearscreen(0)
  360.       PRINTc(0,ymax-35,'keine gültige Extension-Länge')
  361.       pause(1000)
  362.     endif
  363.   else
  364.     sysfont(3,1)
  365.     setcolor(14)
  366.     clearscreen(0)
  367.     PRINTc(0,ymax-35,'keine gültige Dateibezeichnung')
  368.     pause(1000)
  369.   endif
  370.  
  371. end
  372.  
  373.  
  374.