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

mbColorLib: Beginning to remove Delphi support. Cleanup.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5547 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2016-12-20 00:01:53 +00:00
parent 6b7ac652ec
commit 931211381c
14 changed files with 724 additions and 959 deletions
Download Patch File Download Diff File Expand all files Collapse all files

218
components/mbColorLib/BAxisColorPicker.pas
View File

@ -7,11 +7,7 @@ unit BAxisColorPicker;
interface
uses
{$IFDEF FPC}
LCLIntf, LCLType, LMessages,
{$ELSE}
Windows, Messages,
{$ENDIF}
SysUtils, Classes, Controls, Graphics, Math, Forms,
HTMLColors, mbColorPickerControl;
@ -28,10 +24,6 @@ type
procedure CreateWnd; override;
procedure DrawMarker(x, y: integer);
function GetGradientColor2D(x, y: Integer): TColor; override;
(*
procedure CNKeyDown(var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF});
message CN_KEYDOWN;
*)
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
@ -50,11 +42,13 @@ type
property OnChange;
end;
implementation
uses
mbUtils;
{TBAxisColorPicker}
constructor TBAxisColorPicker.Create(AOwner: TComponent);
@ -62,12 +56,7 @@ begin
inherited;
FGradientWidth := 256;
FGradientHeight := 256;
{$IFDEF DELPHI}
Width := 256;
Height := 256;
{$ELSE}
SetInitialBounds(0, 0, 255, 255);
{$ENDIF}
HintFormat := 'R: %r G: %g'#13'Hex: %hex';
FG := 0;
FB := 255;
@ -116,35 +105,6 @@ begin
Result := RGB(x, FBufferBmp.Height - 1 - y, FB);
end;
procedure TBAxisColorPicker.Paint;
begin
Canvas.StretchDraw(ClientRect, FBufferBmp);
CorrectCoords(mxx, myy);
DrawMarker(mxx, myy);
end;
procedure TBAxisColorPicker.Resize;
begin
FManual := false;
mxx := round(FR * (Width / 255));
myy := round((255 - FG) * (Height / 255));
inherited;
end;
procedure TBAxisColorPicker.SetSelectedColor(c: TColor);
begin
if WebSafe then c := GetWebSafe(c);
FR := GetRValue(c);
FG := GetGValue(c);
FB := GetBValue(c);
FSelected := c;
FManual := false;
mxx := Round(FR*(Width/255));
myy := Round((255-FG)*(Height/255));
Invalidate;
if Assigned(FOnChange) then FOnChange(self);
end;
procedure TBAxisColorPicker.KeyDown(var Key: Word; Shift: TShiftState);
var
eraseKey: Boolean;
@ -204,20 +164,12 @@ end;
procedure TBAxisColorPicker.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
var
R: TRect;
begin
inherited;
mxx := x;
myy := y;
if Button = mbLeft then
begin
{$IFDEF DELPHI}
R := ClientRect;
R.TopLeft := ClientToScreen(R.TopLeft);
R.BottomRight := ClientToScreen(R.BottomRight);
ClipCursor(@R);
{$ENDIF}
FSelected := GetColorAtPoint(x, y);
FManual := true;
Invalidate;
@ -225,23 +177,6 @@ begin
SetFocus;
end;
procedure TBAxisColorPicker.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
inherited;
{$IFDEF DELPHI}
ClipCursor(nil);
{$ENDIF}
if ssLeft in Shift then
begin
mxx := x;
myy := y;
FSelected := GetColorAtPoint(x, y);
FManual := true;
Invalidate;
if Assigned(FOnChange) then FOnChange(self);
end;
end;
procedure TBAxisColorPicker.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
inherited;
@ -255,108 +190,40 @@ begin
if Assigned(FOnChange) then FOnChange(self);
end;
end;
(*
procedure TBAxisColorPicker.CNKeyDown(
var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF} );
var
Shift: TShiftState;
FInherited: boolean;
procedure TBAxisColorPicker.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
FInherited := false;
Shift := KeyDataToShiftState(Message.KeyData);
if not (ssCtrl in Shift) then
case Message.CharCode of
VK_LEFT:
begin
mxx := dx - 1;
myy := dy;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
end;
VK_RIGHT:
begin
mxx := dx + 1;
myy := dy;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
end;
VK_UP:
begin
mxx := dx;
myy := dy - 1;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
end;
VK_DOWN:
begin
mxx := dx;
myy := dy + 1;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
end;
else
begin
FInherited := true;
inherited;
end;
end
else
case Message.CharCode of
VK_LEFT:
begin
mxx := dx - 10;
myy := dy;
Refresh;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
end;
VK_RIGHT:
begin
mxx := dx + 10;
myy := dy;
Refresh;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
end;
VK_UP:
begin
mxx := dx;
myy := dy - 10;
Refresh;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
end;
VK_DOWN:
begin
mxx := dx;
myy := dy + 10;
Refresh;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
end;
else
begin
FInherited := true;
inherited;
end;
inherited;
if ssLeft in Shift then
begin
mxx := x;
myy := y;
FSelected := GetColorAtPoint(x, y);
FManual := true;
Invalidate;
if Assigned(FOnChange) then FOnChange(self);
end;
if not FInherited then
if Assigned(OnKeyDown) then
OnKeyDown(Self, Message.CharCode, Shift);
end;
*)
procedure TBAxisColorPicker.SetRValue(r: integer);
procedure TBAxisColorPicker.Paint;
begin
Clamp(r, 0, 255);
FR := r;
Canvas.StretchDraw(ClientRect, FBufferBmp);
CorrectCoords(mxx, myy);
DrawMarker(mxx, myy);
end;
procedure TBAxisColorPicker.Resize;
begin
FManual := false;
mxx := round(FR * (Width / 255));
myy := round((255 - FG) * (Height / 255));
inherited;
end;
procedure TBAxisColorPicker.SetBValue(b: integer);
begin
Clamp(b, 0, 255);
FB := b;
SetSelectedColor(RGB(FR, FG, FB));
end;
@ -367,11 +234,26 @@ begin
SetSelectedColor(RGB(FR, FG, FB));
end;
procedure TBAxisColorPicker.SetBValue(b: integer);
procedure TBAxisColorPicker.SetRValue(r: integer);
begin
Clamp(b, 0, 255);
FB := b;
Clamp(r, 0, 255);
FR := r;
SetSelectedColor(RGB(FR, FG, FB));
end;
procedure TBAxisColorPicker.SetSelectedColor(c: TColor);
begin
if WebSafe then c := GetWebSafe(c);
FR := GetRValue(c);
FG := GetGValue(c);
FB := GetBValue(c);
FSelected := c;
FManual := false;
mxx := Round(FR*(Width/255));
myy := Round((255-FG)*(Height/255));
Invalidate;
if Assigned(FOnChange) then FOnChange(self);
end;
end.

170
components/mbColorLib/BColorPicker.pas
View File

