$MAIN ' Compile as CONSOLE AUTODEFINE "off" $INCLUDE "windowssdk.inc" $INCLUDE "Shlwapi.inc" ' Some floating point constants '#define max(a, b) (((a)>(b))?(a):(b)) '#define min(a, b) (((a)<(b))?(a):(b)) SETPRECISION 15 DECLARE CDECL IMPORT, atan2(DOUBLE y, DOUBLE x),DOUBLE CONST ONE_THIRD = 1.0/3.0 CONST ONE_SIXTH = 1.0/6.0 CONST TWO_THIRD = 2.0/3.0 CONST LkMUL = 2.55 CONST ABkMUL = 1.0625 '255/240 CONST pi = 3.14159265358979323846264338327950288 CONST pi2 = pi*2 CONST KDegToRad = 1.74532925199433E-02 CONST Pr = 0.241 CONST Pg = 0.691 CONST Pb = 0.068 CONST D12 = 0.5 CONST D13 = 0.333333333333333 CONST D14 = 0.25 CONST D15 = 0.2 CONST D16 = 0.166666666666667 CONST D23 = 0.666666666666667 CONST K16d116 = 0.137931034482759 :' 16/116 CONST K1d2p4 = 0.416666666666667 :' 1/2.4 CONST k1d3 = 0.333333333333333 :' 1/3 CONST LkMUL = 2.55 CONST ABkMUL = 1.0625 '255/240 TYPE RGBtype DEF r:INT DEF g:INT DEF b:INT ENDTYPE TYPE HLStype DEF h:DOUBLE DEF s:DOUBLE DEF l:DOUBLE ENDTYPE TYPE HSVtype DEF h:DOUBLE DEF s:DOUBLE DEF v:DOUBLE ENDTYPE TYPE HSPtype DEF h:DOUBLE DEF s:DOUBLE DEF p:DOUBLE ENDTYPE TYPE YIQtype DEF y:DOUBLE DEF i:DOUBLE DEF q:DOUBLE ENDTYPE TYPE CieLABtype DEF l:DOUBLE DEF a:DOUBLE DEF b:DOUBLE ENDTYPE TYPE XYZtype DEF x:DOUBLE DEF y:DOUBLE DEF z:DOUBLE ENDTYPE DEF luma:DOUBLE DEF rgb3:RGBtype DEF hls3:HLStype DEF hsv3:HSVtype DEF yiq3:YIQtype DEF lab3:CieLABtype DEF hsp3:HSPtype DEF xyz3:XYZtype DEF lab0:CieLABtype DEF fli,flo:FILE DEF i:INT DEF neg[3],orec,red$,t=",",base1,base2:STRING DEF RGBColor:UINT DEF dRed,dGrn,dBlu:DOUBLE lab0.l=0.0 lab0.a=0.0 lab0.b=0.0 OPENCONSOLE IF (OPENFILE(fli,GETSTARTPATH+"Colors-Start.txt","R") = 0) IF (OPENFILE(flo,GETSTARTPATH+"Colors-f.txt","W") = 0) READ(fli,red$) red$="000,001,002,003 ," red$+="004 ,005 ,006 ," red$+="007 ," red$+="008 ," ' red$+="RGB ," red$+="009 ,010 ,011 ," red$+="012 ,013 ,014 ," red$+="015 ," red$+="016 ,017 ,018 ," red$+="019 ," red$+="020 ,021 " WRITE(flo,red$) red$="Red,Grn,Blu,Hex ," red$+="Hue ,Sat ,Lum ," red$+="HSLSort ," red$+="Luma ," ' red$+="RGB ," red$+="xyz.x ,xyz.y ,xyz.z ," red$+="lab.l ,lab.a ,lab.b ," red$+="de_2000 ," red$+="Hue ,Sat ,Val ," red$+="Base2 ," red$+="Base ,Color Name" WRITE(flo,red$) orec="" FOR i=1 TO 25 orec+=USING("##########",i) NEXT i WRITE(flo,orec) orec="" FOR i=1 TO 25 orec+="1234567890" NEXT i WRITE(flo,orec) WHILE (READ(fli,red$) = 0) rgb3.r=VAL(MID$(red$,1,3)) rgb3.g=VAL(MID$(red$,5,3)) rgb3.b=VAL(MID$(red$,9,3)) dRed=FLOAT(rgb3.r) / 255 dGrn=FLOAT(rgb3.g) / 255 dBlu=FLOAT(rgb3.b) / 255 RGBColor=RGB(rgb3.r,rgb3.g,rgb3.b) rgb_to_hls() 'rgb_to_cielab() rgb_to_xyz() xyz_to_lab() rgb_to_hsv() 'RGBtoHSV() orec=MID$(red$,1,20)+USING("%d0###.######",hls3.h)+t+USING("%d0###.######",hls3.s)+t+USING("%d0###.######",hls3.l) ' orec+=t+USING("%d0####.######",hls3.l*5+hls3.s*2+hls3.h) ' orec+=t+USING("%d0####.######",0.2126*dRed+0.7152*dGrn+0.0722*dBlu) ' orec+=t+USING("%d0####.######",0.299*dRed+0.587*dGrn+0.114*dBlu) orec+=t+USING("%d0####.######",SQRT(0.299 * dRed^2 + 0.587 * dGrn^2 + 0.114 * dBlu^2)) orec+=t+USING("%d0##.######",luma) ' orec+=t+USING("0########",RGBcolor) IF xyz3.x<0 THEN neg[0]="-" ELSE neg[0]=" " IF xyz3.y<0 THEN neg[1]="-" ELSE neg[1]=" " IF xyz3.z<0 THEN neg[2]="-" ELSE neg[2]=" " orec+=t+neg[0]+USING("%d0###.######",ABS(xyz3.x))+t+neg[1]+USING("%d0###.######",ABS(xyz3.y))+t+neg[2]+USING("%d0###.######",ABS(xyz3.z)) IF lab3.l<0 THEN neg[0]="-" ELSE neg[0]=" " IF lab3.a<0 THEN neg[1]="-" ELSE neg[1]=" " IF lab3.b<0 THEN neg[2]="-" ELSE neg[2]=" " orec+=t+neg[0]+USING("%d0###.######",ABS(lab3.l))+t+neg[1]+USING("%d0###.######",ABS(lab3.a))+t+neg[2]+USING("%d0###.######",ABS(lab3.b)) 'orec+=t+USING("%d0###.######",de_1994(lab3)) orec+=t+USING("%d0###.######",ciede2000(lab0,lab3)) orec+=t+USING("%d0###.######",hsv3.h)+t+USING("%d0###.######",hsv3.s)+t+USING("%d0###.######",hsv3.v) base1=MID$(red$,21,12) IF MID$(base1,1,4) = "Grey" OR MID$(base1,1,5) = "White" OR MID$(base1,1,5) = "Black" base2 = base1 + " " ELSE base2="Red " IF hls3.h> 15.0 AND hls3.h<= 45.0: 'orange (30 degrees) base2="Orange " ELSEIF hls3.h> 45.0 AND hls3.h<= 75.0: 'yellow (60 degrees) base2="Yellow " ELSEIF hls3.h> 75.0 AND hls3.h<=105.0: 'chartreuse (90 degrees) base2="Chartreuse " ELSEIF hls3.h>105.0 AND hls3.h<=135.0: 'green (120 degrees) base2="Green " ELSEIF hls3.h>135.0 AND hls3.h<=165.0: 'spring green (150 degrees) base2="Spring Green " ELSEIF hls3.h>165.0 AND hls3.h<=195.0: 'cyan (180 degrees) base2="Cyan " ELSEIF hls3.h>195.0 AND hls3.h<=225.0: 'azure (210 degrees) base2="Azure " ELSEIF hls3.h>225.0 AND hls3.h<=255.0: 'blue (240 degrees) base2="Blue " ELSEIF hls3.h>255.0 AND hls3.h<=285.0: 'violet (270 degrees) base2="Violet " ELSEIF hls3.h>285.0 AND hls3.h<=315.0: 'magenta (300 degrees) base2="Magenta " ELSEIF hls3.h>315.0 AND hls3.h<=345.0: 'rose (330 degrees) base2="Rose " ENDIF /* IF hls3.h> 10.0 AND hls3.h<= 20.0: 'red-orange 11 to 20 base2="Red-Orange " ELSEIF hls3.h> 20.0 AND hls3.h<= 40.0: 'orange & brown 21 to 40 base2="Orange & Brown" ELSEIF hls3.h> 40.0 AND hls3.h<= 50.0: 'orange-yellow 41 to 50 base2="Orange-Yellow " ELSEIF hls3.h> 50.0 AND hls3.h<= 60.0: 'yellow 51 to 60 base2="Yellow " ELSEIF hls3.h> 60.0 AND hls3.h<= 80.0: 'yellow-green 61 to 80 base2="Yellow-Green " ELSEIF hls3.h> 80.0 AND hls3.h<=140.0: 'green 81 to 140 base2="Green " ELSEIF hls3.h>140.0 AND hls3.h<=170.0: 'green-cyan 140 to 170 base2="Green-Cyan " ELSEIF hls3.h>170.0 AND hls3.h<=200.0: 'cyan 171 to 200 base2="Cyan " ELSEIF hls3.h>200.0 AND hls3.h<=220.0: 'cyan-blue 201 to 220 base2="Cyan-Blue " ELSEIF hls3.h>220.0 AND hls3.h<=240.0: 'blue 221 to 240 base2="Blue " ELSEIF hls3.h>240.0 AND hls3.h<=280.0: 'blue-magenta 241 to 280 base2="Blue-Magenta " ELSEIF hls3.h>280.0 AND hls3.h<=320.0: 'magenta 281 to 320 base2="Magenta " ELSEIF hls3.h>320.0 AND hls3.h<=330.0: 'magenta-mink 321 to 330 base2="Magenta-Pink " ELSEIF hls3.h>330.0 AND hls3.h<=345.0: 'pink 331 to 345 base2="Pink " ELSEIF hls3.h>345.0 AND hls3.h<=355.0: 'pink-red 346 to 355 base2="Pink-Red " ENDIF */ ENDIF orec+=t+base2 orec+=t+MID$(red$,21) WRITE(flo,orec) 'DO: UNTIL INKEY$<>"" ENDWHILE CLOSEFILE flo CLOSEFILE fli ENDIF ENDIF PRINT "Done" WAITCON CLOSECONSOLE END SUB cielab_to_rgb(),INT '====================== DEF x,y,z:DOUBLE DEF x3,y3,z3:DOUBLE DEF fnd:INT DEF r,g,b:DOUBLE lab3.l = lab3.l / LkMUL lab3.a = lab3.a / ABkMUL lab3.b = lab3.b / ABkMUL lab3.a = lab3.a - 120 lab3.b = lab3.b - 120 fnd = True y = (lab3.l + 16) / 116 x = lab3.a / 500 + y z = y - lab3.b / 200 x3 = x * x * x y3 = y * y * y z3 = z * z * z IF (x3 > 0.008856) THEN x = x3 ELSE x = (x - K16d116) / 7.787 IF (y3 > 0.008856) THEN y = y3 ELSE y = (y - K16d116) / 7.787 IF (z3 > 0.008856) THEN z = z3 ELSE z = (z - K16d116) / 7.787 x = x * 0.95047 'Observer= 2°, Illuminant= D65 'y = y * 1 z = z * 1.08883 r = (x * 3.2406 + y * -1.5372 + z * -0.4986) g = (x * -0.9689 + y * 1.8758 + z * 0.0415) b = (x * 0.0557 + y * -0.204 + z * 1.057) IF (r > 0.0031308) THEN r = (1.055 * (r ^ K1d2p4) - 0.055) ELSE r = 12.92 * r IF (g > 0.0031308) THEN g = (1.055 * (g ^ K1d2p4) - 0.055) ELSE g = 12.92 * g IF (b > 0.0031308) THEN b = (1.055 * (b ^ K1d2p4) - 0.055) ELSE b = 12.92 * b rgb3.r = r * 255 rgb3.g = g * 255 rgb3.b = b * 255 IF rgb3.r < 0 THEN rgb3.r = 0 ELSE fnd = False IF rgb3.g < 0 THEN rgb3.g = 0 ELSE fnd = False IF rgb3.b < 0 THEN rgb3.b = 0 ELSE fnd = False IF rgb3.r > 255 THEN rgb3.r = 255 ELSE fnd = False IF rgb3.g > 255 THEN rgb3.g = 255 ELSE fnd = False IF rgb3.b > 255 THEN rgb3.b = 255 ELSE fnd = False RETURN fnd ENDSUB SUB dec_to_rgb(decimal:UINT) '=========================== '---------------------------------------------------------------------------------------- ' Returns RGB Triplet from integer ' Original idea: TexasPete ' Please note : Red,Green AND Blue Must be Global AND declared outside of this function '---------------------------------------------------------------------------------------- DEF getred,getgreen,getblue:UINT DEF blue,green:UINT ' getred blue = (decimal/(256*256)) green = ((decimal-blue*256*256)/256) getred = (decimal-blue*256*256-green*256) ' getgreen blue = (decimal/(256*256)) getgreen = (decimal-blue*256*256)/256 ' getblue getblue = (decimal/(256*256)) rgb3.r = getred rgb3.g = getgreen rgb3.b = getblue RETURN ENDSUB SUB hex_to_dec(txt:STRING),UINT '============================== DEF i,pow:INT DEF res:UINT res=0 FOR i=1 to LEN(txt) pow=16^(LEN(txt)-i) res+=(INSTR("0123456789ABCDEF",MID$(txt,i,1),1)-1)*pow NEXT i RETURN res ENDSUB SUB hls_to_rgb() '=============== DEF p1,p2:DOUBLE IF hls3.l <= 0.5 p2 = hls3.l * (1 + hls3.s) ELSE p2 = hls3.l + hls3.s - hls3.l * hls3.s ENDIF p1 = 2 * hls3.l - p2 IF hls3.s = 0 rgb3.r = hls3.l rgb3.g = hls3.l rgb3.b = hls3.l ELSE rgb3.r = qqh_to_rgb(p1, p2, hls3.h + 120) rgb3.g = qqh_to_rgb(p1, p2, hls3.h) rgb3.b = qqh_to_rgb(p1, p2, hls3.h - 120) ENDIF RETURN ENDSUB SUB hsp_to_rgb() '=============== DEF part,minovermax:DOUBLE DEF h,s,p:DOUBLE DEF r,g,b:DOUBLE h = hsp3.h / 255 s = hsp3.s / 255 p = hsp3.p minovermax = 1 - s 'Stop IF (minovermax > 0) IF (h < 1.0 / 6.0) ' // R>G>B h = 6.0 * (h - 0.0 / 6.0) Part = 1.0 + h * (1.0 / minovermax - 1.0) B = p / SQRT(Pr / minovermax / minovermax + Pg * Part * Part + PB) R = (B) / minovermax G = (B) + H * (R - B) ELSE IF (H < 2.0 / 6.0) ' // G>R>B H = 6.0 * (-H + 2.0 / 6.0) Part = 1.0 + H * (1.0 / minovermax - 1.0) B = P / SQRT(Pg / minovermax / minovermax + Pr * Part * Part + PB) G = (B) / minovermax R = (B) + H * (G - B) ELSE IF (H < 3.0 / 6.0) ' // G>B>R H = 6.0 * (H - 2.0 / 6.0) Part = 1.0 + H * (1.0 / minovermax - 1.0) R = P / SQRT(Pg / minovermax / minovermax + PB * Part * Part + Pr) G = (R) / minovermax B = (R) + H * (G - R) ELSE IF (H < 4.0 / 6.0) ' // B>G>R H = 6.0 * (-H + 4.0 / 6.0) Part = 1.0 + H * (1.0 / minovermax - 1.0) R = P / SQRT(PB / minovermax / minovermax + Pg * Part * Part + Pr) B = (R) / minovermax G = (R) + H * (B - R) ELSE IF (H < 5.0 / 6.0) ' // B>R>G H = 6.0 * (H - 4.0 / 6.0) Part = 1.0 + H * (1.0 / minovermax - 1.0) G = P / SQRT(PB / minovermax / minovermax + Pr * Part * Part + Pg) B = (G) / minovermax R = (G) + H * (B - G) ELSE ' // R>B>G H = 6.0 * (-H + 6.0 / 6.0) Part = 1.0 + H * (1.0 / minovermax - 1.0) G = P / SQRT(Pr / minovermax / minovermax + PB * Part * Part + Pg) R = (G) / minovermax B = (G) + H * (R - G) ENDIF ENDIF ENDIF ENDIF ENDIF ELSE IF (H < 1.0 / 6.0) ' // R>G>B H = 6.0 * (H - 0.0 / 6.0) R = SQRT(P * P / (Pr + Pg * H * H)) G = (R) * H B = 0 ELSE IF (H < 2.0 / 6.0) ' // G>R>B H = 6.0 * (-H + 2.0 / 6.0) G = SQRT(P * P / (Pg + Pr * H * H)) R = (G) * H B = 0 ELSE IF (H < 3.0 / 6.0) ' // G>B>R H = 6.0 * (H - 2.0 / 6.0) G = SQRT(P * P / (Pg + PB * H * H)) B = (G) * H R = 0 ELSE IF (H < 4.0 / 6.0) ' // B>G>R H = 6.0 * (-H + 4.0 / 6.0) B = SQRT(P * P / (PB + Pg * H * H)) G = (B) * H R = 0 ELSE IF (H < 5.0 / 6.0) ' // B>R>G H = 6.0 * (H - 4.0 / 6.0) B = SQRT(P * P / (PB + Pr * H * H)) R = (B) * H G = 0 ELSE ' // R>B>G H = 6.0 * (-H + 6.0 / 6.0) R = SQRT(P * P / (Pr + PB * H * H)) B = (R) * H G = 0 ENDIF ENDIF ENDIF ENDIF ENDIF ENDIF IF R > 255 THEN R = 255 IF G > 255 THEN G = 255 IF B > 255 THEN B = 255 rgb3.r = R rgb3.g = G rgb3.b = B RETURN ENDSUB SUB huedifference(h1:DOUBLE, h2:DOUBLE),DOUBLE '============================================= DEF d:DOUBLE d = h2 - (-h1) IF d < -127.5 THEN d = d + 255 IF d > 127.5 THEN d = d - 255 RETURN ABS(d) ENDSUB SUB qqh_to_rgb(q1:Double, q2:DOUBLE, hue:DOUBLE),DOUBLE '====================================================== IF hue > 360 hue = hue - 360 ELSEIF hue < 0 hue = hue + 360 ENDIF IF hue < 60 RETURN q1 + (q2 - q1) * hue / 60 ELSEIF hue < 180 RETURN q2 ELSEIF hue < 240 RETURN q1 + (q2 - q1) * (240 - hue) / 60 ELSE RETURN q1 ENDIF RETURN 0 ENDSUB SUB rgb_to_cielab() '================== DEF x,y,z:DOUBLE def ll,aa,bb:DOUBLE IF (dRed > 0.04045) THEN dRed = ((dRed + 0.055) / 1.055) ^ 2.4 ELSE dRed = dRed / 12.92 IF (dGrn > 0.04045) THEN dGrn = ((dGrn + 0.055) / 1.055) ^ 2.4 ELSE dGrn = dGrn / 12.92 IF (dBlu > 0.04045) THEN dBlu = ((dBlu + 0.055) / 1.055) ^ 2.4 ELSE dBlu = dBlu / 12.92 dRed = dRed * 100.0 dGrn = dGrn * 100.0 dBlu = dBlu * 100.0 'Observer. = 2°, Illuminant = D65 x = dRed * 0.4124 + dGrn * 0.3576 + dBlu * 0.1805 y = dRed * 0.2126 + dGrn * 0.7152 + dBlu * 0.0722 z = dRed * 0.0193 + dGrn * 0.1192 + dBlu * 0.9505 x = x / 95.047 : 'observer= 2°, illuminant= d65 y = y / 100.00 z = z / 108.883 IF (x > 0.008856) THEN x = x ^ k1d3 ELSE x = (7.787 * x) + (k16d116) IF (y > 0.008856) THEN y = y ^ k1d3 ELSE y = (7.787 * y) + (k16d116) IF (z > 0.008856) THEN z = z ^ k1d3 ELSE z = (7.787 * z) + (k16d116) ll = (116 * y) - 16 aa = 500 * (x - y) bb = 200 * (y - z) aa = aa + 120 bb = bb + 120 lab3.l = ll * lkmul lab3.a = aa * abkmul lab3.b = bb * abkmul RETURN ENDSUB SUB rgb_to_dec(),UINT '==================== RETURN RGB(rgb3.r,rgb3.g,rgb3.b) ENDSUB SUB rgb_to_hls() '=============== DEF cmax, cmin, d:DOUBLE DEF hue, sat, lum:DOUBLE cmax = dRed>dGrn?dRed:dGrn cmax = cmax>dBlu?cmax:dBlu cmin = dRed 0.5 ? d / (2 - cmax - cmin) : d / (cmax + cmin) ENDIF SELECT cmax CASE dRed hue = (dGrn - dBlu) / d + (dGrn < dBlu ? 6 : 0) CASE dGrn hue = (dBlu - dRed) / d + 2 CASE dBlu hue = (dRed - dGrn) / d + 4 ENDSELECT hue /= 6 LABEL done hls3.h = (hue * 360.0) hls3.s = (sat * 100.0) hls3.l = (lum * 100.0) 'luma = 0.3 * dRed + 0.59 * dGrn + 0.11 * dBlu luma = sqrt(0.241 * dRed + 0.691 * dGrn + 0.068 * dBlu) RETURN ENDSUB SUB rgb_to_hsp() '=============== DEF p,h,s:DOUBLE P = SQRT(rgb3.r * rgb3.r * Pr + rgb3.g * rgb3.g * Pg + rgb3.b * rgb3.b * PB) ' // Calculate the Hue AND Saturation. (This part works ' // the same way as in the HSV/B AND HSL systems???.) IF (rgb3.r = rgb3.g AND rgb3.r = rgb3.b) H = 0 S = 0 GOTO ret ENDIF IF (rgb3.r >= rgb3.g AND rgb3.r >= rgb3.b) ' // R is largest IF (rgb3.b >= rgb3.g) H = 1 - D16 * (rgb3.b - rgb3.g) / (rgb3.r - rgb3.g) S = 1 - rgb3.g / rgb3.r ELSE H = D16 * (rgb3.g - rgb3.b) / (rgb3.r - rgb3.b) S = 1 - rgb3.b / rgb3.r ENDIF ELSE IF (rgb3.g >= rgb3.r AND rgb3.g >= rgb3.b) '// G is largest IF (rgb3.r >= rgb3.b) H = D13 - D16 * (rgb3.r - rgb3.b) / (rgb3.g - rgb3.b) S = 1 - rgb3.b / rgb3.g ELSE H = D13 + D16 * (rgb3.b - rgb3.r) / (rgb3.g - rgb3.r) S = 1 - rgb3.r / rgb3.g ENDIF ELSE '// B is largest IF (rgb3.g >= rgb3.r) H = D23 - D16 * (rgb3.g - rgb3.r) / (rgb3.b - rgb3.r) S = 1 - rgb3.r / rgb3.b ELSE H = D23 + D16 * (rgb3.r - rgb3.g) / (rgb3.b - rgb3.g) S = 1 - rgb3.g / rgb3.b ENDIF ENDIF ENDIF LABEL ret 'Stop hsp3.p = P hsp3.h = H * 255 hsp3.s = S * 255 RETURN ENDSUB SUB rgb_to_hsv() '=============== DEF r,g,b:DOUBLE DEF h,s,v:DOUBLE DEF mn, mx:DOUBLE DEF df:DOUBLE r = DOUBLE(rgb3.r) / 255.0 g = DOUBLE(rgb3.g) / 255.0 b = DOUBLE(rgb3.b) / 255.0 mx = r>g?r:g mx = mx>b?mx:b mn = r= 380) AND (wl <= 440)) r = -1 * (wl - 440) / (440 - 380) g = 0 b = 1 crg = 0 ENDIF IF ((wl >= 440) AND (wl <= 490)) r = 0 g = (wl - 440) / (490 - 440) b = 1 crg = 1 ENDIF IF ((wl >= 490) AND (wl <= 510)) r = 0 g = 1 b = -1 * (wl - 510) / (510 - 490) crg = 2 ENDIF IF ((wl >= 510) AND (wl <= 580)) r = (wl - 510) / (580 - 510) g = 1 b = 0 crg = 3 ENDIF IF ((wl >= 580) AND (wl <= 645)) r = 1 g = -1 * (wl - 645) / (645 - 580) b = 0 crg = 4 ENDIF IF ((wl >= 645) AND (wl <= 780)) r = 1 g = 0 b = 0 crg = 5 ENDIF ' LET THE INTENSITY SSS FALL OFF NEAR THE VISION LIMITS sss = 1 IF (wl < 420) sss = 0.3 + 0.7 * (wl - 380) / (420 - 380) ENDIF IF (wl > 700) sss = 0.3 + 0.7 * (780 - wl) / (780 - 700) ENDIF 'c gamma adjust AND write image to an array sss = 1 r = (sss * r) ^ gamma g = (sss * g) ^ gamma b = (sss * b) ^ gamma rgb3.r = int(r * 255) rgb3.g = int(g * 255) rgb3.b = int(b * 255) hr = HEX$(r) hg = HEX$(g) hb = HEX$(b) IF LEN(hr) = 1 THEN hr = "0" + hr IF LEN(hg) = 1 THEN hg = "0" + hg IF LEN(hb) = 1 THEN hb = "0" + hb wl += 0.05 UNTIL wl > 780 RETURN ENDSUB SUB yiq_to_rgb() '=============== rgb3.r = yiq3.y + 0.948262*yiq3.i + 0.624013*yiq3.q rgb3.g = yiq3.y - 0.276066*yiq3.i - 0.639810*yiq3.q rgb3.b = yiq3.y - 1.105450*yiq3.i + 1.729860*yiq3.q IF rgb3.r < 0.0 THEN rgb3.r = 0.0 IF rgb3.g < 0.0 THEN rgb3.g = 0.0 IF rgb3.b < 0.0 THEN rgb3.b = 0.0 IF rgb3.r > 1.0 THEN rgb3.r = 1.0 IF rgb3.g > 1.0 THEN rgb3.g = 1.0 IF rgb3.b > 1.0 THEN rgb3.b = 1.0 RETURN ENDSUB SUB rgb_to_xyz() IF dRed > 0.04045 dRed = (dRed + 0.055) / 1.055 dRed = dRed ^ 2.4 ELSE dRed = dRed / 12.92 ENDIF IF dGrn > 0.04045 dGrn = (dGrn + 0.055) / 1.055 dGrn = dGrn ^ 2.4 ELSE dGrn = dGrn / 12.92 ENDIF IF dBlu > 0.04045 dBlu = (dBlu + 0.055) / 1.055 dBlu = dBlu ^ 2.4 ELSE dBlu = dBlu / 12.92 ENDIF dRed *= 100 dGrn *= 100 dBlu *= 100 xyz3.x = dRed * 0.4124 + dGrn * 0.3576 + dBlu * 0.1805 xyz3.y = dRed * 0.2126 + dGrn * 0.7152 + dBlu * 0.0722 xyz3.z = dRed * 0.0193 + dGrn * 0.1192 + dBlu * 0.9505 RETURN ENDSUB SUB xyz_to_lab() DEF x1,y1,z1:DOUBLE x1 = xyz3.x y1 = xyz3.y z1 = xyz3.z x1 = x1 / 95.047 y1 = y1 / 100 z1 = z1 / 108.883 IF x1 > 0.008856 x1 = x1 ^ k1d3 ELSE x1 = (7.787 * x1) + k16d116 ENDIF IF y1 > 0.008856 y1 = y1 ^ k1d3 ELSE y1 = (7.787 * y1) + k16d116 ENDIF IF z1 > 0.008856 z1 = z1 ^ k1d3 ELSE z1 = (7.787 * z1) + k16d116 ENDIF lab3.l = 116 * y1 - 16 lab3.a = 500 * (x1 - y1) lab3.b = 200 * (y1 - z1) RETURN ENDSUB ' Now, it’s time to determine color difference, using the above formula: 'SUB de_1994(lab1:CieLABtype,lab2:CieLABtype),DOUBLE SUB de_1994(lab1:CieLABtype),DOUBLE DEF c1,c2,dc,dl,da,db,dh,first,second,third:DOUBLE c1 = SQRT(lab1.a * lab1.a + lab1.b * lab1.b) c2 = 0.0 'c2 = SQRT(lab2.a * lab2.a + lab2.b * lab2.b) dc = c1 - c2 'dl = lab1.l - lab2.l dl = lab1.l 'da = lab1.a - lab2.a da = lab1.a 'db = lab1.b - lab2.b db = lab1.b dh = SQRT((da * da) + (db * db) - (dc * dc)) first = dl second = dc / (1 + 0.045 * c1) 'third = dh / (1 + 0.015 * c1) third = 0.0 ? first,second,SQRT(first*first+second*second) RETURN (SQRT(ABS(first * first + second * second + third * third))) ENDSUB SUB deg2rad(deg:DOUBLE),DOUBLE RETURN (deg * (pi / 180.0)) ENDSUB SUB rad2Deg(rad:DOUBLE),DOUBLE RETURN ((180.0 / pi) * rad) ENDSUB SUB pow(value:DOUBLE,power:DOUBLE),DOUBLE RETURN (value^power) ENDSUB SUB Ciede2000(lab1:CieLABtype,lab2:CieLABtype),DOUBLE /* * "For these and all other numerical/graphical [sub]delta E00 values * reported in this article, we set the parametric weighting factors * to unity(i.e., k_L = k_C = k_H = 1.0)." (Page 27). */ DEF k_L = 1.0, k_C = 1.0, k_H = 1.0:DOUBLE DEF deg360InRad = deg2Rad(360.0):DOUBLE DEF deg180InRad = deg2Rad(180.0):DOUBLE DEF pow25To7 = 6103515625.0:DOUBLE /* pow(25, 7) */ DEF C1,C2,barC,G,a1Prime,a2Prime,CPrime1,CPrime2,hPrime1,hPrime2:DOUBLE DEF deltaLPrime,deltaCPrime,DeltahPrime,CPrimeProduct,deltaHPrime2:DOUBLE DEF barLPrime,barCPrime,barhPrime,T,deltaTheta,R_C,S_L,S_C,S_H,R_T:DOUBLE DEF hPrimeSum,deltaE:DOUBLE DEF d1,d2:DOUBLE /* * Step 1 */ /* Equation 2 */ C1 = SQRT((lab1.a * lab1.a) + (lab1.b * lab1.b)) C2 = SQRT((lab2.a * lab2.a) + (lab2.b * lab2.b)) /* Equation 3 */ barC = (C1 + C2) / 2.0 /* Equation 4 */ G = 0.5 * (1 - SQRT(pow(barC, 7) / (pow(barC, 7) + pow25To7))) /* Equation 5 */ a1Prime = (1.0 + G) * lab1.a a2Prime = (1.0 + G) * lab2.a /* Equation 6 */ CPrime1 = SQRT((a1Prime * a1Prime) + (lab1.b * lab1.b)) CPrime2 = SQRT((a2Prime * a2Prime) + (lab2.b * lab2.b)) /* Equation 7 */ IF (lab1.b = 0 AND a1Prime = 0) hPrime1 = 0.0 ELSE hPrime1 = atan2(lab1.b, a1Prime) /* * This must be converted to a hue angle in degrees between 0 * and 360 by addition of 2[sub] to negative hue angles. */ IF (hPrime1 < 0) THEN hPrime1 += deg360InRad ENDIF IF (lab2.b = 0 AND a2Prime = 0) hPrime2 = 0.0 ELSE hPrime2 = atan2(lab2.b, a2Prime) /* * This must be converted to a hue angle in degrees between 0 * and 360 by addition of 2[sub] to negative hue angles. */ IF (hPrime2 < 0) THEN hPrime2 += deg360InRad ENDIF /* * Step 2 */ /* Equation 8 */ deltaLPrime = lab2.l - lab1.l /* Equation 9 */ deltaCPrime = CPrime2 - CPrime1 /* Equation 10 */ CPrimeProduct = CPrime1 * CPrime2 IF (CPrimeProduct = 0) deltahPrime = 0 ELSE /* Avoid the fabs() call */ deltahPrime = hPrime2 - hPrime1 IF (deltahPrime < -deg180InRad) deltahPrime += deg360InRad ELSEIF (deltahPrime > deg180InRad) deltahPrime -= deg360InRad ENDIF ENDIF /* Equation 11 */ deltaHPrime2 = 2.0 * SQRT(CPrimeProduct) * SIN(deltahPrime / 2.0) /* * Step 3 */ /* Equation 12 */ barLPrime = (lab1.l + lab2.l) / 2.0 /* Equation 13 */ barCPrime = (CPrime1 + CPrime2) / 2.0 /* Equation 14 */ barhPrime = hPrime1 + hPrime2 hPrimeSum = hPrime1 + hPrime2 IF (CPrime1 * CPrime2 = 0) barhPrime = hPrimeSum ELSE IF (ABS(hPrime1 - hPrime2) <= deg180InRad) barhPrime = hPrimeSum / 2.0 ELSE IF (hPrimeSum < deg360InRad) barhPrime = (hPrimeSum + deg360InRad) / 2.0 ELSE barhPrime = (hPrimeSum - deg360InRad) / 2.0 ENDIF ENDIF ENDIF /* Equation 15 */ T = 1.0 - (0.17 * COS(barhPrime - deg2Rad(30.0))) + _ (0.24 * COS(2.0 * barhPrime)) + _ (0.32 * COS((3.0 * barhPrime) + deg2Rad(6.0))) - _ (0.20 * COS((4.0 * barhPrime) - deg2Rad(63.0))) /* Equation 16 */ 'deltaTheta = deg2Rad(30.0) * EXP(-pow((barhPrime - deg2Rad(275.0)) / deg2Rad(25.0), 2.0)) d1=deg2Rad(30.0) d2=EXP(-pow((barhPrime - deg2Rad(275.0)) / deg2Rad(25.0), 2.0)) deltaTheta=d1*d2 /* Equation 17 */ R_C = 2.0 * SQRT(pow(barCPrime, 7.0) / (pow(barCPrime, 7.0) + pow25To7)) /* Equation 18 */ S_L = 1 + ((0.015 * pow(barLPrime - 50.0, 2.0)) / SQRT(20 + pow(barLPrime - 50.0, 2.0))) /* Equation 19 */ S_C = 1 + (0.045 * barCPrime) /* Equation 20 */ S_H = 1 + (0.015 * barCPrime * T) /* Equation 21 */ R_T = (-SIN(2.0 * deltaTheta)) * R_C /* Equation 22 */ deltaE = SQRT( _ pow(deltaLPrime / (k_L * S_L), 2.0) + _ pow(deltaCPrime / (k_C * S_C), 2.0) + _ pow(deltaHPrime2 / (k_H * S_H), 2.0) + _ (R_T * (deltaCPrime / (k_C * S_C)) * (deltaHPrime2 / (k_H * S_H)))) RETURN (deltaE) ENDSUB SUB hueToNcol(),STRING DEF hue:DOUBLE hue=hls3.h IF (hue >= 360) THEN hue -= 360 IF (hue < 60) THEN RETURN "R" + USING("0##",INT(hue / 0.6)) IF (hue < 120) THEN RETURN "Y" + USING("0##",INT((hue - 60) / 0.6)) IF (hue < 180) THEN RETURN "G" + USING("0##",INT((hue - 120) / 0.6)) IF (hue < 240) THEN RETURN "C" + USING("0##",INT((hue - 180) / 0.6)) IF (hue < 300) THEN RETURN "B" + USING("0##",INT((hue - 240) / 0.6)) IF (hue < 360) THEN RETURN "M" + USING("0##",INT((hue - 300) / 0.6)) RETURN "OPS" ENDSUB SUB RGBtoHSV() DOUBLE min, max, delta DOUBLE h,s,v IF dRed < dGrn THEN min = dRed ELSE min = dGrn IF min < dBlu THEN min = min ELSE min = dBlu IF dRed > dGrn THEN max = dRed ELSE max = dGrn IF max > dBlu THEN max = max ELSE max = dBlu v = max ' v delta = max - min IF ( max <> 0 ) s = delta / max ' s ELSE ' r = g = b = 0 ' s = 0, v is undefined s = 0 h = 0 hsv3.h = h hsv3.s = s hsv3.v = v RETURN ENDIF IF delta<>0 IF ( dRed = max ) h = ( dGrn - dBlu ) / delta ' between yellow & magenta ELSEIF ( dGrn = max ) h = 2 + ( dBlu - dRed ) / delta ' between cyan & yellow ELSE h = 4 + ( dRed - dGrn ) / delta ' between magenta & cyan ENDIF ELSE h = 0 ENDIF h *= 60 ' degrees IF ( h < 0 ) THEN h += 360 hsv3.h = h hsv3.s = s hsv3.v = v 'PRINT rgb3.r,rgb3.g,rgb3.b,h,s,v 'DO:UNTIL INKEY$<>"" RETURN ENDSUB SUB HSVtoRGB() INT i DOUBLE f, p, q, t, h, s, v, r, g, b h = hsv3.h s = hsv3.s v = hsv3.v IF ( s = 0 ) ' achromatic (grey) r = g = b = v rgb3.r = r rgb3.g = g rgb3.b = b RETURN ENDIF h /= 60 ' sector 0 to 5 i = FLOOR( h ) f = h - i ' factorial part of h p = v * ( 1 - s ) q = v * ( 1 - s * f ) t = v * ( 1 - s * ( 1 - f ) ) SELECT i CASE 0 r = v g = t b = p CASE 1 r = q g = v b = p CASE 2 r = p g = v b = t CASE 3 r = p g = q b = v CASE 4 r = t g = p b = v DEFAULT: ' CASE 5: r = v g = p b = q ENDSELECT rgb3.r = r rgb3.g = g rgb3.b = b RETURN ENDSUB SUB ColorToRGB(UINT value, INT r BYREF, INT g BYREF, INT b BYREF) r = value % 256 g = (value % 65536) / 256 b = value / 65536 ENDSUB SUB RGBToColor(INT r, INT g, INT b), UINT RETURN RGB(r, g, b) ENDSUB SUB ColorToHSV(UINT value, INT h BYREF, INT s BYREF, INT v BYREF) word hue, sat, _val ColorRGBToHLS(value, &hue, &_val, &sat) ' see https://source.winehq.org/WineAPI/ColorRGBToHLS.html h = hue s = sat v = _val ENDSUB SUB HSVToColor(DOUBLE h, DOUBLE s, DOUBLE v), UINT RETURN ColorHLSToRGB(h, v, s) ENDSUB /* SUB atan2(y:DOUBLE,x:DOUBLE), DOUBLE IF x>=0 RETURN ATAN(y/x) :'(x>0,y>0) and (x>0,y<0) ELSE IF y<0 RETURN ATAN(y/x) - pi :'third quadrant ELSE RETURN ATAN(y/x) + pi :'second quadrant ENDIF ENDIF RETURN 0 ENDSUB */