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

mbColorLib: Clean up. Refactoring of single-value pickers ("clamp")

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5457 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2016-12-10 10:17:14 +00:00
parent b8a19cf29b
commit 41feca985b
15 changed files with 138 additions and 530 deletions
Download Patch File Download Diff File Expand all files Collapse all files

60
components/mbColorLib/BColorPicker.pas
View File

@ -8,7 +8,7 @@ interface
uses uses
{$IFDEF FPC} {$IFDEF FPC}
LCLIntf, LCLType, LMessages, LCLIntf, LCLType, //LMessages,
{$ELSE} {$ELSE}
Windows, Messages, Windows, Messages,
{$ENDIF} {$ENDIF}
@ -52,6 +52,9 @@ implementation
{$R BColorPicker.dcr} {$R BColorPicker.dcr}
{$ENDIF} {$ENDIF}
uses
mbUtils;
procedure Register; procedure Register;
begin begin
RegisterComponents('mbColor Lib', [TBColorPicker]); RegisterComponents('mbColor Lib', [TBColorPicker]);
@ -81,47 +84,6 @@ begin
FChange := true; FChange := true;
end; end;
(*
procedure TBColorPicker.CreateBGradient;
var
i,j: integer;
row: pRGBQuadArray;
begin
if FBmp = nil then
begin
FBmp := TBitmap.Create;
FBmp.PixelFormat := pf32bit;
end;
if Layout = lyHorizontal then
begin
FBmp.width := 256;
FBmp.height := 12;
for i := 0 to 255 do
for j := 0 to 11 do
begin
row := FBmp.Scanline[j];
if not WebSafe then
row[i] := RGBtoRGBQuad(FRed, FGreen, i)
else
row[i] := RGBtoRGBQuad(GetWebSafe(RGB(FRed, FGreen, i)));
end;
end
else
begin
FBmp.width := 12;
FBmp.height := 256;
for i := 0 to 255 do
begin
row := FBmp.Scanline[i];
for j := 0 to 11 do
if not WebSafe then
row[j] := RGBtoRGBQuad(FRed, FGreen, 255-i)
else
row[j] := RGBtoRGBQuad(GetWebSafe(RGB(FRed, FGreen, 255-i)));
end;
end;
end; *)
function TBColorPicker.GetGradientColor(AValue: Integer): TColor; function TBColorPicker.GetGradientColor(AValue: Integer): TColor;
begin begin
Result := RGB(FRed, FGreen, AValue); Result := RGB(FRed, FGreen, AValue);
@ -129,8 +91,7 @@ end;
procedure TBColorPicker.SetRed(r: integer); procedure TBColorPicker.SetRed(r: integer);
begin begin
if r < 0 then r := 0; Clamp(r, 0, 255);
if r > 255 then r := 255;
if FRed <> r then if FRed <> r then
begin begin
FRed := r; FRed := r;
@ -143,8 +104,7 @@ end;
procedure TBColorPicker.SetGreen(g: integer); procedure TBColorPicker.SetGreen(g: integer);
begin begin
if g > 255 then g := 255; Clamp(g, 0, 255);
if g < 0 then g := 0;
if FGreen <> g then if FGreen <> g then
begin begin
FGreen := g; FGreen := g;
@ -157,8 +117,7 @@ end;
procedure TBColorPicker.SetBlue(b: integer); procedure TBColorPicker.SetBlue(b: integer);
begin begin
if b > 255 then b := 255; Clamp(b, 0, 255);
if b < 0 then b := 0;
if FBlue <> b then if FBlue <> b then
begin begin
FBlue := b; FBlue := b;
@ -195,9 +154,8 @@ begin
if Layout = lyHorizontal then if Layout = lyHorizontal then
b := Round(p/((Width - 12)/255)) b := Round(p/((Width - 12)/255))
else else
b := Round(255 - p/((Height - 12)/255)); b := Round(255 - p/((Height - 12)/255));
if b < 0 then b := 0; Clamp(b, 0, 255);
if b > 255 then b := 255;
Result := b; Result := b;
end; end;

80
components/mbColorLib/CColorPicker.pas
View File