@ -7,13 +7,9 @@ unit BColorPicker;
interface
uses
{$IFDEF FPC}
LCLIntf, LCLType, //LMessages,
{$ELSE}
Windows, Messages,
{$ENDIF}
LCLIntf, LCLType,
SysUtils, Classes, Controls, Graphics, Forms,
mbTrackBarPicker, HTMLColors;
HTMLColors, mbTrackBarPicker;
type
@ -25,10 +21,10 @@ type
function ArrowPosFromBlue(b: integer): integer;
function BlueFromArrowPos(p: integer): integer;
function GetSelectedColor: TColor;
procedure SetSelectedColor(c: TColor);
procedure SetRed(r: integer);
procedure SetGreen(g: integer);
procedure SetBlue(b: integer);
procedure SetGreen(g: integer);
procedure SetRed(r: integer);
procedure SetSelectedColor(c: TColor);
protected
procedure Execute(tbaAction: integer); override;
function GetArrowPos: integer; override;
@ -37,9 +33,9 @@ type
public
constructor Create(AOwner: TComponent); override;
published
property Red: integer read FRed write SetRed default 128;
property Green: integer read FGreen write SetGreen default 128;
property Blue: integer read FBlue write SetBlue default 255;
property Green: integer read FGreen write SetGreen default 128;
property Red: integer read FRed write SetRed default 128;
property SelectedColor: TColor read GetSelectedColor write SetSelectedColor default clRed;
property Layout default lyVertical;
end;
@ -70,50 +66,6 @@ begin
FChange := true;
end;
function TBColorPicker.GetGradientColor(AValue: Integer): TColor;
begin
Result := RGB(FRed, FGreen, AValue);
end;
procedure TBColorPicker.SetRed(r: integer);
begin
Clamp(r, 0, 255);
if FRed <> r then
begin
FRed := r;
FManual := false;
CreateGradient;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
end;
end;
procedure TBColorPicker.SetGreen(g: integer);
begin
Clamp(g, 0, 255);
if FGreen <> g then
begin
FGreen := g;
FManual := false;
CreateGradient;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
end;
end;
procedure TBColorPicker.SetBlue(b: integer);
begin
Clamp(b, 0, 255);
if FBlue <> b then
begin
FBlue := b;
FArrowPos := ArrowPosFromBlue(b);
FManual := false;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
end;
end;
function TBColorPicker.ArrowPosFromBlue(b: integer): integer;
var
a: integer;
@ -138,43 +90,13 @@ var
b: integer;
begin
if Layout = lyHorizontal then
b := Round(p/((Width - 12)/255))
b := Round(p / (Width - 12) * 255)
else
b := Round(255 - p/((Height - 12)/255));
b := Round(255 - p / (Height - 12) * 255);
Clamp(b, 0, 255);
Result := b;
end;
function TBColorPicker.GetSelectedColor: TColor;
begin
if not WebSafe then
Result := RGB(FRed, FGreen, FBlue)
else
Result := GetWebSafe(RGB(FRed, FGreen, FBlue));
end;
function TBColorPicker.GetSelectedValue: integer;
begin
Result := FBlue;
end;
procedure TBColorPicker.SetSelectedColor(c: TColor);
begin
if WebSafe then c := GetWebSafe(c);
FChange := false;
SetRed(GetRValue(c));
SetGreen(GetGValue(c));
SetBlue(GetBValue(c));
FManual := false;
FChange := true;
if Assigned(OnChange) then OnChange(Self);
end;
function TBColorPicker.GetArrowPos: integer;
begin
Result := ArrowPosFromBlue(FBlue);
end;
procedure TBColorPicker.Execute(tbaAction: integer);
begin
case tbaAction of
@ -211,4 +133,78 @@ begin
end;
end;
function TBColorPicker.GetArrowPos: integer;
begin
Result := ArrowPosFromBlue(FBlue);
end;
function TBColorPicker.GetGradientColor(AValue: Integer): TColor;
begin
Result := RGB(FRed, FGreen, AValue);
end;
function TBColorPicker.GetSelectedColor: TColor;
begin
if not WebSafe then
Result := RGB(FRed, FGreen, FBlue)
else
Result := GetWebSafe(RGB(FRed, FGreen, FBlue));
end;
function TBColorPicker.GetSelectedValue: integer;
begin
Result := FBlue;
end;
procedure TBColorPicker.SetBlue(b: integer);
begin
Clamp(b, 0, 255);
if FBlue <> b then
begin
FBlue := b;
FArrowPos := ArrowPosFromBlue(b);
FManual := false;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
end;
end;
procedure TBColorPicker.SetGreen(g: integer);
begin
Clamp(g, 0, 255);
if FGreen <> g then
begin
FGreen := g;
FManual := false;
CreateGradient;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
end;
end;
procedure TBColorPicker.SetRed(r: integer);
begin
Clamp(r, 0, 255);
if FRed <> r then
begin
FRed := r;
FManual := false;
CreateGradient;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
end;
end;
procedure TBColorPicker.SetSelectedColor(c: TColor);
begin
if WebSafe then c := GetWebSafe(c);
FChange := false;
SetRed(GetRValue(c));
SetGreen(GetGValue(c));
SetBlue(GetBValue(c));
FManual := false;
FChange := true;
if Assigned(OnChange) then OnChange(Self);
end;
end.

181
components/mbColorLib/CColorPicker.pas
View File

