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

58
components/mbColorLib/BColorPicker.pas
View File

@ -8,7 +8,7 @@ interface
uses
{$IFDEF FPC}
LCLIntf, LCLType, LMessages,
LCLIntf, LCLType, //LMessages,
{$ELSE}
Windows, Messages,
{$ENDIF}
@ -52,6 +52,9 @@ implementation
{$R BColorPicker.dcr}
{$ENDIF}
uses
mbUtils;
procedure Register;
begin
RegisterComponents('mbColor Lib', [TBColorPicker]);
@ -81,47 +84,6 @@ begin
FChange := true;
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;
begin
Result := RGB(FRed, FGreen, AValue);
@ -129,8 +91,7 @@ end;
procedure TBColorPicker.SetRed(r: integer);
begin
if r < 0 then r := 0;
if r > 255 then r := 255;
Clamp(r, 0, 255);
if FRed <> r then
begin
FRed := r;
@ -143,8 +104,7 @@ end;
procedure TBColorPicker.SetGreen(g: integer);
begin
if g > 255 then g := 255;
if g < 0 then g := 0;
Clamp(g, 0, 255);
if FGreen <> g then
begin
FGreen := g;
@ -157,8 +117,7 @@ end;
procedure TBColorPicker.SetBlue(b: integer);
begin
if b > 255 then b := 255;
if b < 0 then b := 0;
Clamp(b, 0, 255);
if FBlue <> b then
begin
FBlue := b;
@ -196,8 +155,7 @@ begin
b := Round(p/((Width - 12)/255))
else
b := Round(255 - p/((Height - 12)/255));
if b < 0 then b := 0;
if b > 255 then b := 255;
Clamp(b, 0, 255);
Result := b;
end;

80
components/mbColorLib/CColorPicker.pas
View File

@ -22,7 +22,7 @@ type
function ArrowPosFromCyan(c: integer): integer;
function CyanFromArrowPos(p: integer): integer;
function GetSelectedColor: TColor;
procedure SetSelectedColor(c: TColor);
procedure SetSelectedColor(clr: TColor);
procedure SetCyan(c: integer);
procedure SetMagenta(m: integer);
procedure SetYellow(y: integer);
@ -51,6 +51,9 @@ implementation
{$R CColorPicker.dcr}
{$ENDIF}
uses
mbUtils;
procedure Register;
begin
RegisterComponents('mbColor Lib', [TCColorPicker]);
@ -79,48 +82,6 @@ begin
FChange := true;
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;
begin
Result := CMYKtoTColor(AValue, FMagenta, FYellow, FBlack);
@ -128,8 +89,7 @@ end;
procedure TCColorPicker.SetCyan(C: integer);
begin
if C < 0 then C := 0;
if C > 255 then C := 255;
Clamp(c, 0, 255);
if FCyan <> c then
begin
FCyan := c;
@ -142,8 +102,7 @@ end;
procedure TCColorPicker.SetMagenta(m: integer);
begin
if m > 255 then m := 255;
if m < 0 then m := 0;
Clamp(m, 0, 255);
if FMagenta <> m then
begin
FMagenta := m;
@ -156,8 +115,7 @@ end;
procedure TCColorPicker.SetYellow(y: integer);
begin
if y > 255 then y := 255;
if y < 0 then y := 0;
Clamp(y, 0, 255);
if FYellow <> y then
begin
FYellow := y;
@ -170,8 +128,7 @@ end;
procedure TCColorPicker.SetBlack(k: integer);
begin
if k > 255 then k := 255;
if k < 0 then k := 0;
Clamp(k, 0, 255);
if FBlack <> k then
begin
FBlack := k;
@ -203,15 +160,14 @@ end;
function TCColorPicker.CyanFromArrowPos(p: integer): integer;
var
r: integer;
c: integer;
begin
if Layout = lyHorizontal then
r := Round(p/((Width - 12)/255))
c := Round(p/((Width - 12)/255))
else
r := Round(255 - p/((Height - 12)/255));
if r < 0 then r := 0;
if r > 255 then r := 255;
Result := r;
c := Round(255 - p/((Height - 12)/255));
Clamp(c, 0, 255);
Result := c;
end;
function TCColorPicker.GetSelectedColor: TColor;
@ -227,17 +183,17 @@ begin
Result := FCyan;
end;
procedure TCColorPicker.SetSelectedColor(c: TColor);
procedure TCColorPicker.SetSelectedColor(clr: TColor);
var
cy, m, y, k: integer;
c, m, y, k: integer;
begin
if WebSafe then c := GetWebSafe(c);
ColorToCMYK(c, cy, m, y, k);
if WebSafe then clr := GetWebSafe(clr);
ColorToCMYK(clr, c, m, y, k);
FChange := false;
SetMagenta(m);
SetYellow(y);
SetBlack(k);
SetCyan(cy);
SetCyan(c);
FManual := false;
FChange := true;
if Assigned(OnChange) then OnChange(Self);

