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

212
components/mbColorLib/CIEAColorPicker.pas
View File

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