You've already forked lazarus-ccr
mbColorLib: Beginning to remove Delphi support. Cleanup.
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5547 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
@ -7,11 +7,7 @@ unit BAxisColorPicker;
|
|||||||
interface
|
interface
|
||||||
|
|
||||||
uses
|
uses
|
||||||
{$IFDEF FPC}
|
|
||||||
LCLIntf, LCLType, LMessages,
|
LCLIntf, LCLType, LMessages,
|
||||||
{$ELSE}
|
|
||||||
Windows, Messages,
|
|
||||||
{$ENDIF}
|
|
||||||
SysUtils, Classes, Controls, Graphics, Math, Forms,
|
SysUtils, Classes, Controls, Graphics, Math, Forms,
|
||||||
HTMLColors, mbColorPickerControl;
|
HTMLColors, mbColorPickerControl;
|
||||||
|
|
||||||
@ -28,10 +24,6 @@ type
|
|||||||
procedure CreateWnd; override;
|
procedure CreateWnd; override;
|
||||||
procedure DrawMarker(x, y: integer);
|
procedure DrawMarker(x, y: integer);
|
||||||
function GetGradientColor2D(x, y: Integer): TColor; override;
|
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 KeyDown(var Key: Word; Shift: TShiftState); override;
|
||||||
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
|
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
|
||||||
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
|
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
|
||||||
@ -50,11 +42,13 @@ type
|
|||||||
property OnChange;
|
property OnChange;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
|
|
||||||
uses
|
uses
|
||||||
mbUtils;
|
mbUtils;
|
||||||
|
|
||||||
|
|
||||||
{TBAxisColorPicker}
|
{TBAxisColorPicker}
|
||||||
|
|
||||||
constructor TBAxisColorPicker.Create(AOwner: TComponent);
|
constructor TBAxisColorPicker.Create(AOwner: TComponent);
|
||||||
@ -62,12 +56,7 @@ begin
|
|||||||
inherited;
|
inherited;
|
||||||
FGradientWidth := 256;
|
FGradientWidth := 256;
|
||||||
FGradientHeight := 256;
|
FGradientHeight := 256;
|
||||||
{$IFDEF DELPHI}
|
|
||||||
Width := 256;
|
|
||||||
Height := 256;
|
|
||||||
{$ELSE}
|
|
||||||
SetInitialBounds(0, 0, 255, 255);
|
SetInitialBounds(0, 0, 255, 255);
|
||||||
{$ENDIF}
|
|
||||||
HintFormat := 'R: %r G: %g'#13'Hex: %hex';
|
HintFormat := 'R: %r G: %g'#13'Hex: %hex';
|
||||||
FG := 0;
|
FG := 0;
|
||||||
FB := 255;
|
FB := 255;
|
||||||
@ -116,35 +105,6 @@ begin
|
|||||||
Result := RGB(x, FBufferBmp.Height - 1 - y, FB);
|
Result := RGB(x, FBufferBmp.Height - 1 - y, FB);
|
||||||
end;
|
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);
|
procedure TBAxisColorPicker.KeyDown(var Key: Word; Shift: TShiftState);
|
||||||
var
|
var
|
||||||
eraseKey: Boolean;
|
eraseKey: Boolean;
|
||||||
@ -204,20 +164,12 @@ end;
|
|||||||
|
|
||||||
procedure TBAxisColorPicker.MouseDown(Button: TMouseButton; Shift: TShiftState;
|
procedure TBAxisColorPicker.MouseDown(Button: TMouseButton; Shift: TShiftState;
|
||||||
X, Y: Integer);
|
X, Y: Integer);
|
||||||
var
|
|
||||||
R: TRect;
|
|
||||||
begin
|
begin
|
||||||
inherited;
|
inherited;
|
||||||
mxx := x;
|
mxx := x;
|
||||||
myy := y;
|
myy := y;
|
||||||
if Button = mbLeft then
|
if Button = mbLeft then
|
||||||
begin
|
begin
|
||||||
{$IFDEF DELPHI}
|
|
||||||
R := ClientRect;
|
|
||||||
R.TopLeft := ClientToScreen(R.TopLeft);
|
|
||||||
R.BottomRight := ClientToScreen(R.BottomRight);
|
|
||||||
ClipCursor(@R);
|
|
||||||
{$ENDIF}
|
|
||||||
FSelected := GetColorAtPoint(x, y);
|
FSelected := GetColorAtPoint(x, y);
|
||||||
FManual := true;
|
FManual := true;
|
||||||
Invalidate;
|
Invalidate;
|
||||||
@ -225,23 +177,6 @@ begin
|
|||||||
SetFocus;
|
SetFocus;
|
||||||
end;
|
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);
|
procedure TBAxisColorPicker.MouseMove(Shift: TShiftState; X, Y: Integer);
|
||||||
begin
|
begin
|
||||||
inherited;
|
inherited;
|
||||||
@ -255,108 +190,40 @@ begin
|
|||||||
if Assigned(FOnChange) then FOnChange(self);
|
if Assigned(FOnChange) then FOnChange(self);
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
(*
|
|
||||||
procedure TBAxisColorPicker.CNKeyDown(
|
procedure TBAxisColorPicker.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
||||||
var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF} );
|
|
||||||
var
|
|
||||||
Shift: TShiftState;
|
|
||||||
FInherited: boolean;
|
|
||||||
begin
|
begin
|
||||||
FInherited := false;
|
inherited;
|
||||||
Shift := KeyDataToShiftState(Message.KeyData);
|
if ssLeft in Shift then
|
||||||
if not (ssCtrl in Shift) then
|
|
||||||
case Message.CharCode of
|
|
||||||
VK_LEFT:
|
|
||||||
begin
|
begin
|
||||||
mxx := dx - 1;
|
mxx := x;
|
||||||
myy := dy;
|
myy := y;
|
||||||
FSelected := GetColorAtPoint(mxx, myy);
|
FSelected := GetColorAtPoint(x, y);
|
||||||
FManual := true;
|
FManual := true;
|
||||||
Invalidate;
|
Invalidate;
|
||||||
|
if Assigned(FOnChange) then FOnChange(self);
|
||||||
end;
|
end;
|
||||||
VK_RIGHT:
|
|
||||||
begin
|
|
||||||
mxx := dx + 1;
|
|
||||||
myy := dy;
|
|
||||||
FSelected := GetColorAtPoint(mxx, myy);
|
|
||||||
FManual := true;
|
|
||||||
Invalidate;
|
|
||||||
end;
|
end;
|
||||||
VK_UP:
|
|
||||||
|
procedure TBAxisColorPicker.Paint;
|
||||||
begin
|
begin
|
||||||
mxx := dx;
|
Canvas.StretchDraw(ClientRect, FBufferBmp);
|
||||||
myy := dy - 1;
|
CorrectCoords(mxx, myy);
|
||||||
FSelected := GetColorAtPoint(mxx, myy);
|
DrawMarker(mxx, myy);
|
||||||
FManual := true;
|
|
||||||
Invalidate;
|
|
||||||
end;
|
end;
|
||||||
VK_DOWN:
|
|
||||||
|
procedure TBAxisColorPicker.Resize;
|
||||||
begin
|
begin
|
||||||
mxx := dx;
|
FManual := false;
|
||||||
myy := dy + 1;
|
mxx := round(FR * (Width / 255));
|
||||||
FSelected := GetColorAtPoint(mxx, myy);
|
myy := round((255 - FG) * (Height / 255));
|
||||||
FManual := true;
|
|
||||||
Invalidate;
|
|
||||||
end;
|
|
||||||
else
|
|
||||||
begin
|
|
||||||
FInherited := true;
|
|
||||||
inherited;
|
inherited;
|
||||||
end;
|
end;
|
||||||
end
|
|
||||||
else
|
procedure TBAxisColorPicker.SetBValue(b: integer);
|
||||||
case Message.CharCode of
|
|
||||||
VK_LEFT:
|
|
||||||
begin
|
begin
|
||||||
mxx := dx - 10;
|
Clamp(b, 0, 255);
|
||||||
myy := dy;
|
FB := b;
|
||||||
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;
|
|
||||||
end;
|
|
||||||
if not FInherited then
|
|
||||||
if Assigned(OnKeyDown) then
|
|
||||||
OnKeyDown(Self, Message.CharCode, Shift);
|
|
||||||
end;
|
|
||||||
*)
|
|
||||||
procedure TBAxisColorPicker.SetRValue(r: integer);
|
|
||||||
begin
|
|
||||||
Clamp(r, 0, 255);
|
|
||||||
FR := r;
|
|
||||||
SetSelectedColor(RGB(FR, FG, FB));
|
SetSelectedColor(RGB(FR, FG, FB));
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -367,11 +234,26 @@ begin
|
|||||||
SetSelectedColor(RGB(FR, FG, FB));
|
SetSelectedColor(RGB(FR, FG, FB));
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TBAxisColorPicker.SetBValue(b: integer);
|
procedure TBAxisColorPicker.SetRValue(r: integer);
|
||||||
begin
|
begin
|
||||||
Clamp(b, 0, 255);
|
Clamp(r, 0, 255);
|
||||||
FB := b;
|
FR := r;
|
||||||
SetSelectedColor(RGB(FR, FG, FB));
|
SetSelectedColor(RGB(FR, FG, FB));
|
||||||
end;
|
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.
|
end.
|
||||||
|
@ -7,13 +7,9 @@ unit BColorPicker;
|
|||||||
interface
|
interface
|
||||||
|
|
||||||
uses
|
uses
|
||||||
{$IFDEF FPC}
|
LCLIntf, LCLType,
|
||||||
LCLIntf, LCLType, //LMessages,
|
|
||||||
{$ELSE}
|
|
||||||
Windows, Messages,
|
|
||||||
{$ENDIF}
|
|
||||||
SysUtils, Classes, Controls, Graphics, Forms,
|
SysUtils, Classes, Controls, Graphics, Forms,
|
||||||
mbTrackBarPicker, HTMLColors;
|
HTMLColors, mbTrackBarPicker;
|
||||||
|
|
||||||
type
|
type
|
||||||
|
|
||||||
@ -25,10 +21,10 @@ type
|
|||||||
function ArrowPosFromBlue(b: integer): integer;
|
function ArrowPosFromBlue(b: integer): integer;
|
||||||
function BlueFromArrowPos(p: integer): integer;
|
function BlueFromArrowPos(p: integer): integer;
|
||||||
function GetSelectedColor: TColor;
|
function GetSelectedColor: TColor;
|
||||||
procedure SetSelectedColor(c: TColor);
|
|
||||||
procedure SetRed(r: integer);
|
|
||||||
procedure SetGreen(g: integer);
|
|
||||||
procedure SetBlue(b: integer);
|
procedure SetBlue(b: integer);
|
||||||
|
procedure SetGreen(g: integer);
|
||||||
|
procedure SetRed(r: integer);
|
||||||
|
procedure SetSelectedColor(c: TColor);
|
||||||
protected
|
protected
|
||||||
procedure Execute(tbaAction: integer); override;
|
procedure Execute(tbaAction: integer); override;
|
||||||
function GetArrowPos: integer; override;
|
function GetArrowPos: integer; override;
|
||||||
@ -37,9 +33,9 @@ type
|
|||||||
public
|
public
|
||||||
constructor Create(AOwner: TComponent); override;
|
constructor Create(AOwner: TComponent); override;
|
||||||
published
|
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 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 SelectedColor: TColor read GetSelectedColor write SetSelectedColor default clRed;
|
||||||
property Layout default lyVertical;
|
property Layout default lyVertical;
|
||||||
end;
|
end;
|
||||||
@ -70,50 +66,6 @@ begin
|
|||||||
FChange := true;
|
FChange := true;
|
||||||
end;
|
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;
|
function TBColorPicker.ArrowPosFromBlue(b: integer): integer;
|
||||||
var
|
var
|
||||||
a: integer;
|
a: integer;
|
||||||
@ -138,43 +90,13 @@ var
|
|||||||
b: integer;
|
b: integer;
|
||||||
begin
|
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);
|
||||||
Clamp(b, 0, 255);
|
Clamp(b, 0, 255);
|
||||||
Result := b;
|
Result := b;
|
||||||
end;
|
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);
|
procedure TBColorPicker.Execute(tbaAction: integer);
|
||||||
begin
|
begin
|
||||||
case tbaAction of
|
case tbaAction of
|
||||||
@ -211,4 +133,78 @@ begin
|
|||||||
end;
|
end;
|
||||||
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.
|
end.
|
||||||
|
@ -7,11 +7,7 @@ unit CColorPicker;
|
|||||||
interface
|
interface
|
||||||
|
|
||||||
uses
|
uses
|
||||||
{$IFDEF FPC}
|
|
||||||
LCLIntf, LCLType,
|
LCLIntf, LCLType,
|
||||||
{$ELSE}
|
|
||||||
Windows, Messages,
|
|
||||||
{$ENDIF}
|
|
||||||
SysUtils, Classes, Controls, Graphics, Forms,
|
SysUtils, Classes, Controls, Graphics, Forms,
|
||||||
RGBCMYKUtils, mbTrackBarPicker, HTMLColors;
|
RGBCMYKUtils, mbTrackBarPicker, HTMLColors;
|
||||||
|
|
||||||
@ -22,11 +18,11 @@ 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(clr: TColor);
|
procedure SetBlack(k: integer);
|
||||||
procedure SetCyan(c: integer);
|
procedure SetCyan(c: integer);
|
||||||
procedure SetMagenta(m: integer);
|
procedure SetMagenta(m: integer);
|
||||||
|
procedure SetSelectedColor(clr: TColor);
|
||||||
procedure SetYellow(y: integer);
|
procedure SetYellow(y: integer);
|
||||||
procedure SetBlack(k: integer);
|
|
||||||
protected
|
protected
|
||||||
procedure Execute(tbaAction: integer); override;
|
procedure Execute(tbaAction: integer); override;
|
||||||
function GetArrowPos: integer; override;
|
function GetArrowPos: integer; override;
|
||||||
@ -35,14 +31,15 @@ type
|
|||||||
public
|
public
|
||||||
constructor Create(AOwner: TComponent); override;
|
constructor Create(AOwner: TComponent); override;
|
||||||
published
|
published
|
||||||
|
property Black: integer read FBlack write SetBlack default 0;
|
||||||
property Cyan: integer read FCyan write SetCyan default 255;
|
property Cyan: integer read FCyan write SetCyan default 255;
|
||||||
property Magenta: integer read FMagenta write SetMagenta default 0;
|
property Magenta: integer read FMagenta write SetMagenta default 0;
|
||||||
property Yellow: integer read FYellow write SetYellow 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 SelectedColor: TColor read GetSelectedColor write SetSelectedColor default clRed;
|
||||||
property Layout default lyVertical;
|
property Layout default lyVertical;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
|
|
||||||
uses
|
uses
|
||||||
@ -68,11 +65,96 @@ begin
|
|||||||
FChange := true;
|
FChange := true;
|
||||||
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;
|
||||||
|
|
||||||
|
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;
|
function TCColorPicker.GetGradientColor(AValue: Integer): TColor;
|
||||||
begin
|
begin
|
||||||
Result := CMYKtoColor(AValue, FMagenta, FYellow, FBlack);
|
Result := CMYKtoColor(AValue, FMagenta, FYellow, FBlack);
|
||||||
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;
|
||||||
|
|
||||||
procedure TCColorPicker.SetCyan(C: integer);
|
procedure TCColorPicker.SetCyan(C: integer);
|
||||||
begin
|
begin
|
||||||
Clamp(c, 0, 255);
|
Clamp(c, 0, 255);
|
||||||
@ -112,50 +194,6 @@ begin
|
|||||||
end;
|
end;
|
||||||
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;
|
function TCColorPicker.GetSelectedColor: TColor;
|
||||||
begin
|
begin
|
||||||
Result := CMYKtoColor(FCyan, FMagenta, FYellow, FBlack);
|
Result := CMYKtoColor(FCyan, FMagenta, FYellow, FBlack);
|
||||||
@ -187,45 +225,4 @@ begin
|
|||||||
FChange := true;
|
FChange := true;
|
||||||
end;
|
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.
|
end.
|
||||||
|
@ -7,11 +7,7 @@ unit CIEAColorPicker;
|
|||||||
interface
|
interface
|
||||||
|
|
||||||
uses
|
uses
|
||||||
{$IFDEF FPC}
|
|
||||||
LCLIntf, LCLType, LMessages,
|
LCLIntf, LCLType, LMessages,
|
||||||
{$ELSE}
|
|
||||||
Windows, Messages,
|
|
||||||
{$ENDIF}
|
|
||||||
SysUtils, Classes, Controls, Graphics, Math, Forms,
|
SysUtils, Classes, Controls, Graphics, Math, Forms,
|
||||||
HTMLColors, RGBCIEUtils, mbColorPickerControl;
|
HTMLColors, RGBCIEUtils, mbColorPickerControl;
|
||||||
|
|
||||||
@ -28,13 +24,9 @@ type
|
|||||||
procedure CreateWnd; override;
|
procedure CreateWnd; override;
|
||||||
procedure DrawMarker(x, y: integer);
|
procedure DrawMarker(x, y: integer);
|
||||||
function GetGradientColor2D(x, y: Integer): TColor; override;
|
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 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 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 MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
|
||||||
procedure Paint; override;
|
procedure Paint; override;
|
||||||
procedure Resize; override;
|
procedure Resize; override;
|
||||||
@ -56,25 +48,14 @@ implementation
|
|||||||
uses
|
uses
|
||||||
mbUtils;
|
mbUtils;
|
||||||
|
|
||||||
|
|
||||||
{TCIEAColorPicker}
|
{TCIEAColorPicker}
|
||||||
|
|
||||||
constructor TCIEAColorPicker.Create(AOwner: TComponent);
|
constructor TCIEAColorPicker.Create(AOwner: TComponent);
|
||||||
begin
|
begin
|
||||||
inherited;
|
inherited;
|
||||||
{
|
|
||||||
FBmp := TBitmap.Create;
|
|
||||||
FBmp.PixelFormat := pf32bit;
|
|
||||||
FBmp.SetSize(256, 256);
|
|
||||||
}
|
|
||||||
FGradientWidth := 256;
|
FGradientWidth := 256;
|
||||||
FGradientHeight := 256;
|
FGradientHeight := 256;
|
||||||
{$IFDEF DELPHI}
|
|
||||||
Width := 256;
|
|
||||||
Height := 256;
|
|
||||||
{$ELSE}
|
|
||||||
SetInitialBounds(0, 0, 256, 256);
|
SetInitialBounds(0, 0, 256, 256);
|
||||||
{$ENDIF}
|
|
||||||
HintFormat := 'L: %cieL B: %cieB'#13'Hex: %hex';
|
HintFormat := 'L: %cieL B: %cieB'#13'Hex: %hex';
|
||||||
FSelected := clFuchsia;
|
FSelected := clFuchsia;
|
||||||
FL := 100;
|
FL := 100;
|
||||||
@ -88,25 +69,18 @@ begin
|
|||||||
MarkerStyle := msCircle;
|
MarkerStyle := msCircle;
|
||||||
end;
|
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);
|
procedure TCIEAColorPicker.CorrectCoords(var x, y: integer);
|
||||||
begin
|
begin
|
||||||
Clamp(x, 0, Width - 1);
|
Clamp(x, 0, Width - 1);
|
||||||
Clamp(y, 0, Height - 1);
|
Clamp(y, 0, Height - 1);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TCIEAColorPicker.CreateWnd;
|
||||||
|
begin
|
||||||
|
inherited;
|
||||||
|
CreateGradient;
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TCIEAColorPicker.DrawMarker(x, y: integer);
|
procedure TCIEAColorPicker.DrawMarker(x, y: integer);
|
||||||
var
|
var
|
||||||
c: TColor;
|
c: TColor;
|
||||||
@ -124,91 +98,11 @@ begin
|
|||||||
InternalDrawMarker(x, y, c);
|
InternalDrawMarker(x, y, c);
|
||||||
end;
|
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
|
begin
|
||||||
if WebSafe then c := GetWebSafe(c);
|
Result := LabToRGB(Round(100 - y*100/255), FA, x - 128);
|
||||||
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;
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TCIEAColorPicker.KeyDown(var Key: Word; Shift: TShiftState);
|
procedure TCIEAColorPicker.KeyDown(var Key: Word; Shift: TShiftState);
|
||||||
@ -272,11 +166,65 @@ begin
|
|||||||
inherited;
|
inherited;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TCIEAColorPicker.SetLValue(l: integer);
|
procedure TCIEAColorPicker.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
||||||
begin
|
begin
|
||||||
Clamp(L, 0, 100);
|
inherited;
|
||||||
FL := L;
|
mxx := x;
|
||||||
SetSelectedColor(LabToRGB(FL, FA, FB));
|
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;
|
end;
|
||||||
|
|
||||||
procedure TCIEAColorPicker.SetAValue(a: integer);
|
procedure TCIEAColorPicker.SetAValue(a: integer);
|
||||||
@ -293,4 +241,26 @@ begin
|
|||||||
SetSelectedColor(LabToRGB(FL, FA, FB));
|
SetSelectedColor(LabToRGB(FL, FA, FB));
|
||||||
end;
|
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.
|
end.
|
||||||
|
@ -7,11 +7,7 @@ unit CIEBColorPicker;
|
|||||||
interface
|
interface
|
||||||
|
|
||||||
uses
|
uses
|
||||||
{$IFDEF FPC}
|
|
||||||
LCLIntf, LCLType, LMessages,
|
LCLIntf, LCLType, LMessages,
|
||||||
{$ELSE}
|
|
||||||
Windows, Messages,
|
|
||||||
{$ENDIF}
|
|
||||||
SysUtils, Classes, Controls, Graphics, Math, Forms,
|
SysUtils, Classes, Controls, Graphics, Math, Forms,
|
||||||
HTMLColors, RGBCIEUtils, mbColorPickerControl;
|
HTMLColors, RGBCIEUtils, mbColorPickerControl;
|
||||||
|
|
||||||
@ -31,12 +27,9 @@ type
|
|||||||
procedure CreateWnd; override;
|
procedure CreateWnd; override;
|
||||||
procedure DrawMarker(x, y: integer);
|
procedure DrawMarker(x, y: integer);
|
||||||
function GetGradientColor2D(x, y: Integer): TColor; override;
|
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 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 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 MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
|
||||||
procedure Paint; override;
|
procedure Paint; override;
|
||||||
procedure Resize; override;
|
procedure Resize; override;
|
||||||
@ -44,11 +37,11 @@ type
|
|||||||
public
|
public
|
||||||
constructor Create(AOwner: TComponent); override;
|
constructor Create(AOwner: TComponent); override;
|
||||||
published
|
published
|
||||||
property SelectedColor default clLime;
|
|
||||||
property LValue: integer read FL write SetLValue default 100;
|
|
||||||
property AValue: integer read FA write SetAValue default -128;
|
property AValue: integer read FA write SetAValue default -128;
|
||||||
property BValue: integer read FB write SetBValue default 127;
|
property BValue: integer read FB write SetBValue default 127;
|
||||||
|
property LValue: integer read FL write SetLValue default 100;
|
||||||
property MarkerStyle default msCircle;
|
property MarkerStyle default msCircle;
|
||||||
|
property SelectedColor default clLime;
|
||||||
property OnChange;
|
property OnChange;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -58,7 +51,6 @@ implementation
|
|||||||
uses
|
uses
|
||||||
mbUtils;
|
mbUtils;
|
||||||
|
|
||||||
|
|
||||||
{TCIEBColorPicker}
|
{TCIEBColorPicker}
|
||||||
|
|
||||||
constructor TCIEBColorPicker.Create(AOwner: TComponent);
|
constructor TCIEBColorPicker.Create(AOwner: TComponent);
|
||||||
@ -66,12 +58,7 @@ begin
|
|||||||
inherited;
|
inherited;
|
||||||
FGradientWidth := 256;
|
FGradientWidth := 256;
|
||||||
FGradientHeight := 256;
|
FGradientHeight := 256;
|
||||||
{$IFDEF DELPHI}
|
|
||||||
Width := 256;
|
|
||||||
Height := 256;
|
|
||||||
{$ELSE}
|
|
||||||
SetInitialBounds(0, 0, 256, 256);
|
SetInitialBounds(0, 0, 256, 256);
|
||||||
{$ENDIF}
|
|
||||||
HintFormat := 'L: %cieL A: %cieA'#13'Hex: %hex';
|
HintFormat := 'L: %cieL A: %cieA'#13'Hex: %hex';
|
||||||
FSelected := clLime;
|
FSelected := clLime;
|
||||||
FL := 100;
|
FL := 100;
|
||||||
@ -85,25 +72,18 @@ begin
|
|||||||
MarkerStyle := msCircle;
|
MarkerStyle := msCircle;
|
||||||
end;
|
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);
|
procedure TCIEBColorPicker.CorrectCoords(var x, y: integer);
|
||||||
begin
|
begin
|
||||||
Clamp(x, 0, Width - 1);
|
Clamp(x, 0, Width - 1);
|
||||||
Clamp(y, 0, Height - 1);
|
Clamp(y, 0, Height - 1);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TCIEBColorPicker.CreateWnd;
|
||||||
|
begin
|
||||||
|
inherited;
|
||||||
|
CreateGradient;
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TCIEBColorPicker.DrawMarker(x, y: integer);
|
procedure TCIEBColorPicker.DrawMarker(x, y: integer);
|
||||||
var
|
var
|
||||||
c: TColor;
|
c: TColor;
|
||||||
@ -121,89 +101,11 @@ begin
|
|||||||
InternalDrawMarker(x, y, c);
|
InternalDrawMarker(x, y, c);
|
||||||
end;
|
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
|
begin
|
||||||
if WebSafe then c := GetWebSafe(c);
|
Result := LabToRGB(Round(100 - y*100/255), x - 128, FB);
|
||||||
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;
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TCIEBColorPicker.KeyDown(var Key: Word; Shift: TShiftState);
|
procedure TCIEBColorPicker.KeyDown(var Key: Word; Shift: TShiftState);
|
||||||
@ -267,11 +169,74 @@ begin
|
|||||||
inherited;
|
inherited;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TCIEBColorPicker.SetLValue(L: integer);
|
procedure TCIEBColorPicker.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
||||||
|
var
|
||||||
|
R: TRect;
|
||||||
begin
|
begin
|
||||||
Clamp(L, 0, 100);
|
inherited;
|
||||||
FL := L;
|
mxx := x;
|
||||||
SetSelectedColor(LabToRGB(FL, FA, FB));
|
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;
|
end;
|
||||||
|
|
||||||
procedure TCIEBColorPicker.SetAValue(a: integer);
|
procedure TCIEBColorPicker.SetAValue(a: integer);
|
||||||
@ -288,4 +253,26 @@ begin
|
|||||||
SetSelectedColor(LabToRGB(FL, FA, FB));
|
SetSelectedColor(LabToRGB(FL, FA, FB));
|
||||||
end;
|
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.
|
end.
|
||||||
|
@ -7,11 +7,7 @@ unit CIELColorPicker;
|
|||||||
interface
|
interface
|
||||||
|
|
||||||
uses
|
uses
|
||||||
{$IFDEF FPC}
|
|
||||||
LCLIntf, LCLType, LMessages,
|
LCLIntf, LCLType, LMessages,
|
||||||
{$ELSE}
|
|
||||||
Windows, Messages,
|
|
||||||
{$ENDIF}
|
|
||||||
SysUtils, Classes, Controls, Graphics, Math, Forms,
|
SysUtils, Classes, Controls, Graphics, Math, Forms,
|
||||||
HTMLColors, RGBCIEUtils, mbColorPickerControl;
|
HTMLColors, RGBCIEUtils, mbColorPickerControl;
|
||||||
|
|
||||||
@ -28,10 +24,6 @@ type
|
|||||||
procedure CreateWnd; override;
|
procedure CreateWnd; override;
|
||||||
procedure DrawMarker(x, y: integer);
|
procedure DrawMarker(x, y: integer);
|
||||||
function GetGradientColor2D(x, y: Integer): TColor; override;
|
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 KeyDown(var Key: Word; Shift: TShiftState); override;
|
||||||
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
|
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
|
||||||
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
|
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
|
||||||
@ -42,11 +34,11 @@ type
|
|||||||
public
|
public
|
||||||
constructor Create(AOwner: TComponent); override;
|
constructor Create(AOwner: TComponent); override;
|
||||||
published
|
published
|
||||||
property SelectedColor default clAqua;
|
|
||||||
property LValue: integer read FL write SetLValue default 100;
|
|
||||||
property AValue: integer read FA write SetAValue default -128;
|
property AValue: integer read FA write SetAValue default -128;
|
||||||
property BValue: integer read FB write SetBValue default 127;
|
property BValue: integer read FB write SetBValue default 127;
|
||||||
|
property LValue: integer read FL write SetLValue default 100;
|
||||||
property MarkerStyle default msCircle;
|
property MarkerStyle default msCircle;
|
||||||
|
property SelectedColor default clAqua;
|
||||||
property OnChange;
|
property OnChange;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -63,12 +55,7 @@ begin
|
|||||||
inherited;
|
inherited;
|
||||||
FGradientWidth := 256;
|
FGradientWidth := 256;
|
||||||
FGradientHeight := 256;
|
FGradientHeight := 256;
|
||||||
{$IFDEF DELPHI}
|
|
||||||
Width := 256;
|
|
||||||
Height := 256;
|
|
||||||
{$ELSE}
|
|
||||||
SetInitialBounds(0, 0, 256, 256);
|
SetInitialBounds(0, 0, 256, 256);
|
||||||
{$ENDIF}
|
|
||||||
HintFormat := 'A: %cieA B: %cieB'#13'Hex: %hex';
|
HintFormat := 'A: %cieA B: %cieB'#13'Hex: %hex';
|
||||||
FSelected := clAqua;
|
FSelected := clAqua;
|
||||||
FL := 100;
|
FL := 100;
|
||||||
@ -83,24 +70,18 @@ begin
|
|||||||
SetSelectedColor(clAqua);
|
SetSelectedColor(clAqua);
|
||||||
end;
|
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);
|
procedure TCIELColorPicker.CorrectCoords(var x, y: integer);
|
||||||
begin
|
begin
|
||||||
Clamp(x, 0, Width - 1);
|
Clamp(x, 0, Width - 1);
|
||||||
clamp(y, 0, Height - 1);
|
clamp(y, 0, Height - 1);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TCIELColorPicker.CreateWnd;
|
||||||
|
begin
|
||||||
|
inherited;
|
||||||
|
CreateGradient;
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TCIELColorPicker.DrawMarker(x, y: integer);
|
procedure TCIELColorPicker.DrawMarker(x, y: integer);
|
||||||
var
|
var
|
||||||
c: TColor;
|
c: TColor;
|
||||||
@ -118,89 +99,10 @@ begin
|
|||||||
InternalDrawMarker(x, y, c);
|
InternalDrawMarker(x, y, c);
|
||||||
end;
|
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
|
begin
|
||||||
if WebSafe then c := GetWebSafe(c);
|
Result := LabToRGB(FL, y - 128, x - 128);
|
||||||
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;
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TCIELColorPicker.KeyDown(var Key: Word; Shift: TShiftState);
|
procedure TCIELColorPicker.KeyDown(var Key: Word; Shift: TShiftState);
|
||||||
@ -263,11 +165,63 @@ begin
|
|||||||
inherited;
|
inherited;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TCIELColorPicker.SetLValue(l: integer);
|
procedure TCIELColorPicker.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
||||||
begin
|
begin
|
||||||
Clamp(L, 0, 100);
|
inherited;
|
||||||
FL := L;
|
mxx := x;
|
||||||
SetSelectedColor(LabToRGB(FL, FA, FB));
|
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;
|
end;
|
||||||
|
|
||||||
procedure TCIELColorPicker.SetAValue(a: integer);
|
procedure TCIELColorPicker.SetAValue(a: integer);
|
||||||
@ -284,4 +238,27 @@ begin
|
|||||||
SetSelectedColor(LabToRGB(FL, FA, FB));
|
SetSelectedColor(LabToRGB(FL, FA, FB));
|
||||||
end;
|
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.
|
end.
|
||||||
|
@ -3,9 +3,7 @@ unit RGBCIEUtils;
|
|||||||
interface
|
interface
|
||||||
|
|
||||||
uses
|
uses
|
||||||
SysUtils,
|
SysUtils, LCLIntf, Graphics, Math;
|
||||||
{$IFDEF FPC}LCLIntf,{$ELSE}Windows,{$ENDIF}
|
|
||||||
Graphics, Math;
|
|
||||||
|
|
||||||
const
|
const
|
||||||
{// Observer= 2�, Illuminant= D65 - Daylignt
|
{// Observer= 2�, Illuminant= D65 - Daylignt
|
||||||
|
@ -8,8 +8,7 @@ interface
|
|||||||
{$DEFINE CMYK_FORMULA_2} // Result agrees with OpenOffice
|
{$DEFINE CMYK_FORMULA_2} // Result agrees with OpenOffice
|
||||||
|
|
||||||
uses
|
uses
|
||||||
{$IFDEF FPC}LCLIntf,{$ELSE} Windows,{$ENDIF}
|
LCLIntf, Graphics, Math;
|
||||||
Graphics, Math;
|
|
||||||
|
|
||||||
function CMYtoColor(C, M, Y: integer): TColor;
|
function CMYtoColor(C, M, Y: integer): TColor;
|
||||||
procedure RGBtoCMY(clr: TColor; var C, M, Y: integer);
|
procedure RGBtoCMY(clr: TColor; var C, M, Y: integer);
|
||||||
|
@ -7,12 +7,7 @@ unit RGBHSLUtils;
|
|||||||
interface
|
interface
|
||||||
|
|
||||||
uses
|
uses
|
||||||
{$IFDEF FPC}
|
LCLIntf, LCLType, Graphics, Math, Scanlines;
|
||||||
LCLIntf, LCLType,
|
|
||||||
{$ELSE}
|
|
||||||
Windows,
|
|
||||||
{$ENDIF}
|
|
||||||
Graphics, Math, Scanlines;
|
|
||||||
|
|
||||||
var //set these variables to your needs, e.g. 360, 255, 255
|
var //set these variables to your needs, e.g. 360, 255, 255
|
||||||
MaxHue: integer = 359;
|
MaxHue: integer = 359;
|
||||||
@ -36,6 +31,7 @@ function HSLToRGBTriple(H, S, L : integer) : TRGBTriple;
|
|||||||
function HSLToRGBQuad(H, S, L: integer): TRGBQuad;
|
function HSLToRGBQuad(H, S, L: integer): TRGBQuad;
|
||||||
procedure RGBTripleToHSL(RGBTriple : TRGBTriple; var h, s, l: integer);
|
procedure RGBTripleToHSL(RGBTriple : TRGBTriple; var h, s, l: integer);
|
||||||
|
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
|
|
||||||
uses
|
uses
|
||||||
|
@ -7,12 +7,8 @@ unit RGBHSVUtils;
|
|||||||
interface
|
interface
|
||||||
|
|
||||||
uses
|
uses
|
||||||
{$IFDEF FPC}
|
LCLIntf, LCLType, SysUtils, Classes, Graphics, Math,
|
||||||
LCLIntf, LCLType,
|
Scanlines;
|
||||||
{$ELSE}
|
|
||||||
Windows,
|
|
||||||
{$ENDIF}
|
|
||||||
SysUtils, Classes, Graphics, Math, Scanlines;
|
|
||||||
|
|
||||||
procedure RGBtoHSV(R, G, B: Integer; out H, S, V: Double);
|
procedure RGBtoHSV(R, G, B: Integer; out H, S, V: Double);
|
||||||
procedure RGBtoHSVRange(R, G, B: integer; out H, S, V: integer);
|
procedure RGBtoHSVRange(R, G, B: integer; out H, S, V: integer);
|
||||||
|
@ -7,11 +7,7 @@ unit SColorPicker;
|
|||||||
interface
|
interface
|
||||||
|
|
||||||
uses
|
uses
|
||||||
{$IFDEF FPC}
|
|
||||||
LCLIntf, LCLType, LMessages,
|
LCLIntf, LCLType, LMessages,
|
||||||
{$ELSE}
|
|
||||||
Windows, Messages,
|
|
||||||
{$ENDIF}
|
|
||||||
SysUtils, Classes, Controls, Graphics, Forms,
|
SysUtils, Classes, Controls, Graphics, Forms,
|
||||||
RGBHSVUtils, mbTrackBarPicker, HTMLColors, Scanlines;
|
RGBHSVUtils, mbTrackBarPicker, HTMLColors, Scanlines;
|
||||||
|
|
||||||
@ -21,18 +17,18 @@ type
|
|||||||
FVal, FHue, FSat: Double;
|
FVal, FHue, FSat: Double;
|
||||||
FMaxVal, FMaxHue, FMaxSat: Integer;
|
FMaxVal, FMaxHue, FMaxSat: Integer;
|
||||||
function ArrowPosFromSat(s: integer): integer;
|
function ArrowPosFromSat(s: integer): integer;
|
||||||
function SatFromArrowPos(p: integer): integer;
|
|
||||||
function GetHue: Integer;
|
function GetHue: Integer;
|
||||||
function GetSat: Integer;
|
function GetSat: Integer;
|
||||||
function GetVal: Integer;
|
|
||||||
function GetSelectedColor: TColor;
|
function GetSelectedColor: TColor;
|
||||||
procedure SetSelectedColor(c: TColor);
|
function GetVal: Integer;
|
||||||
|
function SatFromArrowPos(p: integer): integer;
|
||||||
procedure SetHue(h: integer);
|
procedure SetHue(h: integer);
|
||||||
procedure SetSat(s: integer);
|
|
||||||
procedure SetValue(v: integer);
|
|
||||||
procedure SetMaxHue(h: Integer);
|
procedure SetMaxHue(h: Integer);
|
||||||
procedure SetMaxSat(s: Integer);
|
procedure SetMaxSat(s: Integer);
|
||||||
procedure SetMaxVal(v: Integer);
|
procedure SetMaxVal(v: Integer);
|
||||||
|
procedure SetSat(s: integer);
|
||||||
|
procedure SetValue(v: integer);
|
||||||
|
procedure SetSelectedColor(c: TColor);
|
||||||
protected
|
protected
|
||||||
procedure Execute(tbaAction: integer); override;
|
procedure Execute(tbaAction: integer); override;
|
||||||
function GetArrowPos: integer; override;
|
function GetArrowPos: integer; override;
|
||||||
@ -75,6 +71,25 @@ begin
|
|||||||
FChange := true;
|
FChange := true;
|
||||||
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;
|
||||||
|
|
||||||
(*
|
(*
|
||||||
procedure TSColorPicker.CreateSGradient;
|
procedure TSColorPicker.CreateSGradient;
|
||||||
var
|
var
|
||||||
@ -121,162 +136,6 @@ begin
|
|||||||
end;
|
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);
|
procedure TSColorPicker.Execute(tbaAction: integer);
|
||||||
begin
|
begin
|
||||||
case tbaAction of
|
case tbaAction of
|
||||||
@ -313,4 +172,142 @@ begin
|
|||||||
end;
|
end;
|
||||||
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.
|
end.
|
||||||
|
@ -7,12 +7,7 @@ unit Scanlines;
|
|||||||
interface
|
interface
|
||||||
|
|
||||||
uses
|
uses
|
||||||
{$IFDEF FPC}
|
LCLIntf, LCLType, Graphics;
|
||||||
LCLIntf, LCLType,
|
|
||||||
{$ELSE}
|
|
||||||
Windows,
|
|
||||||
{$ENDIF}
|
|
||||||
Graphics;
|
|
||||||
|
|
||||||
type
|
type
|
||||||
TRGBTripleArray = array [0..65535] of TRGBTriple;
|
TRGBTripleArray = array [0..65535] of TRGBTriple;
|
||||||
@ -27,6 +22,7 @@ function RGBToRGBQuad(c: TColor): TRGBQuad; overload;
|
|||||||
function RGBQuadToRGB(q: TRGBQuad): TColor;
|
function RGBQuadToRGB(q: TRGBQuad): TColor;
|
||||||
function RGBTripleToColor(RGBTriple : TRGBTriple) : TColor;
|
function RGBTripleToColor(RGBTriple : TRGBTriple) : TColor;
|
||||||
|
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
|
|
||||||
function RGBtoRGBTriple(R, G, B: byte): TRGBTriple;
|
function RGBtoRGBTriple(R, G, B: byte): TRGBTriple;
|
||||||
|
@ -7,12 +7,8 @@ unit ScreenWin;
|
|||||||
interface
|
interface
|
||||||
|
|
||||||
uses
|
uses
|
||||||
{$IFDEF FPC}
|
LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, Forms,
|
||||||
LCLIntf, LCLType, LMessages,
|
ExtCtrls, StdCtrls,
|
||||||
{$ELSE}
|
|
||||||
Windows, Messages,
|
|
||||||
{$ENDIF}
|
|
||||||
SysUtils, Classes, Graphics, Controls, Forms, ExtCtrls, StdCtrls,
|
|
||||||
PalUtils;
|
PalUtils;
|
||||||
|
|
||||||
const
|
const
|
||||||
@ -47,12 +43,7 @@ var
|
|||||||
|
|
||||||
implementation
|
implementation
|
||||||
|
|
||||||
{$IFDEF DELPHI}
|
|
||||||
{$R *.dfm}
|
|
||||||
{$ELSE}
|
|
||||||
{$R *.lfm}
|
{$R *.lfm}
|
||||||
{$ENDIF}
|
|
||||||
|
|
||||||
{$R PickCursor.res}
|
{$R PickCursor.res}
|
||||||
|
|
||||||
function ColorToHex(Color: TColor): string;
|
function ColorToHex(Color: TColor): string;
|
||||||
@ -74,28 +65,36 @@ begin
|
|||||||
c.Free;
|
c.Free;
|
||||||
end;
|
end;
|
||||||
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
|
begin
|
||||||
Width := Screen.Width;
|
with TCMHintShow(Message) do
|
||||||
Height := Screen.Height;
|
if not ShowHint then
|
||||||
Left := 0;
|
Message.Result := 1
|
||||||
Top := 0;
|
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;
|
end;
|
||||||
|
|
||||||
procedure TScreenForm.FormCreate(Sender: TObject);
|
procedure TScreenForm.FormCreate(Sender: TObject);
|
||||||
@ -118,23 +117,6 @@ begin
|
|||||||
FOnKeyDown(Self, Key, Shift);
|
FOnKeyDown(Self, Key, Shift);
|
||||||
end;
|
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,
|
procedure TScreenForm.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
|
||||||
Y: Integer);
|
Y: Integer);
|
||||||
begin
|
begin
|
||||||
@ -143,21 +125,18 @@ begin
|
|||||||
Application.ProcessMessages;
|
Application.ProcessMessages;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TScreenForm.CMHintShow(var Message: TCMHintShow);
|
procedure TScreenForm.FormMouseUp(Sender: TObject; Button: TMouseButton;
|
||||||
|
Shift: TShiftState; X, Y: Integer);
|
||||||
begin
|
begin
|
||||||
with TCMHintShow(Message) do
|
EndSelection(x, y, true);
|
||||||
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;
|
end;
|
||||||
inherited;
|
|
||||||
|
procedure TScreenForm.FormShow(Sender: TObject);
|
||||||
|
begin
|
||||||
|
Width := Screen.Width;
|
||||||
|
Height := Screen.Height;
|
||||||
|
Left := 0;
|
||||||
|
Top := 0;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
end.
|
end.
|
||||||
|
@ -7,12 +7,7 @@ unit SelPropUtils;
|
|||||||
interface
|
interface
|
||||||
|
|
||||||
uses
|
uses
|
||||||
{$IFDEF FPC}
|
LCLIntf, LCLType, Classes, Graphics;
|
||||||
LCLIntf, LCLType,
|
|
||||||
{$ELSE}
|
|
||||||
Windows,
|
|
||||||
{$ENDIF}
|
|
||||||
Classes, Graphics;
|
|
||||||
|
|
||||||
procedure DrawSelCross(x, y: integer; Canvas: TCanvas; Color: TColor);
|
procedure DrawSelCross(x, y: integer; Canvas: TCanvas; Color: TColor);
|
||||||
procedure DrawSelCrossCirc(x, y: integer; Canvas: TCanvas; Color: TColor);
|
procedure DrawSelCrossCirc(x, y: integer; Canvas: TCanvas; Color: TColor);
|
||||||
|
Reference in New Issue
Block a user