59
components/mbColorLib/GColorPicker.pas
View File

@ -47,6 +47,9 @@ implementation
{$R GColorPicker.dcr}
{$ENDIF}
uses
mbUtils;
procedure Register;
begin
RegisterComponents('mbColor Lib', [TGColorPicker]);
@ -74,50 +77,6 @@ begin
FChange := true;
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;
begin
Result := RGB(FRed, AValue, FBlue);
@ -125,8 +84,7 @@ end;
procedure TGColorPicker.SetRed(r: integer);
begin
if r < 0 then r := 0;
if r > 255 then r := 255;
Clamp(r, 0, 255);
if FRed <> r then
begin
FRed := r;
@ -139,8 +97,7 @@ end;
procedure TGColorPicker.SetGreen(g: integer);
begin
if g > 255 then g := 255;
if g < 0 then g := 0;
Clamp(g, 0, 255);
if FGreen <> g then
begin
FGreen := g;
@ -153,8 +110,7 @@ end;
procedure TGColorPicker.SetBlue(b: integer);
begin
if b > 255 then b := 255;
if b < 0 then b := 0;
Clamp(b, 0, 255);
if FBlue <> b then
begin
FBlue := b;
@ -192,8 +148,7 @@ begin
g := Round(p/((Width - 12)/255))
else
g := Round(255 - p/((Height - 12)/255));
if g < 0 then g := 0;
if g > 255 then g := 255;
Clamp(g, 0, 255);
Result := g;
end;

59
components/mbColorLib/HColorPicker.pas
View File

@ -48,6 +48,9 @@ implementation
{$R HColorPicker.dcr}
{$ENDIF}
uses
mbUtils;
procedure Register;
begin
RegisterComponents('mbColor Lib', [THColorPicker]);
@ -73,50 +76,6 @@ begin
FChange := true;
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;
begin
Result := HSVtoColor(AValue, FSat, FVal);
@ -124,8 +83,7 @@ end;
procedure THColorPicker.SetValue(v: integer);
begin
if v < 0 then v := 0;
if v > 255 then v := 255;
Clamp(v, 0, 255);
if FVal <> v then
begin
FVal := v;
@ -138,8 +96,7 @@ end;
procedure THColorPicker.SetHue(h: integer);
begin
if h > 360 then h := 360;
if h < 0 then h := 0;
Clamp(h, 0, 360);
if FHue <> h then
begin
FHue := h;
@ -152,8 +109,7 @@ end;
procedure THColorPicker.SetSat(s: integer);
begin
if s > 255 then s := 255;
if s < 0 then s := 0;
Clamp(s, 0, 255);
if FSat <> s then
begin
FSat := s;
@ -190,8 +146,7 @@ begin
r := Round(p/((Width - 12)/360))
else
r := Round(p/((Height - 12)/360));
if r < 0 then r := 0;
if r > 360 then r := 360;
Clamp(r, 0, 360);
Result := r;
end;

72
components/mbColorLib/KColorPicker.pas
View File

@ -51,6 +51,9 @@ implementation
{$R KColorPicker.dcr}
{$ENDIF}
uses
mbUtils;
procedure Register;
begin
RegisterComponents('mbColor Lib', [TKColorPicker]);
@ -79,52 +82,6 @@ begin
FChange := true;
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;
begin
Result := CMYKtoTColor(FCyan, FMagenta, FYellow, AValue);
@ -132,8 +89,7 @@ end;
procedure TKColorPicker.SetBlack(k: integer);
begin
if k < 0 then k := 0;
if k > 255 then k := 255;
Clamp(k, 0, 255);
if FBlack <> k then
begin
FBlack := k;
@ -146,8 +102,7 @@ end;
procedure TKColorPicker.SetMagenta(m: integer);
begin
if m > 255 then m := 255;
if m < 0 then m := 0;
Clamp(m, 0, 255);
if FMagenta <> m then
begin
FMagenta := m;
@ -160,8 +115,7 @@ end;
procedure TKColorPicker.SetYellow(y: integer);
begin
if y > 255 then y := 255;
if y < 0 then y := 0;
Clamp(y, 0, 255);
if FYellow <> y then
begin
FYellow := y;
@ -174,8 +128,7 @@ end;
procedure TKColorPicker.SetCyan(c: integer);
begin
if c > 255 then c := 255;
if c < 0 then c := 0;
Clamp(c, 0, 255);
if FCyan <> c then
begin
FCyan := c;
@ -207,15 +160,14 @@ end;
function TKColorPicker.BlackFromArrowPos(p: integer): integer;
var
r: integer;
k: integer;
begin
if Layout = lyHorizontal then
r := Round(p/((Width - 12)/255))
k := Round(p/((Width - 12)/255))
else
r := Round(255 - p/((Height - 12)/255));
if r < 0 then r := 0;
if r > 255 then r := 255;
Result := r;
k := Round(255 - p/((Height - 12)/255));
Clamp(k, 0, 255);
Result := k;
end;
function TKColorPicker.GetSelectedColor: TColor;