@ -7,11 +7,7 @@ unit CColorPicker;
interface
uses
{$IFDEF FPC}
LCLIntf, LCLType,
{$ELSE}
Windows, Messages,
{$ENDIF}
SysUtils, Classes, Controls, Graphics, Forms,
RGBCMYKUtils, mbTrackBarPicker, HTMLColors;
@ -22,11 +18,11 @@ type
function ArrowPosFromCyan(c: integer): integer;
function CyanFromArrowPos(p: integer): integer;
function GetSelectedColor: TColor;
procedure SetSelectedColor(clr: TColor);
procedure SetBlack(k: integer);
procedure SetCyan(c: integer);
procedure SetMagenta(m: integer);
procedure SetSelectedColor(clr: TColor);
procedure SetYellow(y: integer);
procedure SetBlack(k: integer);
protected
procedure Execute(tbaAction: integer); override;
function GetArrowPos: integer; override;
@ -35,14 +31,15 @@ type
public
constructor Create(AOwner: TComponent); override;
published
property Black: integer read FBlack write SetBlack default 0;
property Cyan: integer read FCyan write SetCyan default 255;
property Magenta: integer read FMagenta write SetMagenta default 0;
property Yellow: integer read FYellow write SetYellow default 0;
property Black: integer read FBlack write SetBlack default 0;
property SelectedColor: TColor read GetSelectedColor write SetSelectedColor default clRed;
property Layout default lyVertical;
end;
implementation
uses
@ -68,11 +65,96 @@ begin
FChange := true;
end;
function TCColorPicker.ArrowPosFromCyan(c: integer): integer;
var
a: integer;
begin
if Layout = lyHorizontal then
begin
a := Round(((Width - 12)/255)*c);
if a > Width - FLimit then a := Width - FLimit;
end
else
begin
c := 255 - c;
a := Round(((Height - 12)/255)*c);
if a > Height - FLimit then a := Height - FLimit;
end;
if a < 0 then a := 0;
Result := a;
end;
function TCColorPicker.CyanFromArrowPos(p: integer): integer;
var
c: integer;
begin
if Layout = lyHorizontal then
c := Round(p/((Width - 12)/255))
else
c := Round(255 - p/((Height - 12)/255));
Clamp(c, 0, 255);
Result := c;
end;
procedure TCColorPicker.Execute(tbaAction: integer);
begin
case tbaAction of
TBA_Resize:
SetCyan(FCyan);
TBA_MouseMove:
FCyan := CyanFromArrowPos(FArrowPos);
TBA_MouseDown:
FCyan := CyanFromArrowPos(FArrowPos);
TBA_MouseUp:
FCyan := CyanFromArrowPos(FArrowPos);
TBA_WheelUp:
SetCyan(FCyan + Increment);
TBA_WheelDown:
SetCyan(FCyan - Increment);
TBA_VKRight:
SetCyan(FCyan + Increment);
TBA_VKCtrlRight:
SetCyan(255);
TBA_VKLeft:
SetCyan(FCyan - Increment);
TBA_VKCtrlLeft:
SetCyan(0);
TBA_VKUp:
SetCyan(FCyan + Increment);
TBA_VKCtrlUp:
SetCyan(255);
TBA_VKDown:
SetCyan(FCyan - Increment);
TBA_VKCtrlDown:
SetCyan(0);
else
inherited;
end;
end;
function TCColorPicker.GetArrowPos: integer;
begin
Result := ArrowPosFromCyan(FCyan);
end;
function TCColorPicker.GetGradientColor(AValue: Integer): TColor;
begin
Result := CMYKtoColor(AValue, FMagenta, FYellow, FBlack);
end;
procedure TCColorPicker.SetBlack(k: integer);
begin
Clamp(k, 0, 255);
if FBlack <> k then
begin
FBlack := k;
FManual := false;
CreateGradient;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
end;
end;
procedure TCColorPicker.SetCyan(C: integer);
begin
Clamp(c, 0, 255);
@ -112,50 +194,6 @@ begin
end;
end;
procedure TCColorPicker.SetBlack(k: integer);
begin
Clamp(k, 0, 255);
if FBlack <> k then
begin
FBlack := k;
FManual := false;
CreateGradient;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
end;
end;
function TCColorPicker.ArrowPosFromCyan(c: integer): integer;
var
a: integer;
begin
if Layout = lyHorizontal then
begin
a := Round(((Width - 12)/255)*c);
if a > Width - FLimit then a := Width - FLimit;
end
else
begin
c := 255 - c;
a := Round(((Height - 12)/255)*c);
if a > Height - FLimit then a := Height - FLimit;
end;
if a < 0 then a := 0;
Result := a;
end;
function TCColorPicker.CyanFromArrowPos(p: integer): integer;
var
c: integer;
begin
if Layout = lyHorizontal then
c := Round(p/((Width - 12)/255))
else
c := Round(255 - p/((Height - 12)/255));
Clamp(c, 0, 255);
Result := c;
end;
function TCColorPicker.GetSelectedColor: TColor;
begin
Result := CMYKtoColor(FCyan, FMagenta, FYellow, FBlack);
@ -187,45 +225,4 @@ begin
FChange := true;
end;
function TCColorPicker.GetArrowPos: integer;
begin
Result := ArrowPosFromCyan(FCyan);
end;
procedure TCColorPicker.Execute(tbaAction: integer);
begin
case tbaAction of
TBA_Resize:
SetCyan(FCyan);
TBA_MouseMove:
FCyan := CyanFromArrowPos(FArrowPos);
TBA_MouseDown:
FCyan := CyanFromArrowPos(FArrowPos);
TBA_MouseUp:
FCyan := CyanFromArrowPos(FArrowPos);
TBA_WheelUp:
SetCyan(FCyan + Increment);
TBA_WheelDown:
SetCyan(FCyan - Increment);
TBA_VKRight:
SetCyan(FCyan + Increment);
TBA_VKCtrlRight:
SetCyan(255);
TBA_VKLeft:
SetCyan(FCyan - Increment);
TBA_VKCtrlLeft:
SetCyan(0);
TBA_VKUp:
SetCyan(FCyan + Increment);
TBA_VKCtrlUp:
SetCyan(255);
TBA_VKDown:
SetCyan(FCyan - Increment);
TBA_VKCtrlDown:
SetCyan(0);
else
inherited;
end;
end;
end.

212
components/mbColorLib/CIEAColorPicker.pas
View File

