以前改过，画点是ZPset16。演示程序：
DECLARE FUNCTION GetPI! ()
DECLARE FUNCTION ArcTan! (y AS SINGLE, x AS SINGLE)
DECLARE FUNCTION RGB& (R AS INTEGER, G AS INTEGER, b AS INTEGER)
DECLARE SUB ZPset16 (x AS INTEGER, y AS INTEGER, R AS INTEGER, G AS INTEGER, b AS INTEGER)
DECLARE SUB ZPset16C (x AS INTEGER, y AS INTEGER, C AS LONG)
DECLARE FUNCTION TMC& (TMD AS SINGLE, UpC AS LONG, DnC AS LONG)
DECLARE FUNCTION ZHSB& (H AS INTEGER, S AS SINGLE, L AS SINGLE)
DECLARE FUNCTION ZHB& (H AS INTEGER, L AS SINGLE)
DECLARE FUNCTION WinHSB& (H AS SINGLE, S AS SINGLE, L AS SINGLE)
DECLARE FUNCTION ZLab& (L AS SINGLE, a AS SINGLE, b AS SINGLE)DIM SHARED DDData(0 TO 15, 0 TO 15) AS INTEGER
DIM SHARED ColorTable(0 TO 1, 0 TO 1, 0 TO 1) AS INTEGERDIM I AS INTEGER, J AS INTEGER, K AS INTEGER, T AS INTEGERFOR I = 0 TO 15
FOR J = 0 TO 15
READ T
DDData(I, J) = T
NEXT J
NEXT I
FOR I = 0 TO 1
FOR J = 0 TO 1
FOR K = 0 TO 1
READ T
ColorTable(K, J, I) = T
NEXT K
NEXT J
NEXT ISCREEN 12FOR I = 0 TO 479
FOR J = 0 TO 639
ZPset16C J, I, ((CLNG(J) * 255 \ 639) AND &HFF) * (((I \ 60) AND 1) * &H10000 + ((I \ 120) AND 1) * &H100& + ((I \ 240) AND 1))
NEXT J
NEXT I
WHILE INKEY$ = "": WENDFOR I = 0 TO 479
FOR J = 0 TO 639
ZPset16 J, I, I AND &HFF, J AND &HFF, 0
NEXT J
NEXT I
WHILE INKEY$ = "": WENDFOR I = 0 TO 479
FOR J = 0 TO 639
ZPset16 J, I, I AND &HFF, J AND &HFF, ((I + J) \ 2) AND &HFF
NEXT J
NEXT I
WHILE INKEY$ = "": WENDFOR I = 0 TO 479
FOR J = 0 TO 639
ZPset16C J, I, ZHB(CLNG(J) * 6 * 255 \ 639, 0)
NEXT J
NEXT I
WHILE INKEY$ = "": WENDFOR I = 0 TO 479
FOR J = 0 TO 639
ZPset16C J, I, ZHB(CLNG(J) * 6 * 255 \ 639, (479 \ 2 - I) / (479 \ 2))
NEXT J
NEXT I
WHILE INKEY$ = "": WENDFOR I = 0 TO 479
FOR J = 0 TO 639
ZPset16C J, I, ZLab(1, ((J / 639) * 2 - 1) * 120, (1 - I * 2 / 479) * 120)
NEXT J
NEXT I
WHILE INKEY$ = "": WENDSCREEN 0
ENDDATA 0,235,59,219,15,231,55,215,2,232,56,217,12,229,52,213
DATA 128,64,187,123,143,79,183,119,130,66,184,120,140,76,180,116
DATA 33,192,16,251,47,207,31,247,34,194,18,248,44,204,28,244
DATA 161,97,144,80,175,111,159,95,162,98,146,82,172,108,156,92
DATA 8,225,48,208,5,239,63,223,10,226,50,210,6,236,60,220
DATA 136,72,176,112,133,69,191,127,138,74,178,114,134,70,188,124
DATA 41,200,24,240,36,197,20,255,42,202,26,242,38,198,22,252
DATA 169,105,152,88,164,100,148,84,170,106,154,90,166,102,150,86
DATA 3,233,57,216,13,228,53,212,1,234,58,218,14,230,54,214
DATA 131,67,185,121,141,77,181,117,129,65,186,122,142,78,182,118
DATA 35,195,19,249,45,205,29,245,32,193,17,250,46,206,30,246
DATA 163,99,147,83,173,109,157,93,160,96,145,81,174,110,158,94
DATA 11,227,51,211,7,237,61,221,9,224,49,209,4,238,62,222
DATA 139,75,179,115,135,71,189,125,137,73,177,113,132,68,190,126
DATA 43,203,27,243,39,199,23,253,40,201,25,241,37,196,21,254
DATA 171,107,155,91,167,103,151,87,168,104,153,89,165,101,149,85DATA 0,12,10,14,9,13,11,15'unsigned char ColorTable[2][2][2]= {{{0,12},{10,14}},{{9,13},{11,15}}};FUNCTION ArcTan! (y AS SINGLE, x AS SINGLE)
IF y > 0 THEN
IF x > 0 THEN
ArcTan! = ATN(y / x)
ELSEIF x = 0 THEN
ArcTan! = ATN(1) * 2
ELSE
ArcTan! = ATN(y / x) + ATN(1) * 4
END IF
ELSEIF y = 0 THEN
IF x > 0 THEN
ArcTan! = 0
ELSEIF x = 0 THEN
ArcTan! = 0
ELSE
ArcTan! = ATN(1) * 4
END IF
ELSE
IF x > 0 THEN
ArcTan! = ATN(y / x) + ATN(1) * 8
ELSEIF x = 0 THEN
ArcTan! = ATN(1) * 6
ELSE
ArcTan! = ATN(y / x) + ATN(1) * 4
END IF
END IFEND FUNCTIONFUNCTION GetPI!
GetPI! = ATN(1) * 4
END FUNCTIONFUNCTION RGB& (R AS INTEGER, G AS INTEGER, b AS INTEGER)
RGB = (b AND &HFF) * &H10000 + CLNG(G AND &HFF) * &H100 + (R AND &HFF)END FUNCTIONFUNCTION TMC& (TMD AS SINGLE, UpC AS LONG, DnC AS LONG)
DIM UpR AS INTEGER, UpG AS INTEGER, UpB AS INTEGER
DIM DnR AS INTEGER, DnG AS INTEGER, DnB AS INTEGER
DIM OutR AS INTEGER, OutG AS INTEGER, OutB AS INTEGER
UpR = UpC AND &HFF
UpG = (UpC AND &HFF00&) \ &H100
UpB = (UpC AND &HFF0000) \ &H10000
DnR = DnC AND &HFF
DnG = (DnC AND &HFF00&) \ &H100
DnB = (DnC AND &HFF0000) \ &H10000
OutR = DnR + (UpR - DnR) * TMD
IF OutR < 0 THEN OutR = 0
IF OutR > 255 THEN OutR = 255
OutG = DnG + (UpG - DnG) * TMD
IF OutG < 0 THEN OutG = 0
IF OutG > 255 THEN OutG = 255
OutB = DnB + (UpB - DnB) * TMD
IF OutB < 0 THEN OutB = 0
IF OutB > 255 THEN OutB = 255
TMC = OutR + OutG * &H100& + OutB * &H10000
END FUNCTIONFUNCTION WinHSB& (H AS SINGLE, S AS SINGLE, L AS SINGLE)
WinHSB& = ZHSB(CINT(H * 256 / 60), S, L)END FUNCTIONFUNCTION ZHB& (H AS INTEGER, L AS SINGLE)
IF L > 1 THEN L = 1
IF L < -1 THEN L = -1
IF L >= 0 THEN
ZHB& = ZHSB(H, 1 - L, 1)
ELSE
ZHB& = ZHSB(H, 1, L + 1)
END IFEND FUNCTIONFUNCTION ZHSB& (H AS INTEGER, S AS SINGLE, L AS SINGLE)
DIM T1 AS INTEGER, T2 AS INTEGER
DIM R AS INTEGER, G AS INTEGER, b AS INTEGER
DIM C AS LONG 'IF H < 0 THEN H = H AND &H7FFF
'H = (H AND &HFF) + (((H AND &H7F00) \ &H100) MOD 6) * &H100
T1 = H AND &HFF
T2 = (H AND &H7F00) \ &H100
T2 = T2 MOD 6
IF S > 1 THEN S = 1
IF S < 0 THEN S = 0
IF L > 1 THEN L = 1
IF L < 0 THEN L = 0 SELECT CASE T2
CASE 0
R = 255
G = H AND &HFF
CASE 1
G = 255
R = 255 - H AND &HFF
CASE 2
G = 255
b = H AND &HFF
CASE 3
b = 255
G = 255 - H AND &HFF
CASE 4
b = 255
R = H AND &HFF
CASE 5
R = 255
b = 255 - H AND &HFF
END SELECT 'C = RGB(R, G, B)
IF S < 1 THEN
'C = TMC(S, C, &HFFFFFF)
R = &HFF + (R - &HFF) * S
G = &HFF + (G - &HFF) * S
b = &HFF + (b - &HFF) * S
END IF
IF L < 1 THEN
'C = TMC(L, C, &H0)
R = &H0 + R * L
G = &H0 + G * L
b = &H0 + b * L
END IF
IF R < 0 THEN R = 0
IF R > &HFF THEN R = &HFF
IF G < 0 THEN G = 0
IF G > &HFF THEN G = &HFF
IF b < 0 THEN b = 0
IF b > &HFF THEN b = &HFF
C = RGB(R, G, b)
ZHSB& = CEND FUNCTIONFUNCTION ZLab& (L AS SINGLE, a AS SINGLE, b AS SINGLE)
DIM H AS SINGLE, S AS SINGLE H = ArcTan(b, a) - ATN(1)
IF H < 0 THEN H = H + ATN(1) * 8
H = (H * 3 * 256) / (ATN(1) * 4)
S = SQR(a * a + b * b) / 120
ZLab& = ZHSB(CINT(H), S, L)END FUNCTIONSUB ZPset16 (x AS INTEGER, y AS INTEGER, R AS INTEGER, G AS INTEGER, b AS INTEGER)
DIM L AS INTEGER, C AS INTEGER L = DDData(y AND &HF, x AND &HF)
C = ColorTable((R > L) AND 1, (G > L) AND 1, (b > L) AND 1)
PSET (x, y), CEND SUBSUB ZPset16C (x AS INTEGER, y AS INTEGER, C AS LONG)
ZPset16 x, y, C AND &HFF, (C AND &HFF00&) \ &H100, (C AND &HFF0000) \ &H10000
END SUB
DECLARE FUNCTION GetPI! ()
DECLARE FUNCTION ArcTan! (y AS SINGLE, x AS SINGLE)
DECLARE FUNCTION RGB& (R AS INTEGER, G AS INTEGER, b AS INTEGER)
DECLARE SUB ZPset16 (x AS INTEGER, y AS INTEGER, R AS INTEGER, G AS INTEGER, b AS INTEGER)
DECLARE SUB ZPset16C (x AS INTEGER, y AS INTEGER, C AS LONG)
DECLARE FUNCTION TMC& (TMD AS SINGLE, UpC AS LONG, DnC AS LONG)
DECLARE FUNCTION ZHSB& (H AS INTEGER, S AS SINGLE, L AS SINGLE)
DECLARE FUNCTION ZHB& (H AS INTEGER, L AS SINGLE)
DECLARE FUNCTION WinHSB& (H AS SINGLE, S AS SINGLE, L AS SINGLE)
DECLARE FUNCTION ZLab& (L AS SINGLE, a AS SINGLE, b AS SINGLE)DIM SHARED DDData(0 TO 15, 0 TO 15) AS INTEGER
DIM SHARED ColorTable(0 TO 1, 0 TO 1, 0 TO 1) AS INTEGERDIM I AS INTEGER, J AS INTEGER, K AS INTEGER, T AS INTEGERFOR I = 0 TO 15
FOR J = 0 TO 15
READ T
DDData(I, J) = T
NEXT J
NEXT I
FOR I = 0 TO 1
FOR J = 0 TO 1
FOR K = 0 TO 1
READ T
ColorTable(K, J, I) = T
NEXT K
NEXT J
NEXT ISCREEN 12FOR I = 0 TO 479
FOR J = 0 TO 639
ZPset16C J, I, ((CLNG(J) * 255 \ 639) AND &HFF) * (((I \ 60) AND 1) * &H10000 + ((I \ 120) AND 1) * &H100& + ((I \ 240) AND 1))
NEXT J
NEXT I
WHILE INKEY$ = "": WENDFOR I = 0 TO 479
FOR J = 0 TO 639
ZPset16 J, I, I AND &HFF, J AND &HFF, 0
NEXT J
NEXT I
WHILE INKEY$ = "": WENDFOR I = 0 TO 479
FOR J = 0 TO 639
ZPset16 J, I, I AND &HFF, J AND &HFF, ((I + J) \ 2) AND &HFF
NEXT J
NEXT I
WHILE INKEY$ = "": WENDFOR I = 0 TO 479
FOR J = 0 TO 639
ZPset16C J, I, ZHB(CLNG(J) * 6 * 255 \ 639, 0)
NEXT J
NEXT I
WHILE INKEY$ = "": WENDFOR I = 0 TO 479
FOR J = 0 TO 639
ZPset16C J, I, ZHB(CLNG(J) * 6 * 255 \ 639, (479 \ 2 - I) / (479 \ 2))
NEXT J
NEXT I
WHILE INKEY$ = "": WENDFOR I = 0 TO 479
FOR J = 0 TO 639
ZPset16C J, I, ZLab(1, ((J / 639) * 2 - 1) * 120, (1 - I * 2 / 479) * 120)
NEXT J
NEXT I
WHILE INKEY$ = "": WENDSCREEN 0
ENDDATA 0,235,59,219,15,231,55,215,2,232,56,217,12,229,52,213
DATA 128,64,187,123,143,79,183,119,130,66,184,120,140,76,180,116
DATA 33,192,16,251,47,207,31,247,34,194,18,248,44,204,28,244
DATA 161,97,144,80,175,111,159,95,162,98,146,82,172,108,156,92
DATA 8,225,48,208,5,239,63,223,10,226,50,210,6,236,60,220
DATA 136,72,176,112,133,69,191,127,138,74,178,114,134,70,188,124
DATA 41,200,24,240,36,197,20,255,42,202,26,242,38,198,22,252
DATA 169,105,152,88,164,100,148,84,170,106,154,90,166,102,150,86
DATA 3,233,57,216,13,228,53,212,1,234,58,218,14,230,54,214
DATA 131,67,185,121,141,77,181,117,129,65,186,122,142,78,182,118
DATA 35,195,19,249,45,205,29,245,32,193,17,250,46,206,30,246
DATA 163,99,147,83,173,109,157,93,160,96,145,81,174,110,158,94
DATA 11,227,51,211,7,237,61,221,9,224,49,209,4,238,62,222
DATA 139,75,179,115,135,71,189,125,137,73,177,113,132,68,190,126
DATA 43,203,27,243,39,199,23,253,40,201,25,241,37,196,21,254
DATA 171,107,155,91,167,103,151,87,168,104,153,89,165,101,149,85DATA 0,12,10,14,9,13,11,15'unsigned char ColorTable[2][2][2]= {{{0,12},{10,14}},{{9,13},{11,15}}};FUNCTION ArcTan! (y AS SINGLE, x AS SINGLE)
IF y > 0 THEN
IF x > 0 THEN
ArcTan! = ATN(y / x)
ELSEIF x = 0 THEN
ArcTan! = ATN(1) * 2
ELSE
ArcTan! = ATN(y / x) + ATN(1) * 4
END IF
ELSEIF y = 0 THEN
IF x > 0 THEN
ArcTan! = 0
ELSEIF x = 0 THEN
ArcTan! = 0
ELSE
ArcTan! = ATN(1) * 4
END IF
ELSE
IF x > 0 THEN
ArcTan! = ATN(y / x) + ATN(1) * 8
ELSEIF x = 0 THEN
ArcTan! = ATN(1) * 6
ELSE
ArcTan! = ATN(y / x) + ATN(1) * 4
END IF
END IFEND FUNCTIONFUNCTION GetPI!
GetPI! = ATN(1) * 4
END FUNCTIONFUNCTION RGB& (R AS INTEGER, G AS INTEGER, b AS INTEGER)
RGB = (b AND &HFF) * &H10000 + CLNG(G AND &HFF) * &H100 + (R AND &HFF)END FUNCTIONFUNCTION TMC& (TMD AS SINGLE, UpC AS LONG, DnC AS LONG)
DIM UpR AS INTEGER, UpG AS INTEGER, UpB AS INTEGER
DIM DnR AS INTEGER, DnG AS INTEGER, DnB AS INTEGER
DIM OutR AS INTEGER, OutG AS INTEGER, OutB AS INTEGER
UpR = UpC AND &HFF
UpG = (UpC AND &HFF00&) \ &H100
UpB = (UpC AND &HFF0000) \ &H10000
DnR = DnC AND &HFF
DnG = (DnC AND &HFF00&) \ &H100
DnB = (DnC AND &HFF0000) \ &H10000
OutR = DnR + (UpR - DnR) * TMD
IF OutR < 0 THEN OutR = 0
IF OutR > 255 THEN OutR = 255
OutG = DnG + (UpG - DnG) * TMD
IF OutG < 0 THEN OutG = 0
IF OutG > 255 THEN OutG = 255
OutB = DnB + (UpB - DnB) * TMD
IF OutB < 0 THEN OutB = 0
IF OutB > 255 THEN OutB = 255
TMC = OutR + OutG * &H100& + OutB * &H10000
END FUNCTIONFUNCTION WinHSB& (H AS SINGLE, S AS SINGLE, L AS SINGLE)
WinHSB& = ZHSB(CINT(H * 256 / 60), S, L)END FUNCTIONFUNCTION ZHB& (H AS INTEGER, L AS SINGLE)
IF L > 1 THEN L = 1
IF L < -1 THEN L = -1
IF L >= 0 THEN
ZHB& = ZHSB(H, 1 - L, 1)
ELSE
ZHB& = ZHSB(H, 1, L + 1)
END IFEND FUNCTIONFUNCTION ZHSB& (H AS INTEGER, S AS SINGLE, L AS SINGLE)
DIM T1 AS INTEGER, T2 AS INTEGER
DIM R AS INTEGER, G AS INTEGER, b AS INTEGER
DIM C AS LONG 'IF H < 0 THEN H = H AND &H7FFF
'H = (H AND &HFF) + (((H AND &H7F00) \ &H100) MOD 6) * &H100
T1 = H AND &HFF
T2 = (H AND &H7F00) \ &H100
T2 = T2 MOD 6
IF S > 1 THEN S = 1
IF S < 0 THEN S = 0
IF L > 1 THEN L = 1
IF L < 0 THEN L = 0 SELECT CASE T2
CASE 0
R = 255
G = H AND &HFF
CASE 1
G = 255
R = 255 - H AND &HFF
CASE 2
G = 255
b = H AND &HFF
CASE 3
b = 255
G = 255 - H AND &HFF
CASE 4
b = 255
R = H AND &HFF
CASE 5
R = 255
b = 255 - H AND &HFF
END SELECT 'C = RGB(R, G, B)
IF S < 1 THEN
'C = TMC(S, C, &HFFFFFF)
R = &HFF + (R - &HFF) * S
G = &HFF + (G - &HFF) * S
b = &HFF + (b - &HFF) * S
END IF
IF L < 1 THEN
'C = TMC(L, C, &H0)
R = &H0 + R * L
G = &H0 + G * L
b = &H0 + b * L
END IF
IF R < 0 THEN R = 0
IF R > &HFF THEN R = &HFF
IF G < 0 THEN G = 0
IF G > &HFF THEN G = &HFF
IF b < 0 THEN b = 0
IF b > &HFF THEN b = &HFF
C = RGB(R, G, b)
ZHSB& = CEND FUNCTIONFUNCTION ZLab& (L AS SINGLE, a AS SINGLE, b AS SINGLE)
DIM H AS SINGLE, S AS SINGLE H = ArcTan(b, a) - ATN(1)
IF H < 0 THEN H = H + ATN(1) * 8
H = (H * 3 * 256) / (ATN(1) * 4)
S = SQR(a * a + b * b) / 120
ZLab& = ZHSB(CINT(H), S, L)END FUNCTIONSUB ZPset16 (x AS INTEGER, y AS INTEGER, R AS INTEGER, G AS INTEGER, b AS INTEGER)
DIM L AS INTEGER, C AS INTEGER L = DDData(y AND &HF, x AND &HF)
C = ColorTable((R > L) AND 1, (G > L) AND 1, (b > L) AND 1)
PSET (x, y), CEND SUBSUB ZPset16C (x AS INTEGER, y AS INTEGER, C AS LONG)
ZPset16 x, y, C AND &HFF, (C AND &HFF00&) \ &H100, (C AND &HFF0000) \ &H10000
END SUB
DECLARE FUNCTION GetPI! ()
DECLARE FUNCTION ArcTan! (y AS SINGLE, x AS SINGLE)
DECLARE FUNCTION RGB& (R AS INTEGER, G AS INTEGER, b AS INTEGER)
DECLARE SUB ZPset16 (x AS INTEGER, y AS INTEGER, R AS INTEGER, G AS INTEGER, b AS INTEGER)
DECLARE SUB ZPset16C (x AS INTEGER, y AS INTEGER, C AS LONG)
DECLARE FUNCTION TMC& (TMD AS SINGLE, UpC AS LONG, DnC AS LONG)
DECLARE FUNCTION ZHSB& (H AS INTEGER, S AS SINGLE, L AS SINGLE)
DECLARE FUNCTION ZHB& (H AS INTEGER, L AS SINGLE)
DECLARE FUNCTION WinHSB& (H AS SINGLE, S AS SINGLE, L AS SINGLE)
DECLARE FUNCTION ZLab& (L AS SINGLE, a AS SINGLE, b AS SINGLE)DIM SHARED DDData(0 TO 15, 0 TO 15) AS INTEGER
DIM SHARED ColorTable(0 TO 1, 0 TO 1, 0 TO 1) AS INTEGERDIM I AS INTEGER, J AS INTEGER, K AS INTEGER, T AS INTEGERFOR I = 0 TO 15
FOR J = 0 TO 15
READ T
DDData(I, J) = T
NEXT J
NEXT I
FOR I = 0 TO 1
FOR J = 0 TO 1
FOR K = 0 TO 1
READ T
ColorTable(K, J, I) = T
NEXT K
NEXT J
NEXT ISCREEN 12FOR I = 0 TO 479
FOR J = 0 TO 639
ZPset16C J, I, ((CLNG(J) * 255 \ 639) AND &HFF) * (((I \ 60) AND 1) * &H10000 + ((I \ 120) AND 1) * &H100& + ((I \ 240) AND 1))
NEXT J
NEXT I
WHILE INKEY$ = "": WENDFOR I = 0 TO 479
FOR J = 0 TO 639
ZPset16 J, I, I AND &HFF, J AND &HFF, 0
NEXT J
NEXT I
WHILE INKEY$ = "": WENDFOR I = 0 TO 479
FOR J = 0 TO 639
ZPset16 J, I, I AND &HFF, J AND &HFF, ((I + J) \ 2) AND &HFF
NEXT J
NEXT I
WHILE INKEY$ = "": WENDFOR I = 0 TO 479
FOR J = 0 TO 639
ZPset16C J, I, ZHB(CLNG(J) * 6 * 255 \ 639, 0)
NEXT J
NEXT I
WHILE INKEY$ = "": WENDFOR I = 0 TO 479
FOR J = 0 TO 639
ZPset16C J, I, ZHB(CLNG(J) * 6 * 255 \ 639, (479 \ 2 - I) / (479 \ 2))
NEXT J
NEXT I
WHILE INKEY$ = "": WENDFOR I = 0 TO 479
FOR J = 0 TO 639
ZPset16C J, I, ZLab(1, ((J / 639) * 2 - 1) * 120, (1 - I * 2 / 479) * 120)
NEXT J
NEXT I
WHILE INKEY$ = "": WENDSCREEN 0
ENDDATA 0,235,59,219,15,231,55,215,2,232,56,217,12,229,52,213
DATA 128,64,187,123,143,79,183,119,130,66,184,120,140,76,180,116
DATA 33,192,16,251,47,207,31,247,34,194,18,248,44,204,28,244
DATA 161,97,144,80,175,111,159,95,162,98,146,82,172,108,156,92
DATA 8,225,48,208,5,239,63,223,10,226,50,210,6,236,60,220
DATA 136,72,176,112,133,69,191,127,138,74,178,114,134,70,188,124
DATA 41,200,24,240,36,197,20,255,42,202,26,242,38,198,22,252
DATA 169,105,152,88,164,100,148,84,170,106,154,90,166,102,150,86
DATA 3,233,57,216,13,228,53,212,1,234,58,218,14,230,54,214
DATA 131,67,185,121,141,77,181,117,129,65,186,122,142,78,182,118
DATA 35,195,19,249,45,205,29,245,32,193,17,250,46,206,30,246
DATA 163,99,147,83,173,109,157,93,160,96,145,81,174,110,158,94
DATA 11,227,51,211,7,237,61,221,9,224,49,209,4,238,62,222
DATA 139,75,179,115,135,71,189,125,137,73,177,113,132,68,190,126
DATA 43,203,27,243,39,199,23,253,40,201,25,241,37,196,21,254
DATA 171,107,155,91,167,103,151,87,168,104,153,89,165,101,149,85DATA 0,12,10,14,9,13,11,15'unsigned char ColorTable[2][2][2]= {{{0,12},{10,14}},{{9,13},{11,15}}};FUNCTION ArcTan! (y AS SINGLE, x AS SINGLE)
IF y > 0 THEN
IF x > 0 THEN
ArcTan! = ATN(y / x)
ELSEIF x = 0 THEN
ArcTan! = ATN(1) * 2
ELSE
ArcTan! = ATN(y / x) + ATN(1) * 4
END IF
ELSEIF y = 0 THEN
IF x > 0 THEN
ArcTan! = 0
ELSEIF x = 0 THEN
ArcTan! = 0
ELSE
ArcTan! = ATN(1) * 4
END IF
ELSE
IF x > 0 THEN
ArcTan! = ATN(y / x) + ATN(1) * 8
ELSEIF x = 0 THEN
ArcTan! = ATN(1) * 6
ELSE
ArcTan! = ATN(y / x) + ATN(1) * 4
END IF
END IFEND FUNCTIONFUNCTION GetPI!
GetPI! = ATN(1) * 4
END FUNCTIONFUNCTION RGB& (R AS INTEGER, G AS INTEGER, b AS INTEGER)
RGB = (b AND &HFF) * &H10000 + CLNG(G AND &HFF) * &H100 + (R AND &HFF)END FUNCTIONFUNCTION TMC& (TMD AS SINGLE, UpC AS LONG, DnC AS LONG)
DIM UpR AS INTEGER, UpG AS INTEGER, UpB AS INTEGER
DIM DnR AS INTEGER, DnG AS INTEGER, DnB AS INTEGER
DIM OutR AS INTEGER, OutG AS INTEGER, OutB AS INTEGER
UpR = UpC AND &HFF
UpG = (UpC AND &HFF00&) \ &H100
UpB = (UpC AND &HFF0000) \ &H10000
DnR = DnC AND &HFF
DnG = (DnC AND &HFF00&) \ &H100
DnB = (DnC AND &HFF0000) \ &H10000
OutR = DnR + (UpR - DnR) * TMD
IF OutR < 0 THEN OutR = 0
IF OutR > 255 THEN OutR = 255
OutG = DnG + (UpG - DnG) * TMD
IF OutG < 0 THEN OutG = 0
IF OutG > 255 THEN OutG = 255
OutB = DnB + (UpB - DnB) * TMD
IF OutB < 0 THEN OutB = 0
IF OutB > 255 THEN OutB = 255
TMC = OutR + OutG * &H100& + OutB * &H10000
END FUNCTIONFUNCTION WinHSB& (H AS SINGLE, S AS SINGLE, L AS SINGLE)
WinHSB& = ZHSB(CINT(H * 256 / 60), S, L)END FUNCTIONFUNCTION ZHB& (H AS INTEGER, L AS SINGLE)
IF L > 1 THEN L = 1
IF L < -1 THEN L = -1
IF L >= 0 THEN
ZHB& = ZHSB(H, 1 - L, 1)
ELSE
ZHB& = ZHSB(H, 1, L + 1)
END IFEND FUNCTIONFUNCTION ZHSB& (H AS INTEGER, S AS SINGLE, L AS SINGLE)
DIM T1 AS INTEGER, T2 AS INTEGER
DIM R AS INTEGER, G AS INTEGER, b AS INTEGER
DIM C AS LONG 'IF H < 0 THEN H = H AND &H7FFF
'H = (H AND &HFF) + (((H AND &H7F00) \ &H100) MOD 6) * &H100
T1 = H AND &HFF
T2 = (H AND &H7F00) \ &H100
T2 = T2 MOD 6
IF S > 1 THEN S = 1
IF S < 0 THEN S = 0
IF L > 1 THEN L = 1
IF L < 0 THEN L = 0 SELECT CASE T2
CASE 0
R = 255
G = H AND &HFF
CASE 1
G = 255
R = 255 - H AND &HFF
CASE 2
G = 255
b = H AND &HFF
CASE 3
b = 255
G = 255 - H AND &HFF
CASE 4
b = 255
R = H AND &HFF
CASE 5
R = 255
b = 255 - H AND &HFF
END SELECT 'C = RGB(R, G, B)
IF S < 1 THEN
'C = TMC(S, C, &HFFFFFF)
R = &HFF + (R - &HFF) * S
G = &HFF + (G - &HFF) * S
b = &HFF + (b - &HFF) * S
END IF
IF L < 1 THEN
'C = TMC(L, C, &H0)
R = &H0 + R * L
G = &H0 + G * L
b = &H0 + b * L
END IF
IF R < 0 THEN R = 0
IF R > &HFF THEN R = &HFF
IF G < 0 THEN G = 0
IF G > &HFF THEN G = &HFF
IF b < 0 THEN b = 0
IF b > &HFF THEN b = &HFF
C = RGB(R, G, b)
ZHSB& = CEND FUNCTIONFUNCTION ZLab& (L AS SINGLE, a AS SINGLE, b AS SINGLE)
DIM H AS SINGLE, S AS SINGLE H = ArcTan(b, a) - ATN(1)
IF H < 0 THEN H = H + ATN(1) * 8
H = (H * 3 * 256) / (ATN(1) * 4)
S = SQR(a * a + b * b) / 120
ZLab& = ZHSB(CINT(H), S, L)END FUNCTIONSUB ZPset16 (x AS INTEGER, y AS INTEGER, R AS INTEGER, G AS INTEGER, b AS INTEGER)
DIM L AS INTEGER, C AS INTEGER L = DDData(y AND &HF, x AND &HF)
C = ColorTable((R > L) AND 1, (G > L) AND 1, (b > L) AND 1)
PSET (x, y), CEND SUBSUB ZPset16C (x AS INTEGER, y AS INTEGER, C AS LONG)
ZPset16 x, y, C AND &HFF, (C AND &HFF00&) \ &H100, (C AND &HFF0000) \ &H10000
END SUB