pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

mbColorLib: Apply standard code formatting

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5503 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2016-12-15 11:27:12 +00:00
parent 72c76eb6d6
commit 2c43f4222c
19 changed files with 2429 additions and 2463 deletions
Download Patch File Download Diff File Expand all files Collapse all files

14
components/mbColorLib/HTMLColors.pas
View File

@ -167,7 +167,7 @@ procedure MakeIntoHex(var s: string);
var
i: integer;
begin
if s <> '' then
if s <> '' then
for i := 1 to Length(s) do
if not (s[i] in ['0'..'9', 'A'..'F', 'a'..'f']) then
s[i] := '0';
@ -245,8 +245,7 @@ begin
end;
Result := BASIC_VALUES[k];
end
else
if IsMember(SYSTEM_NAMES, SYSTEM_COUNT, s) then
else if IsMember(SYSTEM_NAMES, SYSTEM_COUNT, s) then
begin
for i := 0 to SYSTEM_COUNT - 1 do
if SameText(s, SYSTEM_NAMES[i]) then
@ -286,8 +285,7 @@ begin
else
Result := clNone;
end
else
if IsMember(SPECIAL_NAMES, SPECIAL_COUNT, s) then
else if IsMember(SPECIAL_NAMES, SPECIAL_COUNT, s) then
begin
s := GetHexFromName(s);
Result := RGB(StrToInt('$'+Copy(S, 1, 2)), StrToInt('$'+Copy(S, 3, 2)), StrToInt('$'+Copy(S, 5, 2)));
@ -323,12 +321,12 @@ end;
//initializes the websafe comparison array
procedure InitializeWS;
var
var
i: integer;
begin
begin
for i := 0 to 255 do
WS[I] := ((i + $19) div $33) * $33;
end;
end;
//------------------------------------------------------------------------------

2
components/mbColorLib/HexaColorPicker.pas
View File

@ -122,7 +122,6 @@ type
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure SelectCombIndex(i: integer);
function GetSelectedCombIndex: integer;
function GetColorUnderCursor: TColor;
@ -157,7 +156,6 @@ type
property DragMode;
property DragKind;
property Constraints;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
property OnIntensityChange: TNotifyEvent read FOnIntensityChange write FOnIntensityChange;
property OnDblClick;

51
components/mbColorLib/PalUtils.pas
View File

@ -23,29 +23,41 @@ type
//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;
//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
function ReplaceFlags(s: string; flags: array of string; value: integer): string;
@ -162,10 +174,13 @@ function IsMember(sl: TStrings; s: string): boolean;
var
i: integer;
begin
Result := false;
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;
@ -468,19 +483,22 @@ 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);
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;
@ -489,10 +507,8 @@ var
i: integer;
begin
if not FileExists(PalFile) then
begin
raise Exception.Create('File not found');
Exit;
end;
p := TStringList.Create;
t := TStringList.Create;
c := TStringList.Create;
@ -521,10 +537,8 @@ var
c: TColor;
begin
if not FileExists(FileName) then
begin
raise Exception.Create('File not found');
Exit;
end;
p := TStringList.Create;
try
p.Add('JASC-PAL');
@ -598,12 +612,12 @@ var
begin
if not FileExists(PalFile) then
begin
raise Exception.Create('File not found');
SetLength(Result.Colors, 0);
SetLength(Result.Names, 0);
Result.HasNames := false;
Exit;
raise Exception.Create('File not found');
end;
AssignFile(f, PalFile);
Reset(f, 1);
//read version
@ -612,9 +626,9 @@ begin
if not (ver in [0, 1, 2]) then
begin
CloseFile(f);
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');
Exit;
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);
@ -645,16 +659,14 @@ begin
ExchangeBytes(z);
Result.Colors[i] := GetAcoColor(space, w, x, y, z);
case ver of
0:
begin
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
2: begin
BlockRead(f, dummy, sizeof(dummy));
BlockRead(f, v2Length, SizeOf(v2Length));
ExchangeBytes(v2Length);
@ -680,11 +692,8 @@ var
i: integer;
begin
if not FileExists(PalFile) then
begin
raise Exception.Create('File not found');
Result := '';
Exit;
end;
s := TStringList.Create;
try
AssignFile(f, PalFile);