@ -22,7 +22,7 @@ type
function ArrowPosFromCyan(c: integer): integer; function ArrowPosFromCyan(c: integer): integer;
function CyanFromArrowPos(p: integer): integer; function CyanFromArrowPos(p: integer): integer;
function GetSelectedColor: TColor; function GetSelectedColor: TColor;
procedure SetSelectedColor(c: TColor); procedure SetSelectedColor(clr: TColor);
procedure SetCyan(c: integer); procedure SetCyan(c: integer);
procedure SetMagenta(m: integer); procedure SetMagenta(m: integer);
procedure SetYellow(y: integer); procedure SetYellow(y: integer);
@ -51,6 +51,9 @@ implementation
{$R CColorPicker.dcr} {$R CColorPicker.dcr}
{$ENDIF} {$ENDIF}
uses
mbUtils;
procedure Register; procedure Register;
begin begin
RegisterComponents('mbColor Lib', [TCColorPicker]); RegisterComponents('mbColor Lib', [TCColorPicker]);
@ -79,48 +82,6 @@ begin
FChange := true; FChange := true;
end; end;
(*
procedure TCColorPicker.CreateCGradient;
var
i,j: integer;
row: pRGBQuadArray;
begin
if FCBmp = nil then
begin
FCBmp := TBitmap.Create;
FCBmp.PixelFormat := pf32bit;
end;
if Layout = lyHorizontal then
begin
FCBmp.width := 255;
FCBmp.height := 12;
for i := 0 to 254 do
for j := 0 to 11 do
begin
row := FCBmp.Scanline[j];
if not WebSafe then
row[i] := RGBToRGBQuad(CMYKtoTColor(i, FMagenta, FYellow, FBlack))
else
row[i] := RGBToRGBQuad(GetWebSafe(CMYKtoTColor(i, FMagenta, FYellow, FBlack)));
end;
end
else
begin
FCBmp.width := 12;
FCBmp.height := 255;
for i := 0 to 254 do
begin
row := FCBmp.Scanline[i];
for j := 0 to 11 do
if not WebSafe then
row[j] := RGBtoRGBQuad(CMYKtoTColor(255-i, FMagenta, FYellow, FBlack))
else
row[j] := RGBtoRGBQuad(GetWebSafe(CMYKtoTColor(255-i, FMagenta, FYellow, FBlack)));
end;
end;
end;
*)
function TCColorPicker.GetGradientColor(AValue: Integer): TColor; function TCColorPicker.GetGradientColor(AValue: Integer): TColor;
begin begin
Result := CMYKtoTColor(AValue, FMagenta, FYellow, FBlack); Result := CMYKtoTColor(AValue, FMagenta, FYellow, FBlack);
@ -128,8 +89,7 @@ end;
procedure TCColorPicker.SetCyan(C: integer); procedure TCColorPicker.SetCyan(C: integer);
begin begin
if C < 0 then C := 0; Clamp(c, 0, 255);
if C > 255 then C := 255;
if FCyan <> c then if FCyan <> c then
begin begin
FCyan := c; FCyan := c;
@ -142,8 +102,7 @@ end;
procedure TCColorPicker.SetMagenta(m: integer); procedure TCColorPicker.SetMagenta(m: integer);
begin begin
if m > 255 then m := 255; Clamp(m, 0, 255);
if m < 0 then m := 0;
if FMagenta <> m then if FMagenta <> m then
begin begin
FMagenta := m; FMagenta := m;
@ -156,8 +115,7 @@ end;
procedure TCColorPicker.SetYellow(y: integer); procedure TCColorPicker.SetYellow(y: integer);
begin begin
if y > 255 then y := 255; Clamp(y, 0, 255);
if y < 0 then y := 0;
if FYellow <> y then if FYellow <> y then
begin begin
FYellow := y; FYellow := y;
@ -170,8 +128,7 @@ end;
procedure TCColorPicker.SetBlack(k: integer); procedure TCColorPicker.SetBlack(k: integer);
begin begin
if k > 255 then k := 255; Clamp(k, 0, 255);
if k < 0 then k := 0;
if FBlack <> k then if FBlack <> k then
begin begin
FBlack := k; FBlack := k;
@ -203,15 +160,14 @@ end;
function TCColorPicker.CyanFromArrowPos(p: integer): integer; function TCColorPicker.CyanFromArrowPos(p: integer): integer;
var var
r: integer; c: integer;
begin begin
if Layout = lyHorizontal then if Layout = lyHorizontal then
r := Round(p/((Width - 12)/255)) c := Round(p/((Width - 12)/255))
else else
r := Round(255 - p/((Height - 12)/255)); c := Round(255 - p/((Height - 12)/255));
if r < 0 then r := 0; Clamp(c, 0, 255);
if r > 255 then r := 255; Result := c;
Result := r;
end; end;
function TCColorPicker.GetSelectedColor: TColor; function TCColorPicker.GetSelectedColor: TColor;
@ -227,17 +183,17 @@ begin
Result := FCyan; Result := FCyan;
end; end;
procedure TCColorPicker.SetSelectedColor(c: TColor); procedure TCColorPicker.SetSelectedColor(clr: TColor);
var var
cy, m, y, k: integer; c, m, y, k: integer;
begin begin
if WebSafe then c := GetWebSafe(c); if WebSafe then clr := GetWebSafe(clr);
ColorToCMYK(c, cy, m, y, k); ColorToCMYK(clr, c, m, y, k);
FChange := false; FChange := false;
SetMagenta(m); SetMagenta(m);
SetYellow(y); SetYellow(y);
SetBlack(k); SetBlack(k);
SetCyan(cy); SetCyan(c);
FManual := false; FManual := false;
FChange := true; FChange := true;
if Assigned(OnChange) then OnChange(Self); if Assigned(OnChange) then OnChange(Self);

59
components/mbColorLib/GColorPicker.pas
View File

@ -47,6 +47,9 @@ implementation
{$R GColorPicker.dcr} {$R GColorPicker.dcr}
{$ENDIF} {$ENDIF}
uses
mbUtils;
procedure Register; procedure Register;
begin begin
RegisterComponents('mbColor Lib', [TGColorPicker]); RegisterComponents('mbColor Lib', [TGColorPicker]);
@ -74,50 +77,6 @@ begin
FChange := true; FChange := true;
end; end;
(*
procedure TGColorPicker.CreateGGradient;
var
i,j: integer;
row: pRGBQuadArray;
begin
if FBmp = nil then
begin
FBmp := TBitmap.Create;
FBmp.PixelFormat := pf32bit;
end;
if Layout = lyHorizontal then
begin
FBmp.width := 256;
FBmp.height := 12;
for i := 0 to 255 do
for j := 0 to 11 do
begin
row := FBmp.ScanLine[j];
if not WebSafe then
row[i] := RGBtoRGBQuad(FRed, i, FBlue)
// FBmp.Canvas.Pixels[i, j] := RGB(FRed, i, FBlue)
else
row[i] := RGBtoRGBQuad(GetWebSafe(RGB(FRed, i, FBlue)));
// FBmp.Canvas.Pixels[i, j] := GetWebSafe(RGB(FRed, i, FBlue));
end;
end
else
begin
FBmp.width := 12;
FBmp.height := 256;
for i := 0 to 255 do
begin
row := FBmp.Scanline[i];
for j := 0 to 11 do
if not WebSafe then
row[j] := RGBtoRGBQuad(FRed, 255-i, FBlue)
else
row[j] := RGBtoRGBQuad(GetWebSafe(RGB(FRed, 255-i, FBlue)));
end;
end;
end;
*)
function TGColorPicker.GetGradientColor(AValue: Integer): TColor; function TGColorPicker.GetGradientColor(AValue: Integer): TColor;
begin begin
Result := RGB(FRed, AValue, FBlue); Result := RGB(FRed, AValue, FBlue);
@ -125,8 +84,7 @@ end;
procedure TGColorPicker.SetRed(r: integer); procedure TGColorPicker.SetRed(r: integer);
begin begin
if r < 0 then r := 0; Clamp(r, 0, 255);
if r > 255 then r := 255;
if FRed <> r then if FRed <> r then
begin begin
FRed := r; FRed := r;
@ -139,8 +97,7 @@ end;
procedure TGColorPicker.SetGreen(g: integer); procedure TGColorPicker.SetGreen(g: integer);
begin begin
if g > 255 then g := 255; Clamp(g, 0, 255);
if g < 0 then g := 0;
if FGreen <> g then if FGreen <> g then
begin begin
FGreen := g; FGreen := g;
@ -153,8 +110,7 @@ end;
procedure TGColorPicker.SetBlue(b: integer); procedure TGColorPicker.SetBlue(b: integer);
begin begin
if b > 255 then b := 255; Clamp(b, 0, 255);
if b < 0 then b := 0;
if FBlue <> b then if FBlue <> b then
begin begin
FBlue := b; FBlue := b;
@ -192,8 +148,7 @@ begin
g := Round(p/((Width - 12)/255)) g := Round(p/((Width - 12)/255))
else else
g := Round(255 - p/((Height - 12)/255)); g := Round(255 - p/((Height - 12)/255));
if g < 0 then g := 0; Clamp(g, 0, 255);
if g > 255 then g := 255;
Result := g; Result := g;
end; end;

