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

mbColorLib: Refactor OnChange events. (NOTE: OfficeColorDialog may hang when switching pickers).

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5578 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2017-01-02 00:05:26 +00:00
parent 176aff8ff1
commit 454f0baf7b
41 changed files with 1830 additions and 1837 deletions
Download Patch File Download Diff File Expand all files Collapse all files

180
components/mbColorLib/CIEBColorPicker.pas
View File

@@ -8,7 +8,7 @@ interface
uses
LCLIntf, LCLType, LMessages,
SysUtils, Classes, Controls, Graphics, Math, Forms,
SysUtils, Classes, Controls, Graphics, Forms,
HTMLColors, RGBCIEUtils, mbColorPickerControl;
type
@@ -33,14 +33,15 @@ type
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure Paint; override;
procedure Resize; override;
procedure SelectColor(x, y: Integer);
procedure SetSelectedColor(c: TColor); override;
public
constructor Create(AOwner: TComponent); override;
function GetColorAtPoint(x, y: Integer): TColor; override;
published
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;
@@ -50,7 +51,7 @@ type
implementation
uses
mbUtils;
Math, mbUtils;
{TCIEBColorPicker}
@@ -65,7 +66,6 @@ begin
FL := 100;
FA := -128;
FB := 127;
FManual := false;
dx := 0;
dy := 0;
mxx := 0;
@@ -115,10 +115,10 @@ end;
}
function TCIEBColorPicker.GetColorAtPoint(x, y: Integer): TColor;
var
l, a: Double;
l, a: Integer;
begin
l := (1 - y / (Height - 1)) * 100;
a := (x / (Width - 1) - 0.5) * 255;
l := Round((1 - y / (Height - 1)) * 100);
a := Round((x / (Width - 1) - 0.5) * 255);
Result := LabToRGB(l, a, FB);
end;
@@ -135,107 +135,44 @@ var
delta: Integer;
begin
eraseKey := true;
if (ssCtrl in Shift) then delta := 10 else delta := 1;
delta := IfThen(ssCtrl in Shift, 10, 1);
case Key of
VK_LEFT:
begin
mxx := dx - delta;
myy := dy;
if myy < 0 then myy := 0;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
if Assigned(FOnChange) then
FOnChange(Self);
end;
VK_RIGHT:
begin
mxx := dx + delta;
myy := dy;
if myy >= Width then myy := Width - 1;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
if Assigned(FOnChange) then
FOnChange(Self);
end;
VK_UP:
begin
mxx := dx;
myy := dy - delta;
if myy < 0 then myy := 0;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
if Assigned(FOnChange) then
FOnChange(Self);
end;
VK_DOWN:
begin
mxx := dx;
myy := dy + delta;
if myy >= Height then myy := Height - 1;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
if Assigned(FOnChange) then
FOnChange(Self);
end;
else
eraseKey := false;
VK_LEFT : SelectColor(mxx - delta, myy);
VK_RIGHT : SelectColor(mxx + delta, myy);
VK_UP : SelectColor(mxx, myy - delta);
VK_DOWN : SelectColor(mxx, myy + delta);
else eraseKey := false;
end;
if eraseKey then Key := 0;
if eraseKey then
Key := 0;
inherited;
end;
procedure TCIEBColorPicker.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure TCIEBColorPicker.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
inherited;
if Button = mbLeft then
begin
mxx := x;
myy := y;
CorrectCoords(mxx, myy);
FSelected := GetColorAtPoint(mxx, myy);
FSelected := GetColorAtPoint(x, y);
FManual := true;
Invalidate;
end;
SelectColor(X, Y);
SetFocus;
end;
procedure TCIEBColorPicker.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
inherited;
if ssLeft in Shift then
begin
mxx := x;
myy := y;
CorrectCoords(mxx, myy);
FSelected := GetColorAtPoint(mxx, myy);
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;
CorrectCoords(mxx, myy);
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
if Assigned(FOnChange) then
FOnChange(Self);
end;
SelectColor(X, Y);
end;
procedure TCIEBColorPicker.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
inherited;
if Button = mbLeft then
SelectColor(X, Y);
end;
procedure TCIEBColorPicker.Paint;
@@ -246,12 +183,41 @@ end;
procedure TCIEBColorPicker.Resize;
begin
FManual := false;
mxx := Round((FA + 128) * (Width / 255));
myy := Round(((100 - FL) * 255 / 100) * (Height / 255));
// myy := Round(((100 - FL) * 255 / 100) * (Height / 255));
myy := Round(( 100 - FL) / 100 * Height);
inherited;
end;
procedure TCIEBColorPicker.SelectColor(x, y: Integer);
var
c: TColor;
l, a, b: Integer;
needNewGradient: Boolean;
begin
CorrectCoords(x, y);
c := GetColorAtPoint(x, y);
if WebSafe then
c := GetWebSafe(c);
if c = FSelected then
exit;
mxx := x;
myy := y;
l := Round(GetCIELValue(c));
a := Round(GetCIEAValue(c));
b := Round(GetCIEBValue(c));
needNewGradient := b <> FB;
FSelected := c;
FL := l;
FA := a;
FB := b;
if needNewGradient then
CreateGradient;
Invalidate;
DoChange;
end;
procedure TCIEBColorPicker.SetAValue(a: integer);
begin
Clamp(a, -128, 127);
@@ -274,18 +240,30 @@ begin
end;
procedure TCIEBColorPicker.SetSelectedColor(c: TColor);
var
l, a, b: Integer;
needNewGradient: Boolean;
begin
if WebSafe then c := GetWebSafe(c);
FL := Round(GetCIELValue(c));
FA := Round(GetCIEAValue(c));
FB := Round(GetCIEBValue(c));
if WebSafe then
c := GetWebSafe(c);
if c = FSelected then
exit;
l := Round(GetCIELValue(c));
a := Round(GetCIEAValue(c));
b := Round(GetCIEBValue(c));
needNewGradient := (b <> FB);
FL := l;
FA := a;
FB := b;
FSelected := c;
FManual := false;
mxx := Round((FA + 128) * Width / 255);
myy := Round((100 - FL) * 255 / 100* Height / 255);
// myy := Round((100 - FL) * 255 / 100* Height / 255);
myy := Round((100 - FL) / 100 * Height);
if needNewGradient then
CreateGradient;
Invalidate;
if Assigned(FOnChange) then
FOnChange(Self);
DoChange;
end;
end.