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

mbColorLib: Beginning to remove Delphi support. Cleanup.

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

217
components/mbColorLib/CIEBColorPicker.pas
View File

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