diff --git a/components/mbColorLib/BAxisColorPicker.pas b/components/mbColorLib/BAxisColorPicker.pas
index b86f7c977..5c390f732 100644
--- a/components/mbColorLib/BAxisColorPicker.pas
+++ b/components/mbColorLib/BAxisColorPicker.pas
@@ -7,57 +7,45 @@ unit BAxisColorPicker;
interface
uses
- {$IFDEF FPC}
- LCLIntf, LCLType, LMessages,
- {$ELSE}
- Windows, Messages,
- {$ENDIF}
- SysUtils, Classes, Controls, Graphics, Math, Forms,
- HTMLColors, SelPropUtils, mbColorPickerControl, Scanlines;
+ {$IFDEF FPC}
+ LCLIntf, LCLType, LMessages,
+ {$ELSE}
+ Windows, Messages,
+ {$ENDIF}
+ SysUtils, Classes, Controls, Graphics, Math, Forms,
+ HTMLColors, mbColorPickerControl;
type
- TBAxisColorPicker = class(TmbColorPickerControl)
- private
- FSelected: TColor;
- FBmp: TBitmap;
- FOnChange: TNotifyEvent;
- FR, FG, FB: integer;
- FManual: boolean;
- dx, dy, mxx, myy: integer;
-
- procedure SetRValue(r: integer);
- procedure SetGValue(g: integer);
- procedure SetBValue(b: integer);
- protected
- function GetSelectedColor: TColor; override;
- procedure WebSafeChanged; override;
- procedure SetSelectedColor(c: TColor); override;
- procedure CNKeyDown(var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF});
- message CN_KEYDOWN;
- procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
- procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
- procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
- procedure DrawMarker(x, y: integer);
- procedure Paint; override;
- procedure CreateRGBGradient;
- procedure Resize; override;
- procedure CreateWnd; override;
- procedure CorrectCoords(var x, y: integer);
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
-
- function GetColorAtPoint(x, y: integer): TColor; override;
- property Manual: boolean read FManual;
- published
- property SelectedColor default clBlue;
- property RValue: integer read FR write SetRValue default 0;
- property GValue: integer read FG write SetGValue default 0;
- property BValue: integer read FB write SetBValue default 255;
- property MarkerStyle default msCircle;
-
- property OnChange: TNotifyEvent read FOnChange write FOnChange;
- end;
+ TBAxisColorPicker = class(TmbColorPickerControl)
+ private
+ FR, FG, FB: integer;
+ dx, dy, mxx, myy: integer;
+ procedure SetRValue(r: integer);
+ procedure SetGValue(g: integer);
+ procedure SetBValue(b: integer);
+ protected
+ function GetGradientColor2D(x, y: Integer): TColor; override;
+ procedure SetSelectedColor(c: TColor); override;
+ procedure CNKeyDown(var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF});
+ message CN_KEYDOWN;
+ procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
+ procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
+ procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
+ procedure DrawMarker(x, y: integer);
+ procedure Paint; override;
+ procedure Resize; override;
+ procedure CreateWnd; override;
+ procedure CorrectCoords(var x, y: integer);
+ public
+ constructor Create(AOwner: TComponent); override;
+ published
+ property SelectedColor default clBlue;
+ property RValue: integer read FR write SetRValue default 0;
+ property GValue: integer read FG write SetGValue default 0;
+ property BValue: integer read FB write SetBValue default 255;
+ property MarkerStyle default msCircle;
+ property OnChange;
+ end;
procedure Register;
@@ -67,218 +55,189 @@ implementation
{$R BAxisColorPicker.dcr}
{$ENDIF}
+uses
+ mbUtils;
+
procedure Register;
begin
- RegisterComponents('mbColor Lib', [TBAxisColorPicker]);
+ RegisterComponents('mbColor Lib', [TBAxisColorPicker]);
end;
{TBAxisColorPicker}
constructor TBAxisColorPicker.Create(AOwner: TComponent);
begin
- inherited;
- FBmp := TBitmap.Create;
- FBmp.PixelFormat := pf32bit;
- FBmp.SetSize(256, 256);
- Width := 256;
- Height := 256;
- HintFormat := 'R: %r G: %g'#13'Hex: %hex';
- FG := 0;
- FB := 255;
- FR := 0;
- FSelected := clBlue;
- FManual := false;
- dx := 0;
- dy := 0;
- mxx := 0;
- myy := 0;
- MarkerStyle := msCircle;
-end;
-
-destructor TBAxisColorPicker.Destroy;
-begin
- FBmp.Free;
- inherited Destroy;
+ inherited;
+ FGradientWidth := 256;
+ FGradientHeight := 256;
+ {$IFDEF DELPHI}
+ Width := 256;
+ Height := 256;
+ {$ELSE}
+ SetInitialBounds(0, 0, 255, 255);
+ {$ENDIF}
+ HintFormat := 'R: %r G: %g'#13'Hex: %hex';
+ FG := 0;
+ FB := 255;
+ FR := 0;
+ FSelected := clBlue;
+ FManual := false;
+ dx := 0;
+ dy := 0;
+ mxx := 0;
+ myy := 0;
+ MarkerStyle := msCircle;
end;
procedure TBAxisColorPicker.CreateWnd;
begin
- inherited;
- CreateRGBGradient;
+ inherited;
+ CreateGradient;
end;
-procedure TBAxisColorPicker.CreateRGBGradient;
-var
- r, g: integer;
- row: pRGBQuadArray;
+{ x is RED, y is GREEN }
+function TBAxisColorPicker.GetGradientColor2D(x, y: Integer): TColor;
begin
- if FBmp = nil then
- begin
- FBmp := TBitmap.Create;
- FBmp.PixelFormat := pf32bit;
- FBmp.Width := 256;
- FBmp.Height := 256;
- end;
-
- for g := 0 to 255 do
- begin
- row := FBmp.ScanLine[255 - g];
- for r := 0 to 255 do
- if not WebSafe then
- row[r] := RGBtoRGBQuad(r, g, FB)
- else
- row[r] := RGBtoRGBQuad(GetWebSafe(RGB(r, g, FB)));
- end;
+ Result := RGB(x, FGradientBmp.Height - 1 - y, FB);
end;
procedure TBAxisColorPicker.CorrectCoords(var x, y: integer);
begin
- if x < 0 then x := 0;
- if y < 0 then y := 0;
- if x > Width - 1 then x := Width - 1;
- if y > Height - 1 then y := Height - 1;
+ Clamp(x, 0, Width - 1);
+ Clamp(y, 0, Height - 1);
end;
procedure TBAxisColorPicker.DrawMarker(x, y: integer);
var
c: TColor;
begin
- CorrectCoords(x, y);
- FR := GetRValue(FSelected);
- FG := GetGValue(FSelected);
- FB := GetBValue(FSelected);
- if Assigned(FOnChange) then
- FOnChange(Self);
- dx := x;
- dy := y;
- if Focused or (csDesigning in ComponentState) then
- c := clBlack
- else
- c := clWhite;
- case MarkerStyle of
- msCircle: DrawSelCirc(x, y, Canvas);
- msSquare: DrawSelSquare(x, y, Canvas);
- msCross: DrawSelCross(x, y, Canvas, c);
- msCrossCirc: DrawSelCrossCirc(x, y, Canvas, c);
- end;
-end;
-
-function TBAxisColorPicker.GetSelectedColor: TColor;
-begin
- Result := FSelected;
+ CorrectCoords(x, y);
+ FR := GetRValue(FSelected);
+ FG := GetGValue(FSelected);
+ FB := GetBValue(FSelected);
+ if Assigned(FOnChange) then
+ FOnChange(Self);
+ dx := x;
+ dy := y;
+ if Focused or (csDesigning in ComponentState) then
+ c := clBlack
+ else
+ c := clWhite;
+ InternalDrawMarker(x, y, c);
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));
- CreateRGBGradient;
- Invalidate;
+ 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));
+ CreateGradient;
+ Invalidate;
end;
procedure TBAxisColorPicker.Paint;
begin
- Canvas.StretchDraw(ClientRect, FBmp);
- CorrectCoords(mxx, myy);
- DrawMarker(mxx, myy);
+ Canvas.StretchDraw(ClientRect, FGradientBmp);
+ 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;
+ FManual := false;
+ mxx := round(FR * (Width / 255));
+ myy := round((255 - FG) * (Height / 255));
+ inherited;
end;
-procedure TBAxisColorPicker.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
+procedure TBAxisColorPicker.MouseDown(Button: TMouseButton; Shift: TShiftState;
+ X, Y: Integer);
var
- R: TRect;
+ R: TRect;
begin
- inherited;
- mxx := x;
- myy := y;
- if Button = mbLeft then
+ inherited;
+ mxx := x;
+ myy := y;
+ if Button = mbLeft then
begin
- R := ClientRect;
- R.TopLeft := ClientToScreen(R.TopLeft);
- R.BottomRight := ClientToScreen(R.BottomRight);
+ R := ClientRect;
+ R.TopLeft := ClientToScreen(R.TopLeft);
+ R.BottomRight := ClientToScreen(R.BottomRight);
{$IFDEF DELPHI}
- ClipCursor(@R);
+ ClipCursor(@R);
{$ENDIF}
- FSelected := GetColorAtPoint(x, y);
- FManual := true;
- Invalidate;
+ FSelected := GetColorAtPoint(x, y);
+ FManual := true;
+ Invalidate;
end;
- SetFocus;
+ SetFocus;
end;
procedure TBAxisColorPicker.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
- inherited;
+ inherited;
{$IFDEF DELPHI}
- ClipCursor(nil);
+ ClipCursor(nil);
{$ENDIF}
- mxx := x;
- myy := y;
- FSelected := GetColorAtPoint(x, y);
- FManual := true;
- Invalidate;
+ mxx := x;
+ myy := y;
+ FSelected := GetColorAtPoint(x, y);
+ FManual := true;
+ Invalidate;
end;
procedure TBAxisColorPicker.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
- inherited;
- if ssLeft in Shift then
+ inherited;
+ if ssLeft in Shift then
begin
- mxx := x;
- myy := y;
- FSelected := GetColorAtPoint(x, y);
- FManual := true;
- Invalidate;
+ mxx := x;
+ myy := y;
+ FSelected := GetColorAtPoint(x, y);
+ FManual := true;
+ Invalidate;
end;
end;
procedure TBAxisColorPicker.CNKeyDown(
var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF} );
var
- Shift: TShiftState;
- FInherited: boolean;
+ Shift: TShiftState;
+ FInherited: boolean;
begin
- FInherited := false;
- Shift := KeyDataToShiftState(Message.KeyData);
- if not (ssCtrl in Shift) then
- case Message.CharCode of
- VK_LEFT:
- begin
- mxx := dx - 1;
- myy := dy;
- FSelected := GetColorAtPoint(mxx, myy);
- FManual := true;
- Invalidate;
- end;
- VK_RIGHT:
- begin
- mxx := dx + 1;
- myy := dy;
- FSelected := GetColorAtPoint(mxx, myy);
- FManual := true;
- Invalidate;
- end;
- VK_UP:
- begin
- mxx := dx;
- myy := dy - 1;
- FSelected := GetColorAtPoint(mxx, myy);
- FManual := true;
- Invalidate;
- end;
+ FInherited := false;
+ Shift := KeyDataToShiftState(Message.KeyData);
+ if not (ssCtrl in Shift) then
+ case Message.CharCode of
+ VK_LEFT:
+ begin
+ mxx := dx - 1;
+ myy := dy;
+ FSelected := GetColorAtPoint(mxx, myy);
+ FManual := true;
+ Invalidate;
+ end;
+ VK_RIGHT:
+ begin
+ mxx := dx + 1;
+ myy := dy;
+ FSelected := GetColorAtPoint(mxx, myy);
+ FManual := true;
+ Invalidate;
+ end;
+ VK_UP:
+ begin
+ mxx := dx;
+ myy := dy - 1;
+ FSelected := GetColorAtPoint(mxx, myy);
+ FManual := true;
+ Invalidate;
+ end;
VK_DOWN:
begin
mxx := dx;
@@ -344,38 +303,23 @@ end;
procedure TBAxisColorPicker.SetRValue(r: integer);
begin
- if r > 255 then r := 255;
- if r < 0 then r := 0;
- FR := r;
- SetSelectedColor(RGB(FR, FG, FB));
+ Clamp(r, 0, 255);
+ FR := r;
+ SetSelectedColor(RGB(FR, FG, FB));
end;
procedure TBAxisColorPicker.SetGValue(g: integer);
begin
- if g > 255 then g := 255;
- if g < 0 then g := 0;
- FG := g;
- SetSelectedColor(RGB(FR, FG, FB));
+ Clamp(g, 0, 255);
+ FG := g;
+ SetSelectedColor(RGB(FR, FG, FB));
end;
procedure TBAxisColorPicker.SetBValue(b: integer);
begin
- if b > 255 then b := 255;
- if b < 0 then b := 0;
- FB := b;
- SetSelectedColor(RGB(FR, FG, FB));
-end;
-
-function TBAxisColorPicker.GetColorAtPoint(x, y: integer): TColor;
-begin
- Result := Canvas.Pixels[x, y];
-end;
-
-procedure TBAxisColorPicker.WebSafeChanged;
-begin
- inherited;
- CreateRGBGradient;
- Invalidate;
+ Clamp(b, 0, 255);
+ FB := b;
+ SetSelectedColor(RGB(FR, FG, FB));
end;
end.
diff --git a/components/mbColorLib/CIEAColorPicker.pas b/components/mbColorLib/CIEAColorPicker.pas
index c85240c1f..8ed62145b 100644
--- a/components/mbColorLib/CIEAColorPicker.pas
+++ b/components/mbColorLib/CIEAColorPicker.pas
@@ -7,57 +7,45 @@ unit CIEAColorPicker;
interface
uses
- {$IFDEF FPC}
- LCLIntf, LCLType, LMessages,
- {$ELSE}
- Windows, Messages,
- {$ENDIF}
- SysUtils, Classes, Controls, Graphics, Math, Forms,
- HTMLColors, SelPropUtils, mbColorPickerControl, RGBCIEUtils, Scanlines;
+ {$IFDEF FPC}
+ LCLIntf, LCLType, LMessages,
+ {$ELSE}
+ Windows, Messages,
+ {$ENDIF}
+ SysUtils, Classes, Controls, Graphics, Math, Forms,
+ HTMLColors, RGBCIEUtils, mbColorPickerControl;
type
- TCIEAColorPicker = class(TmbColorPickerControl)
- private
- FSelected: TColor;
- FBmp: TBitmap;
- FOnChange: TNotifyEvent;
- FL, FA, FB: integer;
- FManual: boolean;
- dx, dy, mxx, myy: integer;
-
- procedure SetLValue(l: integer);
- procedure SetAValue(a: integer);
- procedure SetBValue(b: integer);
- protected
- function GetSelectedColor: TColor; override;
- procedure WebSafeChanged; override;
- procedure SetSelectedColor(c: TColor); override;
- procedure CNKeyDown(var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF});
- message CN_KEYDOWN;
- procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
- procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
- procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
- procedure DrawMarker(x, y: integer);
- procedure Paint; override;
- procedure CreateLABGradient;
- procedure Resize; override;
- procedure CreateWnd; override;
- procedure CorrectCoords(var x, y: integer);
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
-
- function GetColorAtPoint(x, y: integer): TColor; override;
- property Manual: boolean read FManual;
- published
- property SelectedColor default clFuchsia;
- property LValue: integer read FL write SetLValue default 100;
- property AValue: integer read FA write SetAValue default 127;
- property BValue: integer read FB write SetBValue default -128;
- property MarkerStyle default msCircle;
-
- property OnChange: TNotifyEvent read FOnChange write FOnChange;
- end;
+ TCIEAColorPicker = class(TmbColorPickerControl)
+ private
+ FL, FA, FB: integer;
+ dx, dy, mxx, myy: integer;
+ procedure SetLValue(l: integer);
+ procedure SetAValue(a: integer);
+ procedure SetBValue(b: integer);
+ protected
+ function GetGradientColor2D(x, y: Integer): TColor; override;
+ procedure SetSelectedColor(c: TColor); override;
+ procedure CNKeyDown(var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF});
+ message CN_KEYDOWN;
+ procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
+ procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
+ procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
+ procedure DrawMarker(x, y: integer);
+ procedure Paint; override;
+ procedure Resize; override;
+ procedure CreateWnd; override;
+ procedure CorrectCoords(var x, y: integer);
+ public
+ constructor Create(AOwner: TComponent); override;
+ published
+ property SelectedColor default clFuchsia;
+ property LValue: integer read FL write SetLValue default 100;
+ property AValue: integer read FA write SetAValue default 127;
+ property BValue: integer read FB write SetBValue default -128;
+ property MarkerStyle default msCircle;
+ property OnChange;
+ end;
procedure Register;
@@ -67,189 +55,165 @@ implementation
{$R CIEAColorPicker.dcr}
{$ENDIF}
+uses
+ mbUtils;
+
procedure Register;
begin
- RegisterComponents('mbColor Lib', [TCIEAColorPicker]);
+ RegisterComponents('mbColor Lib', [TCIEAColorPicker]);
end;
{TCIEAColorPicker}
constructor TCIEAColorPicker.Create(AOwner: TComponent);
begin
- inherited;
- FBmp := TBitmap.Create;
- FBmp.PixelFormat := pf32bit;
- FBmp.SetSize(256, 256);
- Width := 256;
- Height := 256;
- HintFormat := 'L: %cieL B: %cieB'#13'Hex: %hex';
- FSelected := clFuchsia;
- FL := 100;
- FA := 127;
- FB := -128;
- FManual := false;
- dx := 0;
- dy := 0;
- mxx := 0;
- myy := 0;
- MarkerStyle := msCircle;
-end;
-
-destructor TCIEAColorPicker.Destroy;
-begin
- FBmp.Free;
- inherited Destroy;
+ 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;
+ FA := 127;
+ FB := -128;
+ FManual := false;
+ dx := 0;
+ dy := 0;
+ mxx := 0;
+ myy := 0;
+ MarkerStyle := msCircle;
end;
procedure TCIEAColorPicker.CreateWnd;
begin
inherited;
- CreateLABGradient;
+ CreateGradient;
end;
-procedure TCIEAColorPicker.CreateLABGradient;
-var
- l, b: integer;
- row: pRGBQuadArray;
+// 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 FBmp = nil then
- begin
- FBmp := TBitmap.Create;
- FBmp.PixelFormat := pf32bit;
- FBmp.Width := 256;
- FBmp.Height := 256;
- end;
-
- for l := 255 downto 0 do
- begin
- row := FBmp.Scanline[l];
- for b := 0 to 255 do
- if not WebSafe then
- row[b] := RGBtoRGBQuad(LabToRGB(Round(100 - l*100/255), FA, b - 128))
- else
- row[b] := RGBtoRGBQuad(GetWebSafe(LabToRGB(Round(100 - l*100/255), FA, b - 128)));
- end;
+ Result := LabToRGB(Round(100 - y*100/255), FA, x - 128);
end;
procedure TCIEAColorPicker.CorrectCoords(var x, y: integer);
begin
- if x < 0 then x := 0;
- if y < 0 then y := 0;
- if x > Width - 1 then x := Width - 1;
- if y > Height - 1 then y := Height - 1;
+ Clamp(x, 0, Width - 1);
+ Clamp(y, 0, Height - 1);
end;
procedure TCIEAColorPicker.DrawMarker(x, y: integer);
var
- c: TColor;
+ c: TColor;
begin
- CorrectCoords(x, y);
- FL := Round(GetCIELValue(FSelected));
- FA := Round(GetCIEAValue(FSelected));
- FB := Round(GetCIEBValue(FSelected));
- if Assigned(FOnChange) then
- FOnChange(Self);
- dx := x;
- dy := y;
- if Focused or (csDesigning in ComponentState) then
- c := clBlack
- else
- c := clWhite;
- case MarkerStyle of
- msCircle: DrawSelCirc(x, y, Canvas);
- msSquare: DrawSelSquare(x, y, Canvas);
- msCross: DrawSelCross(x, y, Canvas, c);
- msCrossCirc: DrawSelCrossCirc(x, y, Canvas, c);
- end;
-end;
-
-function TCIEAColorPicker.GetSelectedColor: TColor;
-begin
- Result := FSelected;
+ CorrectCoords(x, y);
+ FL := Round(GetCIELValue(FSelected));
+ FA := Round(GetCIEAValue(FSelected));
+ FB := Round(GetCIEBValue(FSelected));
+ if Assigned(FOnChange) then
+ FOnChange(Self);
+ dx := x;
+ dy := y;
+ if Focused or (csDesigning in ComponentState) then
+ c := clBlack
+ else
+ c := clWhite;
+ InternalDrawMarker(x, y, c);
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));
- CreateLABGradient;
- Invalidate;
+ 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));
+ CreateGradient;
+ Invalidate;
end;
procedure TCIEAColorPicker.Paint;
begin
- Canvas.StretchDraw(ClientRect, FBmp);
- CorrectCoords(mxx, myy);
- DrawMarker(mxx, myy);
+ Canvas.StretchDraw(ClientRect, FGradientBmp);
+ 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;
+ 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;
+ R: TRect;
begin
- inherited;
- mxx := x;
- myy := y;
- if Button = mbLeft then
+ 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;
+ 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;
+ SetFocus;
end;
procedure TCIEAColorPicker.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
- inherited;
- {$IFDEF DELPHI}
- ClipCursor(nil);
- {$ENDIF}
- mxx := x;
- myy := y;
- FSelected := GetColorAtPoint(x, y);
- FManual := true;
- Invalidate;
+ inherited;
+ {$IFDEF DELPHI}
+ ClipCursor(nil);
+ {$ENDIF}
+ mxx := x;
+ myy := y;
+ FSelected := GetColorAtPoint(x, y);
+ FManual := true;
+ Invalidate;
end;
procedure TCIEAColorPicker.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
- inherited;
- if ssLeft in Shift then
+ inherited;
+ if ssLeft in Shift then
begin
- mxx := x;
- myy := y;
- FSelected := GetColorAtPoint(x, y);
- FManual := true;
- Invalidate;
+ mxx := x;
+ myy := y;
+ FSelected := GetColorAtPoint(x, y);
+ FManual := true;
+ Invalidate;
end;
end;
procedure TCIEAColorPicker.CNKeyDown(
var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF} );
var
- Shift: TShiftState;
- FInherited: boolean;
+ Shift: TShiftState;
+ FInherited: boolean;
begin
FInherited := false;
Shift := KeyDataToShiftState(Message.KeyData);
@@ -344,38 +308,23 @@ end;
procedure TCIEAColorPicker.SetLValue(l: integer);
begin
- if l > 100 then l := 100;
- if l < 0 then l := 0;
- FL := l;
- SetSelectedColor(LabToRGB(FL, FA, FB));
+ Clamp(L, 0, 100);
+ FL := L;
+ SetSelectedColor(LabToRGB(FL, FA, FB));
end;
procedure TCIEAColorPicker.SetAValue(a: integer);
begin
- if a > 127 then a := 127;
- if a < -128 then a := -128;
- FA := a;
- SetSelectedColor(LabToRGB(FL, FA, FB));
+ Clamp(a, -128, 127);
+ FA := a;
+ SetSelectedColor(LabToRGB(FL, FA, FB));
end;
procedure TCIEAColorPicker.SetBValue(b: integer);
begin
- if b > 127 then b := 127;
- if b < -128 then b := -128;
- FB := b;
- SetSelectedColor(LabToRGB(FL, FA, FB));
-end;
-
-function TCIEAColorPicker.GetColorAtPoint(x, y: integer): TColor;
-begin
- Result := Canvas.Pixels[x, y];
-end;
-
-procedure TCIEAColorPicker.WebSafeChanged;
-begin
- inherited;
- CreateLABGradient;
- Invalidate;
+ Clamp(b, -128, 127);
+ FB := b;
+ SetSelectedColor(LabToRGB(FL, FA, FB));
end;
end.
diff --git a/components/mbColorLib/CIEBColorPicker.pas b/components/mbColorLib/CIEBColorPicker.pas
index bed88b022..d24b05ce9 100644
--- a/components/mbColorLib/CIEBColorPicker.pas
+++ b/components/mbColorLib/CIEBColorPicker.pas
@@ -7,57 +7,48 @@ unit CIEBColorPicker;
interface
uses
- {$IFDEF FPC}
- LCLIntf, LCLType, LMessages,
- {$ELSE}
- Windows, Messages,
- {$ENDIF}
- SysUtils, Classes, Controls, Graphics, Math, Forms,
- HTMLColors, SelPropUtils, mbColorPickerControl, RGBCIEUtils, Scanlines;
+ {$IFDEF FPC}
+ LCLIntf, LCLType, LMessages,
+ {$ELSE}
+ Windows, Messages,
+ {$ENDIF}
+ SysUtils, Classes, Controls, Graphics, Math, Forms,
+ HTMLColors, RGBCIEUtils, mbColorPickerControl;
type
- TCIEBColorPicker = class(TmbColorPickerControl)
- private
- FSelected: TColor;
- FBmp: TBitmap;
- FOnChange: TNotifyEvent;
- FL, FA, FB: integer;
- FManual: boolean;
- dx, dy, mxx, myy: integer;
- procedure SetLValue(l: integer);
- procedure SetAValue(a: integer);
- procedure SetBValue(b: integer);
- protected
- function GetSelectedColor: TColor; override;
- procedure WebSafeChanged; override;
- procedure SetSelectedColor(c: TColor); override;
- procedure CNKeyDown(var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF});
- message CN_KEYDOWN;
- procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
- procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
- procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
- procedure DrawMarker(x, y: integer);
- procedure Paint; override;
- procedure CreateLABGradient;
- procedure Resize; override;
- procedure CreateWnd; override;
- procedure CorrectCoords(var x, y: integer);
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
+ { TCIEBColorPicker }
- function GetColorAtPoint(x, y: integer): TColor; override;
- property Manual: boolean read FManual;
- 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 MarkerStyle default msCircle;
-
- property OnChange: TNotifyEvent read FOnChange write FOnChange;
- end;
+ TCIEBColorPicker = class(TmbColorPickerControl)
+ private
+ FL, FA, FB: integer;
+ dx, dy, mxx, myy: integer;
+ procedure SetLValue(l: integer);
+ procedure SetAValue(a: integer);
+ procedure SetBValue(b: integer);
+ protected
+ function GetGradientColor2D(x, y: Integer): TColor; override;
+ procedure SetSelectedColor(c: TColor); override;
+ procedure CNKeyDown(var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF});
+ message CN_KEYDOWN;
+ procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
+ procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
+ procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
+ procedure DrawMarker(x, y: integer);
+ procedure Paint; override;
+ procedure Resize; override;
+ procedure CreateWnd; override;
+ procedure CorrectCoords(var x, y: integer);
+ 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 MarkerStyle default msCircle;
+ property OnChange;
+ end;
procedure Register;
@@ -67,181 +58,152 @@ implementation
{$R CIEBColorPicker.dcr}
{$ENDIF}
+uses
+ mbUtils;
+
procedure Register;
begin
- RegisterComponents('mbColor Lib', [TCIEBColorPicker]);
+ RegisterComponents('mbColor Lib', [TCIEBColorPicker]);
end;
{TCIEBColorPicker}
constructor TCIEBColorPicker.Create(AOwner: TComponent);
begin
- inherited;
- FBmp := TBitmap.Create;
- FBmp.PixelFormat := pf32bit;
- FBmp.SetSize(256, 256);
- Width := 256;
- Height := 256;
- HintFormat := 'L: %cieL A: %cieA'#13'Hex: %hex';
- FSelected := clLime;
- FL := 100;
- FA := -128;
- FB := 127;
- FManual := false;
- dx := 0;
- dy := 0;
- mxx := 0;
- myy := 0;
- MarkerStyle := msCircle;
-end;
-
-destructor TCIEBColorPicker.Destroy;
-begin
- FBmp.Free;
- inherited Destroy;
+ 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;
+ FA := -128;
+ FB := 127;
+ FManual := false;
+ dx := 0;
+ dy := 0;
+ mxx := 0;
+ myy := 0;
+ MarkerStyle := msCircle;
end;
procedure TCIEBColorPicker.CreateWnd;
begin
- inherited;
- CreateLABGradient;
+ inherited;
+ CreateGradient;
end;
-procedure TCIEBColorPicker.CreateLABGradient;
-var
- l, a: integer;
- row: pRGBQuadArray;
+{ 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 FBmp = nil then
- begin
- FBmp := TBitmap.Create;
- FBmp.PixelFormat := pf32bit;
- FBmp.Width := 256;
- FBmp.Height := 256;
- end;
-
- for l := 255 downto 0 do
- begin
- row := FBmp.Scanline[l];
- for a := 0 to 255 do
- if not WebSafe then
- row[a] := RGBtoRGBQuad(LabToRGB(Round(100 - l*100/255), a-128, FB))
- else
- row[a] := RGBtoRGBQuad(GetWebSafe(LabToRGB(Round(100 - l*100/255), a-128, FB)));
- end;
+ Result := LabToRGB(Round(100 - y*100/255), x - 128, FB);
end;
procedure TCIEBColorPicker.CorrectCoords(var x, y: integer);
begin
- if x < 0 then x := 0;
- if y < 0 then y := 0;
- if x > Width - 1 then x := Width - 1;
- if y > Height - 1 then y := Height - 1;
+ Clamp(x, 0, Width - 1);
+ Clamp(y, 0, Height - 1);
end;
procedure TCIEBColorPicker.DrawMarker(x, y: integer);
var
- c: TColor;
+ c: TColor;
begin
- CorrectCoords(x, y);
- FL := Round(GetCIELValue(FSelected));
- FA := Round(GetCIEAValue(FSelected));
- FB := Round(GetCIEBValue(FSelected));
- if Assigned(FOnChange) then
- FOnChange(Self);
- dx := x;
- dy := y;
- if Focused or (csDesigning in ComponentState) then
- c := clBlack
- else
- c := clWhite;
- case MarkerStyle of
- msCircle: DrawSelCirc(x, y, Canvas);
- msSquare: DrawSelSquare(x, y, Canvas);
- msCross: DrawSelCross(x, y, Canvas, c);
- msCrossCirc: DrawSelCrossCirc(x, y, Canvas, c);
- end;
-end;
-
-function TCIEBColorPicker.GetSelectedColor: TColor;
-begin
- Result := FSelected;
+ CorrectCoords(x, y);
+ FL := Round(GetCIELValue(FSelected));
+ FA := Round(GetCIEAValue(FSelected));
+ FB := Round(GetCIEBValue(FSelected));
+ if Assigned(FOnChange) then
+ FOnChange(Self);
+ dx := x;
+ dy := y;
+ if Focused or (csDesigning in ComponentState) then
+ c := clBlack
+ else
+ c := clWhite;
+ InternalDrawMarker(x, y, c);
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));
- CreateLABGradient;
- Invalidate;
+ 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));
+ CreateGradient;
+ Invalidate;
end;
procedure TCIEBColorPicker.Paint;
begin
- Canvas.StretchDraw(ClientRect, FBmp);
- CorrectCoords(mxx, myy);
- DrawMarker(mxx, myy);
+ Canvas.StretchDraw(ClientRect, FGradientBmp);
+ 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;
+ 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;
+ R: TRect;
begin
- inherited;
- mxx := x;
- myy := y;
- if Button = mbLeft then
+ 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;
+ 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;
+ SetFocus;
end;
procedure TCIEBColorPicker.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
- inherited;
- {$IFDEF DELPHI}
- ClipCursor(nil);
- {$ENDIF}
- mxx := x;
- myy := y;
- FSelected := GetColorAtPoint(x, y);
- FManual := true;
- Invalidate;
+ inherited;
+ {$IFDEF DELPHI}
+ ClipCursor(nil);
+ {$ENDIF}
+ mxx := x;
+ myy := y;
+ FSelected := GetColorAtPoint(x, y);
+ FManual := true;
+ Invalidate;
end;
procedure TCIEBColorPicker.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
- inherited;
- if ssLeft in Shift then
+ inherited;
+ if ssLeft in Shift then
begin
- mxx := x;
- myy := y;
- FSelected := GetColorAtPoint(x, y);
- FManual := true;
- Invalidate;
+ mxx := x;
+ myy := y;
+ FSelected := GetColorAtPoint(x, y);
+ FManual := true;
+ Invalidate;
end;
end;
@@ -342,40 +304,25 @@ begin
OnKeyDown(Self, Message.CharCode, Shift);
end;
-procedure TCIEBColorPicker.SetLValue(l: integer);
+procedure TCIEBColorPicker.SetLValue(L: integer);
begin
- if l > 100 then l := 100;
- if l < 0 then l := 0;
- FL := l;
- SetSelectedColor(LabToRGB(FL, FA, FB));
+ Clamp(L, 0, 100);
+ FL := L;
+ SetSelectedColor(LabToRGB(FL, FA, FB));
end;
procedure TCIEBColorPicker.SetAValue(a: integer);
begin
- if a > 127 then a := 127;
- if a < -128 then a := -128;
- FA := a;
- SetSelectedColor(LabToRGB(FL, FA, FB));
+ Clamp(a, -128, 127);
+ FA := a;
+ SetSelectedColor(LabToRGB(FL, FA, FB));
end;
procedure TCIEBColorPicker.SetBValue(b: integer);
begin
- if b > 127 then b := 127;
- if b < -128 then b := -128;
- FB := b;
- SetSelectedColor(LabToRGB(FL, FA, FB));
-end;
-
-function TCIEBColorPicker.GetColorAtPoint(x, y: integer): TColor;
-begin
- Result := Canvas.Pixels[x, y];
-end;
-
-procedure TCIEBColorPicker.WebSafeChanged;
-begin
- inherited;
- CreateLABGradient;
- Invalidate;
+ Clamp(b, -128, 127);
+ FB := b;
+ SetSelectedColor(LabToRGB(FL, FA, FB));
end;
end.
diff --git a/components/mbColorLib/CIELColorPicker.pas b/components/mbColorLib/CIELColorPicker.pas
index bb98c0cc9..f6ffd33b4 100644
--- a/components/mbColorLib/CIELColorPicker.pas
+++ b/components/mbColorLib/CIELColorPicker.pas
@@ -7,56 +7,44 @@ unit CIELColorPicker;
interface
uses
- {$IFDEF FPC}
- LCLIntf, LCLType, LMessages,
- {$ELSE}
- Windows, Messages,
- {$ENDIF}
- SysUtils, Classes, Controls, Graphics, Math, Forms,
- HTMLColors, SelPropUtils, mbColorPickerControl, RGBCIEUtils, Scanlines;
+ {$IFDEF FPC}
+ LCLIntf, LCLType, LMessages,
+ {$ELSE}
+ Windows, Messages,
+ {$ENDIF}
+ SysUtils, Classes, Controls, Graphics, Math, Forms,
+ HTMLColors, RGBCIEUtils, mbColorPickerControl;
type
- TCIELColorPicker = class(TmbColorPickerControl)
- private
- FSelected: TColor;
- FBmp: TBitmap;
- FOnChange: TNotifyEvent;
- FL, FA, FB: integer;
- FManual: boolean;
- dx, dy, mxx, myy: integer;
-
- procedure SetLValue(l: integer);
- procedure SetAValue(a: integer);
- procedure SetBValue(b: integer);
- protected
- function GetSelectedColor: TColor; override;
- procedure WebSafeChanged; override;
- procedure SetSelectedColor(c: TColor); override;
- procedure CNKeyDown(var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF});
- message CN_KEYDOWN;
- procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
- procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
- procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
- procedure DrawMarker(x, y: integer);
- procedure Paint; override;
- procedure CreateLABGradient;
- procedure Resize; override;
- procedure CreateWnd; override;
- procedure CorrectCoords(var x, y: integer);
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
-
- function GetColorAtPoint(x, y: integer): TColor; override;
- property Manual: boolean read FManual;
- published
- property SelectedColor default clAqua;
- 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 MarkerStyle default msCircle;
-
- property OnChange: TNotifyEvent read FOnChange write FOnChange;
+ TCIELColorPicker = class(TmbColorPickerControl)
+ private
+ FL, FA, FB: integer;
+ dx, dy, mxx, myy: integer;
+ procedure SetLValue(l: integer);
+ procedure SetAValue(a: integer);
+ procedure SetBValue(b: integer);
+ protected
+ function GetGradientColor2D(x, y: Integer): TColor; override;
+ procedure SetSelectedColor(c: TColor); override;
+ procedure CNKeyDown(var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF});
+ message CN_KEYDOWN;
+ procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
+ procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
+ procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
+ procedure DrawMarker(x, y: integer);
+ procedure Paint; override;
+ procedure Resize; override;
+ procedure CreateWnd; override;
+ procedure CorrectCoords(var x, y: integer);
+ public
+ constructor Create(AOwner: TComponent); override;
+ published
+ property SelectedColor default clAqua;
+ 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 MarkerStyle default msCircle;
+ property OnChange;
end;
procedure Register;
@@ -67,183 +55,151 @@ implementation
{$R CIELColorPicker.dcr}
{$ENDIF}
+uses
+ mbUtils;
+
procedure Register;
begin
- RegisterComponents('mbColor Lib', [TCIELColorPicker]);
+ RegisterComponents('mbColor Lib', [TCIELColorPicker]);
end;
{TCIELColorPicker}
constructor TCIELColorPicker.Create(AOwner: TComponent);
begin
- inherited;
- FBmp := TBitmap.Create;
- FBmp.PixelFormat := pf32bit;
- FBmp.SetSize(256, 256);
- Width := 256;
- Height := 256;
- HintFormat := 'A: %cieA B: %cieB'#13'Hex: %hex';
- FSelected := clAqua;
- FL := 100;
- FA := -128;
- FB := 127;
- FManual := false;
- dx := 0;
- dy := 0;
- mxx := 0;
- myy := 0;
- MarkerStyle := msCircle;
-end;
-
-destructor TCIELColorPicker.Destroy;
-begin
- FBmp.Free;
- inherited Destroy;
+ inherited;
+ FGradientWidth := 256;
+ FGradientHeight := 256;
+ {$IFDEF DELPHI}
+ Width := 256;
+ Height := 256;
+ {$ELSE}
+ SetInitialBounds(0, 0, 256, 256);
+ {$ENDIF}
+ HintFormat := 'A: %cieA B: %cieB'#13'Hex: %hex';
+ FSelected := clAqua;
+ FL := 100;
+ FA := -128;
+ FB := 127;
+ FManual := false;
+ dx := 0;
+ dy := 0;
+ mxx := 0;
+ myy := 0;
+ MarkerStyle := msCircle;
end;
procedure TCIELColorPicker.CreateWnd;
begin
- inherited;
- CreateLABGradient;
+ inherited;
+ CreateGradient;
end;
-procedure TCIELColorPicker.CreateLABGradient;
-var
- a, b: integer;
- row: pRGBQuadArray;
+{ Original code: for A ... for B ---> LabToRGB(FL, A - 128, B - 128) }
+function TCIELColorPicker.GetGradientColor2D(x, y: Integer): TColor;
begin
- if FBmp = nil then
- begin
- FBmp := TBitmap.Create;
- FBmp.PixelFormat := pf32bit;
- FBmp.Width := 256;
- FBmp.Height := 256;
- end;
-
- for a := 0 to 255 do
- for b := 255 downto 0 do
- begin
- row := FBmp.Scanline[255 - b];
- if not WebSafe then
- row[a] := RGBToRGBQuad(LabToRGB(FL, a - 128, b - 128))
-// FBmp.Canvas.Pixels[a, 255 - b] := LabToRGB(FL, a - 128, b - 128)
- else
- row[a] := RGBToRGBQuad(GetWebSafe(LabToRGB(FL, a - 128, b - 128)));
-// FBmp.Canvas.Pixels[a, 255 - b] := GetWebSafe(LabToRGB(FL, a - 128, b - 128));
- end;
+ Result := LabToRGB(FL, y - 128, x - 128);
end;
procedure TCIELColorPicker.CorrectCoords(var x, y: integer);
begin
- if x < 0 then x := 0;
- if y < 0 then y := 0;
- if x > Width - 1 then x := Width - 1;
- if y > Height - 1 then y := Height - 1;
+ Clamp(x, 0, Width - 1);
+ clamp(y, 0, Height - 1);
end;
procedure TCIELColorPicker.DrawMarker(x, y: integer);
var
- c: TColor;
+ c: TColor;
begin
- CorrectCoords(x, y);
- FL := Round(GetCIELValue(FSelected));
- FA := Round(GetCIEAValue(FSelected));
- FB := Round(GetCIEBValue(FSelected));
- if Assigned(FOnChange) then
- FOnChange(Self);
- dx := x;
- dy := y;
- if Focused or (csDesigning in ComponentState) then
- c := clBlack
- else
- c := clWhite;
- case MarkerStyle of
- msCircle: DrawSelCirc(x, y, Canvas);
- msSquare: DrawSelSquare(x, y, Canvas);
- msCross: DrawSelCross(x, y, Canvas, c);
- msCrossCirc: DrawSelCrossCirc(x, y, Canvas, c);
- end;
-end;
-
-function TCIELColorPicker.GetSelectedColor: TColor;
-begin
- Result := FSelected;
+ CorrectCoords(x, y);
+ FL := Round(GetCIELValue(FSelected));
+ FA := Round(GetCIEAValue(FSelected));
+ FB := Round(GetCIEBValue(FSelected));
+ if Assigned(FOnChange) then
+ FOnChange(Self);
+ dx := x;
+ dy := y;
+ if Focused or (csDesigning in ComponentState) then
+ c := clBlack
+ else
+ c := clWhite;
+ InternalDrawMarker(x, y, c);
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));
- CreateLABGradient;
- Invalidate;
+ 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));
+ CreateGradient;
+ Invalidate;
end;
procedure TCIELColorPicker.Paint;
begin
- Canvas.StretchDraw(ClientRect, FBmp);
- CorrectCoords(mxx, myy);
- DrawMarker(mxx, myy);
+ Canvas.StretchDraw(ClientRect, FGradientBmp);
+ 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;
+ 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;
+ R: TRect;
begin
- inherited;
- mxx := x;
- myy := y;
- if Button = mbLeft then
+ 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;
+ 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;
+ SetFocus;
end;
procedure TCIELColorPicker.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
- inherited;
- {$IFDEF DELPHI}
- ClipCursor(nil);
- {$ENDIF}
- mxx := x;
- myy := y;
- FSelected := GetColorAtPoint(x, y);
- FManual := true;
- Invalidate;
+ inherited;
+ {$IFDEF DELPHI}
+ ClipCursor(nil);
+ {$ENDIF}
+ mxx := x;
+ myy := y;
+ FSelected := GetColorAtPoint(x, y);
+ FManual := true;
+ Invalidate;
end;
procedure TCIELColorPicker.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
- inherited;
- if ssLeft in Shift then
+ inherited;
+ if ssLeft in Shift then
begin
- mxx := x;
- myy := y;
- FSelected := GetColorAtPoint(x, y);
- FManual := true;
- Invalidate;
+ mxx := x;
+ myy := y;
+ FSelected := GetColorAtPoint(x, y);
+ FManual := true;
+ Invalidate;
end;
end;
@@ -346,38 +302,23 @@ end;
procedure TCIELColorPicker.SetLValue(l: integer);
begin
- if l > 100 then l := 100;
- if l < 0 then l := 0;
- FL := l;
- SetSelectedColor(LabToRGB(FL, FA, FB));
+ Clamp(L, 0, 100);
+ FL := L;
+ SetSelectedColor(LabToRGB(FL, FA, FB));
end;
procedure TCIELColorPicker.SetAValue(a: integer);
begin
- if a > 127 then a := 127;
- if a < -128 then a := -128;
- FA := a;
- SetSelectedColor(LabToRGB(FL, FA, FB));
+ Clamp(A, -128, 127);
+ FA := a;
+ SetSelectedColor(LabToRGB(FL, FA, FB));
end;
procedure TCIELColorPicker.SetBValue(b: integer);
begin
- if b > 127 then b := 127;
- if b < -128 then b := -128;
- FB := b;
- SetSelectedColor(LabToRGB(FL, FA, FB));
-end;
-
-function TCIELColorPicker.GetColorAtPoint(x, y: integer): TColor;
-begin
- Result := Canvas.Pixels[x, y];
-end;
-
-procedure TCIELColorPicker.WebSafeChanged;
-begin
- inherited;
- CreateLABGradient;
- Invalidate;
+ Clamp(b, -128, 127);
+ FB := b;
+ SetSelectedColor(LabToRGB(FL, FA, FB));
end;
end.
diff --git a/components/mbColorLib/Demo/Demo.lpi b/components/mbColorLib/Demo/Demo.lpi
index 8e3c1ed01..33e1ffed0 100644
--- a/components/mbColorLib/Demo/Demo.lpi
+++ b/components/mbColorLib/Demo/Demo.lpi
@@ -58,6 +58,13 @@
+
+
+
+
+
+
+
diff --git a/components/mbColorLib/Demo/main.lfm b/components/mbColorLib/Demo/main.lfm
index 005579781..3d947a0c8 100644
--- a/components/mbColorLib/Demo/main.lfm
+++ b/components/mbColorLib/Demo/main.lfm
@@ -42,9 +42,9 @@ object Form1: TForm1
Height = 331
Top = 6
Width = 399
- ActivePage = TabSheet11
+ ActivePage = TabSheet1
Anchors = [akTop, akLeft, akRight, akBottom]
- TabIndex = 6
+ TabIndex = 0
TabOrder = 0
object TabSheet1: TTabSheet
Caption = 'HSLColorPicker'
@@ -55,7 +55,7 @@ object Form1: TForm1
Height = 287
Top = 8
Width = 377
- SelectedColor = 562183
+ SelectedColor = 494343
HSPickerHintFormat = 'H: %h S: %s'#13'Hex: %hex'
LPickerHintFormat = 'Luminance: %l'
Anchors = [akTop, akLeft, akRight, akBottom]
@@ -991,13 +991,13 @@ object Form1: TForm1
end
object TabSheet10: TTabSheet
Caption = 'Yet even more'
- ClientHeight = 299
- ClientWidth = 389
+ ClientHeight = 303
+ ClientWidth = 391
ImageIndex = 9
object RAxisColorPicker1: TRAxisColorPicker
Left = 10
Height = 100
- Top = 8
+ Top = 28
Width = 100
HintFormat = 'G: %g B: %b'#13'Hex: %hex'
TabOrder = 0
@@ -1005,25 +1005,25 @@ object Form1: TForm1
object GAxisColorPicker1: TGAxisColorPicker
Left = 130
Height = 100
- Top = 10
+ Top = 28
Width = 100
HintFormat = 'R: %r B: %b'#13'Hex: %hex'
TabOrder = 1
MarkerStyle = msCross
end
object BAxisColorPicker1: TBAxisColorPicker
- Left = 252
+ Left = 250
Height = 100
- Top = 10
+ Top = 28
Width = 100
HintFormat = 'R: %r G: %g'#13'Hex: %hex'
TabOrder = 2
MarkerStyle = msCrossCirc
end
object CIELColorPicker1: TCIELColorPicker
- Left = 8
+ Left = 10
Height = 100
- Top = 130
+ Top = 164
Width = 100
SelectedColor = 16119089
HintFormat = 'A: %cieA B: %cieB'#13'Hex: %hex'
@@ -1033,9 +1033,9 @@ object Form1: TForm1
BValue = -32
end
object CIEAColorPicker1: TCIEAColorPicker
- Left = 128
+ Left = 130
Height = 100
- Top = 130
+ Top = 164
Width = 100
SelectedColor = 16515327
HintFormat = 'L: %cieL B: %cieB'#13'Hex: %hex'
@@ -1048,7 +1048,7 @@ object Form1: TForm1
object CIEBColorPicker1: TCIEBColorPicker
Left = 250
Height = 100
- Top = 130
+ Top = 164
Width = 100
SelectedColor = 130823
HintFormat = 'L: %cieL A: %cieA'#13'Hex: %hex'
@@ -1057,6 +1057,54 @@ object Form1: TForm1
AValue = -88
BValue = 74
end
+ object Label10: TLabel
+ Left = 130
+ Height = 15
+ Top = 8
+ Width = 90
+ Caption = 'GAxisColorPicker'
+ ParentColor = False
+ end
+ object Label11: TLabel
+ Left = 10
+ Height = 15
+ Top = 8
+ Width = 89
+ Caption = 'RAxisColorPicker'
+ ParentColor = False
+ end
+ object Label12: TLabel
+ Left = 250
+ Height = 15
+ Top = 8
+ Width = 89
+ Caption = 'BAxisColorPicker'
+ ParentColor = False
+ end
+ object Label13: TLabel
+ Left = 10
+ Height = 15
+ Top = 144
+ Width = 84
+ Caption = 'CIELColorPicker'
+ ParentColor = False
+ end
+ object Label14: TLabel
+ Left = 130
+ Height = 15
+ Top = 144
+ Width = 86
+ Caption = 'CIEAColorPicker'
+ ParentColor = False
+ end
+ object Label15: TLabel
+ Left = 250
+ Height = 15
+ Top = 144
+ Width = 85
+ Caption = 'CIEBColorPicker'
+ ParentColor = False
+ end
end
end
object sc: TmbColorPreview
diff --git a/components/mbColorLib/Demo/main.pas b/components/mbColorLib/Demo/main.pas
index 5a23bf02f..43d6b89e2 100644
--- a/components/mbColorLib/Demo/main.pas
+++ b/components/mbColorLib/Demo/main.pas
@@ -16,7 +16,16 @@ uses
mbColorTree, mbColorList {for internet shortcuts};
type
+
+ { TForm1 }
+
TForm1 = class(TForm)
+ Label10: TLabel;
+ Label11: TLabel;
+ Label12: TLabel;
+ Label13: TLabel;
+ Label14: TLabel;
+ Label15: TLabel;
PageControl1: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
@@ -295,13 +304,13 @@ end;
// only for internet shortcuts
procedure TForm1.FormCreate(Sender: TObject);
begin
- with TIniFile.Create(ExtractFilePath(Application.ExeName) + '\MXS Website.url') do
+ with TIniFile.Create(ExtractFilePath(Application.ExeName) + '\MXS Website.url') do
try
- WriteString('InternetShortcut','URL', 'http://mxs.bergsoft.net');
- WriteInteger('InternetShortcut','IconIndex', 1);
- WriteString('InternetShortcut','IconFile', '"' + Application.ExeName + '"');
+ WriteString('InternetShortcut','URL', 'http://mxs.bergsoft.net');
+ WriteInteger('InternetShortcut','IconIndex', 1);
+ WriteString('InternetShortcut','IconFile', '"' + Application.ExeName + '"');
finally
- Free;
+ Free;
end;
end;
diff --git a/components/mbColorLib/GAxisColorPicker.pas b/components/mbColorLib/GAxisColorPicker.pas
index dfd3f9137..e94eaa90d 100644
--- a/components/mbColorLib/GAxisColorPicker.pas
+++ b/components/mbColorLib/GAxisColorPicker.pas
@@ -7,57 +7,45 @@ unit GAxisColorPicker;
interface
uses
- {$IFDEF FPC}
- LCLType, LCLIntf, LMessages,
- {$ELSE}
- Windows, Messages,
- {$ENDIF}
- SysUtils, Classes, Controls, Graphics, Math, Forms,
- HTMLColors, SelPropUtils, mbColorPickerControl, Scanlines;
+ {$IFDEF FPC}
+ LCLType, LCLIntf, LMessages,
+ {$ELSE}
+ Windows, Messages,
+ {$ENDIF}
+ SysUtils, Classes, Controls, Graphics, Math, Forms,
+ HTMLColors, mbColorPickerControl;
type
- TGAxisColorPicker = class(TmbColorPickerControl)
- private
- FSelected: TColor;
- FBmp: TBitmap;
- FOnChange: TNotifyEvent;
- FR, FG, FB: integer;
- FManual: boolean;
- dx, dy, mxx, myy: integer;
-
- procedure SetRValue(r: integer);
- procedure SetGValue(g: integer);
- procedure SetBValue(b: integer);
- protected
- function GetSelectedColor: TColor; override;
- procedure WebSafeChanged; override;
- procedure SetSelectedColor(c: TColor); override;
- procedure CNKeyDown(var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF});
- message CN_KEYDOWN;
- procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
- procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
- procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
- procedure DrawMarker(x, y: integer);
- procedure Paint; override;
- procedure CreateRGBGradient;
- procedure Resize; override;
- procedure CreateWnd; override;
- procedure CorrectCoords(var x, y: integer);
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
-
- function GetColorAtPoint(x, y: integer): TColor; override;
- property Manual: boolean read FManual;
- published
- property SelectedColor default clLime;
- property RValue: integer read FR write SetRValue default 0;
- property GValue: integer read FG write SetGValue default 255;
- property BValue: integer read FB write SetBValue default 0;
- property MarkerStyle default msCircle;
-
- property OnChange: TNotifyEvent read FOnChange write FOnChange;
- end;
+ TGAxisColorPicker = class(TmbColorPickerControl)
+ private
+ FR, FG, FB: integer;
+ dx, dy, mxx, myy: integer;
+ procedure SetRValue(r: integer);
+ procedure SetGValue(g: integer);
+ procedure SetBValue(b: integer);
+ protected
+ function GetGradientColor2D(x, y: Integer): TColor; override;
+ procedure SetSelectedColor(c: TColor); override;
+ procedure CNKeyDown(var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF});
+ message CN_KEYDOWN;
+ procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
+ procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
+ procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
+ procedure DrawMarker(x, y: integer);
+ procedure Paint; override;
+ procedure Resize; override;
+ procedure CreateWnd; override;
+ procedure CorrectCoords(var x, y: integer);
+ public
+ constructor Create(AOwner: TComponent); override;
+ published
+ property SelectedColor default clLime;
+ property RValue: integer read FR write SetRValue default 0;
+ property GValue: integer read FG write SetGValue default 255;
+ property BValue: integer read FB write SetBValue default 0;
+ property MarkerStyle default msCircle;
+ property OnChange;
+ end;
procedure Register;
@@ -67,194 +55,164 @@ implementation
{$R GAxisColorPicker.dcr}
{$ENDIF}
+uses
+ mbUtils;
+
procedure Register;
begin
- RegisterComponents('mbColor Lib', [TGAxisColorPicker]);
+ RegisterComponents('mbColor Lib', [TGAxisColorPicker]);
end;
{TGAxisColorPicker}
constructor TGAxisColorPicker.Create(AOwner: TComponent);
begin
- inherited;
- FBmp := TBitmap.Create;
- FBmp.PixelFormat := pf32bit;
- FBmp.SetSize(256, 256);
- Width := 256;
- Height := 256;
- HintFormat := 'R: %r B: %b'#13'Hex: %hex';
- FG := 255;
- FB := 0;
- FR := 0;
- FSelected := clLime;
- FManual := false;
- dx := 0;
- dy := 0;
- mxx := 0;
- myy := 0;
- MarkerStyle := msCircle;
-end;
-
-destructor TGAxisColorPicker.Destroy;
-begin
- FBmp.Free;
- inherited Destroy;
+ inherited;
+ FGradientWidth := 256;
+ FGradientHeight := 256;
+ {$IFDEF DELPHI}
+ Width := 256;
+ Height := 256;
+ {$ELSE}
+ SetInitialBounds(0, 0, 256, 256);
+ {$ENDIF}
+ HintFormat := 'R: %r B: %b'#13'Hex: %hex';
+ FG := 255;
+ FB := 0;
+ FR := 0;
+ FSelected := clLime;
+ FManual := false;
+ dx := 0;
+ dy := 0;
+ mxx := 0;
+ myy := 0;
+ MarkerStyle := msCircle;
end;
procedure TGAxisColorPicker.CreateWnd;
begin
inherited;
- CreateRGBGradient;
+ CreateGradient;
end;
-procedure TGAxisColorPicker.CreateRGBGradient;
-var
- r, b : integer;
- row: pRGBQuadArray;
+function TGAxisColorPicker.GetGradientColor2D(x, y: Integer): TColor;
begin
- if FBmp = nil then
- begin
- FBmp := TBitmap.Create;
- FBmp.PixelFormat := pf32bit;
- FBmp.Width := 256;
- FBmp.Height := 256;
- end;
- for r := 255 downto 0 do
- begin
- row := FBmp.Scanline[255-r];
- for b := 0 to 255 do
- if not WebSafe then
- row[b] := RGBtoRGBQuad(r, FG, b)
- else
- row[b] := RGBtoRGBQuad(GetWebSafe(RGB(r, FG, b)));
- end;
+ Result := RGB(FGradientBmp.Height - 1 - y, FG, x);
end;
procedure TGAxisColorPicker.CorrectCoords(var x, y: integer);
begin
- if x < 0 then x := 0;
- if y < 0 then y := 0;
- if x > Width - 1 then x := Width - 1;
- if y > Height - 1 then y := Height - 1;
+ Clamp(x, 0, Width-1);
+ Clamp(y, 0, Height-1);
end;
procedure TGAxisColorPicker.DrawMarker(x, y: integer);
var
- c: TColor;
+ c: TColor;
begin
- CorrectCoords(x, y);
- FR := GetRValue(FSelected);
- FG := GetGValue(FSelected);
- FB := GetBValue(FSelected);
- if Assigned(FOnChange) then
- FOnChange(Self);
- dx := x;
- dy := y;
- if Focused or (csDesigning in ComponentState) then
- c := clBlack
- else
- c := clWhite;
- case MarkerStyle of
- msCircle: DrawSelCirc(x, y, Canvas);
- msSquare: DrawSelSquare(x, y, Canvas);
- msCross: DrawSelCross(x, y, Canvas, c);
- msCrossCirc: DrawSelCrossCirc(x, y, Canvas, c);
- end;
-end;
-
-function TGAxisColorPicker.GetSelectedColor: TColor;
-begin
- Result := FSelected;
+ CorrectCoords(x, y);
+ FR := GetRValue(FSelected);
+ FG := GetGValue(FSelected);
+ FB := GetBValue(FSelected);
+ if Assigned(FOnChange) then
+ FOnChange(Self);
+ dx := x;
+ dy := y;
+ if Focused or (csDesigning in ComponentState) then
+ c := clBlack
+ else
+ c := clWhite;
+ InternalDrawMarker(x, y, c);
end;
procedure TGAxisColorPicker.SetSelectedColor(c: TColor);
begin
- if WebSafe then c := GetWebSafe(c);
- FR := GetRValue(c);
- FG := GetGValue(c);
- FB := GetBValue(c);
- FSelected := c;
- FManual := false;
- myy := Round((255-FR)*(Height/255));
- mxx := Round(FB*(Width/255));
- CreateRGBGradient;
- Invalidate;
+ if WebSafe then c := GetWebSafe(c);
+ FR := GetRValue(c);
+ FG := GetGValue(c);
+ FB := GetBValue(c);
+ FSelected := c;
+ FManual := false;
+ myy := Round((255-FR)*(Height/255));
+ mxx := Round(FB*(Width/255));
+ CreateGradient;
+ Invalidate;
end;
procedure TGAxisColorPicker.Paint;
begin
- Canvas.StretchDraw(ClientRect, FBmp);
- CorrectCoords(mxx, myy);
- DrawMarker(mxx, myy);
+ Canvas.StretchDraw(ClientRect, FGradientBmp);
+ CorrectCoords(mxx, myy);
+ DrawMarker(mxx, myy);
end;
procedure TGAxisColorPicker.Resize;
begin
- FManual := false;
- myy := Round((255-FR)*(Height/255));
- mxx := Round(FB*(Width/255));
- inherited;
+ FManual := false;
+ myy := Round((255-FR)*(Height/255));
+ mxx := Round(FB*(Width/255));
+ inherited;
end;
procedure TGAxisColorPicker.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
- R: TRect;
+ R: TRect;
begin
- inherited;
- mxx := x;
- myy := y;
- if Button = mbLeft then
+ 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;
+ 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;
+ SetFocus;
end;
procedure TGAxisColorPicker.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
- inherited;
- {$IFDEF DELPHI}
- ClipCursor(nil);
- {$ENDIF}
- mxx := x;
- myy := y;
- FSelected := GetColorAtPoint(x, y);
- FManual := true;
- Invalidate;
+ inherited;
+ {$IFDEF DELPHI}
+ ClipCursor(nil);
+ {$ENDIF}
+ mxx := X;
+ myy := Y;
+ FSelected := GetColorAtPoint(X, Y);
+ FManual := true;
+ Invalidate;
end;
procedure TGAxisColorPicker.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
- inherited;
- if ssLeft in Shift then
+ inherited;
+ if ssLeft in Shift then
begin
- mxx := x;
- myy := y;
- FSelected := GetColorAtPoint(x, y);
- FManual := true;
- Invalidate;
+ mxx := X;
+ myy := Y;
+ FSelected := GetColorAtPoint(X, Y);
+ FManual := true;
+ Invalidate;
end;
end;
procedure TGAxisColorPicker.CNKeyDown(
var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF});
var
- Shift: TShiftState;
- FInherited: boolean;
+ Shift: TShiftState;
+ FInherited: boolean;
begin
- FInherited := false;
- Shift := KeyDataToShiftState(Message.KeyData);
- if not (ssCtrl in Shift) then
- case Message.CharCode of
- VK_LEFT:
+ FInherited := false;
+ Shift := KeyDataToShiftState(Message.KeyData);
+ if not (ssCtrl in Shift) then
+ case Message.CharCode of
+ VK_LEFT:
begin
mxx := dx - 1;
myy := dy;
@@ -343,38 +301,23 @@ end;
procedure TGAxisColorPicker.SetRValue(r: integer);
begin
- if r > 255 then r := 255;
- if r < 0 then r := 0;
- FR := r;
- SetSelectedColor(RGB(FR, FG, FB));
+ Clamp(r, 0, 255);
+ FR := r;
+ SetSelectedColor(RGB(FR, FG, FB));
end;
procedure TGAxisColorPicker.SetGValue(g: integer);
begin
- if g > 255 then g := 255;
- if g < 0 then g := 0;
- FG := g;
- SetSelectedColor(RGB(FR, FG, FB));
+ Clamp(g, 0, 255);
+ FG := g;
+ SetSelectedColor(RGB(FR, FG, FB));
end;
procedure TGAxisColorPicker.SetBValue(b: integer);
begin
- if b > 255 then b := 255;
- if b < 0 then b := 0;
- FB := b;
- SetSelectedColor(RGB(FR, FG, FB));
-end;
-
-function TGAxisColorPicker.GetColorAtPoint(x, y: integer): TColor;
-begin
- Result := Canvas.Pixels[x, y];
-end;
-
-procedure TGAxisColorPicker.WebSafeChanged;
-begin
- inherited;
- CreateRGBGradient;
- Invalidate;
+ Clamp(b, 0, 255);
+ FB := b;
+ SetSelectedColor(RGB(FR, FG, FB));
end;
end.
diff --git a/components/mbColorLib/HColorPicker.pas b/components/mbColorLib/HColorPicker.pas
index c3c5d89c3..ea1dc3dba 100644
--- a/components/mbColorLib/HColorPicker.pas
+++ b/components/mbColorLib/HColorPicker.pas
@@ -61,11 +61,14 @@ end;
constructor THColorPicker.Create(AOwner: TComponent);
begin
inherited;
- FGradientWidth := 256;
+ FGradientWidth := 360;
FGradientHeight := 12;
+ {$IFDEF DELPHI}
+ Width := 267;
+ Height := 22;
+ {$ELSE}
SetInitialBounds(0, 0, 267, 22);
- //Width := 267;
- //Height := 22;
+ {$ENDIF}
FSat := 255;
FVal := 255;
FArrowPos := ArrowPosFromHue(0);
@@ -78,6 +81,7 @@ end;
function THColorPicker.GetGradientColor(AValue: Integer): TColor;
begin
+ if Layout = lyVertical then AValue := 360 - AValue;
Result := HSVtoColor(AValue, FSat, FVal);
end;
diff --git a/components/mbColorLib/HRingPicker.pas b/components/mbColorLib/HRingPicker.pas
index 6d923f713..cf60dd5ae 100644
--- a/components/mbColorLib/HRingPicker.pas
+++ b/components/mbColorLib/HRingPicker.pas
@@ -13,60 +13,52 @@ uses
Windows, Messages,
{$ENDIF}
SysUtils, Classes, Controls, Graphics, Math, RGBHSVUtils,
- Forms, {IFDEF DELPHI_7_UP Themes, $ENDIF} HTMLColors, mbColorPickerControl,
- Scanlines;
+ Forms, {IFDEF DELPHI_7_UP Themes, $ENDIF} HTMLColors, mbColorPickerControl;
type
THRingPicker = class(TmbColorPickerControl)
private
- FHue, FSat, FValue: integer;
- FHueLineColor: TColor;
- FSelectedColor: TColor;
- FOnChange: TNotifyEvent;
- FManual: boolean;
- mx, my, mdx, mdy: integer;
- Fchange: boolean;
- FRadius: integer;
- FBMP: TBitmap;
- FDoChange: boolean;
-
- procedure CreateHSVCircle;
- function RadHue(New: integer): integer;
- procedure SetRadius(r: integer);
- procedure SetValue(v: integer);
- procedure SetHue(h: integer);
- procedure SetSat(s: integer);
- procedure SetHueLineColor(c: TColor);
- procedure DrawHueLine;
- procedure SelectionChanged(x, y: integer);
- procedure UpdateCoords;
+ FHue, FSat, FValue: integer;
+ FHueLineColor: TColor;
+ FSelectedColor: TColor;
+ FManual: boolean;
+ mx, my, mdx, mdy: integer;
+ FChange: boolean;
+ FRadius: integer;
+ FDoChange: boolean;
+ function RadHue(New: integer): integer;
+ procedure SetRadius(r: integer);
+ procedure SetValue(v: integer);
+ procedure SetHue(h: integer);
+ procedure SetSat(s: integer);
+ procedure SetHueLineColor(c: TColor);
+ procedure DrawHueLine;
+ procedure SelectionChanged(x, y: integer);
+ procedure UpdateCoords;
protected
- function GetSelectedColor: TColor; override;
- procedure WebSafeChanged; override;
- procedure SetSelectedColor(c: TColor); override;
- procedure Paint; override;
- procedure Resize; override;
- procedure CreateWnd; override;
- procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
- procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
- procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
- procedure CNKeyDown(var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF});
- message CN_KEYDOWN;
+ procedure CreateGradient; override;
+ function GetGradientColor2D(X, Y: Integer): TColor; override;
+ function GetSelectedColor: TColor; override;
+ procedure SetSelectedColor(c: TColor); override;
+ procedure Paint; override;
+ procedure Resize; override;
+ procedure CreateWnd; override;
+ procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
+ procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
+ procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
+ procedure CNKeyDown(var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF});
+ message CN_KEYDOWN;
public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
-
- function GetColorAtPoint(x, y: integer): TColor; override;
- property Manual: boolean read FManual;
+ constructor Create(AOwner: TComponent); override;
+ function GetColorAtPoint(x, y: integer): TColor; override;
published
- property Hue: integer read FHue write SetHue default 0;
- property Saturation: integer read FSat write SetSat default 0;
- property Value: integer read FValue write SetValue default 255;
- property HueLineColor: TColor read FHueLineColor write SetHueLineColor default clGray;
- property SelectedColor default clNone;
- property Radius: integer read FRadius write SetRadius default 30;
-
- property OnChange: TNotifyEvent read FOnChange write FOnChange;
+ property Hue: integer read FHue write SetHue default 0;
+ property Saturation: integer read FSat write SetSat default 0;
+ property Value: integer read FValue write SetValue default 255;
+ property HueLineColor: TColor read FHueLineColor write SetHueLineColor default clGray;
+ property SelectedColor default clNone;
+ property Radius: integer read FRadius write SetRadius default 40;
+ property OnChange;
end;
procedure Register;
@@ -75,223 +67,176 @@ implementation
{$IFDEF FPC}
{$R HRingPicker.dcr}
+{$ENDIF}
uses
- IntfGraphics, fpimage;
-{$ENDIF}
+ mbUtils;
procedure Register;
begin
RegisterComponents('mbColor Lib', [THRingPicker]);
end;
-function PointInCirc(p: TPoint; size : integer): boolean;
-var
- r: integer;
-begin
- r := size div 2;
- Result := (SQR(p.x - r) + SQR(p.y - r) <= SQR(r));
-end;
+
+{ THRingPicker }
constructor THRingPicker.Create(AOwner: TComponent);
begin
- inherited;
- FBMP := TBitmap.Create;
- FBMP.PixelFormat := pf32bit;
- Width := 204;
- Height := 204;
- FValue := 255;
- FHue := 0;
- FSat := 0;
- FHueLineColor := clGray;
- FSelectedColor := clNone;
- FManual := false;
- Fchange := true;
- FRadius := 30;
- FDoChange := false;
-end;
-
-destructor THRingPicker.Destroy;
-begin
- FBMP.Free;
- inherited;
-end;
-
-procedure THRingPicker.CreateHSVCircle;
-var
- dSquared, H, S, V, i, j, Radius, RadiusSquared, x, y, size: integer;
- row: pRGBQuadArray;
- c: TColor;
- {$IFDEF FPC}
- intfimg: TLazIntfImage;
- imgHandle, imgMaskHandle: HBitmap;
+ inherited;
+ {$IFDEF DELPHI}
+ Width := 204;
+ Height := 204;
+ {$ELSE}
+ SetInitialBounds(0, 0, 204, 204);
{$ENDIF}
+ FValue := 255;
+ FHue := 0;
+ FSat := 0;
+ FHueLineColor := clGray;
+ FSelectedColor := clNone;
+ FManual := false;
+ FChange := true;
+ FRadius := 40;
+ FDoChange := false;
+end;
+
+procedure THRingPicker.CreateGradient;
begin
- if FBmp = nil then
- begin
- FBmp := TBitmap.Create;
- FBmp.PixelFormat := pf32bit;
- end;
-
- size := Min(Width, Height);
- FBmp.Width := size;
- FBmp.Height := size;
- PaintParentBack(FBmp);
+ FGradientWidth := Min(Width, Height);
+ FGradientHeight := FGradientWidth;
+ inherited;
+end;
+{ Outer loop: Y, Inner loop: X }
+function THRingPicker.GetGradientColor2D(X, Y: Integer): TColor;
+var
+ xcoord, ycoord: Integer;
+ dSq, radiusSq: Integer;
+ radius, size: Integer;
+ S, H, V: Integer;
+ q: TRGBQuad;
+begin
+ size := FGradientWidth; // or Height, they are the same...
radius := size div 2;
- radiusSquared := radius * radius;
- V := FValue;
-
-{$IFDEF FPC}
- intfimg := TLazIntfImage.Create(FBmp.Width, FBmp.Height);
- try
- intfImg.LoadFromBitmap(FBmp.Handle, FBmp.MaskHandle);
-{$ENDIF}
-
- for j := 0 to size - 1 do
- begin
- Y := Size - 1 - j - radius;
-
- {$IFDEF FPC}
- row := intfImg.GetDataLineStart(size - 1 - j);
- {$ELSE}
- row := FBmp.Scanline(size - 1 - j);
- {$ENDIF}
-
- for i := 0 to size - 1 do
- begin
- X := i - radius;
- dSquared := X*X + Y*Y;
- if dSquared <= radiusSquared then
- begin
- if Radius <> 0 then
- S := round((255 * sqrt(dSquared)) / radius)
- else
- S := 0;
- H := round( 180 * (1 + arctan2(X, Y) / PI)); // wp: order (x,y) is correct!
- H := H + 90;
- if H > 360 then H := H - 360;
- if not WebSafe then
- row[i] := HSVtoRGBQuad(H,S,V)
- else
- begin
- c := GetWebSafe(HSVtoColor(H, S, V));
- row[i] := RGBtoRGBQuad(GetRValue(c), GetGValue(c), GetBValue(c));
- end;
- end
- end;
- end;
-{$IFDEF FPC}
- intfimg.CreateBitmaps(imgHandle, imgMaskHandle, false);
- FBmp.Handle := imgHandle;
- FBmp.MaskHandle := imgMaskHandle;
- finally
- intfimg.Free;
- end;
-{$ENDIF}
+ radiusSq := sqr(radius);
+ xcoord := X - radius;
+ ycoord := Y - radius;
+ dSq := sqr(xcoord) + sqr(ycoord);
+ if dSq <= radiusSq then
+ begin
+ if radius <> 0 then
+ S := round((255 * sqrt(dSq)) / radius)
+ else
+ S := 0;
+ H := round( 180 * (1 + arctan2(xcoord, ycoord) / pi)); // wp: order (x,y) is correct!
+ H := H + 90;
+ if H > 360 then H := H - 360;
+ Result := HSVtoColor(H, S, FValue);
+ if WebSafe then
+ Result := GetWebSafe(Result);
+ end else
+ Result := GetDefaultColor(dctBrush);
end;
procedure THRingPicker.Resize;
begin
- inherited;
- CreateHSVCircle;
- UpdateCoords;
+ inherited;
+ CreateGradient;
+ UpdateCoords;
end;
procedure THRingPicker.CreateWnd;
begin
- inherited;
- CreateHSVCircle;
- UpdateCoords;
+ inherited;
+ CreateGradient;
+ UpdateCoords;
end;
procedure THRingPicker.UpdateCoords;
var
- r, angle: real;
- radius: integer;
+ r, angle: real;
+ radius: integer;
+ sinAngle, cosAngle: Double;
begin
- radius := Min(Width, Height) div 2;
- r := -MulDiv(radius, FSat, 255);
- angle := -FHue*PI/180 - PI;
- mdx := ROUND(COS(angle)*ROUND(r)) + radius;
- mdy := ROUND(SIN(angle)*ROUND(r)) + radius;
+ radius := Min(Width, Height) div 2;
+ r := -MulDiv(radius, FSat, 255);
+ angle := -FHue * pi/180 - pi;
+ SinCos(angle, sinAngle, cosAngle);
+ mdx := round(cosAngle * r) + radius;
+ mdy := round(sinAngle * r) + radius;
end;
procedure THRingPicker.SetHue(h: integer);
begin
- if h > 360 then h := 360;
- if h < 0 then h := 0;
- if FHue <> h then
+ Clamp(h, 0, 360);
+ if FHue <> h then
begin
- FHue := h;
- FManual := false;
- UpdateCoords;
- Invalidate;
- if Fchange then
- if Assigned(FOnChange) then FOnChange(Self);
+ FHue := h;
+ FManual := false;
+ UpdateCoords;
+ Invalidate;
+ if FChange and Assigned(FOnChange) then FOnChange(Self);
end;
end;
procedure THRingPicker.SetSat(s: integer);
begin
- if s > 255 then s := 255;
- if s < 0 then s := 0;
- if FSat <> s then
+ Clamp(s, 0, 255);
+ if FSat <> s then
begin
- FSat := s;
- FManual := false;
- UpdateCoords;
- Invalidate;
- if Fchange then
- if Assigned(FOnChange) then FOnChange(Self);
+ FSat := s;
+ FManual := false;
+ UpdateCoords;
+ Invalidate;
+ if FChange and Assigned(FOnChange) then FOnChange(Self);
end;
end;
procedure THRingPicker.SetValue(v: integer);
begin
- if V > 255 then V := 255;
- if V < 0 then V := 0;
- if FValue <> V then
+ Clamp(v, 0, 255);
+ if FValue <> V then
begin
- FValue := V;
- FManual := false;
- CreateHSVCircle;
- Invalidate;
- if Fchange then
- if Assigned(FOnChange) then FOnChange(Self);
+ FValue := V;
+ FManual := false;
+ CreateGradient;
+ Invalidate;
+ if FChange and Assigned(FOnChange) then FOnChange(Self);
end;
end;
procedure THRingPicker.SetHueLineColor(c: TColor);
begin
- if FHueLineColor <> c then
+ if FHueLineColor <> c then
begin
- FHueLineColor := c;
- Invalidate;
+ FHueLineColor := c;
+ Invalidate;
end;
end;
procedure THRingPicker.SetRadius(r: integer);
begin
- if FRadius <> r then
+ if FRadius <> r then
begin
- FRadius := r;
- Invalidate;
+ FRadius := r;
+ Invalidate;
end;
end;
procedure THRingPicker.DrawHueLine;
var
- angle: double;
- radius: integer;
+ angle: double;
+ sinAngle, cosAngle: Double;
+ radius: integer;
begin
- Radius := Min(Width, Height) div 2;
- if (FHue >= 0) and (FHue <= 360) then
+ radius := Min(Width, Height) div 2;
+ if (FHue >= 0) and (FHue <= 360) then
begin
- Angle := -FHue*PI/180;
- Canvas.Pen.Color := FHueLineColor;
- Canvas.MoveTo(Radius,Radius);
- Canvas.LineTo(Radius + Round(Radius*COS(angle)), Radius + Round(Radius*SIN(angle)));
+ angle := -FHue*PI/180;
+ SinCos(angle, sinAngle, cosAngle);
+ Canvas.Pen.Color := FHueLineColor;
+ Canvas.MoveTo(radius, radius);
+ Canvas.LineTo(radius + round(radius*cosAngle), radius + round(radius*sinAngle));
end;
end;
@@ -308,6 +253,7 @@ begin
r := ClientRect;
r.Right := R.Left + size;
R.Bottom := R.Top + size;
+ InflateRect(R, -1, -1); // Remove spurious black pixels at the border
r1 := CreateEllipticRgnIndirect(R);
if ringwidth > 0 then
begin
@@ -317,7 +263,7 @@ begin
CombineRgn(rgn, r1, r2, RGN_DIFF);
end;
SelectClipRgn(Canvas.Handle, rgn);
- Canvas.Draw(0, 0, FBmp);
+ Canvas.Draw(0, 0, FGradientBmp);
DeleteObject(rgn);
DrawHueLine;
if FDoChange then
@@ -329,152 +275,157 @@ end;
procedure THRingPicker.SelectionChanged(x, y: integer);
var
- Angle, Distance, xDelta, yDelta, Radius: integer;
+ angle, Distance, xDelta, yDelta, Radius: integer;
begin
- if not PointInCirc(Point(x, y), Min(Width, Height)) then
+ if not PointInCircle(Point(x, y), Min(Width, Height)) then
begin
- FChange := false;
- SetSelectedColor(clNone);
- FChange := true;
- Exit;
+ FChange := false;
+ SetSelectedColor(clNone);
+ FChange := true;
+ Exit;
end
- else
- FSelectedColor := clWhite;
- Radius := Min(Width, Height) div 2;
- xDelta := x - Radius;
- yDelta := y - Radius;
- Angle := ROUND(360 + 180*ArcTan2(-yDelta,xDelta)/PI);
- if Angle < 0 then Inc(Angle, 360)
- else if Angle > 360 then
- Dec(Angle, 360);
- Fchange := false;
- SetHue(Angle);
- Distance := ROUND(SQRT(SQR(xDelta) + SQR(yDelta)));
- if Distance >= Radius then SetSat(255)
- else SetSat(MulDiv(Distance, 255, Radius));
- Fchange := true;
+ else
+ FSelectedColor := clWhite;
+ Radius := Min(Width, Height) div 2;
+ xDelta := x - Radius;
+ yDelta := y - Radius;
+ angle := round(360 + 180*arctan2(-yDelta, xDelta) / pi);
+ if angle < 0 then
+ Inc(angle, 360)
+ else if angle > 360 then
+ Dec(angle, 360);
+ FChange := false;
+ SetHue(angle);
+ distance := round(sqrt(sqr(xDelta) + sqr(yDelta)));
+ if distance >= radius then
+ SetSat(255)
+ else
+ SetSat(MulDiv(distance, 255, radius));
+ FChange := true;
end;
procedure THRingPicker.MouseUp(Button: TMouseButton; Shift: TShiftState;
- X, Y: Integer);
+ X, Y: Integer);
begin
- inherited;
- {$IFDEF DELPHI}
- ClipCursor(nil);
- {$ENDIF}
- if csDesigning in ComponentState then Exit;
- if (Button = mbLeft) and PointInCirc(Point(x, y), Min(Width, Height)) then
+ inherited;
+ {$IFDEF DELPHI}
+ ClipCursor(nil);
+ {$ENDIF}
+ if csDesigning in ComponentState then Exit;
+ if (Button = mbLeft) and PointInCircle(Point(x, y), Min(Width, Height)) then
begin
- mdx := x;
- mdy := y;
- FDoChange := true;
- SelectionChanged(X, Y);
- FManual := true;
+ mdx := x;
+ mdy := y;
+ FDoChange := true;
+ SelectionChanged(X, Y);
+ FManual := true;
end;
end;
procedure THRingPicker.MouseDown(Button: TMouseButton; Shift: TShiftState;
- X, Y: Integer);
+ X, Y: Integer);
var
- R: TRect;
+ R: TRect;
begin
- inherited;
- if csDesigning in ComponentState then Exit;
- if (Button = mbLeft) and PointInCirc(Point(x, y), Min(Width, Height)) then
+ inherited;
+ if csDesigning in ComponentState then Exit;
+ if (Button = mbLeft) and PointInCircle(Point(x, y), Min(Width, Height)) then
begin
- mdx := x;
- mdy := y;
- R := ClientRect;
- InflateRect(R, 1, 1);
- R.TopLeft := ClientToScreen(R.TopLeft);
- R.BottomRight := ClientToScreen(R.BottomRight);
- {$IFDEF DELPHI}
- ClipCursor(@R);
- {$ENDIF}
- FDoChange := true;
- SelectionChanged(X, Y);
- FManual := true;
+ mdx := x;
+ mdy := y;
+ R := ClientRect;
+ InflateRect(R, 1, 1);
+ R.TopLeft := ClientToScreen(R.TopLeft);
+ R.BottomRight := ClientToScreen(R.BottomRight);
+ {$IFDEF DELPHI}
+ ClipCursor(@R);
+ {$ENDIF}
+ FDoChange := true;
+ SelectionChanged(X, Y);
+ FManual := true;
end;
- SetFocus;
+ SetFocus;
end;
procedure THRingPicker.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
- inherited;
- if csDesigning in ComponentState then Exit;
- if (ssLeft in Shift) and PointInCirc(Point(x, y), Min(Width, Height)) then
+ inherited;
+ if csDesigning in ComponentState then Exit;
+ if (ssLeft in Shift) and PointInCircle(Point(x, y), Min(Width, Height)) then
begin
- mdx := x;
- mdy := y;
- FDoChange := true;
- SelectionChanged(X, Y);
- FManual := true;
+ mdx := x;
+ mdy := y;
+ FDoChange := true;
+ SelectionChanged(X, Y);
+ FManual := true;
end;
end;
function THRingPicker.GetSelectedColor: TColor;
begin
- if FSelectedColor <> clNone then
+ if FSelectedColor <> clNone then
begin
- if not WebSafe then
- Result := HSVtoColor(FHue, FSat, FValue)
- else
- Result := GetWebSafe(HSVtoColor(FHue, FSat, FValue));
+ if not WebSafe then
+ Result := HSVtoColor(FHue, FSat, FValue)
+ else
+ Result := GetWebSafe(HSVtoColor(FHue, FSat, FValue));
end
- else
- Result := clNone;
+ else
+ Result := clNone;
end;
function THRingPicker.GetColorAtPoint(x, y: integer): TColor;
var
- Angle, Distance, xDelta, yDelta, Radius: integer;
- h, s: integer;
+ angle, distance, xDelta, yDelta, radius: integer;
+ h, s: integer;
begin
- Radius := Min(Width, Height) div 2;
- xDelta := x - Radius;
- yDelta := y - Radius;
- Angle := ROUND(360 + 180*ArcTan2(-yDelta,xDelta)/PI);
- if Angle < 0 then Inc(Angle, 360)
- else if Angle > 360 then
- Dec(Angle, 360);
- h := Angle;
- Distance := ROUND(SQRT(SQR(xDelta) + SQR(yDelta)));
- if Distance >= Radius then s := 255
- else s := MulDiv(Distance, 255, Radius);
- if PointInCirc(Point(mx, my), Min(Width, Height)) then
+ radius := Min(Width, Height) div 2;
+ xDelta := x - Radius;
+ yDelta := y - Radius;
+ angle := round(360 + 180*arctan2(-yDelta, xDelta) / pi);
+ if angle < 0 then
+ Inc(angle, 360)
+ else if angle > 360 then
+ Dec(angle, 360);
+ h := angle;
+ distance := round(sqrt(sqr(xDelta) + sqr(yDelta)));
+ if distance >= radius then
+ s := 255
+ else
+ s := MulDiv(distance, 255, radius);
+ if PointInCircle(Point(mx, my), Min(Width, Height)) then
begin
- if not WebSafe then
- Result := HSVtoColor(h, s, FValue)
- else
- Result := GetWebSafe(HSVtoColor(h, s, FValue));
+ if not WebSafe then
+ Result := HSVtoColor(h, s, FValue)
+ else
+ Result := GetWebSafe(HSVtoColor(h, s, FValue));
end
- else
- Result := clNone;
+ else
+ Result := clNone;
end;
procedure THRingPicker.SetSelectedColor(c: TColor);
var
- changeSave: boolean;
+ changeSave: boolean;
begin
- if WebSafe then c := GetWebSafe(c);
- changeSave := FChange;
- FManual := false;
- Fchange := false;
- SetValue(GetVValue(c));
- SetHue(GetHValue(c));
- SetSat(GetSValue(c));
- FSelectedColor := c;
- Fchange := changeSave;
- if Fchange then
- if Assigned(FOnChange) then FOnChange(Self);
- FChange := true;
+ if WebSafe then c := GetWebSafe(c);
+ changeSave := FChange;
+ FManual := false;
+ Fchange := false;
+ SetValue(GetVValue(c));
+ SetHue(GetHValue(c));
+ SetSat(GetSValue(c));
+ FSelectedColor := c;
+ FChange := changeSave;
+ if FChange and Assigned(FOnChange) then FOnChange(Self);
+ FChange := true;
end;
function THRingPicker.RadHue(New: integer): integer;
begin
- if New < 0 then New := New + 360;
- if New > 360 then New := New - 360;
- Result := New;
+ if New < 0 then New := New + 360;
+ if New > 360 then New := New - 360;
+ Result := New;
end;
procedure THRingPicker.CNKeyDown(
@@ -538,11 +489,4 @@ begin
OnKeyDown(Self, Message.CharCode, Shift);
end;
-procedure THRingPicker.WebSafeChanged;
-begin
- inherited;
- CreateHSVCircle;
- Invalidate;
-end;
-
end.
diff --git a/components/mbColorLib/HSColorPicker.pas b/components/mbColorLib/HSColorPicker.pas
index 15ad7de3b..10b0ba666 100644
--- a/components/mbColorLib/HSColorPicker.pas
+++ b/components/mbColorLib/HSColorPicker.pas
@@ -7,58 +7,49 @@ unit HSColorPicker;
interface
uses
- {$IFDEF FPC}
- LCLIntf, LCLType, LMessages,
- {$ELSE}
- Windows, Messages, Scanlines,
- {$ENDIF}
- SysUtils, Classes, Controls, Graphics, Math, Forms,
- RGBHSLUtils, HTMLColors, SelPropUtils, mbColorPickerControl;
+ {$IFDEF FPC}
+ LCLIntf, LCLType, LMessages,
+ {$ELSE}
+ Windows, Messages, Scanlines,
+ {$ENDIF}
+ SysUtils, Classes, Controls, Graphics, Math, Forms,
+ RGBHSLUtils, HTMLColors, mbColorPickerControl;
type
- THSColorPicker = class(TmbColorPickerControl)
- private
- FSelected: TColor;
- FHSLBmp: TBitmap;
- FOnChange: TNotifyEvent;
- FHue, FSaturation, FLuminance: integer;
- FLum: integer;
- FManual: boolean;
- dx, dy, mxx, myy: integer;
- procedure SetHValue(h: integer);
- procedure SetSValue(s: integer);
- protected
- function GetSelectedColor: TColor; override;
- procedure WebSafeChanged; override;
- procedure SetSelectedColor(c: TColor); override;
- procedure CNKeyDown(var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF});
- message CN_KEYDOWN;
- procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
- procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
- procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
- procedure DrawMarker(x, y: integer);
- procedure Paint; override;
- procedure CreateHSLGradient;
- procedure Resize; override;
- procedure CreateWnd; override;
- procedure CorrectCoords(var x, y: integer);
- function PredictColor: TColor;
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
+ { THSColorPicker }
- function GetColorAtPoint(x, y: integer): TColor; override;
- property Lum: integer read FLum write FLum default 120;
- property Manual: boolean read FManual;
- published
- property SelectedColor default clRed;
- property HueValue: integer read FHue write SetHValue default 0;
- property SaturationValue: integer read FSaturation write SetSValue default 240;
- property MarkerStyle default msCross;
-
- property OnChange: TNotifyEvent read FOnChange write FOnChange;
- end;
+ THSColorPicker = class(TmbColorPickerControl)
+ private
+ FHue, FSaturation, FLuminance: integer;
+ FLum: integer;
+ dx, dy, mxx, myy: integer;
+ procedure SetHValue(h: integer);
+ procedure SetSValue(s: integer);
+ protected
+ procedure CorrectCoords(var x, y: integer);
+ function GetGradientColor2D(X, Y: Integer): TColor; override;
+ procedure SetSelectedColor(c: TColor); override;
+ procedure CNKeyDown(var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF});
+ message CN_KEYDOWN;
+ procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
+ procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
+ procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
+ procedure DrawMarker(x, y: integer);
+ procedure Paint; override;
+ procedure Resize; override;
+ procedure CreateWnd; override;
+ function PredictColor: TColor;
+ public
+ constructor Create(AOwner: TComponent); override;
+ property Lum: integer read FLum write FLum default 120;
+ published
+ property SelectedColor default clRed;
+ property HueValue: integer read FHue write SetHValue default 0;
+ property SaturationValue: integer read FSaturation write SetSValue default 240;
+ property MarkerStyle default msCross;
+ property OnChange;
+ end;
procedure Register;
@@ -66,226 +57,155 @@ implementation
{$IFDEF FPC}
{$R HSColorPicker.dcr}
+{$ENDIF}
uses
- IntfGraphics, fpimage;
-{$ENDIF}
+ mbUtils;
procedure Register;
begin
- RegisterComponents('mbColor Lib', [THSColorPicker]);
+ RegisterComponents('mbColor Lib', [THSColorPicker]);
end;
{THSColorPicker}
constructor THSColorPicker.Create(AOwner: TComponent);
begin
- inherited;
- FHSLBmp := TBitmap.Create;
- FHSLBmp.PixelFormat := pf32bit;
- FHSLBmp.SetSize(240, 241);
- Width := 239;
- Height := 240;
- HintFormat := 'H: %h S: %hslS'#13'Hex: %hex';
- FHue := 0;
- FSaturation := 240;
- FLuminance := 120;
- FSelected := clRed;
- FLum := 120;
- FManual := false;
- dx := 0;
- dy := 0;
- mxx := 0;
- myy := 0;
- MarkerStyle := msCross;
-end;
-
-destructor THSColorPicker.Destroy;
-begin
- FHSLBmp.Free;
- inherited Destroy;
+ inherited;
+ FGradientWidth := 240;
+ FGradientHeight := 241;
+ {$IFDEF DELPHI}
+ Width := 239;
+ Height := 240;
+ {$ELSE}
+ SetInitialBounds(0, 0, 239, 240);
+ {$ENDIF}
+ HintFormat := 'H: %h S: %hslS'#13'Hex: %hex';
+ FHue := 0;
+ FSaturation := 240;
+ FLuminance := 120;
+ FSelected := clRed;
+ FLum := 120;
+ FManual := false;
+ dx := 0;
+ dy := 0;
+ mxx := 0;
+ myy := 0;
+ MarkerStyle := msCross;
end;
procedure THSColorPicker.CreateWnd;
begin
- inherited;
- CreateHSLGradient;
+ inherited;
+ CreateGradient;
end;
-{$IFDEF DELPHI}
-procedure THSColorPicker.CreateHSLGradient;
-var
- Hue, Sat : integer;
- row: pRGBQuadArray;
+function THSColorPicker.GetGradientColor2D(X, Y: Integer): TColor;
begin
- if FHSLBmp = nil then
- begin
- FHSLBmp := TBitmap.Create;
- FHSLBmp.PixelFormat := pf32bit;
- FHSLBmp.Width := 240;
- FHSLBmp.Height := 241;
- end;
- for Hue := 0 to 239 do
- for Sat := 0 to 240 do
- begin
- row := FHSLBmp.ScanLine[240 - Sat];
- if not WebSafe then
- row[Hue] := RGBToRGBQuad(HSLRangeToRGB(Hue, Sat, 120))
-// FHSLBmp.Canvas.Pixels[Hue, 240 - Sat] := HSLRangeToRGB(Hue, Sat, 120)
- else
- row[Hue] := RGBToRGBQuad(GetWebSafe(HSLRangeToRGB(Hue, Sat, 120)));
-// FHSLBmp.Canvas.Pixels[Hue, 240 - Sat] := GetWebSafe(HSLRangeToRGB(Hue, Sat, 120));
- end;
+ Result := HSLRangeToRGB(x, FGradientBmp.Height - 1 - y, 120);
end;
-{$ELSE}
-procedure THSColorPicker.CreateHSLGradient;
-var
- Hue, Sat: Integer;
- intfimg: TLazIntfImage;
- imgHandle, imgMaskHandle: HBitmap;
- c: TColor;
-begin
- if FHSLBmp = nil then
- begin
- FHSLBmp := TBitmap.Create;
- FHSLBmp.PixelFormat := pf32Bit;
- FHSLBmp.Width := 240;
- FHSLBmp.Height := 241;
- end;
- intfimg := TLazIntfImage.Create(FHSLBmp.Width, FHSLBmp.Height);
- try
- intfImg.LoadFromBitmap(FHSLBmp.Handle, FHSLBmp.MaskHandle);
- for Hue := 0 to 239 do
- for Sat := 0 to 240 do
- begin
- if not WebSafe then
- c := HSLRangeToRGB(Hue, Sat, 120)
- else
- c := GetWebSafe(HSLRangeToRGB(Hue, Sat, 120));
- intfimg.Colors[Hue, 240-Sat] := TColorToFPColor(c);
- end;
- intfimg.CreateBitmaps(imgHandle, imgMaskHandle, false);
- FHSLBmp.Handle := imgHandle;
- FHSLBmp.MaskHandle := imgMaskHandle;
- finally
- intfimg.Free;
- end;
-end;
-{$ENDIF}
procedure THSColorPicker.CorrectCoords(var x, y: integer);
begin
- if x < 0 then x := 0;
- if y < 0 then y := 0;
- if x > Width - 1 then x := Width - 1;
- if y > Height - 1 then y := Height - 1;
+ Clamp(x, 0, Width - 1);
+ Clamp(y, 0, Height - 1);
end;
procedure THSColorPicker.DrawMarker(x, y: integer);
var
- c: TColor;
+ c: TColor;
begin
- CorrectCoords(x, y);
- RGBtoHSLRange(FSelected, FHue, FSaturation, FLuminance);
- if Assigned(FOnChange) then
- FOnChange(Self);
- dx := x;
- dy := y;
- if Focused or (csDesigning in ComponentState) then
- c := clBlack
- else
- c := clWhite;
- case MarkerStyle of
- msCircle: DrawSelCirc(x, y, Canvas);
- msSquare: DrawSelSquare(x, y, Canvas);
- msCross: DrawSelCross(x, y, Canvas, c);
- msCrossCirc: DrawSelCrossCirc(x, y, Canvas, c);
- end;
-end;
-
-function THSColorPicker.GetSelectedColor: TColor;
-begin
- Result := FSelected;
+ CorrectCoords(x, y);
+ RGBtoHSLRange(FSelected, FHue, FSaturation, FLuminance);
+ if Assigned(FOnChange) then
+ FOnChange(Self);
+ dx := x;
+ dy := y;
+ if Focused or (csDesigning in ComponentState) then
+ c := clBlack
+ else
+ c := clWhite;
+ InternalDrawMarker(x, y, c);
end;
procedure THSColorPicker.SetSelectedColor(c: TColor);
begin
- if WebSafe then c := GetWebSafe(c);
- RGBtoHSLRange(c, FHue, FSaturation, FLuminance);
- FSelected := c;
- FManual := false;
- mxx := Round(FHue*(Width/239));
- myy := Round((240-FSaturation)*(Height/240));
- Invalidate;
+ if WebSafe then c := GetWebSafe(c);
+ RGBtoHSLRange(c, FHue, FSaturation, FLuminance);
+ FSelected := c;
+ FManual := false;
+ mxx := Round(FHue*(Width/239));
+ myy := Round((240-FSaturation)*(Height/240));
+ Invalidate;
end;
procedure THSColorPicker.Paint;
begin
- Canvas.StretchDraw(ClientRect, FHSLBmp);
- CorrectCoords(mxx, myy);
- DrawMarker(mxx, myy);
+ Canvas.StretchDraw(ClientRect, FGradientBmp);
+ CorrectCoords(mxx, myy);
+ DrawMarker(mxx, myy);
end;
procedure THSColorPicker.Resize;
begin
- SetSelectedColor(FSelected);
- inherited;
+ SetSelectedColor(FSelected);
+ inherited;
end;
procedure THSColorPicker.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
- R: TRect;
+ R: TRect;
begin
- inherited;
- mxx := x;
- myy := y;
- if Button = mbLeft then
+ 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;
+ 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;
+ SetFocus;
end;
procedure THSColorPicker.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
- inherited;
- {$IFDEF DELPHI}
- ClipCursor(nil);
- {$ENDIF}
- mxx := x;
- myy := y;
- FSelected := GetColorAtPoint(x, y);
- FManual := true;
- Invalidate;
+ inherited;
+ {$IFDEF DELPHI}
+ ClipCursor(nil);
+ {$ENDIF}
+ mxx := x;
+ myy := y;
+ FSelected := GetColorAtPoint(x, y);
+ FManual := true;
+ Invalidate;
end;
procedure THSColorPicker.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
- inherited;
- if ssLeft in Shift then
+ inherited;
+ if ssLeft in Shift then
begin
- mxx := x;
- myy := y;
- FSelected := GetColorAtPoint(x, y);
- FManual := true;
- Invalidate;
+ mxx := x;
+ myy := y;
+ FSelected := GetColorAtPoint(x, y);
+ FManual := true;
+ Invalidate;
end;
end;
function THSColorPicker.PredictColor: TColor;
var
- FTHue, FTSat, FTLum: integer;
+ FTHue, FTSat, FTLum: integer;
begin
- RGBtoHSLRange(GetColorUnderCursor, FTHue, FTSat, FTLum);
- Result := HSLRangeToRGB(FTHue, FTSat, FLum);
+ RGBtoHSLRange(GetColorUnderCursor, FTHue, FTSat, FTLum);
+ Result := HSLRangeToRGB(FTHue, FTSat, FLum);
end;
procedure THSColorPicker.CNKeyDown(
@@ -387,30 +307,16 @@ end;
procedure THSColorPicker.SetHValue(h: integer);
begin
- if h > 239 then h := 239;
- if h < 0 then h := 0;
- FHue := h;
- SetSelectedColor(HSLRangeToRGB(FHue, FSaturation, 120));
+ Clamp(h, 0, 239);
+ FHue := h;
+ SetSelectedColor(HSLRangeToRGB(FHue, FSaturation, 120)); // why hard-coded 120?
end;
procedure THSColorPicker.SetSValue(s: integer);
begin
- if s > 240 then s := 240;
- if s < 0 then s := 0;
- FSaturation := s;
- SetSelectedColor(HSLRangeToRGB(FHue, FSaturation, 120));
-end;
-
-function THSColorPicker.GetColorAtPoint(x, y: integer): TColor;
-begin
- Result := Canvas.Pixels[x, y];
-end;
-
-procedure THSColorPicker.WebSafeChanged;
-begin
- inherited;
- CreateHSLGradient;
- Invalidate;
+ Clamp(s, 0, 240);
+ FSaturation := s;
+ SetSelectedColor(HSLRangeToRGB(FHue, FSaturation, 120));
end;
end.
diff --git a/components/mbColorLib/HSLRingPicker.pas b/components/mbColorLib/HSLRingPicker.pas
index 87af77649..0df3b1d58 100644
--- a/components/mbColorLib/HSLRingPicker.pas
+++ b/components/mbColorLib/HSLRingPicker.pas
@@ -117,65 +117,77 @@ end;
constructor THSLRingPicker.Create(AOwner: TComponent);
begin
- inherited;
- ControlStyle := ControlStyle - [csAcceptsControls] + [csOpaque{$IFDEF DELPHI_7_UP}, csParentBackground{$ENDIF}];
- DoubleBuffered := true;
- PBack := TBitmap.Create;
- PBack.PixelFormat := pf32bit;
- {$IFDEF DELPHI_7_UP} {$IFDEF DELPHI}
- ParentBackground := true;
- {$ENDIF} {$ENDIF}
- Width := 245;
- Height := 245;
- TabStop := true;
- FSelectedColor := clRed;
- FRingPicker := THRingPicker.Create(Self);
- InsertControl(FRingPicker);
- FRingCursor := crDefault;
- FSLCursor := crDefault;
- with FRingPicker do
+ inherited;
+ ControlStyle := ControlStyle - [csAcceptsControls] + [csOpaque{$IFDEF DELPHI_7_UP}, csParentBackground{$ENDIF}];
+ DoubleBuffered := true;
+ PBack := TBitmap.Create;
+ PBack.PixelFormat := pf32bit;
+ {$IFDEF DELPHI_7_UP} {$IFDEF DELPHI}
+ ParentBackground := true;
+ {$ENDIF} {$ENDIF}
+ {$IFDEF DELPHI}
+ Width := 245;
+ Height := 245;
+ {$ELSE}
+ SetInitialBounds(0, 0, 245, 245);
+ {$ENDIF}
+ TabStop := true;
+ FSelectedColor := clRed;
+ FRingPicker := THRingPicker.Create(Self);
+ InsertControl(FRingPicker);
+ FRingCursor := crDefault;
+ FSLCursor := crDefault;
+ with FRingPicker do
begin
- Height := 246;
- Width := 246;
- Top := 0;
- Left := 0;
- Radius := 100;
- Align := alClient;
- Visible := true;
- Saturation := 255;
- Value := 255;
- Hue := 0;
- OnChange := RingPickerChange;
- OnMouseMove := DoMouseMove;
+ {$IFDEF DELPHI}
+ Left := 0;
+ Top := 0;
+ Width := 246;
+ Height := 246;
+ {$ELSE}
+ SetInitialBounds(0, 0, 246, 246);
+ {$ENDIF}
+ Radius := 100;
+ Align := alClient;
+ Visible := true;
+ Saturation := 255;
+ Value := 255;
+ Hue := 0;
+ OnChange := RingPickerChange;
+ OnMouseMove := DoMouseMove;
end;
- FSLPicker := TSLColorPicker.Create(Self);
- InsertControl(FSLPicker);
- with FSLPicker do
+ FSLPicker := TSLColorPicker.Create(Self);
+ InsertControl(FSLPicker);
+ with FSLPicker do
begin
- Height := 120;
- Width := 120;
- Left := 63;
- Top := 63;
- Visible := true;
- OnChange := SLPickerChange;
- OnMouseMove := DoMouseMove;
+ {$IFDEF DELPHI}
+ Left := 63;
+ Top := 63;
+ Width := 120;
+ Height := 120;
+ {$ELSE}
+ SetInitialBounds(63, 63, 120, 120);
+ {$ENDIF}
+ Visible := true;
+ OnChange := SLPickerChange;
+ OnMouseMove := DoMouseMove;
end;
- FHValue := 0;
- FSValue := 255;
- FLValue := 255;
- FRValue := 255;
- FGValue := 0;
- FBValue := 0;
- FRingHint := 'Hue: %h';
- FSLHint := 'S: %hslS L: %l'#13'Hex: %hex';
+ FHValue := 0;
+ FSValue := 255;
+ FLValue := 255;
+ FRValue := 255;
+ FGValue := 0;
+ FBValue := 0;
+ FRingHint := 'Hue: %h';
+ FSLHint := 'S: %hslS L: %l'#13'Hex: %hex';
end;
destructor THSLRingPicker.Destroy;
begin
- PBack.Free;
- FRingPicker.Free;
- FSLPicker.Free;
- inherited Destroy;
+ PBack.Free;
+ FRingPicker.Free;
+ FSLPicker.Free;
+ inherited Destroy;
end;
procedure THSLRingPicker.Resize;
@@ -183,198 +195,191 @@ var
circ: TPoint;
ctr: double;
begin
- inherited;
- if (FRingPicker = nil) or (FSLPicker = nil) then
- exit;
+ inherited;
+ if (FRingPicker = nil) or (FSLPicker = nil) then
+ exit;
- ctr := Min(Width, Height)/100;
+ ctr := Min(Width, Height)/100;
+ circ.x := Min(Width, Height) div 2;
+ circ.y := circ.x;
- circ.x := Min(Width, Height) div 2;
- circ.y := circ.x;
+ FRingPicker.Radius := circ.x - round(12*ctr);
- FRingPicker.Radius := circ.x - round(12*ctr);
+ FSLPicker.Left := circ.x - FSLPicker.Width div 2;
+ FSLPicker.Top := circ.y - FSLPicker.Height div 2;
+ FSLPicker.Width := round(50 * ctr);
+ FSLPicker.Height := FSLPicker.Width;
- FSLPicker.Left := circ.x - FSLPicker.Width div 2;
- FSLPicker.Top := circ.y - FSLPicker.Height div 2;
- FSLPicker.Width := round(50*ctr);
- FSLPicker.Height := FSLPicker.Width;
- (*
- FRingPicker.Radius := (Min(Width, Height)*30) div 245;
- FSLPicker.Left := (21*FRingPicker.Radius) div 10;
- FSLPicker.Top := (21*FRingPicker.Radius) div 10;
- FSLPicker.Width := 4*FRingPicker.Radius;
- FSLPicker.Height := 4*FRingPicker.Radius;
- *)
- PaintParentBack(PBack);
+ PaintParentBack(PBack);
end;
procedure THSLRingPicker.RingPickerChange(Sender: TObject);
begin
- if (FRingPicker = nil) or (FSLPicker = nil) then
- exit;
- FSLPicker.Hue := FRingPicker.Hue;
- DoChange;
+ if (FRingPicker = nil) or (FSLPicker = nil) then
+ exit;
+ FSLPicker.Hue := FRingPicker.Hue;
+ DoChange;
end;
procedure THSLRingPicker.SLPickerChange(Sender: TObject);
begin
- if FSLPicker = nil then
- exit;
- FSelectedColor := FSLPicker.SelectedColor;
- DoChange;
+ if FSLPicker = nil then
+ exit;
+ FSelectedColor := FSLPicker.SelectedColor;
+ DoChange;
end;
procedure THSLRingPicker.DoChange;
begin
- if (FRingPicker = nil) or (FSLPicker = nil) then
- exit;
+ if (FRingPicker = nil) or (FSLPicker = nil) then
+ exit;
- FHValue := FRingPicker.Hue;
- FSValue := FSLPicker.Saturation;
- FLValue := FSLPicker.Luminance;
- FRValue := GetRValue(FSLPicker.SelectedColor);
- FGValue := GetGValue(FSLPicker.SelectedColor);
- FBValue := GetBValue(FSLPicker.SelectedColor);
- if Assigned(FOnChange) then
- FOnChange(Self);
+ FHValue := FRingPicker.Hue;
+ FSValue := FSLPicker.Saturation;
+ FLValue := FSLPicker.Luminance;
+ FRValue := GetRValue(FSLPicker.SelectedColor);
+ FGValue := GetGValue(FSLPicker.SelectedColor);
+ FBValue := GetBValue(FSLPicker.SelectedColor);
+ if Assigned(FOnChange) then
+ FOnChange(Self);
end;
procedure THSLRingPicker.SelectColor(c: TColor);
begin
- if (FRingPicker = nil) or (FSLPicker = nil) then
- exit;
+ if (FRingPicker = nil) or (FSLPicker = nil) then
+ exit;
- FRingPicker.Hue := GetHValue(c);
- FRingPicker.Saturation := 255;
- FRingPicker.Value := 255;
- FSLPicker.SelectedColor := c;
- FSelectedColor := c;
+ FRingPicker.Hue := GetHValue(c);
+ FRingPicker.Saturation := 255;
+ FRingPicker.Value := 255;
+ FSLPicker.SelectedColor := c;
+ FSelectedColor := c;
end;
procedure THSLRingPicker.SetH(v: integer);
begin
- if (FRingPicker = nil) or (FSLPicker = nil) then
- exit;
+ if (FRingPicker = nil) or (FSLPicker = nil) then
+ exit;
- FHValue := v;
- FRingPicker.Hue := v;
- FSLPicker.Hue := v;
+ FHValue := v;
+ FRingPicker.Hue := v;
+ FSLPicker.Hue := v;
end;
procedure THSLRingPicker.SetS(v: integer);
begin
- if (FSLPicker = nil) then
- exit;
- FSValue := v;
- FSLPicker.Saturation := v;
+ if (FSLPicker = nil) then
+ exit;
+ FSValue := v;
+ FSLPicker.Saturation := v;
end;
procedure THSLRingPicker.SetL(v: integer);
begin
- if (FSLPicker = nil) then
- exit;
- FLValue := v;
- FSLPicker.Luminance := v;
+ if (FSLPicker = nil) then
+ exit;
+ FLValue := v;
+ FSLPicker.Luminance := v;
end;
procedure THSLRingPicker.SetR(v: integer);
begin
- FRValue := v;
- SelectColor(RGB(FRValue, FGValue, FBValue));
+ FRValue := v;
+ SelectColor(RGB(FRValue, FGValue, FBValue));
end;
procedure THSLRingPicker.SetG(v: integer);
begin
- FGValue := v;
- SelectColor(RGB(FRValue, FGValue, FBValue));
+ FGValue := v;
+ SelectColor(RGB(FRValue, FGValue, FBValue));
end;
procedure THSLRingPicker.SetB(v: integer);
begin
- FBValue := v;
- SelectColor(RGB(FRValue, FGValue, FBValue));
+ FBValue := v;
+ SelectColor(RGB(FRValue, FGValue, FBValue));
end;
function THSLRingPicker.GetSelectedHexColor: string;
begin
- Result := ColorToHex(FSelectedColor);
+ Result := ColorToHex(FSelectedColor);
end;
procedure THSLRingPicker.SetRingHint(h: string);
begin
- FRingHint := h;
- FRingPicker.HintFormat := h;
+ FRingHint := h;
+ FRingPicker.HintFormat := h;
end;
procedure THSLRingPicker.SetSLHint(h: string);
begin
- FSLHint := h;
- FSLPicker.HintFormat := h;
+ FSLHint := h;
+ FSLPicker.HintFormat := h;
end;
procedure THSLRingPicker.SetRingMenu(m: TPopupMenu);
begin
- FRingMenu := m;
- FRingPicker.PopupMenu := m;
+ FRingMenu := m;
+ FRingPicker.PopupMenu := m;
end;
procedure THSLRingPicker.SetSLMenu(m: TPopupMenu);
begin
- FSLMenu := m;
- FSLPicker.PopupMenu := m;
+ FSLMenu := m;
+ FSLPicker.PopupMenu := m;
end;
procedure THSLRingPicker.DoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
- if Assigned(OnMouseMove) then
- OnMouseMove(Self, Shift, x, y);
- inherited;
+ if Assigned(OnMouseMove) then
+ OnMouseMove(Self, Shift, x, y);
+ inherited;
end;
function THSLRingPicker.GetColorUnderCursor: TColor;
begin
- Result := FSLPicker.GetColorUnderCursor;
+ Result := FSLPicker.GetColorUnderCursor;
end;
function THSLRingPicker.GetHexColorUnderCursor: string;
begin
- Result := FSLPicker.GetHexColorUnderCursor;
+ Result := FSLPicker.GetHexColorUnderCursor;
end;
procedure THSLRingPicker.SetRingCursor(c: TCursor);
begin
- FRingCursor := c;
- FRingPicker.Cursor := c;
+ FRingCursor := c;
+ FRingPicker.Cursor := c;
end;
procedure THSLRingPicker.SetSLCursor(c: TCursor);
begin
- FSLCursor := c;
- FSLPicker.Cursor := c;
+ FSLCursor := c;
+ FSLPicker.Cursor := c;
end;
procedure THSLRingPicker.WMSetFocus(
var Message: {$IFDEF DELPHI}TWMSetFocus{$ELSE}TLMSetFocus{$ENDIF} );
begin
- FRingPicker.SetFocus;
- Message.Result := 1;
+ FRingPicker.SetFocus;
+ Message.Result := 1;
end;
function THSLRingPicker.GetManual:boolean;
begin
- Result := FRingPicker.Manual or FSLPicker.Manual;
+ Result := FRingPicker.Manual or FSLPicker.Manual;
end;
procedure THSLRingPicker.Paint;
begin
- PaintParentBack(PBack);
- Canvas.Draw(0, 0, PBack);
+ PaintParentBack(PBack);
+ Canvas.Draw(0, 0, PBack);
end;
procedure THSLRingPicker.CreateWnd;
begin
- inherited;
- PaintParentBack(PBack);
+ inherited;
+ PaintParentBack(PBack);
end;
end.
diff --git a/components/mbColorLib/HSVColorPicker.pas b/components/mbColorLib/HSVColorPicker.pas
index 0029d283b..fbaacd513 100644
--- a/components/mbColorLib/HSVColorPicker.pas
+++ b/components/mbColorLib/HSVColorPicker.pas
@@ -13,70 +13,62 @@ uses
Windows, Messages,
{$ENDIF}
SysUtils, Classes, Controls, Graphics, Math, RGBHSVUtils, Scanlines,
- Forms, {IFDEF DELPHI_7_UP Themes, $ENDIF} HTMLColors, SelPropUtils,
- mbColorPickerControl;
+ Forms, {$IFDEF DELPHI_7_UP}Themes,{$ENDIF}
+ HTMLColors, mbColorPickerControl;
type
THSVColorPicker = class(TmbColorPickerControl)
private
- FHue, FSat, FValue: integer;
- FSatCircColor, FHueLineColor: TColor;
- FSelectedColor: TColor;
- FOnChange: TNotifyEvent;
- FManual: boolean;
- FShowSatCirc: boolean;
- FShowHueLine: boolean;
- FShowSelCirc: boolean;
- Fchange: boolean;
- FHSVBmp: TBitmap;
- FDoChange: boolean;
-
- procedure CreateHSVCircle;
- function RadHue(New: integer): integer;
- procedure SetValue(V: integer);
- procedure SetHue(h: integer);
- procedure SetSat(s: integer);
- procedure SetSatCircColor(c: TColor);
- procedure SetHueLineColor(c: TColor);
- procedure DrawSatCirc;
- procedure DrawHueLine;
- procedure DrawMarker(x, y: integer);
- procedure SelectionChanged(x, y: integer);
- procedure SetShowSatCirc(s: boolean);
- procedure SetShowSelCirc(s: boolean);
- procedure SetShowHueLine(s: boolean);
- procedure UpdateCoords;
+ FHue, FSat, FValue: integer;
+ FSatCircColor, FHueLineColor: TColor;
+ FSelectedColor: TColor;
+ FShowSatCirc: boolean;
+ FShowHueLine: boolean;
+ FShowSelCirc: boolean;
+ FChange: boolean;
+ FDoChange: boolean;
+ function RadHue(New: integer): integer;
+ procedure SetValue(V: integer);
+ procedure SetHue(h: integer);
+ procedure SetSat(s: integer);
+ procedure SetSatCircColor(c: TColor);
+ procedure SetHueLineColor(c: TColor);
+ procedure DrawSatCirc;
+ procedure DrawHueLine;
+ procedure DrawMarker(x, y: integer);
+ procedure SelectionChanged(x, y: integer);
+ procedure SetShowSatCirc(s: boolean);
+ procedure SetShowSelCirc(s: boolean);
+ procedure SetShowHueLine(s: boolean);
+ procedure UpdateCoords;
protected
- function GetSelectedColor: TColor; override;
- procedure SetSelectedColor(c: TColor); override;
- procedure WebSafeChanged; override;
- procedure Paint; override;
- procedure Resize; override;
- procedure CreateWnd; override;
- procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
- procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
- procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
- procedure CNKeyDown(var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF});
- message CN_KEYDOWN;
+ procedure CreateGradient; override;
+ function GetGradientColor2D(X, Y: Integer): TColor; override;
+ function GetSelectedColor: TColor; override;
+ procedure SetSelectedColor(c: TColor); override;
+ procedure Paint; override;
+ procedure Resize; override;
+ procedure CreateWnd; override;
+ procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
+ procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
+ procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
+ procedure CNKeyDown(var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF});
+ message CN_KEYDOWN;
public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
-
- function GetColorAtPoint(x, y: integer): TColor; override;
- property Manual: boolean read FManual;
+ constructor Create(AOwner: TComponent); override;
+ function GetColorAtPoint(x, y: integer): TColor; override;
published
- property Hue: integer read FHue write SetHue default 0;
- property Saturation: integer read FSat write SetSat default 0;
- property Value: integer read FValue write SetValue default 255;
- property SaturationCircleColor: TColor read FSatCircColor write SetSatCircColor default clSilver;
- property HueLineColor: TColor read FHueLineColor write SetHueLineColor default clGray;
- property SelectedColor default clNone;
- property ShowSaturationCircle: boolean read FShowSatCirc write SetShowSatCirc default true;
- property ShowHueLine: boolean read FShowHueLine write SetShowHueLine default true;
- property ShowSelectionCircle: boolean read FShowSelCirc write SetShowSelCirc default true;
- property MarkerStyle default msCrossCirc;
-
- property OnChange: TNotifyEvent read FOnChange write FOnChange;
+ property Hue: integer read FHue write SetHue default 0;
+ property Saturation: integer read FSat write SetSat default 0;
+ property Value: integer read FValue write SetValue default 255;
+ property SaturationCircleColor: TColor read FSatCircColor write SetSatCircColor default clSilver;
+ property HueLineColor: TColor read FHueLineColor write SetHueLineColor default clGray;
+ property SelectedColor default clNone;
+ property ShowSaturationCircle: boolean read FShowSatCirc write SetShowSatCirc default true;
+ property ShowHueLine: boolean read FShowHueLine write SetShowHueLine default true;
+ property ShowSelectionCircle: boolean read FShowSelCirc write SetShowSelCirc default true;
+ property MarkerStyle default msCrossCirc;
+ property OnChange;
end;
procedure Register;
@@ -85,469 +77,423 @@ implementation
{$IFDEF FPC}
{$R HSVColorPicker.dcr}
+{$ENDIF}
uses
- IntfGraphics, fpimage;
-{$ENDIF}
+ mbUtils;
procedure Register;
begin
RegisterComponents('mbColor Lib', [THSVColorPicker]);
end;
-function PointInCirc(p: TPoint; size : integer): boolean;
-var
- r: integer;
-begin
- r := size div 2;
- Result := (SQR(p.x - r) + SQR(p.y - r) <= SQR(r));
-end;
+
+{ THSVColorPicker }
constructor THSVColorPicker.Create(AOwner: TComponent);
begin
- inherited;
- FHSVBmp := TBitmap.Create;
- FHSVBmp.PixelFormat := pf32bit;
- Width := 204;
- Height := 204;
- FValue := 255;
- FHue := 0;
- FSat := 0;
- FSatCircColor := clSilver;
- FHueLineColor := clGray;
- FSelectedColor := clNone;
- FManual := false;
- FShowSatCirc := true;
- FShowHueLine := true;
- FShowSelCirc := true;
- Fchange := true;
- FDoChange := false;
- MarkerStyle := msCrossCirc;
-end;
-
-destructor THSVColorPicker.Destroy;
-begin
- FHSVBmp.Free;
- inherited;
+ inherited;
+ {$IFDEF DELPHI}
+ Width := 204;
+ Height := 204;
+ {$ELSE}
+ SetInitialBounds(0, 0, 204, 204);
+ {$ENDIF}
+ FValue := 255;
+ FHue := 0;
+ FSat := 0;
+ FSatCircColor := clSilver;
+ FHueLineColor := clGray;
+ FSelectedColor := clNone;
+ FManual := false;
+ FShowSatCirc := true;
+ FShowHueLine := true;
+ FShowSelCirc := true;
+ FChange := true;
+ FDoChange := false;
+ MarkerStyle := msCrossCirc;
end;
procedure THSVColorPicker.Paint;
var
- rgn: HRGN;
- R: TRect;
+ rgn: HRGN;
+ R: TRect;
begin
- PaintParentBack(Canvas);
- R := ClientRect;
- R.Right := R.Left + Min(Width, Height);
- R.Bottom := R.Top + Min(Width, Height);
- rgn := CreateEllipticRgnIndirect(R);
- SelectClipRgn(Canvas.Handle, rgn);
- Canvas.Draw(0, 0, FHSVBmp);
- DeleteObject(rgn);
- DrawSatCirc;
- DrawHueLine;
- DrawMarker(mdx, mdy);
- if FDoChange then
+ PaintParentBack(Canvas);
+ R := ClientRect;
+ R.Right := R.Left + Min(Width, Height);
+ R.Bottom := R.Top + Min(Width, Height);
+ InflateRect(R, -1, -1); // Avoid spurious black pixels at the border
+ rgn := CreateEllipticRgnIndirect(R);
+ SelectClipRgn(Canvas.Handle, rgn);
+ Canvas.Draw(0, 0, FGradientBmp);
+ DeleteObject(rgn);
+ DrawSatCirc;
+ DrawHueLine;
+ DrawMarker(mdx, mdy);
+ if FDoChange then
begin
- if Assigned(FOnChange) then FOnChange(Self);
- FDoChange := false;
+ if Assigned(FOnChange) then FOnChange(Self);
+ FDoChange := false;
end;
end;
-procedure THSVColorPicker.CreateHSVCircle;
-var
- dSquared, H, S, V, i, j, radius, radiusSquared, x, y, size: integer;
- row: pRGBQuadArray;
- c: TColor;
- {$IFDEF FPC}
- intfimg: TLazIntfImage;
- imgHandle, imgMaskHandle: HBitmap;
- {$ENDIF}
+procedure THSVColorPicker.CreateGradient;
begin
- if FHSVBmp = nil then
- begin
- FHSVBmp := TBitmap.Create;
- FHSVBmp.PixelFormat := pf32bit;
- end;
-
- size := Min(Width, Height);
- FHSVBmp.Width := size;
- FHSVBmp.Height := size;
- PaintParentBack(FHSVBmp.Canvas);
+ FGradientWidth := Min(Width, Height);
+ FGradientHeight := FGradientWidth;
+ inherited;
+end;
+{ Outer loop: Y, Inner loop: X }
+function THSVColorPicker.GetGradientColor2D(X, Y: Integer): TColor;
+var
+ xcoord, ycoord: Integer;
+ dSq, radiusSq: Integer;
+ radius, size: Integer;
+ S, H, V: Integer;
+ q: TRGBQuad;
+begin
+ size := FGradientWidth; // or Height, they are the same...
radius := size div 2;
- radiusSquared := radius * radius;
- V := FValue;
-
- {$IFDEF FPC}
- intfimg := TLazIntfImage.Create(FHSVBmp.Width, FHSVBmp.Height);
- try
- intfImg.LoadFromBitmap(FHSVBmp.Handle, FHSVBmp.MaskHandle);
- {$ENDIF}
-
- for j := 0 to size - 1 do
- begin
- Y := size - 1 - j - Radius;
- {$IFDEF FPC}
- row := intfImg.GetDataLineStart(size - 1 - j);
- {$ELSE}
- row := FHSVBmp.Scanline(size - 1 - j);
- {$ENDIF}
- for i := 0 to size - 1 do
- begin
- X := i - Radius;
- dSquared := X*X + Y*Y;
- if dSquared <= RadiusSquared then
- begin
- if Radius <> 0 then
- S := round(255.0 * sqrt(dSquared) / radius)
- else
- S := 0;
- H := round(180 * (1 + arctan2(X, Y) / pi)); // wp: order (x,y) is correct!
- H := H + 90;
- if H > 360 then H := H - 360;
- {$IFDEF FPC}
- c := HSVtoColor(H, S, V);
- if WebSafe then
- c := GetWebSafe(c);
- row^[i].rgbRed := GetRValue(c);
- row^[i].rgbGreen := GetGValue(c);
- row^[i].rgbBlue := GetBValue(c);
- {$ELSE}
- if not WebSafe then
- row[i] := HSVtoRGBQuad(H,S,V)
- else
- begin
- c := GetWebSafe(HSVtoColor(H, S, V));
- row[i] := RGBtoRGBQuad(GetRValue(c), GetGValue(c), GetBValue(c));
- end;
- {$ENDIF}
- end;
- end;
- end;
- {$IFDEF FPC}
- intfimg.CreateBitmaps(imgHandle, imgMaskHandle, false);
- FHSVBmp.Handle := imgHandle;
- FHSVBmp.MaskHandle := imgMaskHandle;
- finally
- intfimg.Free;
- end;
- {$ENDIF}
+ radiusSq := sqr(radius);
+ xcoord := X - radius;
+ ycoord := Y - radius;
+ dSq := sqr(xcoord) + sqr(ycoord);
+ if dSq <= radiusSq then
+ begin
+ if radius <> 0 then
+ S := round((255 * sqrt(dSq)) / radius)
+ //S := trunc((255 * sqrt(dSq)) / radius)
+ else
+ S := 0;
+ H := round( 180 * (1 + arctan2(xcoord, ycoord) / pi)); // wp: order (x,y) is correct!
+ H := H + 90;
+ if H > 360 then H := H - 360;
+ Result := HSVtoColor(H, S, FValue);
+ if WebSafe then
+ Result := GetWebSafe(Result);
+ end else
+ Result := GetDefaultColor(dctBrush);
end;
procedure THSVColorPicker.Resize;
begin
- inherited;
- CreateHSVCircle;
- UpdateCoords;
+ inherited;
+ CreateGradient;
+ UpdateCoords;
end;
procedure THSVColorPicker.CreateWnd;
begin
- inherited;
- CreateHSVCircle;
- UpdateCoords;
+ inherited;
+ CreateGradient;
+ UpdateCoords;
end;
procedure THSVColorPicker.UpdateCoords;
var
- r, angle: real;
- radius: integer;
+ r, angle: double;
+ sinAngle, cosAngle: Double;
+ radius: integer;
begin
- radius := Min(Width, Height) div 2;
- r := -MulDiv(radius, FSat, 255);
- angle := -FHue*PI/180 - PI;
- mdx := ROUND(COS(angle)*ROUND(r)) + radius;
- mdy := ROUND(SIN(angle)*ROUND(r)) + radius;
+ radius := Min(Width, Height) div 2;
+ r := -MulDiv(radius, FSat, 255);
+ angle := -FHue* pi / 180 - PI;
+ SinCos(angle, sinAngle, cosAngle);
+ mdx := round(cosAngle * r) + radius;
+ mdy := round(sinAngle * r) + radius;
end;
procedure THSVColorPicker.SetHue(h: integer);
begin
- if h > 360 then h := 360;
- if h < 0 then h := 0;
- if FHue <> h then
+ Clamp(h, 0, 360);
+ if FHue <> h then
begin
- FHue := h;
- FManual := false;
- UpdateCoords;
- Invalidate;
- if Fchange then
- if Assigned(FOnChange) then FOnChange(Self);
+ FHue := h;
+ FManual := false;
+ UpdateCoords;
+ Invalidate;
+ if FChange and Assigned(FOnChange) then FOnChange(Self);
end;
end;
procedure THSVColorPicker.SetSat(s: integer);
begin
- if s > 255 then s := 255;
- if s < 0 then s := 0;
- if FSat <> s then
+ Clamp(s, 0, 255);
+ if FSat <> s then
begin
- FSat := s;
- FManual := false;
- UpdateCoords;
- Invalidate;
- if Fchange then
- if Assigned(FOnChange) then FOnChange(Self);
+ FSat := s;
+ FManual := false;
+ UpdateCoords;
+ Invalidate;
+ if FChange and Assigned(FOnChange) then FOnChange(Self);
end;
end;
procedure THSVColorPicker.SetValue(V: integer);
begin
- if V > 255 then V := 255;
- if V < 0 then V := 0;
- if FValue <> V then
+ Clamp(V, 0, 255);
+ if FValue <> V then
begin
- FValue := V;
- FManual := false;
- CreateHSVCircle;
- Invalidate;
- if Fchange then
- if Assigned(FOnChange) then FOnChange(Self);
+ FValue := V;
+ FManual := false;
+ CreateGradient;
+ Invalidate;
+ if FChange and Assigned(FOnChange) then FOnChange(Self);
end;
end;
procedure THSVColorPicker.SetSatCircColor(c: TColor);
begin
- if FSatCircColor <> c then
+ if FSatCircColor <> c then
begin
- FSatCircColor := c;
- Invalidate;
+ FSatCircColor := c;
+ Invalidate;
end;
end;
procedure THSVColorPicker.SetHueLineColor(c: TColor);
begin
- if FHueLineColor <> c then
+ if FHueLineColor <> c then
begin
- FHueLineColor := c;
- Invalidate;
+ FHueLineColor := c;
+ Invalidate;
end;
end;
procedure THSVColorPicker.SetShowSatCirc(s: boolean);
begin
- if FShowSatCirc <> s then
+ if FShowSatCirc <> s then
begin
- FShowSatCirc := s;
- Invalidate;
+ FShowSatCirc := s;
+ Invalidate;
end;
end;
procedure THSVColorPicker.SetShowSelCirc(s: boolean);
begin
- if FShowSelCirc <> s then
+ if FShowSelCirc <> s then
begin
- FShowSelCirc := s;
- Invalidate;
+ FShowSelCirc := s;
+ Invalidate;
end;
end;
procedure THSVColorPicker.SetShowHueLine(s: boolean);
begin
- if FShowHueLine <> s then
+ if FShowHueLine <> s then
begin
- FShowHueLine := s;
- Invalidate;
+ FShowHueLine := s;
+ Invalidate;
end;
end;
procedure THSVColorPicker.DrawSatCirc;
var
- delta: integer;
- Radius: integer;
+ delta: integer;
+ radius: integer;
begin
- if not FShowSatCirc then Exit;
- if FSat in [1..254] then
+ if not FShowSatCirc then
+ exit;
+ if (FSat > 0) and (FSat < 255) then
begin
- Radius:= Min(Width, Height) div 2;
- Canvas.Pen.Color := FSatCircColor;
- Canvas.Brush.Style := bsClear;
- delta := MulDiv(Radius, FSat, 255);
- Canvas.Ellipse(Radius - delta, Radius - delta, Radius + delta, Radius + delta);
+ radius := Min(Width, Height) div 2;
+ Canvas.Pen.Color := FSatCircColor;
+ Canvas.Brush.Style := bsClear;
+ delta := MulDiv(radius, FSat, 255);
+ Canvas.Ellipse(radius - delta, radius - delta, radius + delta, radius + delta);
end;
end;
procedure THSVColorPicker.DrawHueLine;
var
- angle: double;
- radius: integer;
+ angle: double;
+ sinAngle, cosAngle: Double;
+ radius: integer;
begin
- if not FShowHueLine then Exit;
- Radius := Min(Width, Height) div 2;
- if (FHue >= 0) and (FHue <= 360) then
+ if not FShowHueLine then
+ exit;
+ radius := Min(Width, Height) div 2;
+ if (FHue >= 0) and (FHue <= 360) then
begin
- Angle := -FHue*PI/180;
- Canvas.Pen.Color := FHueLineColor;
- Canvas.MoveTo(Radius,Radius);
- Canvas.LineTo(Radius + Round(Radius*COS(angle)), Radius + Round(Radius*SIN(angle)));
+ angle := -FHue * pi / 180;
+ SinCos(angle, sinAngle, cosAngle);
+ Canvas.Pen.Color := FHueLineColor;
+ Canvas.MoveTo(radius, radius);
+ Canvas.LineTo(radius + round(radius*cosAngle), radius + round(radius*sinAngle));
end;
end;
procedure THSVColorPicker.DrawMarker(x, y: integer);
var
- c: TColor;
+ c: TColor;
begin
- if not FShowSelCirc then Exit;
- if Focused or (csDesigning in ComponentState) then
- c := clBlack
- else
- c := clGray;
- case MarkerStyle of
- msCircle: DrawSelCirc(x, y, Canvas);
- msSquare: DrawSelSquare(x, y, Canvas);
- msCross: DrawSelCross(x, y, Canvas, c);
- msCrossCirc: DrawSelCrossCirc(x, y, Canvas, c);
- end;
+ if not FShowSelCirc then
+ exit;
+ if Focused or (csDesigning in ComponentState) then
+ c := clBlack
+ else
+ c := clGray;
+ InternalDrawMarker(x, y, c);
end;
procedure THSVColorPicker.SelectionChanged(x, y: integer);
var
- Angle, Distance, xDelta, yDelta, Radius: integer;
+ angle, distance, xDelta, yDelta, radius: integer;
begin
- if not PointInCirc(Point(x, y), Min(Width, Height)) then
+ if not PointInCircle(Point(x, y), Min(Width, Height)) then
begin
- FChange := false;
- SetSelectedColor(clNone);
- FChange := true;
- Exit;
+ FChange := false;
+ SetSelectedColor(clNone);
+ FChange := true;
+ exit;
end
- else
- FSelectedColor := clWhite;
- Radius := Min(Width, Height) div 2;
- xDelta := x - Radius;
- yDelta := y - Radius;
- Angle := ROUND(360 + 180*ArcTan2(-yDelta,xDelta)/PI);
- if Angle < 0 then Inc(Angle, 360)
- else if Angle > 360 then
- Dec(Angle, 360);
- Fchange := false;
- SetHue(Angle);
- Distance := ROUND(SQRT(SQR(xDelta) + SQR(yDelta)));
- if Distance >= Radius then SetSat(255)
- else SetSat(MulDiv(Distance, 255, Radius));
- Fchange := true;
+ else
+ FSelectedColor := clWhite;
+ radius := Min(Width, Height) div 2;
+ xDelta := x - radius;
+ yDelta := y - radius;
+ angle := round(360 + 180*arctan2(-yDelta, xDelta) / pi);
+ if angle < 0 then
+ inc(angle, 360)
+ else if angle > 360 then
+ dec(angle, 360);
+ FChange := false;
+ SetHue(Angle);
+ distance := round(sqrt(sqr(xDelta) + sqr(yDelta)));
+ if distance >= radius then
+ SetSat(255)
+ else
+ SetSat(MulDiv(distance, 255, radius));
+ FChange := true;
end;
procedure THSVColorPicker.MouseUp(Button: TMouseButton; Shift: TShiftState;
- X, Y: Integer);
+ X, Y: Integer);
begin
- inherited;
- {$IFDEF DELPHI}
- ClipCursor(nil);
- {$ENDIF}
- if csDesigning in ComponentState then Exit;
- if (Button = mbLeft) and PointInCirc(Point(x, y), Min(Width, Height)) then
+ inherited;
+ {$IFDEF DELPHI}
+ ClipCursor(nil);
+ {$ENDIF}
+ if csDesigning in ComponentState then
+ exit;
+ if (Button = mbLeft) and PointInCircle(Point(x, y), Min(Width, Height)) then
begin
- mdx := x;
- mdy := y;
- FDoChange := true;
- SelectionChanged(X, Y);
- FManual := true;
+ mdx := x;
+ mdy := y;
+ FDoChange := true;
+ SelectionChanged(X, Y);
+ FManual := true;
end;
end;
procedure THSVColorPicker.MouseDown(Button: TMouseButton; Shift: TShiftState;
- X, Y: Integer);
+ X, Y: Integer);
var
- R: TRect;
+ R: TRect;
begin
- inherited;
- if csDesigning in ComponentState then Exit;
- if (Button = mbLeft) and PointInCirc(Point(x, y), Min(Width, Height)) then
+ inherited;
+ if csDesigning in ComponentState then
+ exit;
+ if (Button = mbLeft) and PointInCircle(Point(x, y), Min(Width, Height)) then
begin
- mdx := x;
- mdy := y;
- R := ClientRect;
- InflateRect(R, 1, 1);
- R.TopLeft := ClientToScreen(R.TopLeft);
- R.BottomRight := ClientToScreen(R.BottomRight);
- {$IFDEF DELPHI}
- ClipCursor(@R);
- {$ENDIF}
- FDoChange := true;
- SelectionChanged(X, Y);
- FManual := true;
+ mdx := x;
+ mdy := y;
+ R := ClientRect;
+ InflateRect(R, 1, 1);
+ R.TopLeft := ClientToScreen(R.TopLeft);
+ R.BottomRight := ClientToScreen(R.BottomRight);
+ {$IFDEF DELPHI}
+ ClipCursor(@R);
+ {$ENDIF}
+ FDoChange := true;
+ SelectionChanged(X, Y);
+ FManual := true;
end;
- SetFocus;
+ SetFocus;
end;
procedure THSVColorPicker.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
- inherited;
- if csDesigning in ComponentState then Exit;
- if (ssLeft in Shift) and PointInCirc(Point(x, y), Min(Width, Height)) then
+ inherited;
+ if csDesigning in ComponentState then
+ exit;
+ if (ssLeft in Shift) and PointInCircle(Point(x, y), Min(Width, Height)) then
begin
- mdx := x;
- mdy := y;
- FDoChange := true;
- SelectionChanged(X, Y);
- FManual := true;
+ mdx := x;
+ mdy := y;
+ FDoChange := true;
+ SelectionChanged(X, Y);
+ FManual := true;
end;
end;
function THSVColorPicker.GetSelectedColor: TColor;
begin
- if FSelectedColor <> clNone then
+ if FSelectedColor <> clNone then
begin
- if not WebSafe then
- Result := HSVtoColor(FHue, FSat, FValue)
+ if not WebSafe then
+ Result := HSVtoColor(FHue, FSat, FValue)
else
- Result := GetWebSafe(HSVtoColor(FHue, FSat, FValue));
+ Result := GetWebSafe(HSVtoColor(FHue, FSat, FValue));
end
- else
- Result := clNone;
+ else
+ Result := clNone;
end;
function THSVColorPicker.GetColorAtPoint(x, y: integer): TColor;
var
- Angle, Distance, xDelta, yDelta, Radius: integer;
- h, s: integer;
+ angle, distance, xDelta, yDelta, radius: integer;
+ h, s: integer;
begin
- Radius := Min(Width, Height) div 2;
- xDelta := x - Radius;
- yDelta := y - Radius;
- Angle := ROUND(360 + 180*ArcTan2(-yDelta,xDelta)/PI);
- if Angle < 0 then Inc(Angle, 360)
- else if Angle > 360 then
- Dec(Angle, 360);
- h := Angle;
- Distance := ROUND(SQRT(SQR(xDelta) + SQR(yDelta)));
- if Distance >= Radius then s := 255
- else s := MulDiv(Distance, 255, Radius);
- if PointInCirc(Point(mx, my), Min(Width, Height)) then
+ radius := Min(Width, Height) div 2;
+ xDelta := x - Radius;
+ yDelta := y - Radius;
+ angle := round(360 + 180*arctan2(-yDelta, xDelta) / pi);
+ if angle < 0 then
+ inc(angle, 360)
+ else if angle > 360 then
+ dec(angle, 360);
+ h := angle;
+ distance := round(sqrt(sqr(xDelta) + sqr(yDelta)));
+ if distance >= radius then
+ s := 255
+ else
+ s := MulDiv(distance, 255, radius);
+ if PointInCircle(Point(mx, my), Min(Width, Height)) then
begin
- if not WebSafe then
- Result := HSVtoColor(h, s, FValue)
- else
- Result := GetWebSafe(HSVtoColor(h, s, FValue));
+ if not WebSafe then
+ Result := HSVtoColor(h, s, FValue)
+ else
+ Result := GetWebSafe(HSVtoColor(h, s, FValue));
end
- else
- Result := clNone;
+ else
+ Result := clNone;
end;
procedure THSVColorPicker.SetSelectedColor(c: TColor);
var
- changeSave: boolean;
+ changeSave: boolean;
begin
- if WebSafe then c := GetWebSafe(c);
- changeSave := FChange;
- FManual := false;
- Fchange := false;
- SetValue(GetVValue(c));
- SetHue(GetHValue(c));
- SetSat(GetSValue(c));
- FSelectedColor := c;
- Fchange := changeSave;
- if Fchange then
- if Assigned(FOnChange) then FOnChange(Self);
- FChange := true;
+ if WebSafe then c := GetWebSafe(c);
+ changeSave := FChange;
+ FManual := false;
+ Fchange := false;
+ SetValue(GetVValue(c));
+ SetHue(GetHValue(c));
+ SetSat(GetSValue(c));
+ FSelectedColor := c;
+ FChange := changeSave;
+ if FChange and Assigned(FOnChange) then FOnChange(Self);
+ FChange := true;
end;
function THSVColorPicker.RadHue(New: integer): integer;
begin
- if New < 0 then New := New + 360;
- if New > 360 then New := New - 360;
- Result := New;
+ if New < 0 then New := New + 360;
+ if New > 360 then New := New - 360;
+ Result := New;
end;
procedure THSVColorPicker.CNKeyDown(
@@ -647,11 +593,4 @@ begin
OnKeyDown(Self, Message.CharCode, Shift);
end;
-procedure THSVColorPicker.WebSafeChanged;
-begin
- inherited;
- CreateHSVCircle;
- Invalidate;
-end;
-
end.
diff --git a/components/mbColorLib/RAxisColorPicker.pas b/components/mbColorLib/RAxisColorPicker.pas
index 15192d6b5..5fe1fdf28 100644
--- a/components/mbColorLib/RAxisColorPicker.pas
+++ b/components/mbColorLib/RAxisColorPicker.pas
@@ -7,57 +7,45 @@ unit RAxisColorPicker;
interface
uses
- {$IFDEF FPC}
- LCLIntf, LCLType, LMessages,
- {$ELSE}
- Windows, Messages,
- {$ENDIF}
- SysUtils, Classes, Controls, Graphics, Math, Forms,
- HTMLColors, SelPropUtils, mbColorPickerControl, Scanlines;
+ {$IFDEF FPC}
+ LCLIntf, LCLType, LMessages,
+ {$ELSE}
+ Windows, Messages,
+ {$ENDIF}
+ SysUtils, Classes, Controls, Graphics, Math, Forms,
+ HTMLColors, mbColorPickerControl;
type
- TRAxisColorPicker = class(TmbColorPickerControl)
- private
- FSelected: TColor;
- FBmp: TBitmap;
- FOnChange: TNotifyEvent;
- FR, FG, FB: integer;
- FManual: boolean;
- dx, dy, mxx, myy: integer;
-
- procedure SetRValue(r: integer);
- procedure SetGValue(g: integer);
- procedure SetBValue(b: integer);
- protected
- function GetSelectedColor: TColor; override;
- procedure WebSafeChanged; override;
- procedure SetSelectedColor(c: TColor); override;
- procedure CNKeyDown(var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF});
- message CN_KEYDOWN;
- procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
- procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
- procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
- procedure DrawMarker(x, y: integer);
- procedure Paint; override;
- procedure CreateRGBGradient;
- procedure Resize; override;
- procedure CreateWnd; override;
- procedure CorrectCoords(var x, y: integer);
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
-
- function GetColorAtPoint(x, y: integer): TColor; override;
- property Manual: boolean read FManual;
- published
- property SelectedColor default clRed;
- property RValue: integer read FR write SetRValue default 255;
- property GValue: integer read FG write SetGValue default 0;
- property BValue: integer read FB write SetBValue default 0;
- property MarkerStyle default msCircle;
-
- property OnChange: TNotifyEvent read FOnChange write FOnChange;
- end;
+ TRAxisColorPicker = class(TmbColorPickerControl)
+ private
+ FR, FG, FB: integer;
+ dx, dy, mxx, myy: integer;
+ procedure SetRValue(r: integer);
+ procedure SetGValue(g: integer);
+ procedure SetBValue(b: integer);
+ protected
+ function GetGradientColor2D(x, y: Integer): TColor; override;
+ procedure SetSelectedColor(c: TColor); override;
+ procedure CNKeyDown(var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF});
+ message CN_KEYDOWN;
+ procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
+ procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
+ procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
+ procedure DrawMarker(x, y: integer);
+ procedure Paint; override;
+ procedure Resize; override;
+ procedure CreateWnd; override;
+ procedure CorrectCoords(var x, y: integer);
+ public
+ constructor Create(AOwner: TComponent); override;
+ published
+ property SelectedColor default clRed;
+ property RValue: integer read FR write SetRValue default 255;
+ property GValue: integer read FG write SetGValue default 0;
+ property BValue: integer read FB write SetBValue default 0;
+ property MarkerStyle default msCircle;
+ property OnChange;
+ end;
procedure Register;
@@ -67,196 +55,165 @@ implementation
{$R RAxisColorPicker.dcr}
{$ENDIF}
+uses
+ mbUtils;
+
procedure Register;
begin
- RegisterComponents('mbColor Lib', [TRAxisColorPicker]);
+ RegisterComponents('mbColor Lib', [TRAxisColorPicker]);
end;
{TRAxisColorPicker}
constructor TRAxisColorPicker.Create(AOwner: TComponent);
begin
- inherited;
- FBmp := TBitmap.Create;
- FBmp.PixelFormat := pf32bit;
- FBmp.SetSize(256, 256);
- Width := 256;
- Height := 256;
- HintFormat := 'G: %g B: %b'#13'Hex: %hex';
- FG := 0;
- FB := 0;
- FR := 255;
- FSelected := clRed;
- FManual := false;
- dx := 0;
- dy := 0;
- mxx := 0;
- myy := 0;
- MarkerStyle := msCircle;
-end;
-
-destructor TRAxisColorPicker.Destroy;
-begin
- FBmp.Free;
- inherited Destroy;
+ inherited;
+ FGradientWidth := 256;
+ FGradientHeight := 256;
+ {$IFDEF DELPHI}
+ Width := 256;
+ Height := 256;
+ {$ELSE}
+ SetInitialBounds(0, 0, 256, 256);
+ {$ENDIF}
+ HintFormat := 'G: %g B: %b'#13'Hex: %hex';
+ FG := 0;
+ FB := 0;
+ FR := 255;
+ FSelected := clRed;
+ FManual := false;
+ dx := 0;
+ dy := 0;
+ mxx := 0;
+ myy := 0;
+ MarkerStyle := msCircle;
end;
procedure TRAxisColorPicker.CreateWnd;
begin
- inherited;
- CreateRGBGradient;
+ inherited;
+ CreateGradient;
end;
-procedure TRAxisColorPicker.CreateRGBGradient;
-var
- g, b : integer;
- row: pRGBQuadArray;
+{ x is BLUE, y is GREEN }
+function TRAxisColorPicker.GetGradientColor2D(x, y: Integer): TColor;
begin
- if FBmp = nil then
- begin
- FBmp := TBitmap.Create;
- FBmp.PixelFormat := pf32bit;
- FBmp.Width := 256;
- FBmp.Height := 256;
- end;
- for g := 255 downto 0 do
- begin
- row := FBmp.Scanline[255-g];
- for b := 0 to 255 do
- if not WebSafe then
- row[b] := RGBtoRGBQuad(FR, g, b)
-// FBmp.Canvas.Pixels[b,255-g] := RGB(FR, g, b)
- else
- row[b] := RGBtoRGBQuad(GetWebSafe(RGB(FR, g, b)));
-// FBmp.Canvas.Pixels[b,255-g] := GetWebSafe(RGB(FR, g, b));
- end;
+ Result := RGB(FR, FGradientBmp.Height - 1 - y, x);
end;
procedure TRAxisColorPicker.CorrectCoords(var x, y: integer);
begin
- if x < 0 then x := 0;
- if y < 0 then y := 0;
- if x > Width - 1 then x := Width - 1;
- if y > Height - 1 then y := Height - 1;
+ Clamp(x, 0, Width - 1);
+ Clamp(y, 0, Height - 1);
end;
procedure TRAxisColorPicker.DrawMarker(x, y: integer);
var
- c: TColor;
+ c: TColor;
begin
- CorrectCoords(x, y);
- FR := GetRValue(FSelected);
- FG := GetGValue(FSelected);
- FB := GetBValue(FSelected);
- if Assigned(FOnChange) then
- FOnChange(Self);
- dx := x;
- dy := y;
- if Focused or (csDesigning in ComponentState) then
- c := clBlack
- else
- c := clWhite;
- case MarkerStyle of
- msCircle: DrawSelCirc(x, y, Canvas);
- msSquare: DrawSelSquare(x, y, Canvas);
- msCross: DrawSelCross(x, y, Canvas, c);
- msCrossCirc: DrawSelCrossCirc(x, y, Canvas, c);
- end;
-end;
-
-function TRAxisColorPicker.GetSelectedColor: TColor;
-begin
- Result := FSelected;
+ CorrectCoords(x, y);
+ FR := GetRValue(FSelected);
+ FG := GetGValue(FSelected);
+ FB := GetBValue(FSelected);
+ if Assigned(FOnChange) then
+ FOnChange(Self);
+ dx := x;
+ dy := y;
+ if Focused or (csDesigning in ComponentState) then
+ c := clBlack
+ else
+ c := clWhite;
+ InternalDrawMarker(x, y, c);
end;
procedure TRAxisColorPicker.SetSelectedColor(c: TColor);
begin
- if WebSafe then c := GetWebSafe(c);
- FR := GetRValue(c);
- FG := GetGValue(c);
- FB := GetBValue(c);
- FSelected := c;
- FManual := false;
- myy := Round((255-FG)*(Height/255));
- mxx := Round(FB*(Width/255));
- CreateRGBGradient;
- Invalidate;
+ if WebSafe then c := GetWebSafe(c);
+ FR := GetRValue(c);
+ FG := GetGValue(c);
+ FB := GetBValue(c);
+ FSelected := c;
+ FManual := false;
+ myy := Round((255-FG)*(Height/255));
+ mxx := Round(FB*(Width/255));
+ CreateGradient;
+ Invalidate;
end;
procedure TRAxisColorPicker.Paint;
begin
- Canvas.StretchDraw(ClientRect, FBmp);
- CorrectCoords(mxx, myy);
- DrawMarker(mxx, myy);
+ Canvas.StretchDraw(ClientRect, FGradientBmp);
+ CorrectCoords(mxx, myy);
+ DrawMarker(mxx, myy);
end;
procedure TRAxisColorPicker.Resize;
begin
- FManual := false;
- myy := Round((255-FG)*(Height/255));
- mxx := Round(FB*(Width/255));
- inherited;
+ FManual := false;
+ myy := Round((255-FG)*(Height/255));
+ mxx := Round(FB*(Width/255));
+ inherited;
end;
procedure TRAxisColorPicker.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
- R: TRect;
+ R: TRect;
begin
- inherited;
- mxx := x;
- myy := y;
- if Button = mbLeft then
+ 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;
+ 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;
+ SetFocus;
end;
procedure TRAxisColorPicker.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
- inherited;
- {$IFDEF DELPHI}
- ClipCursor(nil);
- {$ENDIF}
- mxx := x;
- myy := y;
- FSelected := GetColorAtPoint(x, y);
- FManual := true;
- Invalidate;
+ inherited;
+ {$IFDEF DELPHI}
+ ClipCursor(nil);
+ {$ENDIF}
+ mxx := x;
+ myy := y;
+ FSelected := GetColorAtPoint(x, y);
+ FManual := true;
+ Invalidate;
end;
procedure TRAxisColorPicker.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
- inherited;
- if ssLeft in Shift then
+ inherited;
+ if ssLeft in Shift then
begin
- mxx := x;
- myy := y;
- FSelected := GetColorAtPoint(x, y);
- FManual := true;
- Invalidate;
+ mxx := x;
+ myy := y;
+ FSelected := GetColorAtPoint(x, y);
+ FManual := true;
+ Invalidate;
end;
end;
procedure TRAxisColorPicker.CNKeyDown(
var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF} );
var
- Shift: TShiftState;
- FInherited: boolean;
+ Shift: TShiftState;
+ FInherited: boolean;
begin
- FInherited := false;
- Shift := KeyDataToShiftState(Message.KeyData);
- if not (ssCtrl in Shift) then
- case Message.CharCode of
- VK_LEFT:
+ FInherited := false;
+ Shift := KeyDataToShiftState(Message.KeyData);
+ if not (ssCtrl in Shift) then
+ case Message.CharCode of
+ VK_LEFT:
begin
mxx := dx - 1;
myy := dy;
@@ -345,38 +302,23 @@ end;
procedure TRAxisColorPicker.SetRValue(r: integer);
begin
- if r > 255 then r := 255;
- if r < 0 then r := 0;
- FR := r;
- SetSelectedColor(RGB(FR, FG, FB));
+ Clamp(r, 0, 255);
+ FR := r;
+ SetSelectedColor(RGB(FR, FG, FB));
end;
procedure TRAxisColorPicker.SetGValue(g: integer);
begin
- if g > 255 then g := 255;
- if g < 0 then g := 0;
- FG := g;
- SetSelectedColor(RGB(FR, FG, FB));
+ Clamp(g, 0, 255);
+ FG := g;
+ SetSelectedColor(RGB(FR, FG, FB));
end;
procedure TRAxisColorPicker.SetBValue(b: integer);
begin
- if b > 255 then b := 255;
- if b < 0 then b := 0;
- FB := b;
- SetSelectedColor(RGB(FR, FG, FB));
-end;
-
-function TRAxisColorPicker.GetColorAtPoint(x, y: integer): TColor;
-begin
- Result := Canvas.Pixels[x, y];
-end;
-
-procedure TRAxisColorPicker.WebSafeChanged;
-begin
- inherited;
- CreateRGBGradient;
- Invalidate;
+ Clamp(b, 0, 255);
+ FB := b;
+ SetSelectedColor(RGB(FR, FG, FB));
end;
end.
diff --git a/components/mbColorLib/RGBHSLUtils.pas b/components/mbColorLib/RGBHSLUtils.pas
index ff2efa2dd..09c3c1184 100644
--- a/components/mbColorLib/RGBHSLUtils.pas
+++ b/components/mbColorLib/RGBHSLUtils.pas
@@ -25,13 +25,16 @@ procedure RGBtoHSLRange (RGB: TColor; var H1, S1, L1 : integer);
function GetHValue(AColor: TColor): integer;
function GetSValue(AColor: TColor): integer;
function GetLValue(AColor: TColor): integer;
-procedure Clamp(var Input: integer; Min, Max: integer);
+//procedure Clamp(var Input: integer; Min, Max: integer);
function HSLToRGBTriple(H, S, L : integer) : TRGBTriple;
function HSLToRGBQuad(H, S, L: integer): TRGBQuad;
procedure RGBTripleToHSL(RGBTriple : TRGBTriple; var h, s, l: integer);
implementation
+uses
+ mbUtils;
+
function HSLtoRGB(H, S, L: double): TColor;
var
M1, M2: double;
@@ -156,12 +159,12 @@ begin
RGBToHSLRange(AColor, d, d, l);
Result := l;
end;
-
+ {
procedure Clamp(var Input: integer; Min, Max: integer);
begin
if (Input < Min) then Input := Min;
if (Input > Max) then Input := Max;
-end;
+end; }
function HSLToRGBTriple(H, S, L: integer): TRGBTriple;
const
@@ -198,34 +201,34 @@ end;
function HSLToRGBQuad(H, S, L: integer): TRGBQuad;
const
- Divisor = 255*60;
+ Divisor = 255*60;
var
- hTemp, f, LS, p, q, r: integer;
+ hTemp, f, LS, p, q, r: integer;
begin
- Clamp(H, 0, MaxHue);
- Clamp(S, 0, MaxSat);
- Clamp(L, 0, MaxLum);
- if (S = 0) then
- Result := RGBToRGBQuad(L, L, L)
- else
+ Clamp(H, 0, MaxHue);
+ Clamp(S, 0, MaxSat);
+ Clamp(L, 0, MaxLum);
+ if (S = 0) then
+ Result := RGBToRGBQuad(L, L, L)
+ else
begin
- hTemp := H mod MaxHue;
- f := hTemp mod 60;
- hTemp := hTemp div 60;
- LS := L*S;
- p := L - LS div MaxLum;
- q := L - (LS*f) div Divisor;
- r := L - (LS*(60 - f)) div Divisor;
- case hTemp of
- 0: Result := RGBToRGBQuad(L, r, p);
- 1: Result := RGBToRGBQuad(q, L, p);
- 2: Result := RGBToRGBQuad(p, L, r);
- 3: Result := RGBToRGBQuad(p, q, L);
- 4: Result := RGBToRGBQuad(r, p, L);
- 5: Result := RGBToRGBQuad(L, p, q);
- else
- Result := RGBToRGBQuad(0, 0, 0);
- end;
+ hTemp := H mod MaxHue;
+ f := hTemp mod 60;
+ hTemp := hTemp div 60;
+ LS := L*S;
+ p := L - LS div MaxLum;
+ q := L - (LS*f) div Divisor;
+ r := L - (LS*(60 - f)) div Divisor;
+ case hTemp of
+ 0: Result := RGBToRGBQuad(L, r, p);
+ 1: Result := RGBToRGBQuad(q, L, p);
+ 2: Result := RGBToRGBQuad(p, L, r);
+ 3: Result := RGBToRGBQuad(p, q, L);
+ 4: Result := RGBToRGBQuad(r, p, L);
+ 5: Result := RGBToRGBQuad(L, p, q);
+ else
+ Result := RGBToRGBQuad(0, 0, 0);
+ end;
end;
end;
diff --git a/components/mbColorLib/SLColorPicker.pas b/components/mbColorLib/SLColorPicker.pas
index d6bf6618a..5a8c375b6 100644
--- a/components/mbColorLib/SLColorPicker.pas
+++ b/components/mbColorLib/SLColorPicker.pas
@@ -12,51 +12,42 @@ uses
{$ELSE}
Windows, Messages,
{$ENDIF}
- SysUtils, Classes, Controls, Graphics, Math, RGBHSLUtils,
- Forms, HTMLColors, SelPropUtils, mbColorPickerControl, Scanlines;
+ SysUtils, Classes, Controls, Graphics, Math, Forms,
+ mbColorPickerControl;
type
TSLColorPicker = class(TmbColorPickerControl)
private
- FManual: boolean;
- FHue, FSat, FLum: integer;
- FOnChange: TNotifyEvent;
- FChange: boolean;
- FBMP: TBitmap;
-
- procedure CreateSLGradient;
- procedure DrawMarker(x, y: integer);
- procedure SelectionChanged(x, y: integer);
- procedure UpdateCoords;
- procedure SetHue(h: integer);
- procedure SetSat(s: integer);
- procedure SetLum(l: integer);
+ FHue, FSat, FLum: integer;
+ FChange: boolean;
+ procedure DrawMarker(x, y: integer);
+ procedure SelectionChanged(x, y: integer);
+ procedure UpdateCoords;
+ procedure SetHue(h: integer);
+ procedure SetSat(s: integer);
+ procedure SetLum(l: integer);
protected
- procedure WebSafeChanged; override;
- function GetSelectedColor: TColor; override;
- procedure SetSelectedColor(c: TColor); override;
- procedure Paint; override;
- procedure Resize; override;
- procedure CreateWnd; override;
- procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
- procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
- procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
- procedure CNKeyDown(var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF});
- message CN_KEYDOWN;
+ function GetGradientColor2D(X, Y: Integer): TColor; override;
+ function GetSelectedColor: TColor; override;
+ procedure SetSelectedColor(c: TColor); override;
+ procedure Paint; override;
+ procedure Resize; override;
+ procedure CreateWnd; override;
+ procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
+ procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
+ procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
+ procedure CNKeyDown(var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF});
+ message CN_KEYDOWN;
public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
-
- function GetColorAtPoint(x, y: integer): TColor; override;
- property Manual: boolean read FManual;
+ constructor Create(AOwner: TComponent); override;
+ function GetColorAtPoint(x, y: integer): TColor; override;
published
- property Hue: integer read FHue write SetHue default 0;
- property Saturation: integer read FSat write SetSat default 0;
- property Luminance: integer read FLum write SetLum default 255;
- property SelectedColor default clWhite;
- property MarkerStyle default msCircle;
-
- property OnChange: TNotifyEvent read FOnChange write FOnChange;
+ property Hue: integer read FHue write SetHue default 0;
+ property Saturation: integer read FSat write SetSat default 0;
+ property Luminance: integer read FLum write SetLum default 255;
+ property SelectedColor default clWhite;
+ property MarkerStyle default msCircle;
+ property OnChange;
end;
procedure Register;
@@ -65,10 +56,10 @@ implementation
{$IFDEF FPC}
{$R SLColorPicker.dcr}
+{$ENDIF}
uses
- IntfGraphics, fpimage;
-{$ENDIF}
+ ScanLines, RGBHSLUtils, HTMLColors, mbUtils;
procedure Register;
begin
@@ -77,306 +68,211 @@ end;
constructor TSLColorPicker.Create(AOwner: TComponent);
begin
- inherited;
- FBMP := TBitmap.Create;
- FBMP.PixelFormat := pf32bit;
- FBMP.SetSize(256, 256);
- Width := 255;
- Height := 255;
- MaxHue := 360;
- MaxSat := 255;
- MaxLum := 255;
- FHue := 0;
- FSat := 0;
- FLum := 255;
- FChange := true;
- MarkerStyle := msCircle;
-end;
-
-destructor TSLColorPicker.Destroy;
-begin
- FBMP.Free;
- inherited;
-end;
-
-//{$IFDEF DELPHI}
-procedure TSLColorPicker.CreateSLGradient;
-var
- x, y, skip: integer;
- row: pRGBQuadArray;
- c: TColor;
- {$IFDEF FPC}
- intfimg: TLazIntfImage;
- imgHandle, imgMaskHandle: HBitmap;
+ inherited;
+ FGradientWidth := 256;
+ FGradientHeight := 256;
+ {$IFDEF DELPHI}
+ Width := 255;
+ Height := 255;
+ {$ELSE}
+ SetInitialBounds(0, 0, 256, 256);
{$ENDIF}
-begin
- if FBmp = nil then
- begin
- FBmp := TBitmap.Create;
- FBmp.PixelFormat := pf32bit;
- FBmp.Width := 256;
- FBmp.Height := 256;
- end;
-
- {$IFDEF FPC}
- intfimg := TLazIntfImage.Create(FBmp.Width, FBmp.Height);
- try
- intfImg.LoadFromBitmap(FBmp.Handle, FBmp.MaskHandle);
- {$ENDIF}
- {
- row := FBMP.ScanLine[0];
- skip := integer(FBMP.ScanLine[1]) - Integer(row);
- }
- for y := 0 to 255 do
- begin
- {$IFDEF FPC}
- row := intfImg.GetDataLineStart(y);
- {$ELSE}
- row := FHSVBmp.Scanline(y);
- {$ENDIF}
-
- for x := 0 to 255 do
- if not WebSafe then
- row[x] := HSLtoRGBQuad(FHue, x, 255 - y)
- else
- begin
- c := GetWebSafe(RGBTripleToTColor(HSLToRGBTriple(FHue, x, 255 - y)));
- row[x] := RGBtoRGBQuad(GetRValue(c), GetGValue(c), GetBValue(c));
- end;
-// row := pRGBQuadArray(Integer(row) + skip);
- end;
- {$IFDEF FPC}
- intfimg.CreateBitmaps(imgHandle, imgMaskHandle, false);
- FBmp.Handle := imgHandle;
- FBmp.MaskHandle := imgMaskHandle;
- finally
- intfimg.Free;
- end;
- {$ENDIF}
+ MaxHue := 360;
+ MaxSat := 255;
+ MaxLum := 255;
+ FHue := 0;
+ FSat := 0;
+ FLum := 255;
+ FChange := true;
+ MarkerStyle := msCircle;
end;
- (*
-{$ELSE}
-procedure TSLColorPicker.CreateSLGradient;
+{ This picker has Saturation along the X and Luminance along the Y axis. }
+function TSLColorPicker.GetGradientColor2D(X, Y: Integer): TColor;
var
- x, y: Integer;
- c: TColor;
- intfimg: TLazIntfImage;
- imgHandle, imgMaskHandle: HBitmap;
+ q: TRGBQuad;
begin
- if FBmp = nil then
- begin
- FBmp := TBitmap.Create;
- FBmp.PixelFormat := pf32Bit;
- FBmp.Width := 256;
- FBmp.Height := 256;
- end;
- intfimg := TLazIntfImage.Create(FBmp.Width, FBmp.Height);
- try
- intfImg.LoadFromBitmap(FBmp.Handle, FBmp.MaskHandle);
- for y := 0 to 255 do // y = L
- for x := 0 to 255 do // x = S
- begin
- c := HSLRangeToRGB(FHue, x, 255-y);
- if WebSafe then
- c := GetWebSafe(c);
- intfImg.Colors[x, y] := TColorToFPColor(c);
- end;
- intfimg.CreateBitmaps(imgHandle, imgMaskHandle, false);
- FBmp.Handle := imgHandle;
- FBmp.MaskHandle := imgMaskHandle;
- finally
- intfimg.Free;
- end;
+ q := HSLtoRGBQuad(FHue, x, 255-y);
+ Result := RGB(q.rgbRed, q.rgbGreen, q.rgbBlue);
end;
-{$ENDIF}
- *)
+
procedure TSLColorPicker.Resize;
begin
- inherited;
- UpdateCoords;
+ inherited;
+ UpdateCoords;
end;
procedure TSLColorPicker.CreateWnd;
begin
- inherited;
- CreateSLGradient;
- UpdateCoords;
+ inherited;
+ CreateGradient;
+ UpdateCoords;
end;
procedure TSLColorPicker.UpdateCoords;
begin
- mdx := MulDiv(FSat, Width, 255);
- mdy := MulDiv(255-FLum, Height, 255);
+ mdx := MulDiv(FSat, Width, 255);
+ mdy := MulDiv(255-FLum, Height, 255);
end;
procedure TSLColorPicker.DrawMarker(x, y: integer);
var
- c: TColor;
+ c: TColor;
begin
- c := not GetColorAtPoint(x, y);
- case MarkerStyle of
- msCircle: DrawSelCirc(x, y, Canvas);
- msSquare: DrawSelSquare(x, y, Canvas);
- msCross: DrawSelCross(x, y, Canvas, c);
- msCrossCirc: DrawSelCrossCirc(x, y, Canvas, c);
- end;
+ c := not GetColorAtPoint(x, y);
+ InternalDrawMarker(x, y, c);
end;
procedure TSLColorPicker.Paint;
begin
- Canvas.StretchDraw(ClientRect, FBMP);
- DrawMarker(mdx, mdy);
+ Canvas.StretchDraw(ClientRect, FGradientBMP);
+ UpdateCoords;
+ DrawMarker(mdx, mdy);
end;
procedure TSLColorPicker.SetHue(h: integer);
begin
- if h > 360 then h := 360;
- if h < 0 then h := 0;
- if FHue <> h then
+ Clamp(h, 0, 360);
+ if FHue <> h then
begin
- FHue := h;
- FManual := false;
- CreateSLGradient;
- UpdateCoords;
- Invalidate;
- if Fchange then
- if Assigned(FOnChange) then FOnChange(Self);
+ FHue := h;
+ FManual := false;
+ CreateGradient;
+ UpdateCoords;
+ Invalidate;
+ if FChange and Assigned(FOnChange) then FOnChange(Self);
end;
end;
procedure TSLColorPicker.SetSat(s: integer);
begin
- if s > 255 then s := 255;
- if s < 0 then s := 0;
- if FSat <> s then
+ Clamp(s, 0, 255);
+ if FSat <> s then
begin
- FSat := s;
- FManual := false;
- UpdateCoords;
- Invalidate;
- if Fchange then
- if Assigned(FOnChange) then FOnChange(Self);
+ FSat := s;
+ FManual := false;
+ UpdateCoords;
+ Invalidate;
+ if FChange and Assigned(FOnChange) then FOnChange(Self);
end;
end;
-procedure TSLColorPicker.SetLum(l: integer);
+procedure TSLColorPicker.SetLum(L: integer);
begin
- if l > 255 then l := 255;
- if l < 0 then l := 0;
- if FLum <> l then
+ Clamp(L, 0, 255);
+ if FLum <> L then
begin
- FLum := l;
- FManual := false;
- UpdateCoords;
- Invalidate;
- if Fchange then
- if Assigned(FOnChange) then FOnChange(Self);
+ FLum := L;
+ FManual := false;
+ UpdateCoords;
+ Invalidate;
+ if FChange and Assigned(FOnChange) then FOnChange(Self);
end;
end;
procedure TSLColorPicker.SelectionChanged(x, y: integer);
begin
- FChange := false;
-// SetSat(MulDiv(255, x, Width));
-// SetLum(MulDiv(255, Height - y, Height));
- SetSat(MulDiv(255, x, Width - 1));
- SetLum(MulDiv(255, Height - y -1, Height - 1));
- FChange := true;
+ FChange := false;
+// SetSat(MulDiv(255, x, Width));
+// SetLum(MulDiv(255, Height - y, Height));
+ SetSat(MulDiv(255, x, Width - 1));
+ SetLum(MulDiv(255, Height - y -1, Height - 1));
+ FChange := true;
end;
procedure TSLColorPicker.MouseUp(Button: TMouseButton; Shift: TShiftState;
- X, Y: Integer);
+ X, Y: Integer);
begin
- inherited;
- {$IFDEF DELPHI}
- ClipCursor(nil);
- {$ENDIF}
- if csDesigning in ComponentState then Exit;
- if (Button = mbLeft) and PtInRect(ClientRect, Point(x, y)) then
+ inherited;
+ {$IFDEF DELPHI}
+ ClipCursor(nil);
+ {$ENDIF}
+ if csDesigning in ComponentState then Exit;
+ if (Button = mbLeft) and PtInRect(ClientRect, Point(x, y)) then
begin
- mdx := x;
- mdy := y;
- SelectionChanged(X, Y);
- FManual := true;
- if Assigned(FOnChange) then FOnChange(Self);
+ mdx := x;
+ mdy := y;
+ SelectionChanged(X, Y);
+ FManual := true;
+ if Assigned(FOnChange) then FOnChange(Self);
end;
end;
procedure TSLColorPicker.MouseDown(Button: TMouseButton; Shift: TShiftState;
- X, Y: Integer);
+ X, Y: Integer);
var
- R: TRect;
+ R: TRect;
begin
- inherited;
- if csDesigning in ComponentState then Exit;
- if (Button = mbLeft) and PtInRect(ClientRect, Point(x, y)) then
+ inherited;
+ if csDesigning in ComponentState then
+ Exit;
+ if (Button = mbLeft) and PtInRect(ClientRect, Point(x, y)) then
begin
- mdx := x;
- mdy := y;
- R := ClientRect;
- R.TopLeft := ClientToScreen(R.TopLeft);
- R.BottomRight := ClientToScreen(R.BottomRight);
- {$IFDEF DELPHI}
- ClipCursor(@R);
- {$ENDIF}
- SelectionChanged(X, Y);
- FManual := true;
- if Assigned(FOnChange) then FOnChange(Self);
+ mdx := x;
+ mdy := y;
+ R := ClientRect;
+ R.TopLeft := ClientToScreen(R.TopLeft);
+ R.BottomRight := ClientToScreen(R.BottomRight);
+ {$IFDEF DELPHI}
+ ClipCursor(@R);
+ {$ENDIF}
+ SelectionChanged(X, Y);
+ FManual := true;
+ if Assigned(FOnChange) then FOnChange(Self);
end;
- SetFocus;
+ SetFocus;
end;
procedure TSLColorPicker.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
- inherited;
- if csDesigning in ComponentState then Exit;
- if (ssLeft in Shift) and PtInRect(ClientRect, Point(x, y)) then
+ inherited;
+ if csDesigning in ComponentState then
+ Exit;
+ if (ssLeft in Shift) and PtInRect(ClientRect, Point(x, y)) then
begin
- mdx := x;
- mdy := y;
- SelectionChanged(X, Y);
- FManual := true;
- if Assigned(FOnChange) then FOnChange(Self);
+ mdx := x;
+ mdy := y;
+ SelectionChanged(X, Y);
+ FManual := true;
+ if Assigned(FOnChange) then FOnChange(Self);
end;
end;
procedure TSLColorPicker.SetSelectedColor(c: TColor);
var
- h, s, l: integer;
+ h, s, l: integer;
begin
- if WebSafe then c := GetWebSafe(c);
- FManual := false;
- Fchange := false;
- RGBTripleToHSL(RGBtoRGBTriple(GetRValue(c), GetGValue(c), GetBValue(c)), h, s, l);
- SetHue(h);
- SetSat(s);
- SetLum(l);
- if Fchange then
- if Assigned(FOnChange) then FOnChange(Self);
- FChange := true;
+ if WebSafe then c := GetWebSafe(c);
+ FManual := false;
+ FChange := false;
+ RGBTripleToHSL(RGBtoRGBTriple(GetRValue(c), GetGValue(c), GetBValue(c)), h, s, l);
+ SetHue(h);
+ SetSat(s);
+ SetLum(l);
+ if FChange and Assigned(FOnChange) then FOnChange(Self);
+ FChange := true;
end;
function TSLColorPicker.GetSelectedColor: TColor;
var
- triple: TRGBTriple;
+ triple: TRGBTriple;
begin
- triple := HSLToRGBTriple(FHue, FSat, FLum);
- if not WebSafe then
- Result := RGBTripleToTColor(triple)
- else
- Result := GetWebSafe(RGBTripleToTColor(triple));
+ triple := HSLToRGBTriple(FHue, FSat, FLum);
+ if not WebSafe then
+ Result := RGBTripleToTColor(triple)
+ else
+ Result := GetWebSafe(RGBTripleToTColor(triple));
end;
function TSLColorPicker.GetColorAtPoint(x, y: integer): TColor;
var
- triple: TRGBTriple;
+ triple: TRGBTriple;
begin
- triple := HSLToRGBTriple(FHue, MulDiv(255, x, Width), MulDiv(255, Height - y, Height));
- if not WebSafe then
- Result := RGBTripleToTColor(triple)
- else
- Result := GetWebSafe(RGBTripleToTColor(triple));
+ triple := HSLToRGBTriple(FHue, MulDiv(255, x, Width), MulDiv(255, Height - y, Height));
+ if not WebSafe then
+ Result := RGBTripleToTColor(triple)
+ else
+ Result := GetWebSafe(RGBTripleToTColor(triple));
end;
procedure TSLColorPicker.CNKeyDown(
@@ -472,11 +368,4 @@ begin
OnKeyDown(Self, Message.CharCode, Shift);
end;
-procedure TSLColorPicker.WebSafeChanged;
-begin
- inherited;
- CreateSLGradient;
- Invalidate;
-end;
-
end.
diff --git a/components/mbColorLib/SLHColorPicker.pas b/components/mbColorLib/SLHColorPicker.pas
index 3ec206928..d54e1bc02 100644
--- a/components/mbColorLib/SLHColorPicker.pas
+++ b/components/mbColorLib/SLHColorPicker.pas
@@ -9,94 +9,91 @@ interface
{$I mxs.inc}
uses
- {$IFDEF FPC}
- LCLIntf, LCLType, LMessages,
- {$ELSE}
- Windows, Messages,
- {$ENDIF}
- SysUtils, Classes, Controls, Graphics, Forms,
- RGBHSLUtils, mbTrackBarPicker, SLColorPicker, HColorPicker, Menus,
- {$IFDEF DELPHI_7_UP} Themes, {$ENDIF} HTMLColors, mbBasicPicker;
+ {$IFDEF FPC}
+ LCLIntf, LCLType, LMessages,
+ {$ELSE}
+ Windows, Messages,
+ {$ENDIF}
+ SysUtils, Classes, Controls, Graphics, Forms,
+ RGBHSLUtils, mbTrackBarPicker, SLColorPicker, HColorPicker, Menus,
+ {$IFDEF DELPHI_7_UP} Themes, {$ENDIF} HTMLColors, mbBasicPicker;
type
- TSLHColorPicker = class(TmbBasicPicker)
- private
- FOnChange: TNotifyEvent;
- FSLPicker: TSLColorPicker;
- FHPicker: THColorPicker;
- FSelectedColor: TColor;
- FHValue, FSValue, FLValue: integer;
- FRValue, FGValue, FBValue: integer;
- FSLHint, FHHint: string;
- FSLMenu, FHMenu: TPopupMenu;
- FSLCursor, FHCursor: TCursor;
- PBack: TBitmap;
-
- function GetManual: boolean;
- procedure SelectColor(c: TColor);
- procedure SetH(v: integer);
- procedure SetS(v: integer);
- procedure SetL(v: integer);
- procedure SetR(v: integer);
- procedure SetG(v: integer);
- procedure SetB(v: integer);
- procedure SetHHint(h: string);
- procedure SetSLHint(h: string);
- procedure SetSLMenu(m: TPopupMenu);
- procedure SetHMenu(m: TPopupMenu);
- procedure SetHCursor(c: TCursor);
- procedure SetSLCursor(c: TCursor);
- protected
- procedure CreateWnd; override;
- procedure Resize; override;
- procedure Paint; override;
- procedure PaintParentBack; override;
- procedure WMSetFocus(var Message: {$IFDEF FPC}TLMSetFocus{$ELSE}TWMSetFocus{$ENDIF});
- message {$IFDEF FPC}LM_SETFOCUS{$ELSE}WM_SETFOCUS{$ENDIF};
- procedure DoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
- procedure HPickerChange(Sender: TObject);
- procedure SLPickerChange(Sender: TObject);
- procedure DoChange;
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
-
- function GetColorUnderCursor: TColor;
- function GetHexColorUnderCursor: string;
- function GetSelectedHexColor: string;
- property ColorUnderCursor: TColor read GetColorUnderCursor;
- property HValue: integer read FHValue write SetH default 0;
- property SValue: integer read FSValue write SetS default 240;
- property LValue: integer read FLValue write SetL default 120;
- property RValue: integer read FRValue write SetR default 255;
- property GValue: integer read FGValue write SetG default 0;
- property BValue: integer read FBValue write SetB default 0;
- property Manual: boolean read GetManual;
- published
- property SelectedColor: TColor read FSelectedColor write SelectColor default clRed;
- property HPickerPopupMenu: TPopupMenu read FHMenu write SetHMenu;
- property SLPickerPopupMenu: TPopupMenu read FSLMenu write SetSLMenu;
- property HPickerHintFormat: string read FHHint write SetHHint;
- property SLPickerHintFormat: string read FSLHint write SetSLHint;
- property HPickerCursor: TCursor read FHCursor write SetHCursor default crDefault;
- property SLPickerCursor: TCursor read FSLCursor write SetSLCursor default crDefault;
- property TabStop default true;
- property ShowHint;
- property ParentShowHint;
- property Anchors;
- property Align;
- property Visible;
- property Enabled;
- property TabOrder;
- property Color;
- property ParentColor default true;
- {$IFDEF DELPHI_7_UP}{$IFDEF DELPHI}
- property ParentBackground default true;
- {$ENDIF}{$ENDIF}
-
- property OnChange: TNotifyEvent read FOnChange write FOnChange;
- property OnMouseMove;
- end;
+ TSLHColorPicker = class(TmbBasicPicker)
+ private
+ FOnChange: TNotifyEvent;
+ FSLPicker: TSLColorPicker;
+ FHPicker: THColorPicker;
+ FSelectedColor: TColor;
+ FHValue, FSValue, FLValue: integer;
+ FRValue, FGValue, FBValue: integer;
+ FSLHint, FHHint: string;
+ FSLMenu, FHMenu: TPopupMenu;
+ FSLCursor, FHCursor: TCursor;
+ PBack: TBitmap;
+ function GetManual: boolean;
+ procedure SelectColor(c: TColor);
+ procedure SetH(v: integer);
+ procedure SetS(v: integer);
+ procedure SetL(v: integer);
+ procedure SetR(v: integer);
+ procedure SetG(v: integer);
+ procedure SetB(v: integer);
+ procedure SetHHint(h: string);
+ procedure SetSLHint(h: string);
+ procedure SetSLMenu(m: TPopupMenu);
+ procedure SetHMenu(m: TPopupMenu);
+ procedure SetHCursor(c: TCursor);
+ procedure SetSLCursor(c: TCursor);
+ procedure HPickerChange(Sender: TObject);
+ procedure SLPickerChange(Sender: TObject);
+ protected
+ procedure CreateWnd; override;
+ procedure DoChange;
+ procedure DoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
+ procedure Paint; override;
+ procedure PaintParentBack; override;
+ procedure Resize; override;
+ procedure WMSetFocus(var Message: {$IFDEF FPC}TLMSetFocus{$ELSE}TWMSetFocus{$ENDIF});
+ message {$IFDEF FPC}LM_SETFOCUS{$ELSE}WM_SETFOCUS{$ENDIF};
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ function GetColorUnderCursor: TColor;
+ function GetHexColorUnderCursor: string;
+ function GetSelectedHexColor: string;
+ property ColorUnderCursor: TColor read GetColorUnderCursor;
+ property HValue: integer read FHValue write SetH default 0;
+ property SValue: integer read FSValue write SetS default 240;
+ property LValue: integer read FLValue write SetL default 120;
+ property RValue: integer read FRValue write SetR default 255;
+ property GValue: integer read FGValue write SetG default 0;
+ property BValue: integer read FBValue write SetB default 0;
+ property Manual: boolean read GetManual;
+ published
+ property SelectedColor: TColor read FSelectedColor write SelectColor default clRed;
+ property HPickerPopupMenu: TPopupMenu read FHMenu write SetHMenu;
+ property SLPickerPopupMenu: TPopupMenu read FSLMenu write SetSLMenu;
+ property HPickerHintFormat: string read FHHint write SetHHint;
+ property SLPickerHintFormat: string read FSLHint write SetSLHint;
+ property HPickerCursor: TCursor read FHCursor write SetHCursor default crDefault;
+ property SLPickerCursor: TCursor read FSLCursor write SetSLCursor default crDefault;
+ property TabStop default true;
+ property ShowHint;
+ property ParentShowHint;
+ property Anchors;
+ property Align;
+ property Visible;
+ property Enabled;
+ property TabOrder;
+ property Color;
+ property ParentColor default true;
+ {$IFDEF DELPHI_7_UP}{$IFDEF DELPHI}
+ property ParentBackground default true;
+ {$ENDIF}{$ENDIF}
+ property OnChange: TNotifyEvent read FOnChange write FOnChange;
+ property OnMouseMove;
+ end;
procedure Register;
@@ -106,9 +103,16 @@ implementation
{$R SLHColorPicker.dcr}
{$ENDIF}
+const
+ WSL = 255;
+ HSL = 255;
+ WH = 40;
+ DIST = 2;
+ VDELTA = 8;
+
procedure Register;
begin
- RegisterComponents('mbColor Lib', [TSLHColorPicker]);
+ RegisterComponents('mbColor Lib', [TSLHColorPicker]);
end;
{TSLHColorPicker}
@@ -124,9 +128,12 @@ begin
{$IFDEF DELPHI_7_UP}{$IFDEF DELPHI}
ParentBackground := true;
{$ENDIF}{$ENDIF}
- SetInitialBounds(0, 0, 297, 271);
-// Width := 297;
-// Height := 271;
+ {$IFDEF DELPHI}
+ Width := 297;
+ Height := 271;
+ {$ELSE}
+ SetInitialBounds(0, 0, WSL + DIST + WH, HSL + 2*VDELTA);
+ {$ENDIF}
TabStop := true;
FSelectedColor := clRed;
FHPicker := THColorPicker.Create(Self);
@@ -137,14 +144,15 @@ begin
// Hue picker
with FHPicker do
begin
- SetInitialBounds(257, 0, 40, 271);
- {
- Height := 271;
- Width := 40;
- Top := 0;
+ {$IFDEF DELPHI}
Left := 257;
- }
- Anchors := [akTop, akRight, akBottom];
+ Top := 0;
+ Width := 40;
+ Height := 271;
+ {$ELSE}
+ SetInitialBounds(WSL + DIST, 0, WH, HSL + 2*VDELTA);
+ {$ENDIF}
+ // Anchors := [akTop, akRight, akBottom];
Visible := true;
Layout := lyVertical;
ArrowPlacement := spBoth;
@@ -158,14 +166,15 @@ begin
InsertControl(FSLPicker);
with FSLPicker do
begin
- SetInitialBounds(0, 0, 255, 271);
- {
- Width := 255;
- Height := 271; //255;
- Top := 0; //8;
+ {$IFDEF DELPHI}
Left := 0;
- }
- Anchors := [akLeft, akRight, akTop, akBottom];
+ Top := DELTA;
+ Width := 255;
+ Height := self.Height - 2 * VDELTA;
+ {$ELSE}
+ SetInitialBounds(0, VDELTA, WSL, HSL);
+ {$ENDIF}
+ //Anchors := [akLeft, akRight, akTop, akBottom];
Visible := true;
SelectedColor := clRed;
OnChange := SLPickerChange;
@@ -183,10 +192,10 @@ end;
destructor TSLHColorPicker.Destroy;
begin
- PBack.Free;
- FHPicker.Free;
- FSLPicker.Free;
- inherited Destroy;
+ PBack.Free;
+ FHPicker.Free;
+ FSLPicker.Free;
+ inherited Destroy;
end;
procedure TSLHColorPicker.HPickerChange(Sender: TObject);
@@ -197,134 +206,134 @@ end;
procedure TSLHColorPicker.SLPickerChange(Sender: TObject);
begin
- FSelectedColor := FSLPicker.SelectedColor;
- DoChange;
+ FSelectedColor := FSLPicker.SelectedColor;
+ DoChange;
end;
procedure TSLHColorPicker.DoChange;
begin
- FHValue := FHPicker.Hue;
- FSValue := FSLPicker.Saturation;
- FLValue := FSLPicker.Luminance;
- FRValue := GetRValue(FSLPicker.SelectedColor);
- FGValue := GetGValue(FSLPicker.SelectedColor);
- FBValue := GetBValue(FSLPicker.SelectedColor);
- if Assigned(FOnChange) then
- FOnChange(Self);
+ FHValue := FHPicker.Hue;
+ FSValue := FSLPicker.Saturation;
+ FLValue := FSLPicker.Luminance;
+ FRValue := GetRValue(FSLPicker.SelectedColor);
+ FGValue := GetGValue(FSLPicker.SelectedColor);
+ FBValue := GetBValue(FSLPicker.SelectedColor);
+ if Assigned(FOnChange) then
+ FOnChange(Self);
end;
procedure TSLHColorPicker.SelectColor(c: TColor);
begin
- FSelectedColor := c;
- FHPicker.Hue := GetHValue(c);
- FSLPicker.SelectedColor := c;
+ FSelectedColor := c;
+ FHPicker.Hue := GetHValue(c);
+ FSLPicker.SelectedColor := c;
end;
procedure TSLHColorPicker.SetH(v: integer);
begin
- FHValue := v;
- FSLPicker.Hue := v;
- FHPicker.Hue := v;
+ FHValue := v;
+ FSLPicker.Hue := v;
+ FHPicker.Hue := v;
end;
procedure TSLHColorPicker.SetS(v: integer);
begin
- FSValue := v;
- FSLPicker.Saturation := v;
+ FSValue := v;
+ FSLPicker.Saturation := v;
end;
procedure TSLHColorPicker.SetL(v: integer);
begin
- FLValue := v;
- FSLPicker.Luminance := v;
+ FLValue := v;
+ FSLPicker.Luminance := v;
end;
procedure TSLHColorPicker.SetR(v: integer);
begin
- FRValue := v;
- SelectColor(RGB(FRValue, FGValue, FBValue));
+ FRValue := v;
+ SelectColor(RGB(FRValue, FGValue, FBValue));
end;
procedure TSLHColorPicker.SetG(v: integer);
begin
- FGValue := v;
- SelectColor(RGB(FRValue, FGValue, FBValue));
+ FGValue := v;
+ SelectColor(RGB(FRValue, FGValue, FBValue));
end;
procedure TSLHColorPicker.SetB(v: integer);
begin
- FBValue := v;
- SelectColor(RGB(FRValue, FGValue, FBValue));
+ FBValue := v;
+ SelectColor(RGB(FRValue, FGValue, FBValue));
end;
function TSLHColorPicker.GetSelectedHexColor: string;
begin
- Result := ColorToHex(FSelectedColor);
+ Result := ColorToHex(FSelectedColor);
end;
procedure TSLHColorPicker.SetHHint(h: string);
begin
- FHHint := h;
- FHPicker.HintFormat := h;
+ FHHint := h;
+ FHPicker.HintFormat := h;
end;
procedure TSLHColorPicker.SetSLHint(h: string);
begin
- FSLHint := h;
- FSLPicker.HintFormat := h;
+ FSLHint := h;
+ FSLPicker.HintFormat := h;
end;
procedure TSLHColorPicker.SetSLMenu(m: TPopupMenu);
begin
- FSLMenu := m;
- FSLPicker.PopupMenu := m;
+ FSLMenu := m;
+ FSLPicker.PopupMenu := m;
end;
procedure TSLHColorPicker.SetHMenu(m: TPopupMenu);
begin
- FHMenu := m;
- FHPicker.PopupMenu := m;
+ FHMenu := m;
+ FHPicker.PopupMenu := m;
end;
procedure TSLHColorPicker.DoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
- if Assigned(OnMouseMove) then
- OnMouseMove(Self, Shift, x, y);
+ if Assigned(OnMouseMove) then
+ OnMouseMove(Self, Shift, x, y);
inherited;
end;
function TSLHColorPicker.GetColorUnderCursor: TColor;
begin
- Result := FSLPicker.GetColorUnderCursor;
+ Result := FSLPicker.GetColorUnderCursor;
end;
function TSLHColorPicker.GetHexColorUnderCursor: string;
begin
- Result := FSLPicker.GetHexColorUnderCursor;
+ Result := FSLPicker.GetHexColorUnderCursor;
end;
procedure TSLHColorPicker.SetHCursor(c: TCursor);
begin
- FHCursor := c;
- FHPicker.Cursor := c;
+ FHCursor := c;
+ FHPicker.Cursor := c;
end;
procedure TSLHColorPicker.SetSLCursor(c: TCursor);
begin
- FSLCursor := c;
- FSLPicker.Cursor := c;
+ FSLCursor := c;
+ FSLPicker.Cursor := c;
end;
procedure TSLHColorPicker.WMSetFocus(
var Message: {$IFDEF FPC}TLMSetFocus{$ELSE}TWMSetFocus{$ENDIF} );
begin
- FHPicker.SetFocus;
- Message.Result := 1;
+ FHPicker.SetFocus;
+ Message.Result := 1;
end;
function TSLHColorPicker.GetManual:boolean;
begin
- Result := FHPicker.Manual or FSLPicker.Manual;
+ Result := FHPicker.Manual or FSLPicker.Manual;
end;
procedure TSLHColorPicker.Resize;
@@ -332,16 +341,14 @@ begin
inherited;
PaintParentBack;
- if FSLPicker = nil then
- exit;
- if FHPicker = nil then
- exit;
+ if (FSLPicker = nil) or (FHPicker = nil) then
+ exit;
- FSLPicker.Width := Width - FHPicker.Width - 10;
- FSLPicker.Height := Height - 2;
+ FSLPicker.Width := Width - FHPicker.Width - DIST;
+ FSLPicker.Height := Height - 2*VDELTA;
- FHPicker.Left := Width - FHPicker.Width - 2;
- FHPicker.Height := Height - 2;
+ FHPicker.Left := Width - FHPicker.Width;
+ FHPicker.Height := Height;
end;
procedure TSLHColorPicker.PaintParentBack;
@@ -364,8 +371,8 @@ end;
procedure TSLHColorPicker.CreateWnd;
begin
- inherited;
- PaintParentBack;
+ inherited;
+ PaintParentBack;
end;
end.
diff --git a/components/mbColorLib/mbBasicPicker.pas b/components/mbColorLib/mbBasicPicker.pas
index f8b46f9e5..2d0df67bd 100644
--- a/components/mbColorLib/mbBasicPicker.pas
+++ b/components/mbColorLib/mbBasicPicker.pas
@@ -13,8 +13,17 @@ uses
Classes, SysUtils, Graphics, Controls;
type
+
+ { TmbBasicPicker }
+
TmbBasicPicker = class(TCustomControl)
protected
+ FGradientBmp: TBitmap;
+ FGradientWidth: Integer;
+ FGradientHeight: Integer;
+ procedure CreateGradient; virtual;
+ function GetGradientColor(AValue: Integer): TColor; virtual;
+ function GetGradientColor2D(X, Y: Integer): TColor; virtual;
procedure PaintParentBack; virtual; overload;
procedure PaintParentBack(ACanvas: TCanvas); overload;
procedure PaintParentBack(ABitmap: TBitmap); overload;
@@ -50,11 +59,26 @@ begin
inherited;
end;
+procedure TmbBasicPicker.CreateGradient;
+begin
+ // to be implemented by descendants
+end;
+
function TmbBasicPicker.GetDefaultColor(const DefaultColorType: TDefaultColorType): TColor;
begin
result := inherited GetDefaultColor(DefaultColorType);
end;
+function TmbBasicPicker.GetGradientColor(AValue: Integer): TColor;
+begin
+ Result := clNone;
+end;
+
+function TmbBasicPicker.GetGradientColor2D(X, Y: Integer): TColor;
+begin
+ Result := clNone;
+end;
+
procedure TmbBasicPicker.PaintParentBack;
begin
PaintParentBack(Canvas);
diff --git a/components/mbColorLib/mbColorPickerControl.pas b/components/mbColorLib/mbColorPickerControl.pas
index 37487fd14..b12da33ce 100644
--- a/components/mbColorLib/mbColorPickerControl.pas
+++ b/components/mbColorLib/mbColorPickerControl.pas
@@ -9,238 +9,308 @@ interface
{$I mxs.inc}
uses
- {$IFDEF FPC}
- LCLIntf, LCLType, LMessages,
- {$ELSE}
- Windows, Messages,
- {$ENDIF}
- SysUtils, Classes, Controls, Graphics, Forms,
- {$IFDEF DELPHI_7_UP} Themes,{$ENDIF}
- RGBHSLUtils, RGBHSVUtils, RGBCMYKUtils, RGBCIEUtils, HTMLColors, mbBasicPicker;
+ {$IFDEF FPC}
+ LCLIntf, LCLType, LMessages,
+ {$ELSE}
+ Windows, Messages,
+ {$ENDIF}
+ SysUtils, Classes, Controls, Graphics, Forms,
+ {$IFDEF DELPHI_7_UP} Themes,{$ENDIF}
+ RGBHSLUtils, RGBHSVUtils, RGBCMYKUtils, RGBCIEUtils, HTMLColors, mbBasicPicker;
type
- TMarkerStyle = (msCircle, msSquare, msCross, msCrossCirc);
+ TMarkerStyle = (msCircle, msSquare, msCross, msCrossCirc);
- TmbCustomPicker = class(TmbBasicPicker)
- private
- FHintFormat: string;
- FMarkerStyle: TMarkerStyle;
- FWebSafe: boolean;
- procedure SetMarkerStyle(s: TMarkerStyle);
- procedure SetWebSafe(s: boolean);
- protected
- mx, my, mdx, mdy: integer;
- function GetSelectedColor: TColor; virtual;
- procedure SetSelectedColor(C: TColor); virtual;
- procedure WebSafeChanged; dynamic;
- procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
- procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
- procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
- procedure CreateWnd; override;
- procedure CMHintShow(var Message: TCMHintShow); message CM_HINTSHOW;
- {$IFDEF DELPHI}
- procedure CMGotFocus(var Message: TCMGotFocus); message CM_ENTER;
- procedure CMLostFocus(var Message: TCMLostFocus); message CM_EXIT;
- procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
- {$ELSE}
- procedure CMGotFocus(var Message: TLMessage); message CM_ENTER;
- procedure CMLostFocus(var Message: TLMessage); message CM_EXIT;
- procedure CMMouseLeave(var Message: TLMessage); message CM_MOUSELEAVE;
- {$ENDIF}
- property MarkerStyle: TMarkerStyle read FMarkerStyle write SetMarkerStyle;
- public
- constructor Create(AOwner: TComponent); override;
+ TmbCustomPicker = class(TmbBasicPicker)
+ private
+ FHintFormat: string;
+ FMarkerStyle: TMarkerStyle;
+ FWebSafe: boolean;
+ procedure SetMarkerStyle(s: TMarkerStyle);
+ procedure SetWebSafe(s: boolean);
+ protected
+ FManual: Boolean;
+ FSelected: TColor;
+ mx, my, mdx, mdy: integer;
+ FOnChange: TNotifyEvent;
+ procedure CreateGradient; override;
+ function GetSelectedColor: TColor; virtual;
+ procedure SetSelectedColor(C: TColor); virtual;
+ procedure InternalDrawMarker(X, Y: Integer; C: TColor);
+ procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
+ procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
+ procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
+ procedure CreateWnd; override;
+ procedure WebSafeChanged; dynamic;
+ procedure CMHintShow(var Message: TCMHintShow); message CM_HINTSHOW;
+ {$IFDEF DELPHI}
+ procedure CMGotFocus(var Message: TCMGotFocus); message CM_ENTER;
+ procedure CMLostFocus(var Message: TCMLostFocus); message CM_EXIT;
+ procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
+ {$ELSE}
+ procedure CMGotFocus(var Message: TLMessage); message CM_ENTER;
+ procedure CMLostFocus(var Message: TLMessage); message CM_EXIT;
+ procedure CMMouseLeave(var Message: TLMessage); message CM_MOUSELEAVE;
+ {$ENDIF}
+ property MarkerStyle: TMarkerStyle read FMarkerStyle write SetMarkerStyle;
+ property OnChange: TNotifyEvent read FOnChange write FOnChange;
+ public
+ constructor Create(AOwner: TComponent); override;
+ function GetColorAtPoint(x, y: integer): TColor; dynamic;
+ function GetHexColorAtPoint(X, Y: integer): string;
+ function GetColorUnderCursor: TColor;
+ function GetHexColorUnderCursor: string;
+ property ColorUnderCursor: TColor read GetColorUnderCursor;
+ property Manual: boolean read FManual;
+ published
+ property SelectedColor: TColor read GetSelectedColor write SetSelectedColor;
+ property HintFormat: string read FHintFormat write FHintFormat;
+ property WebSafe: boolean read FWebSafe write SetWebSafe default false;
+ end;
- function GetColorAtPoint(x, y: integer): TColor; dynamic;
- function GetHexColorAtPoint(X, Y: integer): string;
- function GetColorUnderCursor: TColor;
- function GetHexColorUnderCursor: string;
-
- property ColorUnderCursor: TColor read GetColorUnderCursor;
- published
- property SelectedColor: TColor read GetSelectedColor write SetSelectedColor;
- property HintFormat: string read FHintFormat write FHintFormat;
- property WebSafe: boolean read FWebSafe write SetWebSafe default false;
- end;
-
- TmbColorPickerControl = class(TmbCustomPicker)
- published
- property Anchors;
- property Align;
- property ShowHint;
- property ParentShowHint;
- property Visible;
- property Enabled;
- property PopupMenu;
- property TabOrder;
- property TabStop default true;
- property Color;
- property ParentColor;
- {$IFDEF DELPHI_7_UP}{$IFDEF DELPHI}
- property ParentBackground default true;
- {$ENDIF}{$ENDIF}
- property DragCursor;
- property DragMode;
- property DragKind;
- property Constraints;
-
- property OnContextPopup;
- property OnMouseDown;
- property OnMouseMove;
- property OnMouseUp;
- property OnKeyDown;
- property OnKeyPress;
- property OnKeyUp;
- property OnDragDrop;
- property OnDragOver;
- property OnEndDrag;
- property OnEnter;
- property OnExit;
- property OnResize;
- property OnStartDrag;
- end;
+ TmbColorPickerControl = class(TmbCustomPicker)
+ published
+ property Anchors;
+ property Align;
+ property ShowHint;
+ property ParentShowHint;
+ property Visible;
+ property Enabled;
+ property PopupMenu;
+ property TabOrder;
+ property TabStop default true;
+ property Color;
+ property ParentColor;
+ {$IFDEF DELPHI_7_UP}{$IFDEF DELPHI}
+ property ParentBackground default true;
+ {$ENDIF}{$ENDIF}
+ property DragCursor;
+ property DragMode;
+ property DragKind;
+ property Constraints;
+ property OnContextPopup;
+ property OnMouseDown;
+ property OnMouseMove;
+ property OnMouseUp;
+ property OnKeyDown;
+ property OnKeyPress;
+ property OnKeyUp;
+ property OnDragDrop;
+ property OnDragOver;
+ property OnEndDrag;
+ property OnEnter;
+ property OnExit;
+ property OnResize;
+ property OnStartDrag;
+ end;
implementation
-uses PalUtils;
+uses
+ {$IFDEF FPC}
+ IntfGraphics, fpimage,
+ {$ENDIF}
+ ScanLines, PalUtils, SelPropUtils;
constructor TmbCustomPicker.Create(AOwner: TComponent);
begin
- inherited;
- ControlStyle := ControlStyle + [csOpaque] - [csAcceptsControls];
- DoubleBuffered := true;
- TabStop := true;
+ inherited;
+ ControlStyle := ControlStyle + [csOpaque] - [csAcceptsControls];
+ DoubleBuffered := true;
+ TabStop := true;
{$IFDEF DELPHI_7_UP}{$IFDEF DELPHI}
- ParentBackground := true;
+ ParentBackground := true;
{$ENDIF}{$ENDIF}
- mx := 0;
- my := 0;
- mdx := 0;
- mdy := 0;
- FHintFormat := 'Hex #%hex'#10#13'RGB[%r, %g, %b]'#10#13'HSL[%hslH, %hslS, %hslL]'#10#13'HSV[%hsvH, %hsvS, %hsvV]'#10#13'CMYK[%c, %m, %y, %k]'#10#13'L*a*b*[%cieL, %cieA, %cieB]'#10#13'XYZ[%cieX, %cieY, %cieZ]';
- FWebSafe := false;
+ mx := 0;
+ my := 0;
+ mdx := 0;
+ mdy := 0;
+ FHintFormat := 'Hex #%hex'#10#13'RGB[%r, %g, %b]'#10#13'HSL[%hslH, %hslS, %hslL]'#10#13'HSV[%hsvH, %hsvS, %hsvV]'#10#13'CMYK[%c, %m, %y, %k]'#10#13'L*a*b*[%cieL, %cieA, %cieB]'#10#13'XYZ[%cieX, %cieY, %cieZ]';
+ FWebSafe := false;
end;
procedure TmbCustomPicker.CreateWnd;
begin
- inherited;
+ inherited;
end;
procedure TmbCustomPicker.CMGotFocus(
var Message: {$IFDEF FPC}TLMessage{$ELSE}TCMGotFocus{$ENDIF} );
begin
- inherited;
- Invalidate;
+ inherited;
+ Invalidate;
end;
procedure TmbCustomPicker.CMLostFocus(
var Message: {$IFDEF FPC}TLMessage{$ELSE}TCMLostFocus{$ENDIF} );
begin
- inherited;
- Invalidate;
+ inherited;
+ Invalidate;
end;
procedure TmbCustomPicker.CMMouseLeave(
var Message: {$IFDEF FPC}TLMessage{$ELSE}TMessage{$ENDIF});
begin
- mx := 0;
- my := 0;
- inherited;
+ mx := 0;
+ my := 0;
+ inherited;
+end;
+
+procedure TmbCustomPicker.CreateGradient;
+var
+// x, y, skip: integer;
+ x, y: Integer;
+ row: pRGBQuadArray;
+ c: TColor;
+ {$IFDEF FPC}
+ intfimg: TLazIntfImage;
+ imgHandle, imgMaskHandle: HBitmap;
+ {$ENDIF}
+begin
+ if FGradientBmp = nil then
+ begin
+ FGradientBmp := TBitmap.Create;
+ FGradientBmp.PixelFormat := pf32bit;
+ end;
+ FGradientBmp.Width := FGradientWidth;
+ FGradientBmp.Height := FGradientHeight;
+
+ {$IFDEF FPC}
+ intfimg := TLazIntfImage.Create(FGradientBmp.Width, FGradientBmp.Height);
+ try
+ intfImg.LoadFromBitmap(FGradientBmp.Handle, FGradientBmp.MaskHandle);
+ {$ENDIF}
+
+ for y := 0 to FGradientBmp.Height - 1 do
+ begin
+ {$IFDEF FPC}
+ row := intfImg.GetDataLineStart(y); //FGradientBmp.Height - 1 - y);
+ {$ELSE}
+ row := FHSVBmp.Scanline(y); //FGradientBmp.Height - 1 - y);
+ {$ENDIF}
+
+ for x := 0 to FGradientBmp.Width - 1 do
+ begin
+ c := GetGradientColor2D(x, y);
+ if WebSafe then
+ c := GetWebSafe(c);
+ row[x] := RGBToRGBQuad(GetRValue(c), GetGValue(c), GetBValue(c));
+ end;
+ end;
+
+{$IFDEF FPC}
+ intfimg.CreateBitmaps(imgHandle, imgMaskHandle, false);
+ FGradientBmp.Handle := imgHandle;
+ FGradientBmp.MaskHandle := imgMaskHandle;
+ finally
+ intfimg.Free;
+ end;
+{$ENDIF}
end;
function TmbCustomPicker.GetSelectedColor: TColor;
begin
- Result := clNone;
- //handled in descendents
+ Result := FSelected; // valid for most descendents
end;
procedure TmbCustomPicker.SetSelectedColor(C: TColor);
begin
- //handled in descendents
+ FSelected := C;
+ //handled in descendents
end;
function TmbCustomPicker.GetColorAtPoint(x, y: integer): TColor;
begin
- Result := clNone;
- //handled in descendents
+ Result := Canvas.Pixels[x, y]; // valid for most descendents
end;
function TmbCustomPicker.GetHexColorAtPoint(X, Y: integer): string;
begin
- Result := ColorToHex(GetColorAtPoint(x, y));
+ Result := ColorToHex(GetColorAtPoint(x, y));
end;
function TmbCustomPicker.GetColorUnderCursor: TColor;
begin
- Result := GetColorAtPoint(mx, my);
+ Result := GetColorAtPoint(mx, my);
end;
function TmbCustomPicker.GetHexColorUnderCursor: string;
begin
- Result := ColorToHex(GetColorAtPoint(mx, my));
+ Result := ColorToHex(GetColorAtPoint(mx, my));
+end;
+
+procedure TmbCustomPicker.InternalDrawMarker(X, Y: Integer; C: TColor);
+begin
+ case MarkerStyle of
+ msCircle: DrawSelCirc(x, y, Canvas);
+ msSquare: DrawSelSquare(x, y, Canvas);
+ msCross: DrawSelCross(x, y, Canvas, c);
+ msCrossCirc: DrawSelCrossCirc(x, y, Canvas, c);
+ end;
end;
procedure TmbCustomPicker.CMHintShow(var Message: TCMHintShow);
begin
-if GetColorUnderCursor <> clNone then
- with TCMHintShow(Message) do
- if not ShowHint then
- Message.Result := 1
- else
- with HintInfo^ do
- begin
- Result := 0;
- ReshowTimeout := 1;
- HideTimeout := 5000;
- HintStr := FormatHint(FHintFormat, GetColorUnderCursor);;
- end;
- inherited;
+ if GetColorUnderCursor <> clNone then
+ with TCMHintShow(Message) do
+ if not ShowHint then
+ Message.Result := 1
+ else
+ with HintInfo^ do
+ begin
+ Result := 0;
+ ReshowTimeout := 1;
+ HideTimeout := 5000;
+ HintStr := FormatHint(FHintFormat, GetColorUnderCursor);;
+ end;
+ inherited;
end;
procedure TmbCustomPicker.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
- inherited;
- mx := x;
- my := y;
+ inherited;
+ mx := x;
+ my := y;
end;
procedure TmbCustomPicker.MouseDown(Button: TMouseButton; Shift: TShiftState;
- X, Y: Integer);
+ X, Y: Integer);
begin
- inherited;
- mx := x;
- my := y;
+ inherited;
+ mx := x;
+ my := y;
end;
procedure TmbCustomPicker.MouseUp(Button: TMouseButton; Shift: TShiftState;
- X, Y: Integer);
+ X, Y: Integer);
begin
- inherited;
- mx := x;
- my := y;
+ inherited;
+ mx := x;
+ my := y;
end;
procedure TmbCustomPicker.SetMarkerStyle(s: TMarkerStyle);
begin
- if FMarkerStyle <> s then
+ if FMarkerStyle <> s then
begin
- FMarkerStyle := s;
- invalidate;
+ FMarkerStyle := s;
+ Invalidate;
end;
end;
procedure TmbCustomPicker.SetWebSafe(s: boolean);
begin
- if FWebSafe <> s then
+ if FWebSafe <> s then
begin
- FWebSafe := s;
- WebSafeChanged;
+ FWebSafe := s;
+ WebSafeChanged;
end;
end;
procedure TmbCustomPicker.WebSafeChanged;
begin
- //handled in descendents
+ CreateGradient;
+ Invalidate;
end;
end.
diff --git a/components/mbColorLib/mbTrackBarPicker.pas b/components/mbColorLib/mbTrackBarPicker.pas
index 5f94e7b01..e8cbd969b 100644
--- a/components/mbColorLib/mbTrackBarPicker.pas
+++ b/components/mbColorLib/mbTrackBarPicker.pas
@@ -75,12 +75,8 @@ type
FChange: boolean;
FPickRect: TRect;
FLimit: integer;
- FGradientBmp: TBitmap;
- FGradientWidth: Integer;
- FGradientHeight: Integer;
- procedure CreateGradient;
- function GetGradientColor(AValue: Integer): TColor; virtual;
+ procedure CreateGradient; override;
procedure Paint; override;
procedure DrawFrames; dynamic;
procedure Resize; override;
@@ -249,17 +245,13 @@ begin
inherited;
end;
-function TmbTrackbarPicker.GetGradientColor(AValue: Integer): TColor;
-begin
- Result := clDefault;
-end;
-
{ AWidth and AHeight are seen for horizontal arrangement of the bar }
procedure TmbTrackbarPicker.CreateGradient;
var
i,j: integer;
row: pRGBQuadArray;
c: TColor;
+ q: TRGBQuad;
{$IFDEF FPC}
intfimg: TLazIntfImage;
imgHandle, imgMaskHandle: HBitmap;
@@ -283,6 +275,8 @@ begin
for i := 0 to FGradientBmp.Width-1 do
begin
c := GetGradientColor(i);
+ if WebSafe then c := GetWebSafe(c);
+ q := RGBToRGBQuad(c);
for j := 0 to FGradientBmp.Height-1 do
begin
{$IFDEF FPC}
@@ -290,10 +284,7 @@ begin
{$ELSE}
row := FGradientBmp.ScanLine[j];
{$ENDIF}
- if not WebSafe then
- row[i] := RGBtoRGBQuad(c)
- else
- row[i] := RGBtoRGBQuad(GetWebSafe(c));
+ row[i] := q;
end;
end;
end
@@ -312,11 +303,10 @@ begin
row := FGradientBmp.ScanLine[i];
{$ENDIF}
c := GetGradientColor(FGradientBmp.Height - 1 - i);
+ if WebSafe then c := GetWebSafe(c);
+ q := RGBtoRGBQuad(c);
for j := 0 to FGradientBmp.Width-1 do
- if not WebSafe then
- row[j] := RGBtoRGBQuad(c)
- else
- row[j] := RGBtoRGBQuad(GetWebSafe(c));
+ row[j] := q;
end;
end;
diff --git a/components/mbColorLib/mbutils.pas b/components/mbColorLib/mbutils.pas
index b5c1d7f88..e9e5fa9c0 100644
--- a/components/mbColorLib/mbutils.pas
+++ b/components/mbColorLib/mbutils.pas
@@ -8,6 +8,7 @@ uses
Classes, SysUtils;
procedure Clamp(var AValue:Integer; AMin, AMax: Integer);
+function PointInCircle(p: TPoint; Size: integer): boolean;
implementation
@@ -17,6 +18,14 @@ begin
if AValue > AMax then AValue := AMax;
end;
+function PointInCircle(p: TPoint; Size: integer): boolean;
+var
+ r: integer;
+begin
+ r := size div 2;
+ Result := (sqr(p.x - r) + sqr(p.y - r) <= sqr(r));
+end;
+
end.