115
components/mbColorLib/RGBCIEUtils.pas
View File

@ -73,35 +73,38 @@ const
type
xyz = record
x: real;
y: real;
z: real;
x: Double;
y: Double;
z: Double;
end;
function LabToXYZ(l, a, b: real): xyz;
function LabToXYZ(l, a, b: double): xyz;
function XYZToRGB(space: xyz): TColor;
function LabToRGB(l, a, b: real): TColor;
function LabToRGB(l, a, b: double): TColor;
function RGBToXYZ(c: TColor): xyz;
procedure RGBToLab(clr: TColor; var l, a, b: real);
procedure XYZToLab(space: xyz; var l, a, b: real);
procedure LCHToLab(lum, c, h: real; var l, a, b: real);
procedure LabToLCH(l, a, b: real; var lum, c, h: real);
function LCHToRGB(l, c, h: real): TColor;
procedure RGBToLCH(clr: TColor; var l, c, h: real);
function GetCIEXValue(c: TColor): real;
function GetCIEYValue(c: TColor): real;
function GetCIEZValue(c: TColor): real;
function GetCIELValue(c: TColor): real;
function GetCIEAValue(c: TColor): real;
function GetCIEBValue(c: TColor): real;
function GetCIECValue(c: TColor): real;
function GetCIEHValue(c: TColor): real;
procedure RGBToLab(clr: TColor; var l, a, b: double);
procedure XYZToLab(space: xyz; var l, a, b: double);
procedure LCHToLab(lum, c, h: double; var l, a, b: double);
procedure LabToLCH(l, a, b: double; var lum, c, h: double);
function LCHToRGB(l, c, h: double): TColor;
procedure RGBToLCH(clr: TColor; var l, c, h: double);
function GetCIEXValue(c: TColor): double;
function GetCIEYValue(c: TColor): double;
function GetCIEZValue(c: TColor): double;
function GetCIELValue(c: TColor): double;
function GetCIEAValue(c: TColor): double;
function GetCIEBValue(c: TColor): double;
function GetCIECValue(c: TColor): double;
function GetCIEHValue(c: TColor): double;
implementation
function LabToXYZ(l, a, b: real): xyz;
uses
mbUtils;
function LabToXYZ(l, a, b: double): xyz;
var
x, y, z: real;
x, y, z: double;
begin
y := (l + 16)/116;
x := a/500 + y;
@ -125,7 +128,7 @@ end;
function XYZToRGB(space: xyz): TColor;
var
r, g, b, x, y, z: real;
r, g, b, x, y, z: double;
begin
x := space.x/100;
y := space.y/100;
@ -146,23 +149,20 @@ begin
else
b := 12.92 * b;
if r < 0 then r := 0;
if r > 1 then r := 1;
if g < 0 then g := 0;
if g > 1 then g := 1;
if b < 0 then b := 0;
if b > 1 then b := 1;
Clamp(r, 0, 1);
Clamp(g, 0, 1);
Clamp(b, 0, 1);
Result := RGB(Round(r*255), Round(g*255), Round(b*255));
end;
function LabToRGB(l, a, b: real): TColor;
function LabToRGB(l, a, b: double): TColor;
begin
Result := XYZToRGB(LabToXYZ(l, a, b));
end;
function RGBToXYZ(c: TColor): xyz;
var
r, g, b: real;
r, g, b: double;
begin
r := GetRValue(c)/255;
g := GetGValue(c)/255;
@ -188,9 +188,9 @@ begin
Result.z := r * 0.0193 + g * 0.1192 + b * 0.9505;
end;
procedure XYZToLab(space: xyz; var l, a, b: real);
procedure XYZToLab(space: xyz; var l, a, b: Double);
var
x, y, z: real;
x, y, z: double;
begin
x := space.x/ref_X;
y := space.y/100;
@ -210,15 +210,12 @@ begin
l := (116*y) - 16;
a := 500 * (x - y);
b := 200 * (y - z);
if l > 100 then l := 100;
if l < 0 then l := 0;
if a < -128 then a := -128;
if a > 127 then a := 127;
if b < -128 then b := -128;
if b > 127 then b := 127;
Clamp(l, 0, 100);
Clamp(a, -128, 127);
Clamp(b, -128, 127);
end;
procedure RGBToLab(clr: TColor; var l, a, b: real);
procedure RGBToLab(clr: TColor; var l, a, b: Double);
var
s: xyz;
begin
@ -226,41 +223,41 @@ begin
XYZToLab(s, l, a, b);
end;
procedure LCHToLab(lum, c, h: real; var l, a, b: real);
procedure LCHToLab(lum, c, h: double; var l, a, b: double);
begin
l := lum;
a := cos(DegToRad(h)) * c;
b := sin(DegToRad(h)) * c;
end;
procedure LabToLCH(l, a, b: real; var lum, c, h: real);
procedure LabToLCH(l, a, b: double; var lum, c, h: double);
begin
h := ArcTan2(b, a);
if h > 0 then
h := (h/PI) * 180
h := (h/pi) * 180
else
h := 360 - (ABS(h)/PI) * 180;
h := 360 - (abs(h)/pi) * 180;
lum := l;
c := SQRT(a*a + b*b);
end;
procedure RGBToLCH(clr: TColor; var l, c, h: real);
procedure RGBToLCH(clr: TColor; var l, c, h: double);
var
a, b: real;
a, b: double;
begin
RGBToLab(clr, l, a, b);
LabToLCH(l, a, b, l, c, h);
end;
function LCHToRGB(l, c, h: real): TColor;
function LCHToRGB(l, c, h: double): TColor;
var
lum, a, b: real;
lum, a, b: double;
begin
LCHToLab(l, c, h, lum, a, b);
Result := LabToRGB(lum, a, b);
end;
function GetCIEXValue(c: TColor): real;
function GetCIEXValue(c: TColor): double;
var
d: xyz;
begin
@ -268,7 +265,7 @@ begin
Result := d.x;
end;
function GetCIEYValue(c: TColor): real;
function GetCIEYValue(c: TColor): double;
var
d: xyz;
begin
@ -276,7 +273,7 @@ begin
Result := d.y;
end;
function GetCIEZValue(c: TColor): real;
function GetCIEZValue(c: TColor): double;
var
d: xyz;
begin
@ -284,37 +281,37 @@ begin
Result := d.z;
end;
function GetCIELValue(c: TColor): real;
function GetCIELValue(c: TColor): double;
var
d: real;
begin
XYZToLab(RGBToXYZ(c), Result, d, d);
end;
function GetCIEAValue(c: TColor): real;
function GetCIEAValue(c: TColor): double;
var
d: real;
d: double;
begin
XYZToLab(RGBToXYZ(c), d, Result, d);
end;
function GetCIEBValue(c: TColor): real;
function GetCIEBValue(c: TColor): double;
var
d: real;
d: double;
begin
XYZToLab(RGBToXYZ(c), d, d, Result);
end;
function GetCIECValue(c: TColor): real;
function GetCIECValue(c: TColor): double;
var
d: real;
d: double;
begin
RGBToLCH(c, d, Result, d);
end;
function GetCIEHValue(c: TColor): real;
function GetCIEHValue(c: TColor): double;
var
d: real;
d: double;
begin
RGBToLCH(c, d, d, Result);
end;