59
components/mbColorLib/HColorPicker.pas
View File

@ -48,6 +48,9 @@ implementation
{$R HColorPicker.dcr} {$R HColorPicker.dcr}
{$ENDIF} {$ENDIF}
uses
mbUtils;
procedure Register; procedure Register;
begin begin
RegisterComponents('mbColor Lib', [THColorPicker]); RegisterComponents('mbColor Lib', [THColorPicker]);
@ -73,50 +76,6 @@ begin
FChange := true; FChange := true;
end; end;
(*
procedure THColorPicker.CreateHGradient;
var
i,j: integer;
row: pRGBQuadArray;
begin
if FHBmp = nil then
begin
FHBmp := TBitmap.Create;
FHBmp.PixelFormat := pf32bit;
end;
if Layout = lyHorizontal then
begin
FHBmp.width := 360;
FHBmp.height := 12;
for i := 0 to 359 do
for j := 0 to 11 do
begin
row := FHBmp.ScanLine[j];
if not WebSafe then
row[i] := RGBtoRGBQuad(HSVtoColor(i, FSat, FVal))
// FHBmp.Canvas.Pixels[i, j] := HSVtoColor(i, FSat, FVal)
else
row[i] := RGBtoRGBQuad(GetWebSafe(HSVtoColor(i, FSat, FVal)));
// FHBmp.Canvas.Pixels[i, j] := GetWebSafe(HSVtoColor(i, FSat, FVal));
end;
end
else
begin
FHBmp.width := 12;
FHBmp.height := 360;
for i := 0 to 359 do
begin
row := FHBmp.ScanLine[i];
for j := 0 to 11 do
if not WebSafe then
row[j] := RGBtoRGBQuad(HSVtoColor(i, FSat, FVal))
else
row[j] := RGBtoRGBQuad(GetWebSafe(HSVtoColor(i, FSat, FVal)));
end;
end;
end;
*)
function THColorPicker.GetGradientColor(AValue: Integer): TColor; function THColorPicker.GetGradientColor(AValue: Integer): TColor;
begin begin
Result := HSVtoColor(AValue, FSat, FVal); Result := HSVtoColor(AValue, FSat, FVal);
@ -124,8 +83,7 @@ end;
procedure THColorPicker.SetValue(v: integer); procedure THColorPicker.SetValue(v: integer);
begin begin
if v < 0 then v := 0; Clamp(v, 0, 255);
if v > 255 then v := 255;
if FVal <> v then if FVal <> v then
begin begin
FVal := v; FVal := v;
@ -138,8 +96,7 @@ end;
procedure THColorPicker.SetHue(h: integer); procedure THColorPicker.SetHue(h: integer);
begin begin
if h > 360 then h := 360; Clamp(h, 0, 360);
if h < 0 then h := 0;
if FHue <> h then if FHue <> h then
begin begin
FHue := h; FHue := h;
@ -152,8 +109,7 @@ end;
procedure THColorPicker.SetSat(s: integer); procedure THColorPicker.SetSat(s: integer);
begin begin
if s > 255 then s := 255; Clamp(s, 0, 255);
if s < 0 then s := 0;
if FSat <> s then if FSat <> s then
begin begin
FSat := s; FSat := s;
@ -190,8 +146,7 @@ begin
r := Round(p/((Width - 12)/360)) r := Round(p/((Width - 12)/360))
else else
r := Round(p/((Height - 12)/360)); r := Round(p/((Height - 12)/360));
if r < 0 then r := 0; Clamp(r, 0, 360);
if r > 360 then r := 360;
Result := r; Result := r;
end; end;

72
components/mbColorLib/KColorPicker.pas
View File

