You've already forked lazarus-ccr
mbColorLib: several bug fixes. Refactoring of gradient painting.
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5456 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
@@ -7,45 +7,41 @@ unit KColorPicker;
|
||||
interface
|
||||
|
||||
uses
|
||||
{$IFDEF FPC}
|
||||
LCLIntf, LCLType, LMessages,
|
||||
{$ELSE}
|
||||
Windows, Messages,
|
||||
{$ENDIF}
|
||||
SysUtils, Classes, Controls, Graphics, Forms,
|
||||
RGBCMYKUtils, mbTrackBarPicker, HTMLColors, Scanlines;
|
||||
{$IFDEF FPC}
|
||||
LCLIntf, LCLType, LMessages,
|
||||
{$ELSE}
|
||||
Windows, Messages,
|
||||
{$ENDIF}
|
||||
SysUtils, Classes, Controls, Graphics, Forms,
|
||||
RGBCMYKUtils, mbTrackBarPicker, HTMLColors;
|
||||
|
||||
type
|
||||
TKColorPicker = class(TmbTrackBarPicker)
|
||||
private
|
||||
FCyan, FMagenta, FYellow, FBlack: integer;
|
||||
FKBmp: TBitmap;
|
||||
|
||||
function ArrowPosFromBlack(k: integer): integer;
|
||||
function BlackFromArrowPos(p: integer): integer;
|
||||
function GetSelectedColor: TColor;
|
||||
procedure SetSelectedColor(c: TColor);
|
||||
procedure CreateKGradient;
|
||||
procedure SetCyan(c: integer);
|
||||
procedure SetMagenta(m: integer);
|
||||
procedure SetYellow(y: integer);
|
||||
procedure SetBlack(k: integer);
|
||||
protected
|
||||
procedure CreateWnd; override;
|
||||
procedure Execute(tbaAction: integer); override;
|
||||
function GetArrowPos: integer; override;
|
||||
function GetSelectedValue: integer; override;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
published
|
||||
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;
|
||||
TKColorPicker = class(TmbTrackBarPicker)
|
||||
private
|
||||
FCyan, FMagenta, FYellow, FBlack: integer;
|
||||
function ArrowPosFromBlack(k: integer): integer;
|
||||
function BlackFromArrowPos(p: integer): integer;
|
||||
function GetSelectedColor: TColor;
|
||||
procedure SetSelectedColor(c: TColor);
|
||||
procedure SetCyan(c: integer);
|
||||
procedure SetMagenta(m: integer);
|
||||
procedure SetYellow(y: integer);
|
||||
procedure SetBlack(k: integer);
|
||||
protected
|
||||
procedure Execute(tbaAction: integer); override;
|
||||
function GetArrowPos: integer; override;
|
||||
function GetGradientColor(AValue: Integer): TColor; override;
|
||||
function GetSelectedValue: integer; override;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
published
|
||||
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;
|
||||
|
||||
procedure Register;
|
||||
|
||||
@@ -57,47 +53,36 @@ implementation
|
||||
|
||||
procedure Register;
|
||||
begin
|
||||
RegisterComponents('mbColor Lib', [TKColorPicker]);
|
||||
RegisterComponents('mbColor Lib', [TKColorPicker]);
|
||||
end;
|
||||
|
||||
{TKColorPicker}
|
||||
|
||||
constructor TKColorPicker.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited;
|
||||
FKBmp := TBitmap.Create;
|
||||
FKBmp.PixelFormat := pf32bit;
|
||||
FKBmp.SetSize(12, 255);
|
||||
Width := 22;
|
||||
Height := 267;
|
||||
Layout := lyVertical;
|
||||
FCyan := 0;
|
||||
FMagenta := 0;
|
||||
FYellow := 0;
|
||||
FBlack := 255;
|
||||
FArrowPos := ArrowPosFromBlack(255);
|
||||
FChange := false;
|
||||
SetBlack(255);
|
||||
HintFormat := 'Black: %value';
|
||||
FManual := false;
|
||||
FChange := true;
|
||||
end;
|
||||
|
||||
destructor TKColorPicker.Destroy;
|
||||
begin
|
||||
FKBmp.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TKColorPicker.CreateWnd;
|
||||
begin
|
||||
inherited;
|
||||
CreateKGradient;
|
||||
inherited;
|
||||
FGradientWidth := 256;
|
||||
FGradientHeight := 12;
|
||||
SetInitialBounds(0, 0, 22, 267);
|
||||
//Width := 22;
|
||||
//Height := 267;
|
||||
Layout := lyVertical;
|
||||
FCyan := 0;
|
||||
FMagenta := 0;
|
||||
FYellow := 0;
|
||||
FBlack := 255;
|
||||
FArrowPos := ArrowPosFromBlack(255);
|
||||
FChange := false;
|
||||
SetBlack(255);
|
||||
HintFormat := 'Black: %value';
|
||||
FManual := false;
|
||||
FChange := true;
|
||||
end;
|
||||
|
||||
(*
|
||||
procedure TKColorPicker.CreateKGradient;
|
||||
var
|
||||
i,j: integer;
|
||||
i,j: integer;
|
||||
row: pRGBQuadArray;
|
||||
begin
|
||||
if FKBmp = nil then
|
||||
@@ -138,105 +123,107 @@ begin
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
*)
|
||||
|
||||
function TKColorPicker.GetGradientColor(AValue: Integer): TColor;
|
||||
begin
|
||||
Result := CMYKtoTColor(FCyan, FMagenta, FYellow, AValue);
|
||||
end;
|
||||
|
||||
procedure TKColorPicker.SetBlack(k: integer);
|
||||
begin
|
||||
if k < 0 then k := 0;
|
||||
if k > 255 then k := 255;
|
||||
if FBlack <> k then
|
||||
if k < 0 then k := 0;
|
||||
if k > 255 then k := 255;
|
||||
if FBlack <> k then
|
||||
begin
|
||||
FBlack := k;
|
||||
FArrowPos := ArrowPosFromBlack(k);
|
||||
FManual := false;
|
||||
Invalidate;
|
||||
if FChange then
|
||||
if Assigned(OnChange) then OnChange(Self);
|
||||
FBlack := k;
|
||||
FArrowPos := ArrowPosFromBlack(k);
|
||||
FManual := false;
|
||||
Invalidate;
|
||||
if FChange and Assigned(OnChange) then OnChange(Self);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TKColorPicker.SetMagenta(m: integer);
|
||||
begin
|
||||
if m > 255 then m := 255;
|
||||
if m < 0 then m := 0;
|
||||
if FMagenta <> m then
|
||||
if m > 255 then m := 255;
|
||||
if m < 0 then m := 0;
|
||||
if FMagenta <> m then
|
||||
begin
|
||||
FMagenta := m;
|
||||
FManual := false;
|
||||
CreateKGradient;
|
||||
Invalidate;
|
||||
if FChange then
|
||||
if Assigned(OnChange) then OnChange(Self);
|
||||
FMagenta := m;
|
||||
FManual := false;
|
||||
CreateGradient;
|
||||
Invalidate;
|
||||
if FChange and Assigned(OnChange) then OnChange(Self);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TKColorPicker.SetYellow(y: integer);
|
||||
begin
|
||||
if y > 255 then y := 255;
|
||||
if y < 0 then y := 0;
|
||||
if FYellow <> y then
|
||||
if y > 255 then y := 255;
|
||||
if y < 0 then y := 0;
|
||||
if FYellow <> y then
|
||||
begin
|
||||
FYellow := y;
|
||||
FManual := false;
|
||||
CreateKGradient;
|
||||
Invalidate;
|
||||
if FChange then
|
||||
if Assigned(OnChange) then OnChange(Self);
|
||||
FYellow := y;
|
||||
FManual := false;
|
||||
CreateGradient;
|
||||
Invalidate;
|
||||
if FChange and Assigned(OnChange) then OnChange(Self);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TKColorPicker.SetCyan(c: integer);
|
||||
begin
|
||||
if c > 255 then c := 255;
|
||||
if c < 0 then c := 0;
|
||||
if FCyan <> c then
|
||||
if c > 255 then c := 255;
|
||||
if c < 0 then c := 0;
|
||||
if FCyan <> c then
|
||||
begin
|
||||
FCyan := c;
|
||||
FManual := false;
|
||||
CreateKGradient;
|
||||
Invalidate;
|
||||
if FChange then
|
||||
if Assigned(OnChange) then OnChange(Self);
|
||||
FCyan := c;
|
||||
FManual := false;
|
||||
CreateGradient;
|
||||
Invalidate;
|
||||
if FChange and Assigned(OnChange) then OnChange(Self);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TKColorPicker.ArrowPosFromBlack(k: integer): integer;
|
||||
var
|
||||
a: integer;
|
||||
a: integer;
|
||||
begin
|
||||
if Layout = lyHorizontal then
|
||||
if Layout = lyHorizontal then
|
||||
begin
|
||||
a := Round(((Width - 12)/255)*k);
|
||||
if a > Width - FLimit then a := Width - FLimit;
|
||||
a := Round(((Width - 12)/255)*k);
|
||||
if a > Width - FLimit then a := Width - FLimit;
|
||||
end
|
||||
else
|
||||
else
|
||||
begin
|
||||
k := 255 - k;
|
||||
a := Round(((Height - 12)/255)*k);
|
||||
if a > Height - FLimit then a := Height - FLimit;
|
||||
k := 255 - k;
|
||||
a := Round(((Height - 12)/255)*k);
|
||||
if a > Height - FLimit then a := Height - FLimit;
|
||||
end;
|
||||
if a < 0 then a := 0;
|
||||
Result := a;
|
||||
if a < 0 then a := 0;
|
||||
Result := a;
|
||||
end;
|
||||
|
||||
function TKColorPicker.BlackFromArrowPos(p: integer): integer;
|
||||
var
|
||||
r: integer;
|
||||
r: integer;
|
||||
begin
|
||||
if Layout = lyHorizontal then
|
||||
r := Round(p/((Width - 12)/255))
|
||||
else
|
||||
r := Round(255 - p/((Height - 12)/255));
|
||||
if r < 0 then r := 0;
|
||||
if r > 255 then r := 255;
|
||||
Result := r;
|
||||
if Layout = lyHorizontal then
|
||||
r := Round(p/((Width - 12)/255))
|
||||
else
|
||||
r := Round(255 - p/((Height - 12)/255));
|
||||
if r < 0 then r := 0;
|
||||
if r > 255 then r := 255;
|
||||
Result := r;
|
||||
end;
|
||||
|
||||
function TKColorPicker.GetSelectedColor: TColor;
|
||||
begin
|
||||
if not WebSafe then
|
||||
Result := CMYKtoTColor(FCyan, FMagenta, FYellow, FBlack)
|
||||
else
|
||||
Result := GetWebSafe(CMYKtoTColor(FCyan, FMagenta, FYellow, FBlack));
|
||||
if not WebSafe then
|
||||
Result := CMYKtoTColor(FCyan, FMagenta, FYellow, FBlack)
|
||||
else
|
||||
Result := GetWebSafe(CMYKtoTColor(FCyan, FMagenta, FYellow, FBlack));
|
||||
end;
|
||||
|
||||
function TKColorPicker.GetSelectedValue: integer;
|
||||
@@ -246,45 +233,59 @@ end;
|
||||
|
||||
procedure TKColorPicker.SetSelectedColor(c: TColor);
|
||||
var
|
||||
cy, m, y, k: integer;
|
||||
cy, m, y, k: integer;
|
||||
begin
|
||||
if WebSafe then c := GetWebSafe(c);
|
||||
ColorToCMYK(c, cy, m, y, k);
|
||||
FChange := false;
|
||||
SetMagenta(m);
|
||||
SetYellow(y);
|
||||
SetCyan(cy);
|
||||
SetBlack(k);
|
||||
FManual := false;
|
||||
FChange := true;
|
||||
if Assigned(OnChange) then OnChange(Self);
|
||||
if WebSafe then c := GetWebSafe(c);
|
||||
ColorToCMYK(c, cy, m, y, k);
|
||||
FChange := false;
|
||||
SetMagenta(m);
|
||||
SetYellow(y);
|
||||
SetCyan(cy);
|
||||
SetBlack(k);
|
||||
FManual := false;
|
||||
FChange := true;
|
||||
if Assigned(OnChange) then OnChange(Self);
|
||||
end;
|
||||
|
||||
function TKColorPicker.GetArrowPos: integer;
|
||||
begin
|
||||
Result := ArrowPosFromBlack(FBlack);
|
||||
Result := ArrowPosFromBlack(FBlack);
|
||||
end;
|
||||
|
||||
procedure TKColorPicker.Execute(tbaAction: integer);
|
||||
begin
|
||||
case tbaAction of
|
||||
TBA_Resize: SetBlack(FBlack);
|
||||
TBA_Paint: Canvas.StretchDraw(FPickRect, FKBmp);
|
||||
TBA_MouseMove: FBlack := BlackFromArrowPos(FArrowPos);
|
||||
TBA_MouseDown: FBlack := BlackFromArrowPos(FArrowPos);
|
||||
TBA_MouseUp: FBlack := BlackFromArrowPos(FArrowPos);
|
||||
TBA_WheelUp: SetBlack(FBlack + Increment);
|
||||
TBA_WheelDown: SetBlack(FBlack - Increment);
|
||||
TBA_VKRight: SetBlack(FBlack + Increment);
|
||||
TBA_VKCtrlRight: SetBlack(255);
|
||||
TBA_VKLeft: SetBlack(FBlack - Increment);
|
||||
TBA_VKCtrlLeft: SetBlack(0);
|
||||
TBA_VKUp: SetBlack(FBlack + Increment);
|
||||
TBA_VKCtrlUp: SetBlack(255);
|
||||
TBA_VKDown: SetBlack(FBlack - Increment);
|
||||
TBA_VKCtrlDown: SetBlack(0);
|
||||
TBA_RedoBMP: CreateKGradient;
|
||||
end;
|
||||
case tbaAction of
|
||||
TBA_Resize:
|
||||
SetBlack(FBlack);
|
||||
TBA_MouseMove:
|
||||
FBlack := BlackFromArrowPos(FArrowPos);
|
||||
TBA_MouseDown:
|
||||
FBlack := BlackFromArrowPos(FArrowPos);
|
||||
TBA_MouseUp:
|
||||
FBlack := BlackFromArrowPos(FArrowPos);
|
||||
TBA_WheelUp:
|
||||
SetBlack(FBlack + Increment);
|
||||
TBA_WheelDown:
|
||||
SetBlack(FBlack - Increment);
|
||||
TBA_VKRight:
|
||||
SetBlack(FBlack + Increment);
|
||||
TBA_VKCtrlRight:
|
||||
SetBlack(255);
|
||||
TBA_VKLeft:
|
||||
SetBlack(FBlack - Increment);
|
||||
TBA_VKCtrlLeft:
|
||||
SetBlack(0);
|
||||
TBA_VKUp:
|
||||
SetBlack(FBlack + Increment);
|
||||
TBA_VKCtrlUp:
|
||||
SetBlack(255);
|
||||
TBA_VKDown:
|
||||
SetBlack(FBlack - Increment);
|
||||
TBA_VKCtrlDown:
|
||||
SetBlack(0);
|
||||
else
|
||||
inherited;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
Reference in New Issue
Block a user