62
components/mbColorLib/RGBHSLUtils.pas
View File

@ -45,16 +45,13 @@ var
begin
if Hue < 0 then
Hue := Hue + 1
else
if Hue > 1 then
else if Hue > 1 then
Hue := Hue - 1;
if 6 * Hue < 1 then
V := M1 + (M2 - M1) * Hue * 6
else
if 2 * Hue < 1 then
else if 2 * Hue < 1 then
V := M2
else
if 3 * Hue < 2 then
else if 3 * Hue < 2 then
V := M1 + (M2 - M1) * (2/3 - Hue) * 6
else
V := M1;
@ -66,7 +63,7 @@ var
begin
if S = 0 then
begin
R := round (MaxLum * L);
R := round(MaxLum * L);
G := R;
B := R
end
@ -77,34 +74,33 @@ begin
else
M2 := L + S - L * S;
M1 := 2 * L - M2;
R := HueToColorValue (H + 1/3);
G := HueToColorValue (H);
B := HueToColorValue (H - 1/3)
R := HueToColorValue(H + 1/3);
G := HueToColorValue(H);
B := HueToColorValue(H - 1/3)
end;
Result := RGB (R, G, B)
Result := RGB(R, G, B)
end;
function HSLRangeToRGB(H, S, L : integer): TColor;
function HSLRangeToRGB(H, S, L: integer): TColor;
begin
if s > MaxSat then s := MaxSat;
if s < 0 then s := 0;
if l > MaxLum then l := MaxLum;
if l < 0 then l := 0;
Clamp(H, 0, MaxHue);
Clamp(S, 0, MaxSat);
Clamp(L, 0, MaxLum);
Result := HSLToRGB(H / MaxHue, S / MaxSat, L / MaxLum);
end;
procedure RGBtoHSLRange(RGB: TColor; var H1, S1, L1 : integer);
procedure RGBtoHSLRange(RGB: TColor; var H1, S1, L1: integer);
var
R, G, B, D, Cmax, Cmin, h, s, l: double;
begin
H := h1;
S := s1;
L := l1;
R := GetRValue (RGB) / 255;
G := GetGValue (RGB) / 255;
B := GetBValue (RGB) / 255;
Cmax := Max (R, Max (G, B));
Cmin := Min (R, Min (G, B));
R := GetRValue(RGB) / 255;
G := GetGValue(RGB) / 255;
B := GetBValue(RGB) / 255;
Cmax := Max(R, Max (G, B));
Cmin := Min(R, Min (G, B));
L := (Cmax + Cmin) / 2;
if Cmax = Cmin then
begin
@ -122,8 +118,7 @@ begin
//calc H
if R = Cmax then
H := (G - B) / D
else
if G = Cmax then
else if G = Cmax then
H := 2 + (B - R) /D
else
H := 4 + (R - G) / D;
@ -131,9 +126,9 @@ begin
if H < 0 then
H := H + 1;
end;
H1 := round (H * MaxHue);
S1 := round (S * MaxSat);
L1 := round (L * MaxLum);
H1 := round(H * MaxHue);
S1 := round(S * MaxSat);
L1 := round(L * MaxLum);
end;
function GetHValue(AColor: TColor): integer;
@ -159,12 +154,6 @@ begin
RGBToHSLRange(AColor, d, d, l);
Result := l;
end;
{
procedure Clamp(var Input: integer; Min, Max: integer);
begin
if (Input < Min) then Input := Min;
if (Input > Max) then Input := Max;
end; }
function HSLToRGBTriple(H, S, L: integer): TRGBTriple;
const
@ -247,6 +236,7 @@ procedure RGBTripleToHSL(RGBTriple: TRGBTriple; var h, s, l: integer);
if (Result > RGB.rgbtGreen) then Result := RGB.rgbtGreen;
if (Result > RGB.rgbtBlue) then Result := RGB.rgbtBlue;
end;
var
Delta, Min: byte;
begin
@ -265,11 +255,9 @@ begin
begin
if (rgbtRed = L) then
H := MulDiv(60, rgbtGreen-rgbtBlue, Delta)
else
if (rgbtGreen = L) then
else if (rgbtGreen = L) then
H := MulDiv(60, rgbtBlue-rgbtRed, Delta) + 120
else
if (rgbtBlue = L) then
else if (rgbtBlue = L) then
H := MulDiv(60, rgbtRed-rgbtGreen, Delta) + 240;
if (H < 0) then H := H + 360;
end;