@ -51,6 +51,9 @@ implementation
{$R KColorPicker.dcr} {$R KColorPicker.dcr}
{$ENDIF} {$ENDIF}
uses
mbUtils;
procedure Register; procedure Register;
begin begin
RegisterComponents('mbColor Lib', [TKColorPicker]); RegisterComponents('mbColor Lib', [TKColorPicker]);
@ -79,52 +82,6 @@ begin
FChange := true; FChange := true;
end; end;
(*
procedure TKColorPicker.CreateKGradient;
var
i,j: integer;
row: pRGBQuadArray;
begin
if FKBmp = nil then
begin
FKBmp := TBitmap.Create;
FKBmp.PixelFormat := pf32bit;
end;
if Layout = lyHorizontal then
begin
FKBmp.width := 255;
FKBmp.height := 12;
for i := 0 to 254 do
for j := 0 to 11 do
begin
row := FKBmp.ScanLine[j];
if not WebSafe then
row[i] := RGBToRGBQuad(CMYKtoTColor(FCyan, FMagenta, FYellow, i))
// FKBmp.Canvas.Pixels[i, j] := CMYKtoTColor(FCyan, FMagenta, FYellow, i)
else
row[i] := RGBToRGBQuad(GetWebSafe(CMYKtoTColor(FCyan, FMagenta, FYellow, i)));
// FKBmp.Canvas.Pixels[i, j] := GetWebSafe(CMYKtoTColor(FCyan, FMagenta, FYellow, i));
end;
end
else
begin
FKBmp.width := 12;
FKBmp.height := 255;
for i := 0 to 254 do
begin
row := FKBmp.Scanline[i];
for j := 0 to 11 do
if not WebSafe then
row[j] := RGBToRGBQuad(CMYKtoTColor(FCyan, FMagenta, FYellow, 255-i))
// FKBmp.Canvas.Pixels[j, i] := CMYKtoTColor(FCyan, FMagenta, FYellow, 255-i)
else
row[j] := RGBToRGBQuad(GetWebSafe(CMYKtoTColor(FCyan, FMagenta, FYellow, 255-i)));
// FKBmp.Canvas.Pixels[j, i] := GetWebSafe(CMYKtoTColor(FCyan, FMagenta, FYellow, 255-i));
end;
end;
end;
*)
function TKColorPicker.GetGradientColor(AValue: Integer): TColor; function TKColorPicker.GetGradientColor(AValue: Integer): TColor;
begin begin
Result := CMYKtoTColor(FCyan, FMagenta, FYellow, AValue); Result := CMYKtoTColor(FCyan, FMagenta, FYellow, AValue);
@ -132,8 +89,7 @@ end;
procedure TKColorPicker.SetBlack(k: integer); procedure TKColorPicker.SetBlack(k: integer);
begin begin
if k < 0 then k := 0; Clamp(k, 0, 255);
if k > 255 then k := 255;
if FBlack <> k then if FBlack <> k then
begin begin
FBlack := k; FBlack := k;
@ -146,8 +102,7 @@ end;
procedure TKColorPicker.SetMagenta(m: integer); procedure TKColorPicker.SetMagenta(m: integer);
begin begin
if m > 255 then m := 255; Clamp(m, 0, 255);
if m < 0 then m := 0;
if FMagenta <> m then if FMagenta <> m then
begin begin
FMagenta := m; FMagenta := m;
@ -160,8 +115,7 @@ end;
procedure TKColorPicker.SetYellow(y: integer); procedure TKColorPicker.SetYellow(y: integer);
begin begin
if y > 255 then y := 255; Clamp(y, 0, 255);
if y < 0 then y := 0;
if FYellow <> y then if FYellow <> y then
begin begin
FYellow := y; FYellow := y;
@ -174,8 +128,7 @@ end;
procedure TKColorPicker.SetCyan(c: integer); procedure TKColorPicker.SetCyan(c: integer);
begin begin
if c > 255 then c := 255; Clamp(c, 0, 255);
if c < 0 then c := 0;
if FCyan <> c then if FCyan <> c then
begin begin
FCyan := c; FCyan := c;
@ -207,15 +160,14 @@ end;
function TKColorPicker.BlackFromArrowPos(p: integer): integer; function TKColorPicker.BlackFromArrowPos(p: integer): integer;
var var
r: integer; k: integer;
begin begin
if Layout = lyHorizontal then if Layout = lyHorizontal then
r := Round(p/((Width - 12)/255)) k := Round(p/((Width - 12)/255))
else else
r := Round(255 - p/((Height - 12)/255)); k := Round(255 - p/((Height - 12)/255));
if r < 0 then r := 0; Clamp(k, 0, 255);
if r > 255 then r := 255; Result := k;
Result := r;
end; end;
function TKColorPicker.GetSelectedColor: TColor; function TKColorPicker.GetSelectedColor: TColor;

78
components/mbColorLib/LColorPicker.pas
View File