78
components/mbColorLib/LColorPicker.pas
View File

@ -49,6 +49,9 @@ implementation
{$R LColorPicker.dcr}
{$ENDIF}
uses
mbUtils;
procedure Register;
begin
RegisterComponents('mbColor Lib', [TLColorPicker]);
@ -61,6 +64,7 @@ begin
inherited;
FGradientWidth := 256;
FGradientHeight := 12;
SetInitialBounds(0, 0, 22, 267);
Layout := lyVertical;
FHue := 0;
FSat := MaxSat;
@ -72,52 +76,6 @@ begin
FChange := true;
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;
begin
Result := HSLRangeToRGB(FHue, FSat, AValue);
@ -125,8 +83,7 @@ end;
procedure TLColorPicker.SetHue(h: integer);
begin
if h > MaxHue then h := MaxHue;
if h < 0 then h := 0;
Clamp(h, 0, MaxHue);
if FHue <> h then
begin
FHue := h;
@ -139,8 +96,7 @@ end;
procedure TLColorPicker.SetSat(s: integer);
begin
if s > MaxSat then s := MaxSat;
if s < 0 then s := 0;
Clamp(s, 0, MaxSat);
if FSat <> s then
begin
FSat := s;
@ -172,25 +128,23 @@ end;
function TLColorPicker.LumFromArrowPos(p: integer): integer;
var
r: integer;
L: integer;
begin
if Layout = lyHorizontal then
r := Round(p/((Width - 12)/MaxLum))
L := Round(p/((Width - 12)/MaxLum))
else
r := Round(MaxLum - p/((Height - 12)/MaxLum));
if r < 0 then r := 0;
if r > MaxLum then r := MaxLum;
Result := r;
L := Round(MaxLum - p/((Height - 12)/MaxLum));
Clamp(L, 0, MaxLum);
Result := L;
end;
procedure TLColorPicker.SetLuminance(l: integer);
procedure TLColorPicker.SetLuminance(L: integer);
begin
if l < 0 then l := 0;
if l > MaxLum then l := MaxLum;
if FLuminance <> l then
Clamp(L, 0, MaxLum);
if FLuminance <> L then
begin
FLuminance := l;
FArrowPos := ArrowPosFromLum(l);
FLuminance := L;
FArrowPos := ArrowPosFromLum(L);
FManual := false;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);

77
components/mbColorLib/MColorPicker.pas
View File

@ -51,6 +51,9 @@ implementation
{$R MColorPicker.dcr}
{$ENDIF}
uses
mbUtils;
procedure Register;
begin
RegisterComponents('mbColor Lib', [TMColorPicker]);
@ -63,8 +66,9 @@ begin
inherited;
FGradientWidth := 256;
FGradientHeight := 12;
Width := 22;
Height := 267;
// Width := 22;
// Height := 267;
SetInitialBounds(0, 0, 22, 267);
Layout := lyVertical;
FCyan := 0;
FMagenta := 255;
@ -78,51 +82,7 @@ begin
FChange := true;
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;
begin
Result := CMYKtoTColor(FCyan, AValue, FYellow, FBlack);
@ -130,8 +90,7 @@ end;
procedure TMColorPicker.SetMagenta(m: integer);
begin
if M < 0 then M := 0;
if M > 255 then M := 255;
Clamp(m, 0, 255);
if FMagenta <> m then
begin
FMagenta := m;
@ -144,8 +103,7 @@ end;
procedure TMColorPicker.SetCyan(c: integer);
begin
if c > 255 then c := 255;
if c < 0 then c := 0;
Clamp(c, 0, 255);
if FCyan <> c then
begin
FCyan := c;
@ -158,8 +116,7 @@ end;
procedure TMColorPicker.SetYellow(y: integer);
begin
if y > 255 then y := 255;
if y < 0 then y := 0;
Clamp(y, 0, 255);
if FYellow <> y then
begin
FYellow := y;
@ -172,8 +129,7 @@ end;
procedure TMColorPicker.SetBlack(k: integer);
begin
if k > 255 then k := 255;
if k < 0 then k := 0;
Clamp(k, 0, 255);
if FBlack <> k then
begin
FBlack := k;
@ -205,15 +161,14 @@ end;
function TMColorPicker.MagentaFromArrowPos(p: integer): integer;
var
r: integer;
m: integer;
begin
if Layout = lyHorizontal then
r := Round(p/((Width - 12)/255))
m := Round(p/((Width - 12)/255))
else
r := Round(255 - p/((Height - 12)/255));
if r < 0 then r := 0;
if r > 255 then r := 255;
Result := r;
m := Round(255 - p/((Height - 12)/255));
Clamp(m, 0, 255);
Result := m;
end;
function TMColorPicker.GetSelectedColor: TColor;

