home *** CD-ROM | disk | FTP | other *** search
/ Inside Multimedia 1995 August / IMM0895.BIN / magazin / optix / disk1 / optxppac.set / NEARCOL.OPT < prev    next >
Text File  |  1995-05-05  |  2KB  |  110 lines
  1.  
  2. def(i)
  3. def(j)
  4.  
  5. def(r)
  6. def(g)
  7. def(b)
  8.  
  9. def(r2)
  10. def(g2)
  11. def(b2)
  12.  
  13. def(x)
  14. def(y)
  15. def(ncol)
  16. defs(dum$)
  17.  
  18. procedure nearcol(r,g,b,cmin,cmax,tmax)
  19.  
  20.   rem *** ermittelt die Farbe aus der aktuellen Palette bzw.
  21.   rem *** aus einem bestimmten Palettenbereich, die den in
  22.   rem *** 'r,g,b' angegebenen Farbwerten am nächsten kommt und
  23.   rem *** liefert den Index dieser Farbe in der Global 'NCOL'zurück.
  24.   rem *** Wird in dem Toleranzbereich nichts gefunden, wird -1 geliefert.
  25.   rem ***
  26.   rem *** 'r, g, b'    = (r)ot-, (g)rün-, (b)lau-Werte der gesuchten Farbe
  27.   rem *** 'cmin, cmax' = Start- und End-Index des Suchbereiches innerhalb
  28.   rem ***                der aktuellen Vordergrundpalette (0-255)
  29.   rem *** 'tmax'       = Toleranzbereich (0-63). Je größer dieser Bereich
  30.   rem ***                angegeben wird, desto genauer wird das Ergebnis.
  31.   rem ***
  32.  
  33.   locals(i,j,tol,tol2)
  34.   if cmin>=cmax
  35.     cmin:=cmax
  36.   endif
  37.   ncol:=-1
  38.   for tol:=0 TO tmax DO
  39.     tol2:=tol*tol
  40.     for i:=cmin TO cmax DO
  41.       getrgbcolor(i,r2,g2,b2)
  42.       r2:=r-r2
  43.       g2:=g-g2
  44.       b2:=b-b2
  45.       r2:=r2*r2
  46.       g2:=g2*g2
  47.       b2:=b2*b2
  48.       if (r+r2) < (r+tol2)
  49.         if (g+g2) < (g+tol2)
  50.           if (b+b2) < (b+tol2)
  51.             ncol:=i
  52.             goto('nearcolexit')
  53.           endif
  54.         endif
  55.       endif
  56.     next(i)
  57.   next(tol)
  58.   :nearcolexit
  59.  
  60. return
  61.  
  62. begin
  63.  
  64.   setpvga
  65.   setallpal
  66.   clearscreen(8)
  67.   setrgbcolor(53,45,10,255)
  68.  
  69.   for j:=0 to 15 do
  70.     for i:=0 to 15 do
  71.       viewport(160+20*i,50+16*j,160+20*i+18,50+16*j+14)
  72.       cbox(0,i+j*16,0)
  73.     next(i)
  74.   next(j)
  75.  
  76.   nearcol(53,45,10,20,50,13)
  77.  
  78.   sysfont(3,0)
  79.   setcolor(0)
  80.   setbcolor(255)
  81.  
  82.   printat(80,360,' ')
  83.   print('gesuchte Farbe                  :')
  84.   print(' 255 ( r = 53 / g = 45 / b = 10 )')
  85.   setbcolor(ncol)
  86.   getrgbcolor(ncol,r,g,b)
  87.   str(ncol,3,dum$)
  88.   printat(80,380,' ')
  89.   print('gefundene Farbe im Bereich 20-50: '+dum$)
  90.   str(r,3,dum$)
  91.   print(' ( r ='+dum$)
  92.   str(g,3,dum$)
  93.   print(' / g ='+dum$)
  94.   str(b,3,dum$)
  95.   print(' / b ='+dum$)
  96.   print(' )')
  97.  
  98.   y:=ncol/16
  99.   x:=ncol-y*16
  100.   viewport(160+x*20,50+y*16,160+x*20+18,50+y*16+14)
  101.   for i:=0 to 25 do
  102.     cbox(13,0,0)
  103.     noise(20*ncol+20,20)
  104.     pause(100)
  105.   next(i)
  106.  
  107.   pause(0)
  108.  
  109. end
  110.