@ -49,6 +49,9 @@ implementation
{$R LColorPicker.dcr} {$R LColorPicker.dcr}
{$ENDIF} {$ENDIF}
uses
mbUtils;
procedure Register; procedure Register;
begin begin
RegisterComponents('mbColor Lib', [TLColorPicker]); RegisterComponents('mbColor Lib', [TLColorPicker]);
@ -61,6 +64,7 @@ begin
inherited; inherited;
FGradientWidth := 256; FGradientWidth := 256;
FGradientHeight := 12; FGradientHeight := 12;
SetInitialBounds(0, 0, 22, 267);
Layout := lyVertical; Layout := lyVertical;
FHue := 0; FHue := 0;
FSat := MaxSat; FSat := MaxSat;
@ -72,52 +76,6 @@ begin
FChange := true; FChange := true;
end; end;
(*
procedure TLColorPicker.CreateLGradient;
var
i,j: integer;
row: pRGBQuadArray;
begin
if FLBmp = nil then
begin
FLBmp := TBitmap.Create;
FLBmp.PixelFormat := pf32bit;
end;
if Layout = lyHorizontal then
begin
FLBmp.width := MaxLum;
FLBmp.height := 12;
for i := 0 to MaxLum - 1 do
for j := 0 to 11 do
begin
row := FLBmp.Scanline[j];
if not WebSafe then
row[i] := RGBToRGBQuad(HSLRangeToRGB(FHue, FSat, i))
// FLBmp.Canvas.Pixels[i, j] := HSLRangeToRGB(FHue, FSat, i)
else
row[i] := RGBToRGBQuad(GetWebSafe(HSLRangeToRGB(FHue, FSat, i)));
// FLBmp.Canvas.Pixels[i, j] := GetWebSafe(HSLRangeToRGB(FHue, FSat, i));
end;
end
else
begin
FLBmp.width := 12;
FLBmp.height := MaxLum;
for i := 0 to MaxLum - 1 do
begin
row := FLBmp.Scanline[i];
for j := 0 to 11 do
if not WebSafe then
row[j] := RGBToRGBQuad(HSLRangeToRGB(FHue, FSat, MaxLum - i))
// FLBmp.Canvas.Pixels[j, i] := HSLRangeToRGB(FHue, FSat, MaxLum - i)
else
row[j] := RGBToRGBQuad(GetWebSafe(HSLRangeToRGB(FHue, FSat, MaxLum - i)));
// FLBmp.Canvas.Pixels[j, i] := GetWebSafe(HSLRangeToRGB(FHue, FSat, MaxLum - i));
end;
end;
end;
*)
function TLColorPicker.GetGradientColor(AValue: Integer): TColor; function TLColorPicker.GetGradientColor(AValue: Integer): TColor;
begin begin
Result := HSLRangeToRGB(FHue, FSat, AValue); Result := HSLRangeToRGB(FHue, FSat, AValue);
@ -125,8 +83,7 @@ end;
procedure TLColorPicker.SetHue(h: integer); procedure TLColorPicker.SetHue(h: integer);
begin begin
if h > MaxHue then h := MaxHue; Clamp(h, 0, MaxHue);
if h < 0 then h := 0;
if FHue <> h then if FHue <> h then
begin begin
FHue := h; FHue := h;
@ -139,8 +96,7 @@ end;
procedure TLColorPicker.SetSat(s: integer); procedure TLColorPicker.SetSat(s: integer);
begin begin
if s > MaxSat then s := MaxSat; Clamp(s, 0, MaxSat);
if s < 0 then s := 0;
if FSat <> s then if FSat <> s then
begin begin
FSat := s; FSat := s;
@ -172,25 +128,23 @@ end;
function TLColorPicker.LumFromArrowPos(p: integer): integer; function TLColorPicker.LumFromArrowPos(p: integer): integer;
var var
r: integer; L: integer;
begin begin
if Layout = lyHorizontal then if Layout = lyHorizontal then
r := Round(p/((Width - 12)/MaxLum)) L := Round(p/((Width - 12)/MaxLum))
else else
r := Round(MaxLum - p/((Height - 12)/MaxLum)); L := Round(MaxLum - p/((Height - 12)/MaxLum));
if r < 0 then r := 0; Clamp(L, 0, MaxLum);
if r > MaxLum then r := MaxLum; Result := L;
Result := r;
end; end;
procedure TLColorPicker.SetLuminance(l: integer); procedure TLColorPicker.SetLuminance(L: integer);
begin begin
if l < 0 then l := 0; Clamp(L, 0, MaxLum);
if l > MaxLum then l := MaxLum; if FLuminance <> L then
if FLuminance <> l then
begin begin
FLuminance := l; FLuminance := L;
FArrowPos := ArrowPosFromLum(l); FArrowPos := ArrowPosFromLum(L);
FManual := false; FManual := false;
Invalidate; Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self); if FChange and Assigned(OnChange) then OnChange(Self);

77
components/mbColorLib/MColorPicker.pas
View File