10
components/mbColorLib/RGBHSVUtils.pas
View File

@ -50,12 +50,12 @@ end;
function RGBTripleToColor(Triple: TRGBTriple): TColor;
begin
Result := TColor(RGB(Triple.rgbtRed, Triple.rgbtGreen, Triple.rgbtBlue));
Result := RGB(Triple.rgbtRed, Triple.rgbtGreen, Triple.rgbtBlue);
end;
procedure RGBToHSV(R, G, B: integer; var H, S, V: integer);
var
Delta, Min, H1, S1: real;
Delta, Min, H1, S1: double;
begin
h1 := h;
s1 := s;
@ -69,11 +69,9 @@ begin
begin
if R = V then
H1 := 60.0 * (G - B) / Delta
else
if G = V then
else if G = V then
H1 := 120.0 + 60.0 * (B - R) / Delta
else
if B = V then
else if B = V then
H1 := 240.0 + 60.0 * (R - G) / Delta;
if H1 < 0.0 then H1 := H1 + 360.0;
end;

1
components/mbColorLib/YColorPicker.pas
View File

@ -19,7 +19,6 @@ type
TYColorPicker = class(TmbTrackBarPicker)
private
FYellow, FMagenta, FCyan, FBlack: integer;
function ArrowPosFromYellow(y: integer): integer;
function YellowFromArrowPos(p: integer): integer;
function GetSelectedColor: TColor;