65
components/mbColorLib/RColorPicker.pas
View File

@ -52,6 +52,9 @@ implementation
{$R RColorPicker.dcr}
{$ENDIF}
uses
mbUtils;
procedure Register;
begin
RegisterComponents('mbColor Lib', [TRColorPicker]);
@ -64,8 +67,9 @@ begin
inherited;
FGradientWidth := 256;
FGradientHeight := 12;
Width := 22;
Height := 268;
SetInitialBounds(0, 0, 22, 268);
// Width := 22;
// Height := 268;
Layout := lyVertical;
FRed := 255;
FGreen := 122;
@ -78,51 +82,6 @@ begin
FChange := true;
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;
begin
Result := RGB(AValue, FGreen, FBlue);
@ -130,8 +89,7 @@ end;
procedure TRColorPicker.SetRed(r: integer);
begin
if r < 0 then r := 0;
if r > 255 then r := 255;
Clamp(r, 0, 255);
if FRed <> r then
begin
FRed := r;
@ -144,8 +102,7 @@ end;
procedure TRColorPicker.SetGreen(g: integer);
begin
if g > 255 then g := 255;
if g < 0 then g := 0;
Clamp(g, 0, 255);
if FGreen <> g then
begin
FGreen := g;
@ -158,8 +115,7 @@ end;
procedure TRColorPicker.SetBlue(b: integer);
begin
if b > 255 then b := 255;
if b < 0 then b := 0;
Clamp(b, 0, 255);
if FBlue <> b then
begin
FBlue := b;
@ -197,8 +153,7 @@ begin
r := Round(p/((Width - 12)/255))
else
r := Round(255 - p/((Height - 12)/255));
if r < 0 then r := 0;
if r > 255 then r := 255;
Clamp(r, 0, 255);
Result := r;
end;

7
components/mbColorLib/RGBHSVUtils.pas
View File

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

15
components/mbColorLib/SColorPicker.pas
View File

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

65
components/mbColorLib/YColorPicker.pas
View File

@ -52,6 +52,9 @@ implementation
{$R YColorPicker.dcr}
{$ENDIF}
uses
mbUtils;
procedure Register;
begin
RegisterComponents('mbColor Lib', [TYColorPicker]);
@ -79,53 +82,6 @@ begin
FChange := true;
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;
begin
Result := CMYKtoTColor(FCyan, FMagenta, AValue, FBlack);
@ -133,8 +89,7 @@ end;
procedure TYColorPicker.SetYellow(y: integer);
begin
if y < 0 then y := 0;
if y > 255 then y := 255;
Clamp(y, 0, 255);
if FYellow <> y then
begin
FYellow := y;
@ -147,8 +102,7 @@ end;
procedure TYColorPicker.SetMagenta(m: integer);
begin
if m > 255 then m := 255;
if m < 0 then m := 0;
Clamp(m, 0, 255);
if FMagenta <> m then
begin
FMagenta := m;
@ -161,8 +115,7 @@ end;
procedure TYColorPicker.SetCyan(c: integer);
begin
if c > 255 then c := 255;
if c < 0 then c := 0;
Clamp(c, 0, 255);
if FCyan <> c then
begin
FCyan := c;
@ -175,8 +128,7 @@ end;
procedure TYColorPicker.SetBlack(k: integer);
begin
if k > 255 then k := 255;
if k < 0 then k := 0;
Clamp(k, 0, 255);
if FBlack <> k then
begin
FBlack := k;
@ -214,8 +166,7 @@ begin
r := Round(p/((Width - 12)/255))
else
r := Round(255 - p/((Height - 12)/255));
if r < 0 then r := 0;
if r > 255 then r := 255;
Clamp(r, 0, 255);
Result := r;
end;

1
components/mbColorLib/mbBasicPicker.pas
View File

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

6
components/mbColorLib/mbcolorliblaz.lpk
View File

@ -15,7 +15,7 @@
<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."/>
<Version Major="2" Release="2"/>
<Files Count="44">
<Files Count="45">
<Item1>
<Filename Value="PalUtils.pas"/>
<UnitName Value="PalUtils"/>
@ -223,6 +223,10 @@
<Filename Value="mbBasicPicker.pas"/>
<UnitName Value="mbBasicPicker"/>
</Item44>
<Item45>
<Filename Value="mbutils.pas"/>
<UnitName Value="mbutils"/>
</Item45>
</Files>
<RequiredPkgs Count="2">
<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.