@ -51,6 +51,9 @@ implementation
{$R MColorPicker.dcr} {$R MColorPicker.dcr}
{$ENDIF} {$ENDIF}
uses
mbUtils;
procedure Register; procedure Register;
begin begin
RegisterComponents('mbColor Lib', [TMColorPicker]); RegisterComponents('mbColor Lib', [TMColorPicker]);
@ -63,8 +66,9 @@ begin
inherited; inherited;
FGradientWidth := 256; FGradientWidth := 256;
FGradientHeight := 12; FGradientHeight := 12;
Width := 22; // Width := 22;
Height := 267; // Height := 267;
SetInitialBounds(0, 0, 22, 267);
Layout := lyVertical; Layout := lyVertical;
FCyan := 0; FCyan := 0;
FMagenta := 255; FMagenta := 255;
@ -78,51 +82,7 @@ begin
FChange := true; FChange := true;
end; end;
(*
procedure TMColorPicker.CreateMGradient;
var
i,j: integer;
row: pRGBQuadArray;
begin
if FMBmp = nil then
begin
FMBmp := TBitmap.Create;
FMBmp.PixelFormat := pf32bit;
end;
if Layout = lyHorizontal then
begin
FMBmp.width := 255;
FMBmp.height := 12;
for i := 0 to 254 do
for j := 0 to 11 do
begin
row := FMBmp.ScanLine[j];
if not WebSafe then
row[i] := RGBToRGBQuad(CMYKtoTColor(FCyan, i, FYellow, FBlack))
// FMBmp.Canvas.Pixels[i, j] := CMYKtoTColor(FCyan, i, FYellow, FBlack)
else
row[i] := RGBToRGBQuad(GetWebSafe(CMYKtoTColor(FCyan, i, FYellow, FBlack)));
// FMBmp.Canvas.Pixels[i, j] := GetWebSafe(CMYKtoTColor(FCyan, i, FYellow, FBlack));
end;
end
else
begin
FMBmp.width := 12;
FMBmp.height := 255;
for i := 0 to 254 do
begin
row := FMBmp.Scanline[i];
for j := 0 to 11 do
if not WebSafe then
row[j] := RGBToRGBQuad(CMYKtoTColor(FCyan, 255-i, FYellow, FBlack))
// FMBmp.Canvas.Pixels[j, i] := CMYKtoTColor(FCyan, 255-i, FYellow, FBlack)
else
row[j] := RGBToRGBQuad(GetWebSafe(CMYKtoTColor(FCyan, 255-i, FYellow, FBlack)));
// FMBmp.Canvas.Pixels[j, i] := GetWebSafe(CMYKtoTColor(FCyan, 255-i, FYellow, FBlack));
end;
end;
end;
*)
function TMColorPicker.GetGradientColor(AValue: Integer): TColor; function TMColorPicker.GetGradientColor(AValue: Integer): TColor;
begin begin
Result := CMYKtoTColor(FCyan, AValue, FYellow, FBlack); Result := CMYKtoTColor(FCyan, AValue, FYellow, FBlack);
@ -130,8 +90,7 @@ end;
procedure TMColorPicker.SetMagenta(m: integer); procedure TMColorPicker.SetMagenta(m: integer);
begin begin
if M < 0 then M := 0; Clamp(m, 0, 255);
if M > 255 then M := 255;
if FMagenta <> m then if FMagenta <> m then
begin begin
FMagenta := m; FMagenta := m;
@ -144,8 +103,7 @@ end;
procedure TMColorPicker.SetCyan(c: integer); procedure TMColorPicker.SetCyan(c: integer);
begin begin
if c > 255 then c := 255; Clamp(c, 0, 255);
if c < 0 then c := 0;
if FCyan <> c then if FCyan <> c then
begin begin
FCyan := c; FCyan := c;
@ -158,8 +116,7 @@ end;
procedure TMColorPicker.SetYellow(y: integer); procedure TMColorPicker.SetYellow(y: integer);
begin begin
if y > 255 then y := 255; Clamp(y, 0, 255);
if y < 0 then y := 0;
if FYellow <> y then if FYellow <> y then
begin begin
FYellow := y; FYellow := y;
@ -172,8 +129,7 @@ end;
procedure TMColorPicker.SetBlack(k: integer); procedure TMColorPicker.SetBlack(k: integer);
begin begin
if k > 255 then k := 255; Clamp(k, 0, 255);
if k < 0 then k := 0;
if FBlack <> k then if FBlack <> k then
begin begin
FBlack := k; FBlack := k;
@ -205,15 +161,14 @@ end;
function TMColorPicker.MagentaFromArrowPos(p: integer): integer; function TMColorPicker.MagentaFromArrowPos(p: integer): integer;
var var
r: integer; m: integer;
begin begin
if Layout = lyHorizontal then if Layout = lyHorizontal then
r := Round(p/((Width - 12)/255)) m := Round(p/((Width - 12)/255))
else else
r := Round(255 - p/((Height - 12)/255)); m := Round(255 - p/((Height - 12)/255));
if r < 0 then r := 0; Clamp(m, 0, 255);
if r > 255 then r := 255; Result := m;
Result := r;
end; end;
function TMColorPicker.GetSelectedColor: TColor; function TMColorPicker.GetSelectedColor: TColor;

65
components/mbColorLib/RColorPicker.pas
View File

@ -52,6 +52,9 @@ implementation
{$R RColorPicker.dcr} {$R RColorPicker.dcr}
{$ENDIF} {$ENDIF}
uses
mbUtils;
procedure Register; procedure Register;
begin begin
RegisterComponents('mbColor Lib', [TRColorPicker]); RegisterComponents('mbColor Lib', [TRColorPicker]);
@ -64,8 +67,9 @@ begin
inherited; inherited;
FGradientWidth := 256; FGradientWidth := 256;
FGradientHeight := 12; FGradientHeight := 12;
Width := 22; SetInitialBounds(0, 0, 22, 268);
Height := 268; // Width := 22;
// Height := 268;
Layout := lyVertical; Layout := lyVertical;
FRed := 255; FRed := 255;
FGreen := 122; FGreen := 122;
@ -78,51 +82,6 @@ begin
FChange := true; FChange := true;
end; end;
(*
procedure TRColorPicker.CreateRGradient;
var
i,j: integer;
row: pRGBQuadArray;
begin
if FBmp = nil then
begin
FBmp := TBitmap.Create;
FBmp.PixelFormat := pf32bit;
end;
if Layout = lyHorizontal then
begin
FBmp.width := 256;
FBmp.height := 12;
for i := 0 to 255 do
for j := 0 to 11 do
begin
row := FBmp.Scanline[j];
if not WebSafe then
row[i] := RGBToRGBQuad(i, FGreen, FBlue)
// FBmp.Canvas.Pixels[i, j] := RGB(i, FGreen, FBlue)
else
row[i] := RGBToRGBQuad(GetWebSafe(RGB(i, FGreen, FBlue)));
// FBmp.Canvas.Pixels[i, j] := GetWebSafe(RGB(i, FGreen, FBlue));
end;
end
else
begin
FBmp.width := 12;
FBmp.height := 256;
for i := 0 to 255 do
begin
row := FBmp.ScanLine[i];
for j := 0 to 11 do
if not WebSafe then
row[j] := RGBtoRGBQuad(255-i, FGreen, FBlue)
// FBmp.Canvas.Pixels[j, i] := RGB(255-i, FGreen, FBlue)
else
row[j] := RGBtoRGBQuad(GetWebSafe(RGB(255-i, FGreen, FBlue)));
// FBmp.Canvas.Pixels[j, i] := GetWebSafe(RGB(255-i, FGreen, FBlue));
end;
end;
end; *)
function TRColorPicker.GetGradientColor(AValue: Integer): TColor; function TRColorPicker.GetGradientColor(AValue: Integer): TColor;
begin begin
Result := RGB(AValue, FGreen, FBlue); Result := RGB(AValue, FGreen, FBlue);
@ -130,8 +89,7 @@ end;
procedure TRColorPicker.SetRed(r: integer); procedure TRColorPicker.SetRed(r: integer);
begin begin
if r < 0 then r := 0; Clamp(r, 0, 255);
if r > 255 then r := 255;
if FRed <> r then if FRed <> r then
begin begin
FRed := r; FRed := r;
@ -144,8 +102,7 @@ end;
procedure TRColorPicker.SetGreen(g: integer); procedure TRColorPicker.SetGreen(g: integer);
begin begin
if g > 255 then g := 255; Clamp(g, 0, 255);
if g < 0 then g := 0;
if FGreen <> g then if FGreen <> g then
begin begin
FGreen := g; FGreen := g;
@ -158,8 +115,7 @@ end;
procedure TRColorPicker.SetBlue(b: integer); procedure TRColorPicker.SetBlue(b: integer);
begin begin
if b > 255 then b := 255; Clamp(b, 0, 255);
if b < 0 then b := 0;
if FBlue <> b then if FBlue <> b then
begin begin
FBlue := b; FBlue := b;
@ -197,8 +153,7 @@ begin
r := Round(p/((Width - 12)/255)) r := Round(p/((Width - 12)/255))
else else
r := Round(255 - p/((Height - 12)/255)); r := Round(255 - p/((Height - 12)/255));
if r < 0 then r := 0; Clamp(r, 0, 255);
if r > 255 then r := 255;
Result := r; Result := r;
end; end;