13
components/mbColorLib/mbColorList.pas
View File

@ -167,9 +167,11 @@ end;
constructor TmbColorList.Create(AOwner: TComponent);
begin
inherited;
{
MaxHue := 360;
MaxSat := 255;
MaxLum := 255;
}
style := lbOwnerDrawFixed;
SetLength(Colors, 0);
ItemHeight := 48;
@ -325,16 +327,10 @@ var
i: integer;
begin
if Length(Colors) = 0 then
begin
raise Exception.Create('There''s nothing to delete! The length of the array is 0.');
Exit;
end;
if Index > Length(Colors) - 1 then
begin
raise Exception.Create(Format('List index out of bounds (%d)', [Index]));
Exit;
end;
for i := Index to Length(Colors) - 2 do
Colors[i] := Colors[i+1];
@ -382,10 +378,7 @@ var
i: integer;
begin
if Index > Length(Colors) - 1 then
begin
raise Exception.Create(Format('List index out of bounds (%d)', [Index]));
Exit;
end;
SetLength(Colors, Length(Colors) + 1);
for i := Length(Colors) - 1 downto Index do
@ -409,7 +402,7 @@ var
Handled: boolean;
i: integer;
begin
if PtInRect(ClientRect, Point(mx, my)) and ShowHint then
if PtInRect(ClientRect, Point(mx, my)) and ShowHint then
begin
i := ItemAtPos(Point(mx, my), true);
if i > -1 then

21
components/mbColorLib/mbColorPalette.pas
View File

@ -583,8 +583,7 @@ begin
begin
if FState <> ccsNone then
InflateRect(R, -2, -2)
else
if FColCount > 1 then
else if FColCount > 1 then
Inc(R.Right);
end;
with ACanvas do
@ -700,7 +699,7 @@ end;
procedure TmbColorPalette.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then
if Button = mbLeft then
begin
SetFocus;
FMouseDown := true;
@ -933,7 +932,8 @@ begin
FCheckedIndex := GetMoveCellIndex(mdDown);
if Assigned(FOnArrowKey) then FOnArrowKey(Message.CharCode, Shift);
end;
VK_SPACE, VK_RETURN: if Assigned(FOnChange) then FOnChange(Self);
VK_SPACE, VK_RETURN:
if Assigned(FOnChange) then FOnChange(Self);
else
begin
FInherited := true;
@ -954,7 +954,7 @@ var
clr: TColor;
Handled: boolean;
begin
if (Colors.Count > 0) and (FIndex > -1) then
if (Colors.Count > 0) and (FIndex > -1) then
with TCMHintShow(Message) do
begin
if not ShowHint then
@ -970,7 +970,8 @@ if (Colors.Count > 0) and (FIndex > -1) then
clr := GetColorUnderCursor;
//fire event
Handled := false;
if Assigned(FOnGetHintText) then FOnGetHintText(clr, GetIndexUnderCursor, HintStr, Handled);
if Assigned(FOnGetHintText) then
FOnGetHintText(clr, GetIndexUnderCursor, HintStr, Handled);
if Handled then Exit;
//do default
if FIndex < FNames.Count then
@ -1112,8 +1113,7 @@ begin
FNames.Clear;
FColors.Text := ReadJASCPal(FileName);
end
else
if SameText(ExtractFileExt(FileName), '.aco') then
else if SameText(ExtractFileExt(FileName), '.aco') then
begin
supported := true;
a := ReadPhotoshopAco(FileName);
@ -1125,15 +1125,14 @@ begin
for i := 0 to Length(a.Names) - 1 do
FNames.Add(a.Names[i]);
end
else
if SameText(ExtractFileExt(FileName), '.act') then
else if SameText(ExtractFileExt(FileName), '.act') then
begin
supported := true;
FNames.Clear;
FColors.Text := ReadPhotoshopAct(FileName);
end
else
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');
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
begin
CalcAutoHeight;