@ -7,11 +7,7 @@ unit CIEAColorPicker;
interface
uses
{$IFDEF FPC}
LCLIntf, LCLType, LMessages,
{$ELSE}
Windows, Messages,
{$ENDIF}
SysUtils, Classes, Controls, Graphics, Math, Forms,
HTMLColors, RGBCIEUtils, mbColorPickerControl;
@ -28,13 +24,9 @@ type
procedure CreateWnd; override;
procedure DrawMarker(x, y: integer);
function GetGradientColor2D(x, y: Integer): TColor; override;
(*
procedure CNKeyDown(var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF});
message CN_KEYDOWN;
*)
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure Paint; override;
procedure Resize; override;
@ -56,25 +48,14 @@ implementation
uses
mbUtils;
{TCIEAColorPicker}
constructor TCIEAColorPicker.Create(AOwner: TComponent);
begin
inherited;
{
FBmp := TBitmap.Create;
FBmp.PixelFormat := pf32bit;
FBmp.SetSize(256, 256);
}
FGradientWidth := 256;
FGradientHeight := 256;
{$IFDEF DELPHI}
Width := 256;
Height := 256;
{$ELSE}
SetInitialBounds(0, 0, 256, 256);
{$ENDIF}
HintFormat := 'L: %cieL B: %cieB'#13'Hex: %hex';
FSelected := clFuchsia;
FL := 100;
@ -88,25 +69,18 @@ begin
MarkerStyle := msCircle;
end;
procedure TCIEAColorPicker.CreateWnd;
begin
inherited;
CreateGradient;
end;
// In the original code: for L ... for B ... LabToRGB(Round(100-L*100/255), FA, B-128);
// --> x is B, y is L
function TCIEAColorPicker.GetGradientColor2D(x, y: Integer): TColor;
begin
Result := LabToRGB(Round(100 - y*100/255), FA, x - 128);
end;
procedure TCIEAColorPicker.CorrectCoords(var x, y: integer);
begin
Clamp(x, 0, Width - 1);
Clamp(y, 0, Height - 1);
end;
procedure TCIEAColorPicker.CreateWnd;
begin
inherited;
CreateGradient;
end;
procedure TCIEAColorPicker.DrawMarker(x, y: integer);
var
c: TColor;
@ -124,91 +98,11 @@ begin
InternalDrawMarker(x, y, c);
end;
procedure TCIEAColorPicker.SetSelectedColor(c: TColor);
// In the original code: for L ... for B ... LabToRGB(Round(100-L*100/255), FA, B-128);
// --> x is B, y is L
function TCIEAColorPicker.GetGradientColor2D(x, y: Integer): TColor;
begin
if WebSafe then c := GetWebSafe(c);
FL := Round(GetCIELValue(c));
FA := Round(GetCIEAValue(c));
FB := Round(GetCIEBValue(c));
FSelected := c;
FManual := false;
mxx := Round((FB + 128) * Width / 255);
myy := Round((100 - FL) * 255 / 100 * Height / 255);
Invalidate;
if Assigned(FOnChange) then
FOnChange(Self);
end;
procedure TCIEAColorPicker.Paint;
begin
Canvas.StretchDraw(ClientRect, FBufferBmp);
CorrectCoords(mxx, myy);
DrawMarker(mxx, myy);
end;
procedure TCIEAColorPicker.Resize;
begin
FManual := false;
mxx := Round((FB + 128) * Width / 255);
myy := Round(((100 - FL) * 255 / 100) * Height / 255);
inherited;
end;
procedure TCIEAColorPicker.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
R: TRect;
begin
inherited;
mxx := x;
myy := y;
if Button = mbLeft then
begin
{$IFDEF DELPHI}
R := ClientRect;
R.TopLeft := ClientToScreen(R.TopLeft);
R.BottomRight := ClientToScreen(R.BottomRight);
ClipCursor(@R);
{$ENDIF}
FSelected := GetColorAtPoint(x, y);
FManual := true;
Invalidate;
if Assigned(FOnChange) then
FOnChange(Self);
end;
SetFocus;
end;
procedure TCIEAColorPicker.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
inherited;
{$IFDEF DELPHI}
ClipCursor(nil);
{$ENDIF}
if ssLeft in Shift then
begin
mxx := x;
myy := y;
FSelected := GetColorAtPoint(x, y);
FManual := true;
Invalidate;
if Assigned(FOnChange) then
FOnChange(Self);
end;
end;
procedure TCIEAColorPicker.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
inherited;
if ssLeft in Shift then
begin
mxx := x;
myy := y;
FSelected := GetColorAtPoint(x, y);
FManual := true;
Invalidate;
if Assigned(FOnChange) then
FOnChange(Self);
end;
Result := LabToRGB(Round(100 - y*100/255), FA, x - 128);
end;
procedure TCIEAColorPicker.KeyDown(var Key: Word; Shift: TShiftState);
@ -272,11 +166,65 @@ begin
inherited;
end;
procedure TCIEAColorPicker.SetLValue(l: integer);
procedure TCIEAColorPicker.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
Clamp(L, 0, 100);
FL := L;
SetSelectedColor(LabToRGB(FL, FA, FB));
inherited;
mxx := x;
myy := y;
if Button = mbLeft then
begin
FSelected := GetColorAtPoint(x, y);
FManual := true;
Invalidate;
if Assigned(FOnChange) then
FOnChange(Self);
end;
SetFocus;
end;
procedure TCIEAColorPicker.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
inherited;
if ssLeft in Shift then
begin
mxx := x;
myy := y;
FSelected := GetColorAtPoint(x, y);
FManual := true;
Invalidate;
if Assigned(FOnChange) then
FOnChange(Self);
end;
end;
procedure TCIEAColorPicker.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
inherited;
if ssLeft in Shift then
begin
mxx := x;
myy := y;
FSelected := GetColorAtPoint(x, y);
FManual := true;
Invalidate;
if Assigned(FOnChange) then
FOnChange(Self);
end;
end;
procedure TCIEAColorPicker.Paint;
begin
Canvas.StretchDraw(ClientRect, FBufferBmp);
CorrectCoords(mxx, myy);
DrawMarker(mxx, myy);
end;
procedure TCIEAColorPicker.Resize;
begin
FManual := false;
mxx := Round((FB + 128) * Width / 255);
myy := Round(((100 - FL) * 255 / 100) * Height / 255);
inherited;
end;
procedure TCIEAColorPicker.SetAValue(a: integer);
@ -293,4 +241,26 @@ begin
SetSelectedColor(LabToRGB(FL, FA, FB));
end;
procedure TCIEAColorPicker.SetLValue(l: integer);
begin
Clamp(L, 0, 100);
FL := L;
SetSelectedColor(LabToRGB(FL, FA, FB));
end;
procedure TCIEAColorPicker.SetSelectedColor(c: TColor);
begin
if WebSafe then c := GetWebSafe(c);
FL := Round(GetCIELValue(c));
FA := Round(GetCIEAValue(c));
FB := Round(GetCIEBValue(c));
FSelected := c;
FManual := false;
mxx := Round((FB + 128) * Width / 255);
myy := Round((100 - FL) * 255 / 100 * Height / 255);
Invalidate;
if Assigned(FOnChange) then
FOnChange(Self);
end;
end.

217
components/mbColorLib/CIEBColorPicker.pas
View File