7
components/mbColorLib/RGBHSVUtils.pas
View File

@ -14,7 +14,6 @@ uses
{$ENDIF} {$ENDIF}
SysUtils, Classes, Graphics, Math, Scanlines; SysUtils, Classes, Graphics, Math, Scanlines;
procedure Clamp(var Input: integer; Min, Max: integer);
function RGBtoRGBTriple(R, G, B: byte): TRGBTriple; function RGBtoRGBTriple(R, G, B: byte): TRGBTriple;
function RGBtoRGBQuad(R, G, B: byte): TRGBQuad; function RGBtoRGBQuad(R, G, B: byte): TRGBQuad;
function RGBTripleToColor(Triple: TRGBTriple): TColor; function RGBTripleToColor(Triple: TRGBTriple): TColor;
@ -28,12 +27,6 @@ function GetSValue(Color: TColor): integer;
implementation implementation
procedure Clamp(var Input: integer; Min, Max: integer);
begin
if Input < Min then Input := Min;
if Input > Max then Input := Max;
end;
function RGBtoRGBTriple(R, G, B: byte): TRGBTriple; function RGBtoRGBTriple(R, G, B: byte): TRGBTriple;
begin begin
with Result do with Result do

15
components/mbColorLib/SColorPicker.pas
View File

@ -48,6 +48,9 @@ implementation
{$R SColorPicker.dcr} {$R SColorPicker.dcr}
{$ENDIF} {$ENDIF}
uses
mbUtils;
procedure Register; procedure Register;
begin begin
RegisterComponents('mbColor Lib', [TSColorPicker]); RegisterComponents('mbColor Lib', [TSColorPicker]);
@ -125,8 +128,7 @@ end;
procedure TSColorPicker.SetValue(v: integer); procedure TSColorPicker.SetValue(v: integer);
begin begin
if v < 0 then v := 0; Clamp(v, 0, 255);
if v > 255 then v := 255;
if FVal <> v then if FVal <> v then
begin begin
FVal := v; FVal := v;
@ -139,8 +141,7 @@ end;
procedure TSColorPicker.SetHue(h: integer); procedure TSColorPicker.SetHue(h: integer);
begin begin
if h > 360 then h := 360; Clamp(h, 0, 360);
if h < 0 then h := 0;
if FHue <> h then if FHue <> h then
begin begin
FHue := h; FHue := h;
@ -153,8 +154,7 @@ end;
procedure TSColorPicker.SetSat(s: integer); procedure TSColorPicker.SetSat(s: integer);
begin begin
if s > 255 then s := 255; Clamp(s, 0, 255);
if s < 0 then s := 0;
if FSat <> s then if FSat <> s then
begin begin
FSat := s; FSat := s;
@ -192,8 +192,7 @@ begin
r := Round(p/((Width - 12)/255)) r := Round(p/((Width - 12)/255))
else else
r := Round(255 - p/((Height - 12)/255)); r := Round(255 - p/((Height - 12)/255));
if r < 0 then r := 0; Clamp(r, 0, 255);
if r > 255 then r := 255;
Result := r; Result := r;
end; end;

65
components/mbColorLib/YColorPicker.pas
View File