7
components/mbColorLib/mbColorPreview.pas
View File

@ -51,7 +51,6 @@ type
property DragMode;
property DragKind;
property Constraints;
property OnColorChange: TNotifyEvent read FOnColorChange write FOnColorChange;
property OnOpacityChange: TNotifyEvent read FOnOpacityChange write FOnOpacityChange;
property OnContextPopup;
@ -71,6 +70,7 @@ type
property OnDblClick;
end;
implementation
uses
@ -84,8 +84,7 @@ begin
DoubleBuffered := true;
ControlStyle := COntrolStyle - [csAcceptsControls] + [csOpaque];
FSelColor := clWhite;
Width := 68;
Height := 32;
SetInitialBounds(0, 0, 68, 32);
TabStop := false;
FOpacity := 100;
FBlockSize := 6;
@ -93,7 +92,7 @@ begin
end;
function TmbColorPreview.MakeBmp: TBitmap;
begin
begin
Result := TBitmap.Create;
Result.Width := FBlockSize;
Result.Height := FBlockSize;

99
components/mbColorLib/mbColorTree.pas
View File

@ -25,8 +25,8 @@ type
{$ENDIF}
TmbColor = record
name: string;
value: TColor;
Name: string;
Value: TColor;
end;
TDrawCaptionEvent = procedure (Sender: TObject; AIndex: integer; AFont: TFont; var AText: string; Selected: boolean) of object;
@ -35,7 +35,6 @@ type
TmbColorTree = class(TCustomTreeView)
private
dummy: TCustomImageList;
FInfo1, FInfo2: string;
FInfoLabel: string;
FDraw: TDrawCaptionEvent;
@ -63,15 +62,13 @@ type
Colors: array of TmbColor;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure UpdateColors;
procedure AddColor(Name: string; Value: TColor; refresh: boolean = true);
procedure AddColor(AName: string; AValue: TColor; ARefresh: boolean = true);
procedure ClearColors;
procedure DeleteColor(Index: integer; refresh: boolean = true);
procedure DeleteColorByName(Name: string; All: boolean);
procedure DeleteColorByValue(Value: TColor; All: boolean);
procedure InsertColor(Index: integer; Name: string; Value: TColor);
procedure DeleteColor(AIndex: integer; ARefresh: boolean = true);
procedure DeleteColorByName(AName: string; All: boolean);
procedure DeleteColorByValue(AValue: TColor; All: boolean);
procedure InsertColor(AIndex: integer; AName: string; AValue: TColor);
function ColorCount: integer;
published
property InfoLabelText: string read FInfoLabel write SetInfoLabel;
@ -117,7 +114,6 @@ type
property TabStop default True;
property ToolTips;
property Visible;
property OnGetHint: TGetHintEvent read FGetHint write FGetHint;
property OnDrawCaption: TDrawCaptionEvent read FDraw write FDraw;
property OnDrawInfoLabel: TDrawLabelEvent read FDraw1 write FDraw1;
@ -205,9 +201,11 @@ constructor TmbColorTree.Create(AOwner: TComponent);
begin
inherited;
ControlStyle := ControlStyle + [csDisplayDragImage];
{
MaxHue := 360;
MaxSat := 255;
MaxLum := 255;
}
ReadOnly := true;
ShowButtons := false;
ShowLines := false;
@ -218,23 +216,11 @@ begin
Images := TImageList.Create(Self);
Images.Width := 48;
Images.Height := 48;
{
dummy := TCustomImageList.Create(Self);
dummy.Width := 48;
dummy.Height := 48;
Images := dummy;
}
FInfoLabel := 'Color Values:';
FInfo1 := 'RGB: %r.%g.%b';
FInfo2 := 'HEX: #%hex';
end;
destructor TmbColorTree.Destroy;
begin
dummy.Free;
inherited;
end;
procedure TmbColorTree.UpdateColors;
var
i: integer;
@ -257,7 +243,7 @@ begin
if Selected <> nil then
r := Selected.DisplayRect(false)
else
Exit;
exit;
if (x > r.Right - 15) and (x < r.Right - 3) and (y > r.Top + 13) and (y < r.Top + 30) then
if (Selected.HasChildren) and PtInRect(r, Point(x, y)) then
begin
@ -281,7 +267,7 @@ begin
else
begin
Cursor := crDefault;
Exit;
exit;
end;
if (x > r.Right - 15) and (x < r.Right - 3) and (y > r.Top + 13) and (y < r.Top + 30) then
@ -306,7 +292,8 @@ begin
DrawInfoItem(Node.DisplayRect(false), node.Parent.Index);
end;
procedure TmbColorTree.DoArrow(c: TCanvas; dir: TScrollDirection; p: TPoint; sel: boolean);
procedure TmbColorTree.DoArrow(c: TCanvas; dir: TScrollDirection; p: TPoint;
sel: boolean);
var
b: TBitmap;
begin
@ -328,8 +315,8 @@ begin
end;
b.Canvas.FillRect(B.Canvas.ClipRect);
case dir of
sdDown: DrawArrow(b.Canvas, dir, Point(2, 3), 3);
sdRight: DrawArrow(b.Canvas, dir, Point(1, 2), 3);
sdDown : DrawArrow(b.Canvas, dir, Point(2, 3), 3);
sdRight : DrawArrow(b.Canvas, dir, Point(1, 2), 3);
end;
c.Draw(p.x, p.y, b);
finally
@ -337,7 +324,8 @@ begin
end;
end;
procedure TmbColorTree.DrawColorItem(R: TRect; Selected: boolean; Index: integer; itemText: string; Expanded: boolean);
procedure TmbColorTree.DrawColorItem(R: TRect; Selected: boolean; Index: integer;
itemText: string; Expanded: boolean);
var
SR, TR: TRect;
begin
@ -541,15 +529,16 @@ begin
end;
end;
procedure TmbColorTree.AddColor(Name: string; Value: TColor; refresh: boolean = true);
procedure TmbColorTree.AddColor(AName: string; AValue: TColor;
ARefresh: boolean = true);
var
L: integer;
begin
L := Length(Colors);
SetLength(Colors, L + 1);
Colors[L].name := Name;
Colors[L].value := Value;
if refresh then
Colors[L].Name := AName;
Colors[L].Value := AValue;
if ARefresh then
UpdateColors;
end;
@ -564,35 +553,29 @@ begin
Result := Length(Colors);
end;
procedure TmbColorTree.DeleteColor(Index: integer; refresh: boolean = true);
procedure TmbColorTree.DeleteColor(AIndex: integer; ARefresh: boolean = true);
var
i: integer;
begin
if Length(Colors) = 0 then
begin
raise Exception.Create('There''s nothing to delete! The length of the array is 0.');
Exit;
end;
if Index > Length(Colors) - 1 then
begin
raise Exception.Create(Format('List index out of bounds (%d)', [Index]));
Exit;
end;
if AIndex > Length(Colors) - 1 then
raise Exception.Create(Format('List index out of bounds (%d)', [AIndex]));
for i := Index to Length(Colors) - 2 do
for i := AIndex to Length(Colors) - 2 do
Colors[i] := Colors[i+1];
SetLength(Colors, Length(Colors) - 1);
if refresh then
if ARefresh then
UpdateColors;
end;
procedure TmbColorTree.DeleteColorByName(Name: string; All: boolean);
procedure TmbColorTree.DeleteColorByName(AName: string; All: boolean);
var
i: integer;
begin
for i := Length(Colors) - 1 downto 0 do
if SameText(Colors[i].name, Name) then
if SameText(Colors[i].Name, AName) then
begin
DeleteColor(i, false);
if not All then
@ -604,12 +587,12 @@ begin
UpdateColors;
end;
procedure TmbColorTree.DeleteColorByValue(Value: TColor; All: boolean);
procedure TmbColorTree.DeleteColorByValue(AValue: TColor; All: boolean);
var
i: integer;
begin
for i := Length(Colors) - 1 downto 0 do
if Colors[i].Value = Value then
if Colors[i].Value = AValue then
begin
DeleteColor(i, false);
if not All then
@ -621,22 +604,19 @@ begin
UpdateColors;
end;
procedure TmbColorTree.InsertColor(Index: integer; Name: string; Value: TColor);
procedure TmbColorTree.InsertColor(AIndex: integer; AName: string; AValue: TColor);
var
i: integer;
begin
if Index > Length(Colors) - 1 then
begin
raise Exception.Create(Format('List index out of bounds (%d)', [Index]));
Exit;
end;
if AIndex > Length(Colors) - 1 then
raise Exception.Create(Format('List index out of bounds (%d)', [AIndex]));
SetLength(Colors, Length(Colors) + 1);
for i := Length(Colors) - 1 downto Index do
for i := Length(Colors) - 1 downto AIndex do
Colors[i] := Colors[i-1];
Colors[Index].Name := Name;
Colors[Index].Value := Value;
Colors[AIndex].Name := AName;
Colors[AIndex].Value := AValue;
UpdateColors;
end;
@ -647,7 +627,7 @@ var
i: integer;
n: TTreeNode;
begin
if PtInRect(ClientRect, Point(mx, my)) and ShowHint and not Dragging then
if PtInRect(ClientRect, Point(mx, my)) and ShowHint and not Dragging then
begin
n := GetNodeAt(mx, my);
if n <> nil then
@ -666,7 +646,8 @@ if PtInRect(ClientRect, Point(mx, my)) and ShowHint and not Dragging then
ReshowTimeout := 2000;
HideTimeout := 1000;
Handled := false;
if Assigned(FGetHint) then FGetHint(i, HintStr, Handled);
if Assigned(FGetHint) then
FGetHint(i, HintStr, Handled);
if Handled then
HintStr := FormatHint(HintStr, Colors[i].Value)
else