@ -7,11 +7,7 @@ unit CIEBColorPicker;
interface
uses
{$IFDEF FPC}
LCLIntf, LCLType, LMessages,
{$ELSE}
Windows, Messages,
{$ENDIF}
SysUtils, Classes, Controls, Graphics, Math, Forms,
HTMLColors, RGBCIEUtils, mbColorPickerControl;
@ -31,12 +27,9 @@ type
procedure CreateWnd; override;
procedure DrawMarker(x, y: integer);
function GetGradientColor2D(x, y: Integer): TColor; override;
(*
procedure CNKeyDown(var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF});
message CN_KEYDOWN;*)
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure Paint; override;
procedure Resize; override;
@ -44,11 +37,11 @@ type
public
constructor Create(AOwner: TComponent); override;
published
property SelectedColor default clLime;
property LValue: integer read FL write SetLValue default 100;
property AValue: integer read FA write SetAValue default -128;
property BValue: integer read FB write SetBValue default 127;
property LValue: integer read FL write SetLValue default 100;
property MarkerStyle default msCircle;
property SelectedColor default clLime;
property OnChange;
end;
@ -58,7 +51,6 @@ implementation
uses
mbUtils;
{TCIEBColorPicker}
constructor TCIEBColorPicker.Create(AOwner: TComponent);
@ -66,12 +58,7 @@ begin
inherited;
FGradientWidth := 256;
FGradientHeight := 256;
{$IFDEF DELPHI}
Width := 256;
Height := 256;
{$ELSE}
SetInitialBounds(0, 0, 256, 256);
{$ENDIF}
HintFormat := 'L: %cieL A: %cieA'#13'Hex: %hex';
FSelected := clLime;
FL := 100;
@ -85,25 +72,18 @@ begin
MarkerStyle := msCircle;
end;
procedure TCIEBColorPicker.CreateWnd;
begin
inherited;
CreateGradient;
end;
{ In the original code: for L ... for A ... LabToRGB(Round(100-L*100/244), A-128, FB)
--> x is A, y is L}
function TCIEBColorPicker.GetGradientColor2D(x, y: Integer): TColor;
begin
Result := LabToRGB(Round(100 - y*100/255), x - 128, FB);
end;
procedure TCIEBColorPicker.CorrectCoords(var x, y: integer);
begin
Clamp(x, 0, Width - 1);
Clamp(y, 0, Height - 1);
end;
procedure TCIEBColorPicker.CreateWnd;
begin
inherited;
CreateGradient;
end;
procedure TCIEBColorPicker.DrawMarker(x, y: integer);
var
c: TColor;
@ -121,89 +101,11 @@ begin
InternalDrawMarker(x, y, c);
end;
procedure TCIEBColorPicker.SetSelectedColor(c: TColor);
{ In the original code: for L ... for A ... LabToRGB(Round(100-L*100/244), A-128, FB)
--> x is A, y is L}
function TCIEBColorPicker.GetGradientColor2D(x, y: Integer): TColor;
begin
if WebSafe then c := GetWebSafe(c);
FL := Round(GetCIELValue(c));
FA := Round(GetCIEAValue(c));
FB := Round(GetCIEBValue(c));
FSelected := c;
FManual := false;
mxx := Round((FA + 128) * Width / 255);
myy := Round((100 - FL) * 255 / 100* Height / 255);
Invalidate;
if Assigned(FOnChange) then
FOnChange(Self);
end;
procedure TCIEBColorPicker.Paint;
begin
Canvas.StretchDraw(ClientRect, FBufferBmp);
CorrectCoords(mxx, myy);
DrawMarker(mxx, myy);
end;
procedure TCIEBColorPicker.Resize;
begin
FManual := false;
mxx := Round((FA + 128) * (Width / 255));
myy := Round(((100 - FL) * 255 / 100) * (Height / 255));
inherited;
end;
procedure TCIEBColorPicker.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
R: TRect;
begin
inherited;
mxx := x;
myy := y;
if Button = mbLeft then
begin
R := ClientRect;
R.TopLeft := ClientToScreen(R.TopLeft);
R.BottomRight := ClientToScreen(R.BottomRight);
{$IFDEF DELPHI}
ClipCursor(@R);
{$ENDIF}
FSelected := GetColorAtPoint(x, y);
FManual := true;
Invalidate;
end;
SetFocus;
end;
procedure TCIEBColorPicker.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
inherited;
if ssLeft in Shift then
begin
{$IFDEF DELPHI}
ClipCursor(nil);
{$ENDIF}
mxx := x;
myy := y;
FSelected := GetColorAtPoint(x, y);
FManual := true;
Invalidate;
if Assigned(FOnChange) then
FOnChange(Self);
end;
end;
procedure TCIEBColorPicker.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
inherited;
if ssLeft in Shift then
begin
mxx := x;
myy := y;
FSelected := GetColorAtPoint(x, y);
FManual := true;
Invalidate;
if Assigned(FOnChange) then
FOnChange(Self);
end;
Result := LabToRGB(Round(100 - y*100/255), x - 128, FB);
end;
procedure TCIEBColorPicker.KeyDown(var Key: Word; Shift: TShiftState);
@ -267,11 +169,74 @@ begin
inherited;
end;
procedure TCIEBColorPicker.SetLValue(L: integer);
procedure TCIEBColorPicker.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
R: TRect;
begin
Clamp(L, 0, 100);
FL := L;
SetSelectedColor(LabToRGB(FL, FA, FB));
inherited;
mxx := x;
myy := y;
if Button = mbLeft then
begin
R := ClientRect;
R.TopLeft := ClientToScreen(R.TopLeft);
R.BottomRight := ClientToScreen(R.BottomRight);
{$IFDEF DELPHI}
ClipCursor(@R);
{$ENDIF}
FSelected := GetColorAtPoint(x, y);
FManual := true;
Invalidate;
end;
SetFocus;
end;
procedure TCIEBColorPicker.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
inherited;
if ssLeft in Shift then
begin
{$IFDEF DELPHI}
ClipCursor(nil);
{$ENDIF}
mxx := x;
myy := y;
FSelected := GetColorAtPoint(x, y);
FManual := true;
Invalidate;
if Assigned(FOnChange) then
FOnChange(Self);
end;
end;
procedure TCIEBColorPicker.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
inherited;
if ssLeft in Shift then
begin
mxx := x;
myy := y;
FSelected := GetColorAtPoint(x, y);
FManual := true;
Invalidate;
if Assigned(FOnChange) then
FOnChange(Self);
end;
end;
procedure TCIEBColorPicker.Paint;
begin
Canvas.StretchDraw(ClientRect, FBufferBmp);
CorrectCoords(mxx, myy);
DrawMarker(mxx, myy);
end;
procedure TCIEBColorPicker.Resize;
begin
FManual := false;
mxx := Round((FA + 128) * (Width / 255));
myy := Round(((100 - FL) * 255 / 100) * (Height / 255));
inherited;
end;
procedure TCIEBColorPicker.SetAValue(a: integer);
@ -288,4 +253,26 @@ begin
SetSelectedColor(LabToRGB(FL, FA, FB));
end;
procedure TCIEBColorPicker.SetLValue(L: integer);
begin
Clamp(L, 0, 100);
FL := L;
SetSelectedColor(LabToRGB(FL, FA, FB));
end;
procedure TCIEBColorPicker.SetSelectedColor(c: TColor);
begin
if WebSafe then c := GetWebSafe(c);
FL := Round(GetCIELValue(c));
FA := Round(GetCIEAValue(c));
FB := Round(GetCIEBValue(c));
FSelected := c;
FManual := false;
mxx := Round((FA + 128) * Width / 255);
myy := Round((100 - FL) * 255 / 100* Height / 255);
Invalidate;
if Assigned(FOnChange) then
FOnChange(Self);
end;
end.

203
components/mbColorLib/CIELColorPicker.pas
View File