@ -52,6 +52,9 @@ implementation
{$R YColorPicker.dcr} {$R YColorPicker.dcr}
{$ENDIF} {$ENDIF}
uses
mbUtils;
procedure Register; procedure Register;
begin begin
RegisterComponents('mbColor Lib', [TYColorPicker]); RegisterComponents('mbColor Lib', [TYColorPicker]);
@ -79,53 +82,6 @@ begin
FChange := true; FChange := true;
end; end;
(*
procedure TYColorPicker.CreateYGradient;
var
i,j: integer;
row: pRGBQuadArray;
begin
if FYBmp = nil then
begin
FYBmp := TBitmap.Create;
FYBmp.PixelFormat := pf32bit;
end;
if Layout = lyHorizontal then
begin
FYBmp.width := 255;
FYBmp.height := 12;
for i := 0 to 254 do
for j := 0 to 11 do
begin
row := FYBmp.Scanline[j];
if not WebSafe then
row[i] := RGBToRGBQuad(CMYKtoTColor(FCyan, FMagenta, i, FBlack))
// FYBmp.Canvas.Pixels[i, j] := CMYKtoTColor(FCyan, FMagenta, i, FBlack)
else
row[i] := RGBToRGBQuad(GetWebSafe(CMYKtoTColor(FCyan, FMagenta, i, FBlack)));
// FYBmp.Canvas.Pixels[i, j] := GetWebSafe(CMYKtoTColor(FCyan, FMagenta, i, FBlack));
end;
end
else
begin
FYBmp.width := 12;
FYBmp.height := 255;
for i := 0 to 254 do
begin
row := FYBmp.Scanline[i];
for j := 0 to 11 do
if not WebSafe then
row[j] := RGBToRGBQuad(CMYKtoTColor(FCyan, FMagenta, 255-i, FBlack))
// FYBmp.Canvas.Pixels[j, i] := CMYKtoTColor(FCyan, FMagenta, 255-i, FBlack)
else
row[j] := RGBToRGBQuad(GetWebSafe(CMYKtoTColor(FCyan, FMagenta, 255-i, FBlack)));
// FYBmp.Canvas.Pixels[j, i] := GetWebSafe(CMYKtoTColor(FCyan, FMagenta, 255-i, FBlack));
end;
end;
end;
*)
function TYColorPicker.GetGradientColor(AValue: Integer): TColor; function TYColorPicker.GetGradientColor(AValue: Integer): TColor;
begin begin
Result := CMYKtoTColor(FCyan, FMagenta, AValue, FBlack); Result := CMYKtoTColor(FCyan, FMagenta, AValue, FBlack);
@ -133,8 +89,7 @@ end;
procedure TYColorPicker.SetYellow(y: integer); procedure TYColorPicker.SetYellow(y: integer);
begin begin
if y < 0 then y := 0; Clamp(y, 0, 255);
if y > 255 then y := 255;
if FYellow <> y then if FYellow <> y then
begin begin
FYellow := y; FYellow := y;
@ -147,8 +102,7 @@ end;
procedure TYColorPicker.SetMagenta(m: integer); procedure TYColorPicker.SetMagenta(m: integer);
begin begin
if m > 255 then m := 255; Clamp(m, 0, 255);
if m < 0 then m := 0;
if FMagenta <> m then if FMagenta <> m then
begin begin
FMagenta := m; FMagenta := m;
@ -161,8 +115,7 @@ end;
procedure TYColorPicker.SetCyan(c: integer); procedure TYColorPicker.SetCyan(c: integer);
begin begin
if c > 255 then c := 255; Clamp(c, 0, 255);
if c < 0 then c := 0;
if FCyan <> c then if FCyan <> c then
begin begin
FCyan := c; FCyan := c;
@ -175,8 +128,7 @@ end;
procedure TYColorPicker.SetBlack(k: integer); procedure TYColorPicker.SetBlack(k: integer);
begin begin
if k > 255 then k := 255; Clamp(k, 0, 255);
if k < 0 then k := 0;
if FBlack <> k then if FBlack <> k then
begin begin
FBlack := k; FBlack := k;
@ -214,8 +166,7 @@ begin
r := Round(p/((Width - 12)/255)) r := Round(p/((Width - 12)/255))
else else
r := Round(255 - p/((Height - 12)/255)); r := Round(255 - p/((Height - 12)/255));
if r < 0 then r := 0; Clamp(r, 0, 255);
if r > 255 then r := 255;
Result := r; Result := r;
end; end;

1
components/mbColorLib/mbBasicPicker.pas
View File

@ -32,7 +32,6 @@ type
property ParentColor default true; property ParentColor default true;
end; end;
implementation implementation
constructor TmbBasicPicker.Create(AOwner: TComponent); constructor TmbBasicPicker.Create(AOwner: TComponent);

2
components/mbColorLib/mbTrackBarPicker.pas
View File

@ -266,7 +266,7 @@ var
{$ENDIF} {$ENDIF}
begin begin
if FGradientBmp = nil then if FGradientBmp = nil then
exit; exit;
{$IFDEF FPC} {$IFDEF FPC}
intfimg := TLazIntfImage.Create(0, 0); intfimg := TLazIntfImage.Create(0, 0);

6
components/mbColorLib/mbcolorliblaz.lpk
View File

@ -15,7 +15,7 @@
<Description Value="Comprehensive color selection library with more than 30 components"/> <Description Value="Comprehensive color selection library with more than 30 components"/>
<License Value="License is granted to use, modify and redistribute these units in your applications as you see fit. You are given COMPLETE FREEDOM with the sources found in this pack; you're free to use it in ANY kind of app without even mentioning my name, my site or any other stuff, that depends on your good will and nothing else. I will accept any modifications and incorporate them in this pack if they'll help make it better. You are under NO obligation to pay for these components to neither me nor anyone else trying to sell them in their current form. If you wish to support development of these components you can do so by contributing some source or making a donation, again this solely depends on your good will."/> <License Value="License is granted to use, modify and redistribute these units in your applications as you see fit. You are given COMPLETE FREEDOM with the sources found in this pack; you're free to use it in ANY kind of app without even mentioning my name, my site or any other stuff, that depends on your good will and nothing else. I will accept any modifications and incorporate them in this pack if they'll help make it better. You are under NO obligation to pay for these components to neither me nor anyone else trying to sell them in their current form. If you wish to support development of these components you can do so by contributing some source or making a donation, again this solely depends on your good will."/>
<Version Major="2" Release="2"/> <Version Major="2" Release="2"/>
<Files Count="44"> <Files Count="45">
<Item1> <Item1>
<Filename Value="PalUtils.pas"/> <Filename Value="PalUtils.pas"/>
<UnitName Value="PalUtils"/> <UnitName Value="PalUtils"/>
@ -223,6 +223,10 @@
<Filename Value="mbBasicPicker.pas"/> <Filename Value="mbBasicPicker.pas"/>
<UnitName Value="mbBasicPicker"/> <UnitName Value="mbBasicPicker"/>
</Item44> </Item44>
<Item45>
<Filename Value="mbutils.pas"/>
<UnitName Value="mbutils"/>
</Item45>
</Files> </Files>
<RequiredPkgs Count="2"> <RequiredPkgs Count="2">
<Item1> <Item1>

22
components/mbColorLib/mbutils.pas Normal file
View File

@ -0,0 +1,22 @@
unit mbUtils;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils;
procedure Clamp(var AValue:Integer; AMin, AMax: Integer);
implementation
procedure Clamp(var AValue: integer; AMin, AMax: integer);
begin
if AValue < AMin then AValue := AMin;
if AValue > AMax then AValue := AMax;
end;
end.