2
components/mbColorLib/mbDeskPickerButton.pas
View File

@ -50,7 +50,7 @@ implementation
constructor TmbDeskPickerButton.Create(AOwner: TComponent);
begin
inherited;
DoubleBuffered := true;
// DoubleBuffered := true;
// ControlStyle := ControlStyle - [csAcceptsControls] + [csOpaque{$IFDEF DELPHI_7_UP}, csParentBackground{$ENDIF}];
FHintFmt := 'RGB(%r, %g, %b)'#13'Hex: %h';
FShowScreenHint := false;

9
components/mbColorLib/mbutils.pas
View File

@ -7,7 +7,8 @@ interface
uses
Classes, SysUtils, Graphics, LCLIntf;
procedure Clamp(var AValue:Integer; AMin, AMax: Integer);
procedure Clamp(var AValue: Integer; AMin, AMax: Integer); overload;
procedure Clamp(var AValue: Double; AMin, AMax: Double); overload;
procedure DrawHorDottedLine(ACanvas: TCanvas; X1, X2, Y: Integer; AColor: TColor);
function PointInCircle(p: TPoint; Size: integer): boolean;
function PtInCircle(p, ctr: TPoint; Radius: Integer): Boolean;
@ -25,6 +26,12 @@ begin
if AValue > AMax then AValue := AMax;
end;
procedure Clamp(var AValue: Double; AMin, AMax: Double);
begin
if AValue < AMin then AValue := AMin;
if AValue > AMax then AValue := AMax;
end;
procedure DrawHorDottedLine(ACanvas: TCanvas; X1, X2, Y: Integer; AColor: TColor);
begin
while X1 <= X2 do begin