@ -7,11 +7,7 @@ unit CIELColorPicker;
interface
uses
{$IFDEF FPC}
LCLIntf, LCLType, LMessages,
{$ELSE}
Windows, Messages,
{$ENDIF}
SysUtils, Classes, Controls, Graphics, Math, Forms,
HTMLColors, RGBCIEUtils, mbColorPickerControl;
@ -28,10 +24,6 @@ type
procedure CreateWnd; override;
procedure DrawMarker(x, y: integer);
function GetGradientColor2D(x, y: Integer): TColor; override;
(*
procedure CNKeyDown(var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF});
message CN_KEYDOWN;
*)
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
@ -42,11 +34,11 @@ type
public
constructor Create(AOwner: TComponent); override;
published
property SelectedColor default clAqua;
property LValue: integer read FL write SetLValue default 100;
property AValue: integer read FA write SetAValue default -128;
property BValue: integer read FB write SetBValue default 127;
property LValue: integer read FL write SetLValue default 100;
property MarkerStyle default msCircle;
property SelectedColor default clAqua;
property OnChange;
end;
@ -63,12 +55,7 @@ begin
inherited;
FGradientWidth := 256;
FGradientHeight := 256;
{$IFDEF DELPHI}
Width := 256;
Height := 256;
{$ELSE}
SetInitialBounds(0, 0, 256, 256);
{$ENDIF}
HintFormat := 'A: %cieA B: %cieB'#13'Hex: %hex';
FSelected := clAqua;
FL := 100;
@ -83,24 +70,18 @@ begin
SetSelectedColor(clAqua);
end;
procedure TCIELColorPicker.CreateWnd;
begin
inherited;
CreateGradient;
end;
{ Original code: for A ... for B ---> LabToRGB(FL, A - 128, B - 128) }
function TCIELColorPicker.GetGradientColor2D(x, y: Integer): TColor;
begin
Result := LabToRGB(FL, y - 128, x - 128);
end;
procedure TCIELColorPicker.CorrectCoords(var x, y: integer);
begin
Clamp(x, 0, Width - 1);
clamp(y, 0, Height - 1);
end;
procedure TCIELColorPicker.CreateWnd;
begin
inherited;
CreateGradient;
end;
procedure TCIELColorPicker.DrawMarker(x, y: integer);
var
c: TColor;
@ -118,89 +99,10 @@ begin
InternalDrawMarker(x, y, c);
end;
procedure TCIELColorPicker.SetSelectedColor(c: TColor);
{ Original code: for A ... for B ---> LabToRGB(FL, A - 128, B - 128) }
function TCIELColorPicker.GetGradientColor2D(x, y: Integer): TColor;
begin
if WebSafe then c := GetWebSafe(c);
FL := Round(GetCIELValue(c));
FA := Round(GetCIEAValue(c));
FB := Round(GetCIEBValue(c));
FSelected := c;
FManual := false;
mxx := Round((FA + 128) * Width / 255);
myy := Round((255 - (FB + 128)) * Height / 255);
Invalidate;
if Assigned(FOnChange) then
FOnChange(Self);
end;
procedure TCIELColorPicker.Paint;
begin
Canvas.StretchDraw(ClientRect, FBufferBmp);
CorrectCoords(mxx, myy);
DrawMarker(mxx, myy);
end;
procedure TCIELColorPicker.Resize;
begin
FManual := false;
mxx := Round((FA + 128) * Width / 255);
myy := Round((255 - (FB + 128)) * Height / 255);
inherited;
end;
procedure TCIELColorPicker.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
R: TRect;
begin
inherited;
mxx := x;
myy := y;
if Button = mbLeft then
begin
R := ClientRect;
R.TopLeft := ClientToScreen(R.TopLeft);
R.BottomRight := ClientToScreen(R.BottomRight);
{$IFDEF DELPHI}
ClipCursor(@R);
{$ENDIF}
FSelected := GetColorAtPoint(x, y);
FManual := true;
Invalidate;
end;
SetFocus;
end;
procedure TCIELColorPicker.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
inherited;
if ssLeft in Shift then
begin
{$IFDEF DELPHI}
ClipCursor(nil);
{$ENDIF}
mxx := x;
myy := y;
FSelected := GetColorAtPoint(x, y);
FManual := true;
Invalidate;
if Assigned(FOnChange) then
FOnChange(Self);
end;
end;
procedure TCIELColorPicker.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
inherited;
if ssLeft in Shift then
begin
mxx := x;
myy := y;
FSelected := GetColorAtPoint(x, y);
FManual := true;
Invalidate;
if Assigned(FOnChange) then
FOnChange(Self);
end;
Result := LabToRGB(FL, y - 128, x - 128);
end;
procedure TCIELColorPicker.KeyDown(var Key: Word; Shift: TShiftState);
@ -263,11 +165,63 @@ begin
inherited;
end;
procedure TCIELColorPicker.SetLValue(l: integer);
procedure TCIELColorPicker.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
Clamp(L, 0, 100);
FL := L;
SetSelectedColor(LabToRGB(FL, FA, FB));
inherited;
mxx := x;
myy := y;
if Button = mbLeft then
begin
FSelected := GetColorAtPoint(x, y);
FManual := true;
Invalidate;
end;
SetFocus;
end;
procedure TCIELColorPicker.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
inherited;
if ssLeft in Shift then
begin
mxx := x;
myy := y;
FSelected := GetColorAtPoint(x, y);
FManual := true;
Invalidate;
if Assigned(FOnChange) then
FOnChange(Self);
end;
end;
procedure TCIELColorPicker.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
inherited;
if ssLeft in Shift then
begin
mxx := x;
myy := y;
FSelected := GetColorAtPoint(x, y);
FManual := true;
Invalidate;
if Assigned(FOnChange) then
FOnChange(Self);
end;
end;
procedure TCIELColorPicker.Paint;
begin
Canvas.StretchDraw(ClientRect, FBufferBmp);
CorrectCoords(mxx, myy);
DrawMarker(mxx, myy);
end;
procedure TCIELColorPicker.Resize;
begin
FManual := false;
mxx := Round((FA + 128) * Width / 255);
myy := Round((255 - (FB + 128)) * Height / 255);
inherited;
end;
procedure TCIELColorPicker.SetAValue(a: integer);
@ -284,4 +238,27 @@ begin
SetSelectedColor(LabToRGB(FL, FA, FB));
end;
procedure TCIELColorPicker.SetLValue(l: integer);
begin
Clamp(L, 0, 100);
FL := L;
SetSelectedColor(LabToRGB(FL, FA, FB));
end;
procedure TCIELColorPicker.SetSelectedColor(c: TColor);
begin
if WebSafe then c := GetWebSafe(c);
FL := Round(GetCIELValue(c));
FA := Round(GetCIEAValue(c));
FB := Round(GetCIEBValue(c));
FSelected := c;
FManual := false;
mxx := Round((FA + 128) * Width / 255);
myy := Round((255 - (FB + 128)) * Height / 255);
Invalidate;
if Assigned(FOnChange) then
FOnChange(Self);
end;
end.

16
components/mbColorLib/RGBCIEUtils.pas
View File

