09-10-2005, 05:11 PM
Now I wrote a 24Bit -> QB standard palette conversion sub but it's quite slow and the result looks ugly...
Code:
'********************************************************************
'**** ****
'**** Showing a true color image in screen 12 ****
'**** (c) 2005 Sebastian Steiner, sebastian@ssteiner.com ****
'**** ****
'**** ATTENTION: No warranty, use on own risk! ****
'**** ****
'********************************************************************
DECLARE FUNCTION RGBtoPAL% (xColor AS LONG)
DECLARE FUNCTION TwoFigures$ (Number AS STRING)
DECLARE SUB BSort (SortField() AS INTEGER, SecondField() AS INTEGER)
'#### QB Palette data
DIM SHARED Pal(15, 2) AS INTEGER
Pal(0, 0) = 0: Pal(0, 1) = 0: Pal(0, 2) = 0
Pal(1, 0) = 0: Pal(1, 1) = 0: Pal(1, 2) = 170
Pal(2, 0) = 0: Pal(2, 1) = 170: Pal(2, 2) = 0
Pal(3, 0) = 0: Pal(3, 1) = 170: Pal(3, 2) = 170
Pal(4, 0) = 170: Pal(4, 1) = 0: Pal(4, 2) = 0
Pal(5, 0) = 170: Pal(5, 1) = 0: Pal(5, 2) = 170
Pal(6, 0) = 170: Pal(6, 1) = 85: Pal(6, 2) = 0
Pal(7, 0) = 170: Pal(7, 1) = 170: Pal(7, 2) = 170
Pal(8, 0) = 85: Pal(8, 1) = 85: Pal(8, 2) = 85
Pal(9, 0) = 85: Pal(9, 1) = 85: Pal(9, 2) = 255
Pal(10, 0) = 85: Pal(10, 1) = 255: Pal(10, 2) = 85
Pal(11, 0) = 85: Pal(11, 1) = 255: Pal(11, 2) = 255
Pal(12, 0) = 255: Pal(12, 1) = 85: Pal(12, 2) = 85
Pal(13, 0) = 255: Pal(13, 1) = 85: Pal(13, 2) = 255
Pal(14, 0) = 255: Pal(14, 1) = 255: Pal(14, 2) = 85
Pal(15, 0) = 255: Pal(15, 1) = 255: Pal(15, 2) = 255
SCREEN 12
'Add your BMP loader here. Just write instead of
'"PSET (x,y), QuiteLongNumber&" "PSET(x,y),RGBtoPAL(QuiteLongNumber&)".
'RGBtoPAL converts a value like &HABCDEF into a palette index (0-15).
'This source doesn't change the palette of SCREEN 12.
SLEEP
END
SUB BSort (SortField() AS INTEGER, SecondField() AS INTEGER)
DIM i AS LONG
DIM Flag AS INTEGER
DIM z AS INTEGER
DIM y AS INTEGER
DO
Flag = 1
FOR i = 0 TO UBOUND(SortField, 1) - 1
IF SortField(i) > SortField(i + 1) THEN
y = SecondField(i)
z = SortField(i)
SortField(i) = SortField(i + 1)
SecondField(i) = SecondField(i + 1)
SortField(i + 1) = z
SecondField(i + 1) = y
Flag = 0
END IF
NEXT i
LOOP UNTIL Flag = 1
END SUB
FUNCTION RGBtoPAL% (xColor AS LONG)
REDIM Deviation(15, 2) AS INTEGER
REDIM Dev(15) AS INTEGER
REDIM Index(15) AS INTEGER
REDIM Colors(2) AS INTEGER
Number$ = HEX$(xColor)
FOR i% = 0 TO 15
Index(i%) = i%
NEXT i%
Colors(0) = VAL("&H" + LEFT$(Number$, 2))
Colors(1) = VAL("&H" + MID$(Number$, 4, 2))
Colors(2) = VAL("&H" + RIGHT$(Number$, 2))
FOR i% = 0 TO 15
FOR x% = 0 TO 2
Deviation(i%, x%) = Colors(x%) - Pal(i%, x%)
IF Deviation(i%, x%) < 0 THEN
Deviation(i%, x%) = Deviation(i%, x%) * (-1)
End if
Dev(i%) = Dev(i%) + Deviation(i%, x%)
NEXT x%
NEXT i%
BSort Dev(), Index()
RGBtoPAL = Index(0)
END FUNCTION
FUNCTION TwoFigures$ (Number AS STRING)
IF LEN(Number) = 1 THEN
TwoFigures$ = "0" + Number
ELSE
TwoFigures$ = Number
END IF
END FUNCTION