2b49b563a1
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5678 8e941d3f-bd1b-0410-a28a-d453659cc2b4
796 lines
20 KiB
ObjectPascal
796 lines
20 KiB
ObjectPascal
unit PalUtils;
|
||
|
||
interface
|
||
|
||
uses
|
||
LCLType, LCLIntf, SysUtils, Classes, Graphics,
|
||
//RGBHSVUtils, RGBHSLUtils,
|
||
RGBCIEUtils, RGBCMYKUtils,
|
||
HTMLColors;
|
||
|
||
const
|
||
clCustom = $2FFFFFFF;
|
||
clTransparent = $3FFFFFFF;
|
||
|
||
type
|
||
TSortOrder = (soAscending, soDescending);
|
||
TSortMode = (smRed, smGreen, smBlue, smHue, smSaturation, smLuminance, smValue, smNone, smCyan, smMagenta, smYellow, smBlacK, smCIEx, smCIEy, smCIEz, smCIEl, smCIEa, smCIEb);
|
||
|
||
AcoColors = record
|
||
Colors: array of TColor;
|
||
Names: array of WideString;
|
||
HasNames: boolean;
|
||
end;
|
||
|
||
//replaces passed strings with passed value
|
||
function ReplaceFlags(s: string; flags: array of string; value: integer): string;
|
||
|
||
//replaces the appropriate tags with values in a hint format string
|
||
function FormatHint(fmt: string; c: TColor): string;
|
||
|
||
//converts a string value to TColor including clCustom and clTransparent
|
||
function mbStringToColor(s: string): TColor;
|
||
|
||
//converts a TColor to a string value including clCustom and clTransparent
|
||
function mbColorToString(c: TColor): string;
|
||
|
||
//blends two colors together in proportion C1 : C2 = W1 : 100 - W1, where 0 <= W1 <= 100
|
||
function Blend(C1, C2: TColor; W1: Integer): TColor;
|
||
|
||
// Inverts a color
|
||
function InvertedColor(C: TColor): TColor;
|
||
|
||
//generates a white-color-black or a black-color-white gradient palette
|
||
function MakePalette(BaseColor: TColor; SortOrder: TSortOrder): string;
|
||
|
||
//generates a gradient palette from the given colors
|
||
function MakeGradientPalette(Colors: array of TColor): string;
|
||
|
||
//sorts colors in a string list
|
||
procedure SortPalColors(Colors: TStrings; SortMode: TSortMode; SortOrder: TSortOrder);
|
||
|
||
//reads JASC .pal file
|
||
function ReadJASCPal(PalFile: TFileName): string;
|
||
|
||
//saves a string list to a JASC .pal file
|
||
procedure SaveJASCPal(pal: TStrings; FileName: TFileName);
|
||
|
||
//reads Photoshop .aco file into an Aco record
|
||
function ReadPhotoshopAco(PalFile: TFileName): AcoColors;
|
||
|
||
//reads Photoshop .act file
|
||
function ReadPhotoshopAct(PalFile: TFileName): string;
|
||
|
||
|
||
implementation
|
||
|
||
uses
|
||
Math, mbColorConv;
|
||
|
||
function ReplaceFlags(s: string; flags: array of string; value: integer): string;
|
||
var
|
||
i, p: integer;
|
||
v: string;
|
||
begin
|
||
Result := s;
|
||
v := IntToStr(value);
|
||
for i := 0 to Length(flags) - 1 do
|
||
begin
|
||
p := Pos(flags[i], Result);
|
||
if p > 0 then
|
||
begin
|
||
Delete(Result, p, Length(flags[i]));
|
||
Insert(v, Result, p);
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
function AnsiReplaceText(const AText, AFromText, AToText: string): string;
|
||
begin
|
||
Result := StringReplace(AText, AFromText, AToText, [rfReplaceAll, rfIgnoreCase]);
|
||
end;
|
||
|
||
function FormatHint(fmt: string; c: TColor): string;
|
||
var
|
||
h: string;
|
||
hslH, hslS, hslL: Double;
|
||
hsvH, hsvS, hsvV: Double;
|
||
begin
|
||
ColorToHSL(c, hslH, hslS, hslL);
|
||
ColorToHSV(c, hsvH, hsvS, hsvV);
|
||
|
||
h := AnsiReplaceText(fmt, '%hex', '#' + ColorToHex(c));
|
||
h := AnsiReplaceText(h, '%cieL', IntToStr(Round(GetCIElValue(c))));
|
||
h := AnsiReplaceText(h, '%cieA', IntToStr(Round(GetCIEaValue(c))));
|
||
h := AnsiReplaceText(h, '%cieB', IntToStr(Round(GetCIEbValue(c))));
|
||
h := AnsiReplaceText(h, '%cieX', IntToStr(Round(GetCIExValue(c))));
|
||
h := AnsiReplaceText(h, '%cieY', IntToStr(Round(GetCIEyValue(c))));
|
||
h := AnsiReplaceText(h, '%cieZ', IntToStr(Round(GetCIEzValue(c))));
|
||
h := AnsiReplaceText(h, '%cieC', IntToStr(Round(GetCIEcValue(c))));
|
||
h := AnsiReplaceText(h, '%cieH', IntToStr(Round(GetCIEhValue(c))));
|
||
h := AnsiReplaceText(h, '%hslH', IntToStr(Round(hslH * 360))); //RGBHSLUtils.GetHValue(c)));
|
||
h := AnsiReplaceText(h, '%hslS', IntToStr(Round(hslS * 255))); //RGBHSLUtils.GetSValue(c)));
|
||
h := AnsiReplaceText(h, '%hslL', IntToStr(Round(hslL * 255))); //RGBHSLUtils.GetLValue(c)));
|
||
h := AnsiReplaceText(h, '%hsvH', IntToStr(round(hsvH * 360))); //RGBHSVUtils.GetHValue(c)));
|
||
h := AnsiReplaceText(h, '%hsvS', IntToStr(round(hsvS * 255))); //RGBHSVUtils.GetSValue(c)));
|
||
h := AnsiReplaceText(h, '%hsvV', IntToStr(round(hsvV * 255))); //RGBHSVUtils.GetVValue(c)));
|
||
h := AnsiReplaceText(h, '%r', IntToStr(GetRValue(c)));
|
||
h := AnsiReplaceText(h, '%g', IntToStr(GetGValue(c)));
|
||
h := AnsiReplaceText(h, '%b', IntToStr(GetBValue(c)));
|
||
h := AnsiReplaceText(h, '%c', IntToStr(GetCValue(c)));
|
||
h := AnsiReplaceText(h, '%m', IntToStr(GetMValue(c)));
|
||
h := AnsiReplaceText(h, '%y', IntToStr(GetYValue(c)));
|
||
h := AnsiReplaceText(h, '%k', IntToStr(GetKValue(c)));
|
||
h := AnsiReplaceText(h, '%h', IntToStr(round(hslH * 360))); //RGBHSLUtils.GetHValue(c)));
|
||
h := AnsiReplaceText(h, '%s', IntToStr(round(hslS * 255))); //RGBHSLUtils.GetSValue(c)));
|
||
h := AnsiReplaceText(h, '%l', IntToStr(round(hslL * 255))); //RGBHSLUtils.GetLValue(c)));
|
||
h := AnsiReplaceText(h, '%v', IntToStr(round(hsvV * 255))); //RGBHSVUtils.GetVValue(c)));
|
||
Result := h;
|
||
end;
|
||
|
||
function mbStringToColor(s: string): TColor;
|
||
begin
|
||
//remove spaces
|
||
s := AnsiReplaceText(s, ' ', '');
|
||
if SameText(s, 'clCustom') then
|
||
Result := clCustom
|
||
else
|
||
if SameText(s, 'clTransparent') then
|
||
Result := clTransparent
|
||
else
|
||
Result := StringToColor(s);
|
||
end;
|
||
|
||
function mbColorToString(c: TColor): string;
|
||
begin
|
||
if c = clCustom then
|
||
Result := 'clCustom'
|
||
else
|
||
if c = clTransparent then
|
||
Result := 'clTransparent'
|
||
else
|
||
Result := ColorToString(c);
|
||
end;
|
||
|
||
//taken from TBXUtils, TBX Package <20> Alex Denisov (www.g32.org)
|
||
function Blend(C1, C2: TColor; W1: Integer): TColor;
|
||
var
|
||
W2, A1, A2, D, F, G: Integer;
|
||
begin
|
||
if C1 < 0 then C1 := GetSysColor(C1 and $FF);
|
||
if C2 < 0 then C2 := GetSysColor(C2 and $FF);
|
||
|
||
if W1 >= 100 then D := 1000
|
||
else D := 100;
|
||
|
||
W2 := D - W1;
|
||
F := D div 2;
|
||
|
||
A2 := C2 shr 16 * W2;
|
||
A1 := C1 shr 16 * W1;
|
||
G := (A1 + A2 + F) div D and $FF;
|
||
Result := G shl 16;
|
||
|
||
A2 := (C2 shr 8 and $FF) * W2;
|
||
A1 := (C1 shr 8 and $FF) * W1;
|
||
G := (A1 + A2 + F) div D and $FF;
|
||
Result := Result or G shl 8;
|
||
|
||
A2 := (C2 and $FF) * W2;
|
||
A1 := (C1 and $FF) * W1;
|
||
G := (A1 + A2 + F) div D and $FF;
|
||
Result := Result or G;
|
||
end;
|
||
|
||
function InvertedColor(C: TColor): TColor;
|
||
begin
|
||
Result := RgbToColor(255 - GetRValue(c), 255 - GetGValue(c), 255 - GetBValue(c));
|
||
end;
|
||
|
||
function IsMember(sl: TStrings; s: string): boolean;
|
||
var
|
||
i: integer;
|
||
begin
|
||
for i := 0 to sl.count -1 do
|
||
if sl.Strings[i] = s then
|
||
begin
|
||
Result := true;
|
||
exit;
|
||
end;
|
||
Result := false;
|
||
end;
|
||
|
||
function MakePalette(BaseColor: TColor; SortOrder: TSortOrder): string;
|
||
const
|
||
maxL = 240;
|
||
var
|
||
i: integer;
|
||
s: TStrings;
|
||
hslH, hslS, hslL: Double;
|
||
begin
|
||
Result := '';
|
||
s := TStringList.Create;
|
||
try
|
||
ColorToHSL(BaseColor, hslH, hslS, hslL);
|
||
case SortOrder of
|
||
soAscending:
|
||
for i := maxL downto 0 do
|
||
s.Add(ColorToString(HSLToColor(hslH, hslS, 1 - i/maxL)));
|
||
// for i := 239 downto 0 do
|
||
// s.Add(ColorToString(HSLRangeToRGB(GetHValue(BaseColor), GetSValue(BaseColor), 240 - i)));
|
||
soDescending:
|
||
for i := 0 to maxL do
|
||
s.Add(ColorToString(HSLToColor(hslH, hslS, i/maxL)));
|
||
// for i := 0 to 239 do
|
||
// s.Add(ColorToString(HSLRangeToRGB(GetHValue(BaseColor), GetSValue(BaseColor), 240 - i)));
|
||
end;
|
||
Result := s.Text;
|
||
finally
|
||
s.Free;
|
||
end;
|
||
end;
|
||
|
||
function MakeGradientPalette(Colors: array of TColor): string;
|
||
type
|
||
RGBArray = array[0..2] of Byte;
|
||
var
|
||
i, j, k, Span: Integer;
|
||
s: TStringList;
|
||
Scolor: string;
|
||
Faktor: double;
|
||
a: RGBArray;
|
||
b: array of RGBArray;
|
||
begin
|
||
Result := '';
|
||
Span := 300;
|
||
s := TStringList.Create;
|
||
try
|
||
SetLength(b, High(Colors) + 1);
|
||
for i := 0 to High(Colors) do
|
||
begin
|
||
Colors[i] := ColorToRGB(Colors[i]);
|
||
b[i, 0] := GetRValue(Colors[i]);
|
||
b[i, 1] := GetGValue(Colors[i]);
|
||
b[i, 2] := GetBValue(Colors[i]);
|
||
end;
|
||
for i := 0 to High(Colors) - 1 do
|
||
for j := 0 to Span do
|
||
begin
|
||
Faktor := j / Span;
|
||
for k := 0 to 3 do
|
||
a[k] := Trunc(b[i, k] + ((b[i + 1, k] - b[i, k]) * Faktor));
|
||
Scolor := ColorToString(RGB(a[0], a[1], a[2]));
|
||
if not IsMember(s, Scolor) then
|
||
s.add(Scolor);
|
||
end;
|
||
Result := s.Text;
|
||
finally
|
||
s.Free;
|
||
end;
|
||
end;
|
||
|
||
procedure SortPalColors(Colors: TStrings; SortMode: TSortMode; SortOrder: TSortOrder);
|
||
|
||
function MaxPos(s: TStrings; sm: TSortMode): integer;
|
||
var
|
||
i: integer;
|
||
first: TColor;
|
||
c: TColor;
|
||
hc, sc, lc, vc: Double;
|
||
hf, sf, lf, vf: Double;
|
||
begin
|
||
Result := 0;
|
||
first := clBlack;
|
||
for i := 0 to s.Count - 1 do
|
||
begin
|
||
c := mbStringToColor(s.Strings[i]);
|
||
case sm of
|
||
smRed:
|
||
if GetRValue(first) < GetRValue(c) then
|
||
begin
|
||
first := c;
|
||
Result := i;
|
||
end;
|
||
smGreen:
|
||
if GetGValue(first) < GetGValue(c) then
|
||
begin
|
||
first := c;
|
||
Result := i;
|
||
end;
|
||
smBlue:
|
||
if GetBValue(first) < GetBValue(c) then
|
||
begin
|
||
first := c;
|
||
Result := i;
|
||
end;
|
||
smHue:
|
||
begin
|
||
ColorToHSL(c, hc, sc, lc);
|
||
ColorToHSL(first, hf, sf, lf);
|
||
if hf < hc then begin
|
||
first := c;
|
||
Result := i;
|
||
end;
|
||
end;
|
||
smSaturation:
|
||
begin
|
||
ColorToHSL(c, hc, sc, lc);
|
||
ColorToHSL(first, hf, sf, lf);
|
||
if sf < sc then begin
|
||
first := c;
|
||
Result := i;
|
||
end;
|
||
end;
|
||
smLuminance:
|
||
begin
|
||
ColorToHSL(c, hc, sc, lc);
|
||
ColorToHSL(first, hf, sc, lf);
|
||
if lf < lc then
|
||
begin
|
||
first := c;
|
||
Result := i;
|
||
end;
|
||
end;
|
||
smValue:
|
||
begin
|
||
ColorToHSV(c, hc, sc, vc);
|
||
ColorToHSV(first, hf, sc, vf);
|
||
if vf < vc then
|
||
begin
|
||
first := c;
|
||
Result := i;
|
||
end;
|
||
end;
|
||
smCyan:
|
||
if GetCValue(first) < GetCValue(c) then
|
||
begin
|
||
first := c;
|
||
Result := i;
|
||
end;
|
||
smMagenta:
|
||
if GetMValue(first) < GetMValue(c) then
|
||
begin
|
||
first := c;
|
||
Result := i;
|
||
end;
|
||
smYellow:
|
||
if GetYValue(first) < GetYValue(c) then
|
||
begin
|
||
first := c;
|
||
Result := i;
|
||
end;
|
||
smBlacK:
|
||
if GetKValue(first) < GetKValue(c) then
|
||
begin
|
||
first := c;
|
||
Result := i;
|
||
end;
|
||
smCIEx:
|
||
if GetCIEXValue(first) < GetCIEXValue(c) then
|
||
begin
|
||
first := c;
|
||
Result := i;
|
||
end;
|
||
smCIEy:
|
||
if GetCIEYValue(first) < GetCIEYValue(c) then
|
||
begin
|
||
first := c;
|
||
Result := i;
|
||
end;
|
||
smCIEz:
|
||
if GetCIEZValue(first) < GetCIEZValue(c) then
|
||
begin
|
||
first := c;
|
||
Result := i;
|
||
end;
|
||
smCIEl:
|
||
if GetCIELValue(first) < GetCIELValue(c) then
|
||
begin
|
||
first := c;
|
||
Result := i;
|
||
end;
|
||
smCIEa:
|
||
if GetCIEAValue(first) < GetCIEAValue(c) then
|
||
begin
|
||
first := c;
|
||
Result := i;
|
||
end;
|
||
smCIEb:
|
||
if GetCIEBValue(first) < GetCIEBValue(c) then
|
||
begin
|
||
first := c;
|
||
Result := i;
|
||
end;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
function MinPos(s: TStrings; sm: TSortMode): integer;
|
||
var
|
||
i: integer;
|
||
first: TColor;
|
||
c: TColor;
|
||
hc, sc, lc, vc: Double;
|
||
hf, sf, lf, vf: Double;
|
||
begin
|
||
Result := 0;
|
||
first := clWhite;
|
||
for i := 0 to s.Count - 1 do
|
||
begin
|
||
c := mbStringToColor(s.Strings[i]);
|
||
case sm of
|
||
smRed:
|
||
if GetRValue(first) > GetRValue(c) then
|
||
begin
|
||
first := c;
|
||
Result := i;
|
||
end;
|
||
smGreen:
|
||
if GetGValue(first) > GetGValue(c) then
|
||
begin
|
||
first := c;
|
||
Result := i;
|
||
end;
|
||
smBlue:
|
||
if GetBValue(first) > GetBValue(c) then
|
||
begin
|
||
first := c;
|
||
Result := i;
|
||
end;
|
||
smHue:
|
||
begin
|
||
ColorToHSL(c, hc, sc, lc);
|
||
ColorToHSL(first, hf, sf, lf);
|
||
if hf > hc then
|
||
begin
|
||
first := c;
|
||
Result := i;
|
||
end;
|
||
end;
|
||
smSaturation:
|
||
begin
|
||
ColorToHSL(c, hc, sc, lc);
|
||
ColorToHSV(first, hf, sf, vf);
|
||
if sf > sc then
|
||
begin
|
||
first := c;
|
||
Result := i;
|
||
end;
|
||
end;
|
||
smLuminance:
|
||
begin
|
||
ColorToHSL(c, hc, sc, lc);
|
||
ColorToHSV(first, hf, sf, vf);
|
||
if lf > lc then
|
||
begin
|
||
first := c;
|
||
Result := i;
|
||
end;
|
||
end;
|
||
smValue:
|
||
begin
|
||
ColorToHSV(c, hc, sc, vc);
|
||
ColorToHSV(first, hf, sf, vf);
|
||
if vf > vc then
|
||
begin
|
||
first := c;
|
||
Result := i;
|
||
end;
|
||
end;
|
||
smCyan:
|
||
if GetCValue(first) > GetCValue(c) then
|
||
begin
|
||
first := c;
|
||
Result := i;
|
||
end;
|
||
smMagenta:
|
||
if GetMValue(first) > GetMValue(c) then
|
||
begin
|
||
first := c;
|
||
Result := i;
|
||
end;
|
||
smYellow:
|
||
if GetYValue(first) > GetYValue(c) then
|
||
begin
|
||
first := c;
|
||
Result := i;
|
||
end;
|
||
smBlacK:
|
||
if GetKValue(first) > GetKValue(c) then
|
||
begin
|
||
first := c;
|
||
Result := i;
|
||
end;
|
||
smCIEx:
|
||
if GetCIEXValue(first) > GetCIEXValue(c) then
|
||
begin
|
||
first := c;
|
||
Result := i;
|
||
end;
|
||
smCIEy:
|
||
if GetCIEYValue(first) > GetCIEYValue(c) then
|
||
begin
|
||
first := c;
|
||
Result := i;
|
||
end;
|
||
smCIEz:
|
||
if GetCIEZValue(first) > GetCIEZValue(c) then
|
||
begin
|
||
first := c;
|
||
Result := i;
|
||
end;
|
||
smCIEl:
|
||
if GetCIELValue(first) > GetCIELValue(c) then
|
||
begin
|
||
first := c;
|
||
Result := i;
|
||
end;
|
||
smCIEa:
|
||
if GetCIEAValue(first) > GetCIEAValue(c) then
|
||
begin
|
||
first := c;
|
||
Result := i;
|
||
end;
|
||
smCIEb:
|
||
if GetCIEBValue(first) > GetCIEBValue(c) then
|
||
begin
|
||
first := c;
|
||
Result := i;
|
||
end;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
var
|
||
i, m: integer;
|
||
s: TStrings;
|
||
begin
|
||
if SortMode <> smNone then
|
||
begin
|
||
if Colors.Count = 0 then Exit;
|
||
m := 0;
|
||
s := TStringList.Create;
|
||
try
|
||
s.AddStrings(Colors);
|
||
Colors.Clear;
|
||
for i := s.Count - 1 downto 0 do
|
||
begin
|
||
case SortOrder of
|
||
soAscending : m := MinPos(s, SortMode);
|
||
soDescending : m := MaxPos(s, SortMode);
|
||
end;
|
||
Colors.Add(s.Strings[m]);
|
||
s.Delete(m);
|
||
end;
|
||
finally
|
||
s.Free;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
function ReadJASCPal(PalFile: TFileName): string;
|
||
var
|
||
p, t, c: TStrings;
|
||
i: integer;
|
||
begin
|
||
if not FileExists(PalFile) then
|
||
raise Exception.Create('File not found');
|
||
|
||
p := TStringList.Create;
|
||
t := TStringList.Create;
|
||
c := TStringList.Create;
|
||
try
|
||
p.LoadFromFile(PalFile);
|
||
for i := 0 to p.Count - 1 do
|
||
if p.strings[i] <> '' then
|
||
begin
|
||
t.Clear;
|
||
ExtractStrings([' '], [], PChar(p.strings[i]), t);
|
||
if t.Count = 3 then
|
||
c.Add(ColorToString(RGB(StrToInt(t.strings[0]), StrToInt(t.strings[1]), StrToInt(t.strings[2]))));
|
||
end;
|
||
Result := c.Text;
|
||
finally
|
||
c.Free;
|
||
t.Free;
|
||
p.Free;
|
||
end;
|
||
end;
|
||
|
||
procedure SaveJASCPal(pal: TStrings; FileName: TFileName);
|
||
var
|
||
i: integer;
|
||
p: TStringList;
|
||
c: TColor;
|
||
begin
|
||
if not FileExists(FileName) then
|
||
raise Exception.Create('File not found');
|
||
|
||
p := TStringList.Create;
|
||
try
|
||
p.Add('JASC-PAL');
|
||
p.Add('0100');
|
||
p.Add('256');
|
||
for i := 0 to pal.Count - 1 do
|
||
if (pal.Strings[i] <> '') and not SameText(pal.Strings[i], 'clCustom') and not SameText(pal.Strings[i], 'clTransparent') then
|
||
begin
|
||
c := StringToColor(pal.Strings[i]);
|
||
p.Add(IntToStr(GetRValue(c)) + ' ' + IntToStr(GetGValue(c)) + ' ' + IntToStr(GetBValue(c)));
|
||
end;
|
||
p.SaveToFile(FileName);
|
||
finally
|
||
p.Free;
|
||
end;
|
||
end;
|
||
|
||
procedure ExchangeBytes(var w: Word);
|
||
type
|
||
TWordRec = packed record
|
||
a, b: byte;
|
||
end;
|
||
var
|
||
brec: TWordRec;
|
||
tmp: Byte;
|
||
begin
|
||
brec := TWordRec(w);
|
||
tmp := brec.a;
|
||
brec.a := brec.b;
|
||
brec.b := tmp;
|
||
w := word(brec);
|
||
|
||
// Swap(w);
|
||
{
|
||
asm
|
||
MOV DX,[w] //assign the word to the data register
|
||
XCHG DL,DH // exchange low and high data values
|
||
MOV [w],DX //assign the register data to the word
|
||
}
|
||
end;
|
||
|
||
procedure ExchangeChars(var s: WideString);
|
||
var
|
||
i: Integer;
|
||
w: Word;
|
||
begin
|
||
for i := 1 to Length(s) do
|
||
begin
|
||
w := Word(s[i]);
|
||
ExchangeBytes(w);
|
||
s[i] := WideChar(w);
|
||
end;
|
||
end;
|
||
|
||
function GetAcoColor(space,w,x,y,z: word): TColor;
|
||
begin
|
||
case space of
|
||
0: //RGB
|
||
Result := RGB(w div 256, x div 256, y div 256);
|
||
1: //HSB - HSV
|
||
Result := HSVToColor(Round(w/182.04), Round(x/655.35), Round(y/655.35));
|
||
2: //CMYK
|
||
Result := CMYKToColor(Round(100-w/55.35), Round(100-x/655.35), Round(100-y/655.35), Round(100-z/655.35));
|
||
7: //Lab
|
||
Result := LabToRGB(w/100, x/100, y/100);
|
||
8: //Grayscale
|
||
Result := RGB(Round(w/39.0625), Round(w/39.0625), Round(w/39.0625));
|
||
9: //Wide CMYK
|
||
Result := CMYKToColor(w div 100, x div 100, y div 100, z div 100)
|
||
else //unknown
|
||
Result := RGB(w div 256, x div 256, y div 256);
|
||
end;
|
||
end;
|
||
|
||
function ReadPhotoshopAco(PalFile: TFileName): AcoColors;
|
||
var
|
||
f: file;
|
||
ver, num, space, w, x, y, z, dummy: Word;
|
||
i: integer;
|
||
v0Length: byte;
|
||
v0Name: string;
|
||
v2Length: Word;
|
||
v2Name: WideString;
|
||
begin
|
||
if not FileExists(PalFile) then
|
||
begin
|
||
SetLength(Result.Colors, 0);
|
||
SetLength(Result.Names, 0);
|
||
Result.HasNames := false;
|
||
raise Exception.Create('File not found');
|
||
end;
|
||
|
||
AssignFile(f, PalFile);
|
||
Reset(f, 1);
|
||
//read version
|
||
BlockRead(f, ver, sizeof(ver));
|
||
ExchangeBytes(ver);
|
||
if not (ver in [0, 1, 2]) then
|
||
begin
|
||
CloseFile(f);
|
||
raise Exception.Create('The file you are trying to load is not (yet) supported.'#13'Please submit the file for testing to MXS so loading of this version will be supported too');
|
||
end;
|
||
|
||
//read number of colors
|
||
BlockRead(f, num, sizeof(num));
|
||
ExchangeBytes(num);
|
||
//read names
|
||
if (ver = 0) or (ver = 2) then
|
||
begin
|
||
SetLength(Result.Names, num);
|
||
Result.HasNames := true;
|
||
end
|
||
else
|
||
begin
|
||
SetLength(Result.Names, 0);
|
||
Result.HasNames := false;
|
||
end;
|
||
//read colors
|
||
SetLength(Result.Colors, num);
|
||
for i := 0 to num - 1 do
|
||
begin
|
||
BlockRead(f, space, sizeof(space));
|
||
ExchangeBytes(space);
|
||
BlockRead(f, w, sizeof(w));
|
||
ExchangeBytes(w);
|
||
BlockRead(f, x, sizeof(x));
|
||
ExchangeBytes(x);
|
||
BlockRead(f, y, sizeof(y));
|
||
ExchangeBytes(y);
|
||
BlockRead(f, z, sizeof(z));
|
||
ExchangeBytes(z);
|
||
Result.Colors[i] := GetAcoColor(space, w, x, y, z);
|
||
case ver of
|
||
0: begin
|
||
BlockRead(f, v0Length, SizeOf(v0Length));
|
||
SetLength(v0Name, v0Length);
|
||
if v0Length > 0 then
|
||
BlockRead(f, PChar(v0Name)^, v0Length);
|
||
Result.Names[i] := v0Name;
|
||
end;
|
||
2: begin
|
||
BlockRead(f, dummy, sizeof(dummy));
|
||
BlockRead(f, v2Length, SizeOf(v2Length));
|
||
ExchangeBytes(v2Length);
|
||
SetLength(v2Name, v2Length - 1);
|
||
if v2Length > 0 then
|
||
begin
|
||
BlockRead(f, PWideChar(v2Name)^, 2*(v2Length - 1));
|
||
ExchangeChars(v2Name);
|
||
end;
|
||
Result.Names[i] := v2Name;
|
||
BlockRead(f, dummy, sizeof(dummy));
|
||
end;
|
||
end;
|
||
end;
|
||
CloseFile(f);
|
||
end;
|
||
|
||
function ReadPhotoshopAct(PalFile: TFileName): string;
|
||
var
|
||
f: file;
|
||
r, g, b: byte;
|
||
s: TStringList;
|
||
i: integer;
|
||
begin
|
||
if not FileExists(PalFile) then
|
||
raise Exception.Create('File not found');
|
||
|
||
s := TStringList.Create;
|
||
try
|
||
AssignFile(f, PalFile);
|
||
Reset(f, 1);
|
||
for i := 0 to 255 do
|
||
begin
|
||
BlockRead(f, r, sizeof(r));
|
||
BlockRead(f, g, sizeof(g));
|
||
BlockRead(f, b, sizeof(b));
|
||
s.Add(ColorToString(RGB(r, g, b)));
|
||
end;
|
||
Result := s.Text;
|
||
finally
|
||
s.Free;
|
||
end;
|
||
CloseFile(f);
|
||
end;
|
||
|
||
end.
|