@ -3,9 +3,7 @@ unit RGBCIEUtils;
interface
uses
SysUtils,
{$IFDEF FPC}LCLIntf,{$ELSE}Windows,{$ENDIF}
Graphics, Math;
SysUtils, LCLIntf, Graphics, Math;
const
{// Observer= 2�, Illuminant= D65 - Daylignt
@ -290,23 +288,23 @@ end;
function GetCIEAValue(c: TColor): double;
var
d: double;
d: double;
begin
XYZToLab(RGBToXYZ(c), d, Result, d);
XYZToLab(RGBToXYZ(c), d, Result, d);
end;
function GetCIEBValue(c: TColor): double;
var
d: double;
d: double;
begin
XYZToLab(RGBToXYZ(c), d, d, Result);
XYZToLab(RGBToXYZ(c), d, d, Result);
end;
function GetCIECValue(c: TColor): double;
var
d: double;
d: double;
begin
RGBToLCH(c, d, Result, d);
RGBToLCH(c, d, Result, d);
end;
function GetCIEHValue(c: TColor): double;

3
components/mbColorLib/RGBCMYKUtils.pas
View File

@ -8,8 +8,7 @@ interface
{$DEFINE CMYK_FORMULA_2} // Result agrees with OpenOffice
uses
{$IFDEF FPC}LCLIntf,{$ELSE} Windows,{$ENDIF}
Graphics, Math;
LCLIntf, Graphics, Math;
function CMYtoColor(C, M, Y: integer): TColor;
procedure RGBtoCMY(clr: TColor; var C, M, Y: integer);

8
components/mbColorLib/RGBHSLUtils.pas
View File

@ -7,12 +7,7 @@ unit RGBHSLUtils;
interface
uses
{$IFDEF FPC}
LCLIntf, LCLType,
{$ELSE}
Windows,
{$ENDIF}
Graphics, Math, Scanlines;
LCLIntf, LCLType, Graphics, Math, Scanlines;
var //set these variables to your needs, e.g. 360, 255, 255
MaxHue: integer = 359;
@ -36,6 +31,7 @@ function HSLToRGBTriple(H, S, L : integer) : TRGBTriple;
function HSLToRGBQuad(H, S, L: integer): TRGBQuad;
procedure RGBTripleToHSL(RGBTriple : TRGBTriple; var h, s, l: integer);
implementation
uses

8
components/mbColorLib/RGBHSVUtils.pas
View File

@ -7,12 +7,8 @@ unit RGBHSVUtils;
interface
uses
{$IFDEF FPC}
LCLIntf, LCLType,
{$ELSE}
Windows,
{$ENDIF}
SysUtils, Classes, Graphics, Math, Scanlines;
LCLIntf, LCLType, SysUtils, Classes, Graphics, Math,
Scanlines;
procedure RGBtoHSV(R, G, B: Integer; out H, S, V: Double);
procedure RGBtoHSVRange(R, G, B: integer; out H, S, V: integer);

327
components/mbColorLib/SColorPicker.pas
View File

@ -7,11 +7,7 @@ unit SColorPicker;
interface
uses
{$IFDEF FPC}
LCLIntf, LCLType, LMessages,
{$ELSE}
Windows, Messages,
{$ENDIF}
SysUtils, Classes, Controls, Graphics, Forms,
RGBHSVUtils, mbTrackBarPicker, HTMLColors, Scanlines;
@ -21,18 +17,18 @@ type
FVal, FHue, FSat: Double;
FMaxVal, FMaxHue, FMaxSat: Integer;
function ArrowPosFromSat(s: integer): integer;
function SatFromArrowPos(p: integer): integer;
function GetHue: Integer;
function GetSat: Integer;
function GetVal: Integer;
function GetSelectedColor: TColor;
procedure SetSelectedColor(c: TColor);
function GetVal: Integer;
function SatFromArrowPos(p: integer): integer;
procedure SetHue(h: integer);
procedure SetSat(s: integer);
procedure SetValue(v: integer);
procedure SetMaxHue(h: Integer);
procedure SetMaxSat(s: Integer);
procedure SetMaxVal(v: Integer);
procedure SetSat(s: integer);
procedure SetValue(v: integer);
procedure SetSelectedColor(c: TColor);
protected
procedure Execute(tbaAction: integer); override;
function GetArrowPos: integer; override;
@ -75,6 +71,25 @@ begin
FChange := true;
end;
function TSColorPicker.ArrowPosFromSat(s: integer): integer;
var
a: integer;
begin
if Layout = lyHorizontal then
begin
a := Round(s / FMaxSat * (Width - 12));
if a > Width - FLimit then a := Width - FLimit;
end
else
begin
s := FMaxSat - s;
a := Round(s / FMaxSat * (Height - 12));
if a > Height - FLimit then a := Height - FLimit;
end;
if a < 0 then a := 0;
Result := a;
end;
(*
procedure TSColorPicker.CreateSGradient;
var
@ -121,162 +136,6 @@ begin
end;
*)
function TSColorPicker.GetGradientColor(AValue: Integer): TColor;
begin
Result := HSVtoColor(FHue, AValue/FMaxSat, FVal);
end;
procedure TSColorPicker.SetValue(v: integer);
begin
Clamp(v, 0, FMaxVal);
if GetVal() <> v then
begin
FVal := v / FMaxVal;
FManual := false;
CreateGradient;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
end;
end;
procedure TSColorPicker.SetHue(h: integer);
begin
Clamp(h, 0, FMaxHue);
if GetHue() <> h then
begin
FHue := h / FMaxHue;
CreateGradient;
FManual := false;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
end;
end;
procedure TSColorPicker.SetSat(s: integer);
begin
Clamp(s, 0, FMaxSat);
if GetSat() <> s then
begin
FSat := s / FMaxSat;
FManual := false;
FArrowPos := ArrowPosFromSat(s);
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
end;
end;
function TSColorPicker.ArrowPosFromSat(s: integer): integer;
var
a: integer;
begin
if Layout = lyHorizontal then
begin
a := Round(s / FMaxSat * (Width - 12));
if a > Width - FLimit then a := Width - FLimit;
end
else
begin
s := FMaxSat - s;
a := Round(s / FMaxSat * (Height - 12));
if a > Height - FLimit then a := Height - FLimit;
end;
if a < 0 then a := 0;
Result := a;
end;
function TSColorPicker.SatFromArrowPos(p: integer): integer;
var
r: integer;
begin
if Layout = lyHorizontal then
r := Round(p / (Width - 12) * FMaxSat)
else
r := Round(FMaxSat - p / (Height - 12) * FMaxSat);
Clamp(r, 0, FMaxSat);
Result := r;
end;
function TSColorPicker.GetHue: Integer;
begin
Result := round(FHue * FMaxHue);
end;
function TSColorPicker.GetSat: Integer;
begin
Result := round(FSat * FMaxSat);
end;
function TSColorPicker.GetVal: Integer;
begin
Result := round(FVal * FMaxVal);
end;
procedure TSColorPicker.SetMaxHue(h: Integer);
begin
if h = FMaxHue then
exit;
FMaxHue := h;
CreateGradient;
if FChange and Assigned(OnChange) then OnChange(Self);
Invalidate;
end;
procedure TSColorPicker.SetMaxSat(s: Integer);
begin
if s = FMaxSat then
exit;
FMaxSat := s;
FGradientWidth := FMaxSat + 1;
CreateGradient;
if FChange and Assigned(OnChange) then OnChange(Self);
Invalidate;
end;
procedure TSColorPicker.SetMaxVal(v: Integer);
begin
if v = FMaxVal then
exit;
FMaxVal := v;
CreateGradient;
if FChange and Assigned(OnChange) then OnChange(Self);
Invalidate;
end;
function TSColorPicker.GetSelectedColor: TColor;
begin
Result := HSVToColor(FHue, FSat, FVal);
if WebSafe then
Result := GetWebSafe(Result);
end;
function TSColorPicker.GetSelectedValue: integer;
begin
Result := GetSat();
end;
procedure TSColorPicker.SetSelectedColor(c: TColor);
var
h, s, v: integer;
begin
if WebSafe then c := GetWebSafe(c);
RGBToHSVRange(GetRValue(c), GetGValue(c), GetBValue(c), h, s, v);
FChange := false;
SetHue(h);
SetSat(s);
SetValue(v);
FManual := false;
FChange := true;
if Assigned(OnChange) then OnChange(Self);
end;
function TSColorPicker.GetArrowPos: integer;
begin
if FMaxSat = 0 then
Result := inherited GetArrowPos
else
Result := ArrowPosFromSat(GetSat());
end;
procedure TSColorPicker.Execute(tbaAction: integer);
begin
case tbaAction of
@ -313,4 +172,142 @@ begin
end;
end;
function TSColorPicker.GetArrowPos: integer;
begin
if FMaxSat = 0 then
Result := inherited GetArrowPos
else
Result := ArrowPosFromSat(GetSat());
end;
function TSColorPicker.GetGradientColor(AValue: Integer): TColor;
begin
Result := HSVtoColor(FHue, AValue/FMaxSat, FVal);
end;
function TSColorPicker.GetHue: Integer;
begin
Result := round(FHue * FMaxHue);
end;
function TSColorPicker.GetSat: Integer;
begin
Result := round(FSat * FMaxSat);
end;
function TSColorPicker.GetSelectedColor: TColor;
begin
Result := HSVToColor(FHue, FSat, FVal);
if WebSafe then
Result := GetWebSafe(Result);
end;
function TSColorPicker.GetSelectedValue: integer;
begin
Result := GetSat();
end;
function TSColorPicker.GetVal: Integer;
begin
Result := round(FVal * FMaxVal);
end;
function TSColorPicker.SatFromArrowPos(p: integer): integer;
var
r: integer;
begin
if Layout = lyHorizontal then
r := Round(p / (Width - 12) * FMaxSat)
else
r := Round(FMaxSat - p / (Height - 12) * FMaxSat);
Clamp(r, 0, FMaxSat);
Result := r;
end;
procedure TSColorPicker.SetMaxHue(h: Integer);
begin
if h = FMaxHue then
exit;
FMaxHue := h;
CreateGradient;
if FChange and Assigned(OnChange) then OnChange(Self);
Invalidate;
end;
procedure TSColorPicker.SetMaxSat(s: Integer);
begin
if s = FMaxSat then
exit;
FMaxSat := s;
FGradientWidth := FMaxSat + 1;
CreateGradient;
if FChange and Assigned(OnChange) then OnChange(Self);
Invalidate;
end;
procedure TSColorPicker.SetMaxVal(v: Integer);
begin
if v = FMaxVal then
exit;
FMaxVal := v;
CreateGradient;
if FChange and Assigned(OnChange) then OnChange(Self);
Invalidate;
end;
procedure TSColorPicker.SetHue(h: integer);
begin
Clamp(h, 0, FMaxHue);
if GetHue() <> h then
begin
FHue := h / FMaxHue;
CreateGradient;
FManual := false;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
end;
end;
procedure TSColorPicker.SetSat(s: integer);
begin
Clamp(s, 0, FMaxSat);
if GetSat() <> s then
begin
FSat := s / FMaxSat;
FManual := false;
FArrowPos := ArrowPosFromSat(s);
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
end;
end;
procedure TSColorPicker.SetSelectedColor(c: TColor);
var
h, s, v: integer;
begin
if WebSafe then c := GetWebSafe(c);
RGBToHSVRange(GetRValue(c), GetGValue(c), GetBValue(c), h, s, v);
FChange := false;
SetHue(h);
SetSat(s);
SetValue(v);
FManual := false;
FChange := true;
if Assigned(OnChange) then OnChange(Self);
end;
procedure TSColorPicker.SetValue(v: integer);
begin
Clamp(v, 0, FMaxVal);
if GetVal() <> v then
begin
FVal := v / FMaxVal;
FManual := false;
CreateGradient;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
end;
end;
end.

8
components/mbColorLib/Scanlines.pas
View File

@ -7,12 +7,7 @@ unit Scanlines;
interface
uses
{$IFDEF FPC}
LCLIntf, LCLType,
{$ELSE}
Windows,
{$ENDIF}
Graphics;
LCLIntf, LCLType, Graphics;
type
TRGBTripleArray = array [0..65535] of TRGBTriple;
@ -27,6 +22,7 @@ function RGBToRGBQuad(c: TColor): TRGBQuad; overload;
function RGBQuadToRGB(q: TRGBQuad): TColor;
function RGBTripleToColor(RGBTriple : TRGBTriple) : TColor;
implementation
function RGBtoRGBTriple(R, G, B: byte): TRGBTriple;

105
components/mbColorLib/ScreenWin.pas
View File

@ -7,12 +7,8 @@ unit ScreenWin;
interface
uses
{$IFDEF FPC}
LCLIntf, LCLType, LMessages,
{$ELSE}
Windows, Messages,
{$ENDIF}
SysUtils, Classes, Graphics, Controls, Forms, ExtCtrls, StdCtrls,
LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, Forms,
ExtCtrls, StdCtrls,
PalUtils;
const
@ -47,12 +43,7 @@ var
implementation
{$IFDEF DELPHI}
{$R *.dfm}
{$ELSE}
{$R *.lfm}
{$ENDIF}
{$R *.lfm}
{$R PickCursor.res}
function ColorToHex(Color: TColor): string;
@ -74,28 +65,36 @@ begin
c.Free;
end;
end;
(*
{$ELSE}
var
bmp: TBitmap;
screenDC: HDC;
begin
bmp := TBitmap.Create;
screenDC := GetDC(0);
bmp.LoadFromDevice(screenDC);
Result := bmp.Canvas.Pixels[X, Y];
ReleaseDC(0, screenDC);
bmp.Free;
end;
{$ENDIF}
*)
procedure TScreenForm.FormShow(Sender: TObject);
{ TScreenForm }
procedure TScreenForm.CMHintShow(var Message: TCMHintShow);
begin
Width := Screen.Width;
Height := Screen.Height;
Left := 0;
Top := 0;
with TCMHintShow(Message) do
if not ShowHint then
Message.Result := 1
else
with HintInfo^ do
begin
Result := 0;
ReshowTimeout := 1;
HideTimeout := 5000;
HintPos := Point(HintPos.X + 16, HintPos.y - 16);
HintStr := FormatHint(FHintFormat, SelectedColor);
end;
inherited;
end;
procedure TScreenForm.EndSelection(x, y: integer; ok: boolean);
begin
if ok then
SelectedColor := GetDesktopColor(x, y)
else
SelectedColor := clNone;
Close;
if Assigned(FOnSelColorChange) then
FOnSelColorChange(Self);
end;
procedure TScreenForm.FormCreate(Sender: TObject);
@ -118,23 +117,6 @@ begin
FOnKeyDown(Self, Key, Shift);
end;
procedure TScreenForm.EndSelection(x, y: integer; ok: boolean);
begin
if ok then
SelectedColor := GetDesktopColor(x, y)
else
SelectedColor := clNone;
Close;
if Assigned(FOnSelColorChange) then
FOnSelColorChange(Self);
end;
procedure TScreenForm.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
EndSelection(x, y, true);
end;
procedure TScreenForm.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
@ -143,21 +125,18 @@ begin
Application.ProcessMessages;
end;
procedure TScreenForm.CMHintShow(var Message: TCMHintShow);
procedure TScreenForm.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
with TCMHintShow(Message) do
if not ShowHint then
Message.Result := 1
else
with HintInfo^ do
begin
Result := 0;
ReshowTimeout := 1;
HideTimeout := 5000;
HintPos := Point(HintPos.X + 16, HintPos.y - 16);
HintStr := FormatHint(FHintFormat, SelectedColor);
end;
inherited;
EndSelection(x, y, true);
end;
procedure TScreenForm.FormShow(Sender: TObject);
begin
Width := Screen.Width;
Height := Screen.Height;
Left := 0;
Top := 0;
end;
end.

7
components/mbColorLib/SelPropUtils.pas
View File

@ -7,12 +7,7 @@ unit SelPropUtils;
interface
uses
{$IFDEF FPC}
LCLIntf, LCLType,
{$ELSE}
Windows,
{$ENDIF}
Classes, Graphics;
LCLIntf, LCLType, Classes, Graphics;
procedure DrawSelCross(x, y: integer; Canvas: TCanvas; Color: TColor);
procedure DrawSelCrossCirc(x, y: integer; Canvas: TCanvas; Color: TColor);