mbControls: Refactoring of the 2D gradients and code used in several units over again.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5461 8e941d3f-bd1b-0410-a28a-d453659cc2b4

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.

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.

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.

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.

components/mbColorLib/Demo/Demo.lpi

@@ -58,6 +58,13 @@
       <IncludeFiles Value="$(ProjOutDir)"/>
       <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
     </SearchPaths>
+    <Linking>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+      </Options>
+    </Linking>
   </CompilerOptions>
   <Debugging>
     <Exceptions Count="3">

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

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;
 

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.

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;
 

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.

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.

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.

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.

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.

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;
 

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.

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.

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);

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.

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;
 

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.