type
TvColors =
array [0..7, 0..1]
of byte;
const
RGBData:
array[0..7]
of TvColors = (
(($B1, $4F), ($B1, $6F), ($B1, $7E), ($B1, $2F), ($B1, $3F), ($B1, $1F), ($B1, $5F), ($B1, $4F)),
(($B2, $7C), ($B1, $76), ($B1, $7E), ($B2, $7A), ($B2, $7B), ($B1, $79), ($B2, $7D), ($B2, $7C)),
(($B1, $4C), ($B2, $76), ($B2, $7E), ($B1, $2A), ($B1, $3B), ($B1, $09), ($B1, $5D), ($B1, $4C)),
(($B0, $4C), ($B2, $76), ($B2, $7E), ($B0, $2A), ($B0, $3B), ($B0, $19), ($B0, $5D), ($B0, $4C)),
(($B0, $44), ($B0, $66), (
{DB}$B0, $0E), ($B2, $22), ($B2, $33), ($B2, $11), ($B2, $55), ($B2, $44)),
(($B2, $04), ($B2, $06), ($B2, $0E), ($B2, $02), ($B2, $03), ($B2, $01), ($B2, $05), ($B2, $04)),
(($B1, $04), ($B1, $06), ($B1, $0E), ($B1, $02), ($B1, $03), ($B1, $01), ($B1, $05), ($B1, $04)),
(($B0, $04), ($B0, $06), ($B0, $0E), ($B0, $02), ($B0, $03), ($B0, $01), ($B0, $05), ($B0, $04)));
procedure TDosASCIIText.RGBtoHSL(Color: COLORREF;
out H, S, L: Single);
var
Delta: Single;
CMax, CMin: Single;
Red, Green, Blue : Single;
begin
Red := GetRValue(Color) / 255;
Green := GetGValue(Color) / 255;
Blue := GetBValue(Color) / 255;
CMax := Max(Red, Max(Green, Blue));
CMin := Min(Red, Min(Green, Blue));
L := (CMax + CMin) / 2;
if CMax = CMin
then
begin
S := 0;
H := 0;
end else
begin
if L < 0.5
then S := (CMax - CMin) / (CMax + CMin)
else S := (cmax - cmin) / (2 - cmax - cmin);
delta := CMax - CMin;
if Red = CMax
then H := (Green - Blue) / Delta
else
if Green = CMax
then H := 2 + (Blue - Red) / Delta
else H := 4.0 + (Red - Green) / Delta;
H := H / 6;
if H < 0
then H := H + 1;
end;
H := (H * 360);
// 0.0 .. 360.0
S := (S * 100);
// 0.0 .. 100.0
L := (L * 100);
// 0.0 .. 100.0
end;
procedure TDosASCIIText.RGBToHSL_AsInteger(
const Color: COLORREF;
out Huge, Saturation, Luminance: integer);
var _Huge, _Saturation, _Luminance: single;
begin
RGBToHSL(Color, _Huge, _Saturation, _Luminance);
Huge := round(_Huge );
Saturation := round(_Saturation);
Luminance := round(_Luminance);
end;
procedure TDosASCIIText.BitmapToArray(
var conBuffer: TConBuffer);
type
TRGBA =
packed record
B, G, R, A: Byte;
end;
PRGBA = ^TRGBA;
var
xx,yy: integer;
rgba: prgba;
C: Byte;
Ch: Char;
H, S, L, p, p2,p3: integer;
function _SetTextColor(FColor, BColor: Byte): Byte;
begin
Result := FColor
or (BColor
shl 4);
end;
begin
for yy := 0
to BmpH - 1
do
begin
for xx := 0
to BmpW - 1
do
begin
rgba := pRGBA(DWORD(pBmpBits) + DWORD(xx + yy * BmpW) * 4);
RGBToHSL_AsInteger(
RGB(rgba.R, rgba.G, rgba.B), H, S, L);
c := 0;
ch := #0;
if (H = 0)
and (S = 0)
then // black & white gedöns
begin
case L
of
0.. 25: C := 0;
26.. 50: C := 8;
51.. 75: C := 7;
76..100: C := 15;
end;
case L
of
0.. 19: Ch := '
';
20.. 39: Ch := '
°';
40.. 59: Ch := '
±';
60.. 79: Ch := '
²';
80..100: Ch := '
Û';
end;
end else
begin // Farbe
p := round( (H / 360) * 100 );
p := round( (7 / 100) * p );
// sättigung & hälligkeit zusammen packen ???
p2:= round( (7 / 100) * l );
p3:= round( (7 / 100) * s );
p2 := (p2 + p3)
div 2;
C := RGBData[7-p2,p,1];
//?farben im array vertauscht ?
Ch := chr( RGBData[p2,p,0] );
end;
conBuffer[xx + yy * BmpW].AsciiChar := Ch;
conBuffer[xx + yy * BmpW].Attributes := C;
end;
end;
end;