From 2b49b563a17c247b842ba97decb4bfd99f877b59 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Wed, 18 Jan 2017 20:41:59 +0000 Subject: [PATCH] mbColorLib: Restore loading of color palettes. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5678 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- components/mbColorLib/PalUtils.pas | 263 ++++++++++++++--------- components/mbColorLib/mbColorPalette.pas | 2 - components/mbColorLib/mbReg.lrs | 23 +- 3 files changed, 178 insertions(+), 110 deletions(-) diff --git a/components/mbColorLib/PalUtils.pas b/components/mbColorLib/PalUtils.pas index 9c1e25c89..9a438a1f9 100644 --- a/components/mbColorLib/PalUtils.pas +++ b/components/mbColorLib/PalUtils.pas @@ -4,7 +4,8 @@ interface uses LCLType, LCLIntf, SysUtils, Classes, Graphics, - RGBHSVUtils, RGBHSLUtils, RGBCIEUtils, RGBCMYKUtils, + //RGBHSVUtils, RGBHSLUtils, + RGBCIEUtils, RGBCMYKUtils, HTMLColors; const @@ -53,18 +54,18 @@ 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; + Math, mbColorConv; function ReplaceFlags(s: string; flags: array of string; value: integer): string; var @@ -92,7 +93,12 @@ 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)))); @@ -102,12 +108,12 @@ begin 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(RGBHSLUtils.GetHValue(c))); - h := AnsiReplaceText(h, '%hslS', IntToStr(RGBHSLUtils.GetSValue(c))); - h := AnsiReplaceText(h, '%hslL', IntToStr(RGBHSLUtils.GetLValue(c))); - h := AnsiReplaceText(h, '%hsvH', IntToStr(RGBHSVUtils.GetHValue(c))); - h := AnsiReplaceText(h, '%hsvS', IntToStr(RGBHSVUtils.GetSValue(c))); - h := AnsiReplaceText(h, '%hsvV', IntToStr(RGBHSVUtils.GetVValue(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))); @@ -115,10 +121,10 @@ begin 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(RGBHSLUtils.GetHValue(c))); - h := AnsiReplaceText(h, '%s', IntToStr(RGBHSLUtils.GetSValue(c))); - h := AnsiReplaceText(h, '%l', IntToStr(RGBHSLUtils.GetLValue(c))); - h := AnsiReplaceText(h, '%v', IntToStr(RGBHSVUtils.GetVValue(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; @@ -195,20 +201,28 @@ begin 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 := 239 downto 0 do - s.Add(ColorToString(HSLRangeToRGB(GetHValue(BaseColor), GetSValue(BaseColor), 240 - i))); + 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 239 do - s.Add(ColorToString(HSLRangeToRGB(GetHValue(BaseColor), GetSValue(BaseColor), 240 - i))); + 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 @@ -261,228 +275,270 @@ procedure SortPalColors(Colors: TStrings; SortMode: TSortMode; SortOrder: TSortO 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(mbStringToColor(s.Strings[i])) then + if GetRValue(first) < GetRValue(c) then begin - first := mbStringToColor(s.Strings[i]); + first := c; Result := i; end; smGreen: - if GetGValue(first) < GetGValue(mbStringToColor(s.Strings[i])) then + if GetGValue(first) < GetGValue(c) then begin - first := mbStringToColor(s.Strings[i]); + first := c; Result := i; end; smBlue: - if GetBValue(first) < GetBValue(mbStringToColor(s.Strings[i])) then + if GetBValue(first) < GetBValue(c) then begin - first := mbStringToColor(s.Strings[i]); + first := c; Result := i; end; smHue: - if GetHValue(first) < GetHValue(mbStringToColor(s.Strings[i])) then begin - first := mbStringToColor(s.Strings[i]); - Result := i; + ColorToHSL(c, hc, sc, lc); + ColorToHSL(first, hf, sf, lf); + if hf < hc then begin + first := c; + Result := i; + end; end; smSaturation: - if GetSValue(first) < GetSValue(mbStringToColor(s.Strings[i])) then begin - first := mbStringToColor(s.Strings[i]); - Result := i; + ColorToHSL(c, hc, sc, lc); + ColorToHSL(first, hf, sf, lf); + if sf < sc then begin + first := c; + Result := i; + end; end; smLuminance: - if GetLValue(first) < GetLValue(mbStringToColor(s.Strings[i])) then begin - first := mbStringToColor(s.Strings[i]); - Result := i; + ColorToHSL(c, hc, sc, lc); + ColorToHSL(first, hf, sc, lf); + if lf < lc then + begin + first := c; + Result := i; + end; end; smValue: - if GetVValue(first) < GetVValue(mbStringToColor(s.Strings[i])) then begin - first := mbStringToColor(s.Strings[i]); - Result := i; + 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(mbStringToColor(s.Strings[i])) then + if GetCValue(first) < GetCValue(c) then begin - first := mbStringToColor(s.Strings[i]); + first := c; Result := i; end; smMagenta: - if GetMValue(first) < GetMValue(mbStringToColor(s.Strings[i])) then + if GetMValue(first) < GetMValue(c) then begin - first := mbStringToColor(s.Strings[i]); + first := c; Result := i; end; smYellow: - if GetYValue(first) < GetYValue(mbStringToColor(s.Strings[i])) then + if GetYValue(first) < GetYValue(c) then begin - first := mbStringToColor(s.Strings[i]); + first := c; Result := i; end; smBlacK: - if GetKValue(first) < GetKValue(mbStringToColor(s.Strings[i])) then + if GetKValue(first) < GetKValue(c) then begin - first := mbStringToColor(s.Strings[i]); + first := c; Result := i; end; smCIEx: - if GetCIEXValue(first) < GetCIEXValue(mbStringToColor(s.Strings[i])) then + if GetCIEXValue(first) < GetCIEXValue(c) then begin - first := mbStringToColor(s.Strings[i]); + first := c; Result := i; end; smCIEy: - if GetCIEYValue(first) < GetCIEYValue(mbStringToColor(s.Strings[i])) then + if GetCIEYValue(first) < GetCIEYValue(c) then begin - first := mbStringToColor(s.Strings[i]); + first := c; Result := i; end; smCIEz: - if GetCIEZValue(first) < GetCIEZValue(mbStringToColor(s.Strings[i])) then + if GetCIEZValue(first) < GetCIEZValue(c) then begin - first := mbStringToColor(s.Strings[i]); + first := c; Result := i; end; smCIEl: - if GetCIELValue(first) < GetCIELValue(mbStringToColor(s.Strings[i])) then + if GetCIELValue(first) < GetCIELValue(c) then begin - first := mbStringToColor(s.Strings[i]); + first := c; Result := i; end; smCIEa: - if GetCIEAValue(first) < GetCIEAValue(mbStringToColor(s.Strings[i])) then + if GetCIEAValue(first) < GetCIEAValue(c) then begin - first := mbStringToColor(s.Strings[i]); + first := c; Result := i; end; smCIEb: - if GetCIEBValue(first) < GetCIEBValue(mbStringToColor(s.Strings[i])) then + if GetCIEBValue(first) < GetCIEBValue(c) then begin - first := mbStringToColor(s.Strings[i]); + 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(mbStringToColor(s.Strings[i])) then + if GetRValue(first) > GetRValue(c) then begin - first := mbStringToColor(s.Strings[i]); + first := c; Result := i; end; smGreen: - if GetGValue(first) > GetGValue(mbStringToColor(s.Strings[i])) then + if GetGValue(first) > GetGValue(c) then begin - first := mbStringToColor(s.Strings[i]); + first := c; Result := i; end; smBlue: - if GetBValue(first) > GetBValue(mbStringToColor(s.Strings[i])) then + if GetBValue(first) > GetBValue(c) then begin - first := mbStringToColor(s.Strings[i]); + first := c; Result := i; end; smHue: - if GetHValue(first) > GetHValue(mbStringToColor(s.Strings[i])) then begin - first := mbStringToColor(s.Strings[i]); - Result := i; + ColorToHSL(c, hc, sc, lc); + ColorToHSL(first, hf, sf, lf); + if hf > hc then + begin + first := c; + Result := i; + end; end; smSaturation: - if GetSValue(first) > GetSValue(mbStringToColor(s.Strings[i])) then begin - first := mbStringToColor(s.Strings[i]); - Result := i; + ColorToHSL(c, hc, sc, lc); + ColorToHSV(first, hf, sf, vf); + if sf > sc then + begin + first := c; + Result := i; + end; end; smLuminance: - if GetLValue(first) > GetLValue(mbStringToColor(s.Strings[i])) then begin - first := mbStringToColor(s.Strings[i]); - Result := i; + ColorToHSL(c, hc, sc, lc); + ColorToHSV(first, hf, sf, vf); + if lf > lc then + begin + first := c; + Result := i; + end; end; smValue: - if GetVValue(first) > GetVValue(mbStringToColor(s.Strings[i])) then begin - first := mbStringToColor(s.Strings[i]); - Result := i; + 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(mbStringToColor(s.Strings[i])) then + if GetCValue(first) > GetCValue(c) then begin - first := mbStringToColor(s.Strings[i]); + first := c; Result := i; end; smMagenta: - if GetMValue(first) > GetMValue(mbStringToColor(s.Strings[i])) then + if GetMValue(first) > GetMValue(c) then begin - first := mbStringToColor(s.Strings[i]); + first := c; Result := i; end; smYellow: - if GetYValue(first) > GetYValue(mbStringToColor(s.Strings[i])) then + if GetYValue(first) > GetYValue(c) then begin - first := mbStringToColor(s.Strings[i]); + first := c; Result := i; end; smBlacK: - if GetKValue(first) > GetKValue(mbStringToColor(s.Strings[i])) then + if GetKValue(first) > GetKValue(c) then begin - first := mbStringToColor(s.Strings[i]); + first := c; Result := i; end; smCIEx: - if GetCIEXValue(first) > GetCIEXValue(mbStringToColor(s.Strings[i])) then + if GetCIEXValue(first) > GetCIEXValue(c) then begin - first := mbStringToColor(s.Strings[i]); + first := c; Result := i; end; smCIEy: - if GetCIEYValue(first) > GetCIEYValue(mbStringToColor(s.Strings[i])) then + if GetCIEYValue(first) > GetCIEYValue(c) then begin - first := mbStringToColor(s.Strings[i]); + first := c; Result := i; end; smCIEz: - if GetCIEZValue(first) > GetCIEZValue(mbStringToColor(s.Strings[i])) then + if GetCIEZValue(first) > GetCIEZValue(c) then begin - first := mbStringToColor(s.Strings[i]); + first := c; Result := i; end; smCIEl: - if GetCIELValue(first) > GetCIELValue(mbStringToColor(s.Strings[i])) then + if GetCIELValue(first) > GetCIELValue(c) then begin - first := mbStringToColor(s.Strings[i]); + first := c; Result := i; end; smCIEa: - if GetCIEAValue(first) > GetCIEAValue(mbStringToColor(s.Strings[i])) then + if GetCIEAValue(first) > GetCIEAValue(c) then begin - first := mbStringToColor(s.Strings[i]); + first := c; Result := i; end; smCIEb: - if GetCIEBValue(first) > GetCIEBValue(mbStringToColor(s.Strings[i])) then + if GetCIEBValue(first) > GetCIEBValue(c) then begin - first := mbStringToColor(s.Strings[i]); + first := c; Result := i; end; end; + end; end; var @@ -568,8 +624,21 @@ begin end; procedure ExchangeBytes(var w: Word); +type + TWordRec = packed record + a, b: byte; + end; +var + brec: TWordRec; + tmp: Byte; begin - Swap(w); + 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 @@ -590,7 +659,7 @@ begin s[i] := WideChar(w); end; end; - (* + function GetAcoColor(space,w,x,y,z: word): TColor; begin case space of @@ -722,5 +791,5 @@ begin end; CloseFile(f); end; - *) + end. diff --git a/components/mbColorLib/mbColorPalette.pas b/components/mbColorLib/mbColorPalette.pas index 664c4acd7..56dbdb44a 100644 --- a/components/mbColorLib/mbColorPalette.pas +++ b/components/mbColorLib/mbColorPalette.pas @@ -682,7 +682,6 @@ begin FNames.Clear; FColors.Text := ReadJASCPal(FileName); end - (* else if SameText(ExtractFileExt(FileName), '.aco') then begin supported := true; @@ -701,7 +700,6 @@ begin FNames.Clear; FColors.Text := ReadPhotoshopAct(FileName); end - *) else raise Exception.Create('The file format you are trying to load is not supported in this version of the palette'#13'Please send a request to MXS along with the files of this format so'#13'loading support for this file can be added too'); if supported then diff --git a/components/mbColorLib/mbReg.lrs b/components/mbColorLib/mbReg.lrs index 0d4ac7f02..8d29427ef 100644 --- a/components/mbColorLib/mbReg.lrs +++ b/components/mbColorLib/mbReg.lrs @@ -521,17 +521,6 @@ LazarusResources.Add('TRColorPicker','PNG',[ +#162'b'#192#11#187#209' '#26#186'U&'#205#1#0'C'#2'<{?'#184#187'_'#0#0#0#0'IE' +'ND'#174'B`'#130 ]); -LazarusResources.Add('TSColorPicker','PNG',[ - #137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#24#0#0#0#24#8#6#0#0#0#224'w='#248#0 - +#0#0#9'pHYs'#0#0#11#19#0#0#11#19#1#0#154#156#24#0#0#0#140'IDATH'#199#237#146 - +'1'#10#3'!'#16'E'#159#144'-'#236#4'At'#147#173#189#136'7'#245#26#150'^'#198 - +#206'e'#3#150#166'X'#2#233#146#144'l'#147#248#154#153#15#195'|'#254'00'#248 - +'y'#196#179#1#239'}/'#165'PkE)'#133'1'#134#249'<'#179'\'#22'b'#140#226'c'#3#0 - +#231'\o'#173'!'#165'Dk'#141#181#150#148#146#248'J'#130#199'$'#211'4'#161#148 - +'"'#231','#14#185'g'#8#161#255#241#23#245#190'v'#216#128'+{'#189#247#239#234 - +'m_,V'#1'p::'#193'0'#24#6#131#193#11#220#0']'#214','#236#161'*'#153#199#0#0#0 - +#0'IEND'#174'B`'#130 -]); LazarusResources.Add('TSLColorPicker','PNG',[ #137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#24#0#0#0#24#8#6#0#0#0#224'w='#248#0 +#0#0#9'pHYs'#0#0#11#19#0#0#11#19#1#0#154#156#24#0#0#1#143'IDATH'#199#221#148 @@ -634,3 +623,15 @@ LazarusResources.Add('THSCirclePicker','PNG',[ +#30#132'p'#229'b'#140#147#222#250#128#167#24#160'W'#145#205'y'#245#247#16#252 +'_'#255#182#254#4'leR'#175#234#10''''#210#0#0#0#0'IEND'#174'B`'#130 ]); +LazarusResources.Add('TSColorPicker','PNG',[ + #137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#24#0#0#0#24#8#6#0#0#0#224'w='#248#0 + +#0#0#9'pHYs'#0#0#11#19#0#0#11#19#1#0#154#156#24#0#0#0#176'IDATH'#199#237#149 + +'A'#10#131'0'#16'E'#255'@5'#184#11#4'D'#210#186#207'A'#188#152'W'#241#26'.=' + +#141';w'#146'Y'#244'wQAp'#211#148'"'#180'%'#3#3#147'0'#195#227#135#31'FH'#226 + +#204#184#224#228#200#128#207#1'!'#4#206#243#140'eY`'#173'E]'#215#240'W'#143 + +#246#214'b'#24#6'y5/).'#242#222's]WTU'#5#231#28#154#166#193'8'#142#146#162'@' + +'Rm'#26'B`Q'#20#176#214'b'#154'&I~#'#146#201#217'u'#29#223#233''''#153#174 + +#224#251']'#212#247'=K'#141'0'#241#153#165#234'^'#199#8#179#157#203#237#206 + +#168#238#245#161#223#168#2'wJ'#254#201#25#240'#'#0#201'+'#243#255#1#15#140 + +#197#148#197#26'E'#187's'#0#0#0#0'IEND'#174'B`'#130 +]);