lazarus-ccr/components/mbColorLib/mbTrackBarPicker.pas

unit mbTrackBarPicker;

{$MODE DELPHI}

interface

uses
  LCLIntf, LCLType, LMessages, SysUtils, Classes, Controls, Graphics, Forms,
  Themes, ExtCtrls,
  PalUtils, mbColorConv, mbBasicPicker;

const
  TBA_Resize = 0;
  TBA_Paint = 1;
  TBA_MouseMove = 2;
  TBA_MouseDown = 3;
  TBA_MouseUp = 4;
  TBA_WheelUp = 5;
  TBA_WheelDown = 6;
  TBA_VKUp = 7;
  TBA_VKCtrlUp = 8;
  TBA_VKDown = 9;
  TBA_VKCtrlDown = 10;
  TBA_VKLeft = 11;
  TBA_VKCtrlLeft = 12;
  TBA_VKRight = 13;
  TBA_VKCtrlRight = 14;
  TBA_RedoBMP = 15;

type
  TTrackBarLayout = (lyHorizontal, lyVertical);
  TSliderPlacement = (spBefore, spAfter, spBoth);
  TSelIndicator = (siArrows, siRect);

  { TmbTrackBarPicker }

  TmbTrackBarPicker = class(TmbBasicPicker)
  private
    Aw, Ah: integer;
    mx, my: integer;
    FBevelInner: TBevelCut;
    FBevelOuter: TBevelCut;
    FBevelWidth: TBevelWidth;
    FBorderStyle: TBorderStyle;
    FHintFormat: string;
    FIncrement: integer;
    FNewArrowStyle: boolean;
    FPlacement: TSliderPlacement;
    FSelIndicator: TSelIndicator;
    FWebSafe: boolean;
    procedure CalcPickRect;
    procedure DrawMarker(p: integer);
    procedure SetBevelInner(Value: TBevelCut);
    procedure SetBevelOuter(Value: TBevelCut);
    procedure SetBevelWidth(Value: TBevelWidth);
    procedure SetLayout(Value: TTrackBarLayout);
    procedure SetNewArrowStyle(s: boolean);
    procedure SetPlacement(Value: TSliderPlacement);
    procedure SetSelIndicator(Value: TSelIndicator);
    procedure SetWebSafe(s: boolean);
    function XToArrowPos(p: integer): integer;
    function YToArrowPos(p: integer): integer;
  protected
    FArrowPos: integer;
//    FBack: TBitmap;
    FLayout: TTrackBarLayout;
    FLimit: integer;
    FPickRect: TRect;
    procedure CreateGradient; override;
    procedure CreateWnd; override;
    function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
      MousePos: TPoint): Boolean; override;
    procedure DrawFrames; dynamic;
    procedure Execute(tbaAction: integer); dynamic;
    function GetArrowPos: integer; dynamic;
    function GetHintPos(X, Y: Integer): TPoint; override;
    function GetHintStr(X, Y: Integer): String; override;
    function GetSelectedValue: integer; virtual; abstract;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseLeave; override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure Paint; override;
    procedure Resize; override;
    procedure SetBorderStyle(Value: TBorderStyle); override;
    procedure CMGotFocus(var Message: TLMessage); message CM_ENTER;
    procedure CMLostFocus(var Message: TLMessage); message CM_EXIT;
    property HintFormat: string read FHintFormat write FHintFormat;

  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

  published
    property BevelInner: TPanelBevel read FBevelInner write SetBevelInner default bvNone;
    property BevelOuter: TPanelBevel read FBevelOuter write SetBevelOuter default bvNone;
    property BevelWidth: TBevelWidth read FBevelWidth write SetBevelWidth default 1;
    property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsNone;
    property Increment: integer read FIncrement write FIncrement default 1;
    property Layout: TTrackBarLayout read FLayout write SetLayout default lyHorizontal;
    property ArrowPlacement: TSliderPlacement read FPlacement write SetPlacement default spAfter;
    property NewArrowStyle: boolean read FNewArrowStyle write SetNewArrowStyle default false;
    property SelectionIndicator: TSelIndicator read FSelIndicator write SetSelIndicator default siArrows;
    property WebSafe: boolean read FWebSafe write SetWebSafe default false;
    property TabStop default true;
    property ShowHint;
    property Color;
    property ParentColor;
    property ParentShowHint default true;
    property Anchors;
    property Align;
    property BorderSpacing;
    property Visible;
    property Enabled;
    property PopupMenu;
    property TabOrder;
    property DragCursor;
    property DragMode;
    property DragKind;
    property Constraints;
    property OnChange;
    property OnContextPopup;
    property OnGetHintStr;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnMouseWheel;
    property OnMouseWheelUp;
    property OnMouseWheelDown;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnResize;
    property OnStartDrag;
  end;

  { TmbHSLVTrackbarPicker }

  TmbHSLVTrackbarPicker = class(TmbTrackbarPicker)
  private
    FBrightnessMode: TBrightnessMode;
    function GetHue: Integer;
    function GetLum: Integer;
    function GetSat: Integer;
    function GetVal: Integer;
    procedure SetHue(h: integer);
    procedure SetLum(L: Integer);
    procedure SetSat(s: integer);
    procedure SetVal(v: integer);
  protected
    FHue, FSat, FLum, FVal: Double;
    FMaxHue, FMaxSat, FMaxLum, FMaxVal: Integer;
    procedure ColorToHSLV(c: TColor; var H, S, L, V: Double);
    function GetSelectedColor: TColor; override;
    function HSLVtoColor(H, S, L, V: Double): TColor;
    procedure SetBrightnessMode(AMode: TBrightnessMode); virtual;
    procedure SetMaxHue(h: Integer); virtual;
    procedure SetMaxLum(L: Integer); virtual;
    procedure SetMaxSat(s: Integer); virtual;
    procedure SetMaxVal(v: Integer); virtual;
    procedure SetRelHue(H: Double); virtual;
    procedure SetRelLum(L: Double); virtual;
    procedure SetRelSat(S: Double); virtual;
    procedure SetRelVal(V: Double); virtual;
  public
    constructor Create(AOwner: TComponent); override;
    property RelHue: Double read FHue write SetRelHue;
    property RelSaturation: Double read FSat write SetRelSat;
    property RelLuminance: Double read FLum write SetRelLum;
    property RelValue: Double read FVal write SetRelVal;
  published
    property BrightnessMode: TBrightnessMode
      read FBrightnessMode write SetBrightnessMode default bmLuminance;
    property Hue: integer read GetHue write SetHue;
    property Luminance: Integer read GetLum write SetLum;
    property Saturation: integer read GetSat write SetSat;
    property Value: integer read GetVal write SetVal;
    property MaxHue: Integer read FMaxHue write SetMaxHue default 360;
    property MaxSaturation: Integer read FMaxSat write SetMaxSat default 255;
    property MaxLuminance: Integer read FMaxLum write SetMaxLum default 255;
    property MaxValue: Integer read FMaxVal write SetMaxVal default 255;
  end;

implementation

uses
  IntfGraphics, fpimage, Math,
  mbUtils, HTMLColors;

const
  { 3D border styles }
  BDR_RAISEDOUTER = 1;
  BDR_SUNKENOUTER = 2;
  BDR_RAISEDINNER = 4;
  BDR_SUNKENINNER = 8;

  BDR_OUTER = 3;
  BDR_INNER = 12;

  { Border flags }
  BF_LEFT = 1;
  BF_TOP = 2;
  BF_RIGHT = 4;
  BF_BOTTOM = 8;
  BF_RECT = (BF_LEFT or BF_TOP or BF_RIGHT or BF_BOTTOM);


{TmbTrackBarPicker}

constructor TmbTrackBarPicker.Create(AOwner: TComponent);
begin
  inherited;
  //ControlStyle := ControlStyle - [csAcceptsControls]; // + [csOpaque];  // !!!!!!!!
  //DoubleBuffered := true;

  Width := 267;
  Height := 22;
  TabStop := true;
  ParentShowHint := true;

  FGradientWidth := 256;
  FGradientHeight := 1;

//  FBack := TBitmap.Create;

  FBufferBmp := TBitmap.Create;
  //FBufferBmp.PixelFormat := pf32bit;

  mx := 0;
  my := 0;
  FIncrement := 1;
  FArrowPos := GetArrowPos;
  FHintFormat := '';
  FLayout := lyHorizontal;
  FNewArrowStyle := false;
  Aw := 6;
  Ah := 10;
  FPlacement := spAfter;
  FPickRect := Rect(Aw, 0, Width - Aw, Height - Ah);
//  FDoChange := false;
  FSelIndicator := siArrows;
  FLimit := 7;
  FWebSafe := false;
  FBevelInner := bvNone;
  FBevelOuter := bvNone;
  FBevelWidth := 1;
  FBorderStyle := bsNone;
end;

destructor TmbTrackbarPicker.Destroy;
begin
//  FBack.Free;
  inherited;
end;

procedure TmbTrackBarPicker.CalcPickRect;
var
  f: integer;
begin
  case FSelIndicator of
    siArrows:
      if not FNewArrowStyle then
      begin
        f := 0;
        Aw := 6;
        Ah := 10;
        FLimit := 7;
      end
      else
      begin
        Aw := 8;
        Ah := 9;
        f := 2;
        FLimit := 7;
      end;

    siRect:
      begin
        f := 0;
        Aw := 4;
        Ah := 5;
        FLimit := 3;
      end

    else
      f := 0;
  end;

  case FLayout of
    lyHorizontal:
      case FSelIndicator of
        siArrows:
          case FPlacement of
            spAfter  : FPickRect := Rect(Aw, 0, Width - Aw, Height - Ah - f);
            spBefore : FPickRect := Rect(Aw, Ah + f, Width - Aw, Height);
            spBoth   : FPickRect := Rect(Aw, Ah + f, Width - Aw, Height - Ah - f);
          end;
        siRect:
         FPickRect := Rect(Aw, Ah, width - 2*Aw + 1, height - Ah);
      end;
    lyVertical:
      case FSelIndicator of
        siArrows:
          case FPlacement of
            spAfter  : FPickRect := Rect(0, Aw, Width - Ah - f, Height - Aw);
            spBefore : FPickRect := Rect(Ah + f, Aw, Width, Height - Aw);
            spBoth   : FPickRect := Rect(Ah + f, Aw, Width - Ah - f, Height - Aw);
          end;
        siRect:
         FPickRect := Rect(Ah, Aw, width - 5, height - 2*Aw + 1);
      end;
  end;
end;

procedure TmbTrackBarPicker.CMGotFocus(
  var Message: {$IFDEF FPC}TLMessage{$ELSE}TCMGotFocus{$ENDIF});
begin
  inherited;
  Invalidate;
end;

procedure TmbTrackBarPicker.CMLostFocus(
  var Message: {$IFDEF FPC}TLMessage{$ELSE}TCMLostFocus{$ENDIF});
begin
  inherited;
  Invalidate;
end;

{ AWidth and AHeight are seen for horizontal arrangement of the bar }
procedure TmbTrackbarPicker.CreateGradient;
var
  i,j: integer;
  col: TColor;
  fpcol: TFPColor;
  intfimg: TLazIntfImage;
  imgHandle, imgMaskHandle: HBitmap;
begin
  if FBufferBmp = nil then
    exit;

  intfimg := TLazIntfImage.Create(0, 0);
  try
    if Layout = lyHorizontal then
    begin
      FBufferBmp.Width := FGradientWidth;
      FBufferBmp.Height := FGradientHeight;
      intfImg.LoadFromBitmap(FBufferBmp.Handle, FBufferBmp.MaskHandle);

      for i := 0 to FBufferBmp.Width-1 do
      begin
        col := GetGradientColor(i);
        if WebSafe then col := GetWebSafe(col);
        fpcol := TColorToFPColor(col);
        for j := 0 to FBufferBmp.Height-1 do
          intfImg.Colors[i, j] := fpcol;
      end;
    end
    else
    begin
      FBufferBmp.Width := FGradientHeight;
      FBufferBmp.Height := FGradientWidth;
      intfImg.LoadFromBitmap(FBufferBmp.Handle, FBufferBmp.MaskHandle);
      for j := 0 to FBufferBmp.Height-1 do
      begin
        col := GetGradientColor(FBufferBmp.Height - 1 - j);
        if WebSafe then col := GetWebSafe(col);
        fpcol := TColorToFPColor(col);
        for i := 0 to FBufferBmp.Width-1 do
          intfImg.Colors[i, j] := fpcol;
      end;
    end;

    intfimg.CreateBitmaps(imgHandle, imgMaskHandle, false);
    FBufferBmp.Handle := imgHandle;
    FBufferBmp.MaskHandle := imgMaskHandle;
  finally
    intfImg.Free;
  end;
end;

procedure TmbTrackbarPicker.CreateWnd;
begin
  inherited;
  CreateGradient;
end;

function TmbTrackbarPicker.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
  MousePos: TPoint): Boolean;
begin
  Result := inherited DoMouseWheel(Shift, WheelDelta, MousePos);
  if not Result then
  begin
    Result := True;
    if WheelDelta > 0 then
      Execute(TBA_WheelUp)
    else
      Execute(TBA_WheelDown);
    DoChange;
  end;
end;

procedure TmbTrackBarPicker.DrawFrames;
var
  flags: cardinal;
  R: TRect;
  i: integer;
begin
  flags := 0;
  if (FBorderStyle = bsNone) or (FBevelWidth = 0) then Exit;
  case FBevelInner of
    bvNone: flags := 0;
    bvRaised: flags := BDR_RAISEDINNER;
    bvLowered: flags := BDR_SUNKENINNER;
    bvSpace: flags := BDR_INNER;
  end;
  case FBevelOuter of
    bvRaised: flags := flags or BDR_RAISEDOUTER;
    bvLowered: flags := flags or BDR_SUNKENOUTER;
    bvSpace: flags := flags or BDR_OUTER;
  end;
  R := FPickRect;
  InflateRect(R, -FBevelWidth + 1, -FBevelWidth + 1);
  for i := 0 to FBevelWidth do
  begin
    DrawEdge(Canvas.Handle, R, flags, BF_RECT);
    InflateRect(R, 1, 1);
  end;
end;

procedure TmbTrackBarPicker.DrawMarker(p: integer);
var
  x, y: integer;
  R: TRect;
begin
  case FSelIndicator of
    siRect:
      begin
        case FLayout of
          lyHorizontal:
            begin
              p := p + Aw;
              R := Rect(p - 2, 2, p + 3, Height - 2);
            end;
          lyVertical:
            begin
              p := p + Aw;
              R := Rect(2, p - 2, Width - 2, p + 3);
            end;
        end;
        Canvas.Pen.Mode := pmNot;
        Canvas.Brush.Style := bsClear;
        Canvas.Rectangle(R);
        Canvas.Brush.Style := bsSolid;
        Canvas.Pen.Mode := pmCopy;
      end;

    siArrows:
      begin
        if not FNewArrowStyle then
        begin
          if Focused or (csDesigning in ComponentState) then
          begin
            Canvas.Brush.Color := clBlack;
            Canvas.Pen.Color := clBlack;
          end
          else
          begin
            Canvas.Brush.Color := clGray;
            Canvas.Pen.Color := clGray;
          end;
        end
        else
        begin
          Canvas.Brush.Color := clWindow;
          Canvas.Pen.Color := clBtnShadow;
        end;

        if FLayout = lyHorizontal then
        begin
          x := p + Aw;
          if x < Aw then x := Aw;
          if x > Width - Aw then x := Width - Aw;
          case FPlacement of
            spAfter:
              begin
                y := Height - Aw - 1;
                if not FNewArrowStyle then
                  Canvas.Polygon([Point(x, y), Point(x - 4, y + 6), Point(x + 4, y + 6)])
                else
                  Canvas.Polygon([Point(x, y), Point(x - 4, y + 4), Point(x - 4, y + 6),
                    Point(x - 3, y + 7), Point(x + 3, y + 7), Point(x + 4, y + 6),
                    Point(x + 4, y + 4)]);
              end;
            spBefore:
              begin
                y := Aw;
                if not FNewArrowStyle then
                  Canvas.Polygon([Point(x, y), Point(x - 4, y - 6), Point(x +4, y - 6)
                  ])
                else
                  Canvas.Polygon([Point(x, y), Point(x + 4, y - 4), Point(x + 4, y - 6),
                    Point(x + 3, y - 7), Point(x - 3, y - 7), Point(x - 4, y - 6),
                    Point(x - 4, y - 4) ]);
              end;
            spBoth:
              begin
                y := Height - Aw - 1;
                if not FNewArrowStyle then
                  Canvas.Polygon([Point(x, y), Point(x - 4, y + 6), Point(x + 4, y + 6) ])
                else
                  Canvas.Polygon([Point(x, y), Point(x - 4, y + 4), Point(x - 4, y + 6),
                    Point(x - 3, y + 7), Point(x + 3, y + 7), Point(x + 4, y + 6),
                    Point(x + 4, y + 4) ]);
                 y := Aw;
                if not FNewArrowStyle then
                  Canvas.Polygon([Point(x, y), Point(x - 4, y - 6), Point(x +4, y - 6) ])
                else
                  Canvas.Polygon([Point(x, y), Point(x + 4, y - 4), Point(x + 4, y - 6),
                    Point(x + 3, y - 7), Point(x - 3, y - 7), Point(x - 4, y - 6),
                    Point(x - 4, y - 4) ]);
              end;
          end;  // case FPlacement
        end  // if FLayout
        else
        begin
          if not FNewArrowStyle then
            y := p + Aw
          else
           y := p + Aw - 1;
          if y < Aw then y := Aw;
          if y > Height - Aw - 1 then y := Height - Aw - 1;
          case FPlacement of
            spAfter:
              begin
                x := width - Aw - 1;
                if not FNewArrowStyle then
                  Canvas.Polygon([Point(x, y), Point(x + 6, y - 4), Point(x + 6, y + 4)])
                else
                  Canvas.Polygon([Point(x, y), Point(x + 4, y - 4), Point(x + 6, y - 4),
                    Point(x + 7, y - 3), Point(x + 7, y + 3), Point(x + 6, y + 4),
                    Point(x + 4, y + 4)]);
              end;
            spBefore:
              begin
                x := Aw;
                if not FNewArrowStyle then
                  Canvas.Polygon([Point(x, y), Point(x - 6, y - 4), Point(x - 6, y + 4)])
                else
                  Canvas.Polygon([Point(x, y), Point(x - 4, y - 4), Point(x - 6, y - 4),
                    Point(x - 7, y + 1 - 4), Point(x - 7, y + 3), Point(x - 6, y + 4),
                    Point(x - 4, y + 4)]);
              end;
            spBoth:
              begin
                x := width - Aw - 1;
                if not FNewArrowStyle then
                  Canvas.Polygon([Point(x, y), Point(x + 6, y - 4), Point(x + 6, y + 4)])
               else
                 Canvas.Polygon([Point(x, y), Point(x + 4, y - 4), Point(x + 6, y - 4),
                   Point(x + 7, y - 3), Point(x + 7, y + 3), Point(x + 6, y + 4),
                   Point(x + 4, y + 4)]);
               x := Aw;
               if not FNewArrowStyle then
                 Canvas.Polygon([Point(x, y), Point(x - 6, y - 4), Point(x - 6, y + 4)])
               else
                 Canvas.Polygon([Point(x, y), Point(x - 4, y - 4), Point(x - 6, y - 4),
                   Point(x - 7, y + 1 - 4), Point(x - 7, y + 3), Point(x - 6, y + 4),
                   Point(x - 4, y + 4)]);
              end;
          end;  // case FPlacement
        end;  // else (if FLayout)
      end;  // siArrow
  end;  // case FSelIndicator
end;

procedure TmbTrackBarPicker.Execute(tbaAction: integer);
begin
 case tbaAction of
   TBA_Paint   : Canvas.StretchDraw(FPickRect, FBufferBmp);
   TBA_RedoBMP : CreateGradient;
   // Rest handled in descendants
 end;
end;

function TmbTrackBarPicker.GetArrowPos: integer;
begin
  Result := 0;
  //handled in descendants
end;

function TmbTrackBarPicker.GetHintPos(X, Y: Integer): TPoint;
begin
  case FLayout of
    lyHorizontal:
      Result := Point(X - 8, Height + 2);
    lyVertical:
      Result := Point(Width + 2, Y - 8);
  end;
end;

function TmbTrackBarPicker.GetHintStr(X, Y: Integer): string;
begin
  Result := inherited GetHintStr(X, Y);
  if Result = '' then
    Result := ReplaceFlags(FHintFormat, ['%value', '%h', '%s', '%l', '%v', '%c',
      '%m', '%y', '%k', '%r', '%g', '%b'], GetSelectedValue);
end;

procedure TmbTrackBarPicker.KeyDown(var Key: Word; Shift: TShiftState);
var
  eraseKey: Boolean;
begin
  eraseKey := true;
  case Key of
    VK_UP:
      if FLayout = lyHorizontal then
        eraseKey := false
      else
      begin
        if not (ssCtrl in Shift) then
          Execute(TBA_VKUp)
        else
          Execute(TBA_VKCtrlUp);
        DoChange;
      end;
    VK_LEFT:
      if FLayout = lyVertical then
        eraseKey := false
      else
      begin
        if not (ssCtrl in Shift) then
          Execute(TBA_VKLeft)
        else
          Execute(TBA_VKCtrlLeft);
        DoChange;
      end;
    VK_RIGHT:
      if FLayout = lyVertical then
        eraseKey := false
      else
      begin
        if not (ssCtrl in Shift) then
          Execute(TBA_VKRight)
        else
          Execute(TBA_VKCtrlRight);
        DoChange;
      end;
    VK_DOWN:
      if FLayout = lyHorizontal then
        eraseKey := false
      else
      begin
        if not (ssCtrl in Shift) then
          Execute(TBA_VKDown)
        else
          Execute(TBA_VKCtrlDown);
        DoChange;
      end
    else
      eraseKey := false;
  end;  // case

  if eraseKey then
    Key := 0;

  inherited;
end;

procedure TmbTrackBarPicker.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then
  begin
    SetFocus;
    mx := X;
    my := Y;
    FArrowPos := IfThen(FLayout = lyHorizontal, XToArrowPos(X), YToArrowPos(Y));
    Execute(TBA_MouseDown);
  end;
  inherited;
end;

procedure TmbTrackBarPicker.MouseLeave;
begin
  inherited;
  FHintShown := false;
end;

procedure TmbTrackBarPicker.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  if ssLeft in shift then
  begin
    mx := X;
    my := Y;
    FArrowPos := IfThen(FLayout = lyHorizontal, XToArrowPos(X), YToArrowPos(Y));
    Execute(TBA_MouseMove);
  end;
  inherited;
end;

procedure TmbTrackBarPicker.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then
  begin
    mx := X;
    my := Y;
    FArrowPos := IfThen(FLayout = lyHorizontal, XToArrowPos(X), YToArrowPos(Y));
    Execute(TBA_MouseUp);
  end;

  inherited;
end;

procedure TmbTrackBarPicker.Paint;
begin
  CalcPickRect;
  PaintParentBack(Canvas);
  FArrowPos := GetArrowPos;
  Execute(TBA_Paint);
  if FBorderStyle <> bsNone then
    DrawFrames;
  DrawMarker(FArrowPos);
  {
  if FDoChange then
  begin
    if Assigned(OnChange) then OnChange(Self);
    FDoChange := false;
  end;
  }
end;

procedure TmbTrackBarPicker.Resize;
begin
  inherited;
  Execute(TBA_Resize);
end;

procedure TmbTrackBarPicker.SetBevelInner(Value: TBevelCut);
begin
  if FBevelInner <> Value then
  begin
    FBevelInner := Value;
    Invalidate;
  end;
end;

procedure TmbTrackBarPicker.SetBevelOuter(Value: TBevelCut);
begin
  if FBevelOuter <> Value then
  begin
    FBevelOuter := Value;
    Invalidate;
  end;
end;

procedure TmbTrackBarPicker.SetBorderStyle(Value: TBorderStyle);
begin
  if FBorderStyle <> Value then
  begin
    FBorderStyle := Value;
    Invalidate;
  end;
end;

procedure TmbTrackBarPicker.SetBevelWidth(Value: TBevelWidth);
begin
  if FBevelWidth <> Value then
  begin
    FBevelWidth := Value;
    Invalidate;
  end;
end;

{ IMPORTANT: If pickers are created at designtime the layout must be set before
  defining the picker width and height because changing the layout will flip the
  bounding rectangle !!! }
procedure TmbTrackBarPicker.SetLayout(Value: TTrackBarLayout);
begin
  if FLayout <> Value then
  begin
    FLayout := Value;
    if not (csLoading in ComponentState) then
      SetBounds(Left, Top, Height, Width);  // flip rectangle
    Execute(TBA_RedoBMP);
    Invalidate;
  end;
end;

procedure TmbTrackBarPicker.SetNewArrowStyle(s: boolean);
begin
  if FNewArrowStyle <> s then
  begin
    FNewArrowStyle := s;
    Invalidate;
  end;
end;

procedure TmbTrackBarPicker.SetPlacement(Value: TSliderPlacement);
begin
  if FPlacement <> Value then
  begin
    FPlacement := Value;
    Invalidate;
  end;
end;

procedure TmbTrackBarPicker.SetSelIndicator(Value: TSelIndicator);
begin
  if FSelIndicator <> Value then
  begin
    FSelIndicator := Value;
    Invalidate;
  end;
end;

procedure TmbTrackBarPicker.SetWebSafe(s: boolean);
begin
  if FWebSafe <> s then
  begin
    FWebSafe := s;
    Execute(TBA_RedoBMP);
    Invalidate;
  end;
end;

function TmbTrackBarPicker.XToArrowPos(p: integer): integer;
var
  pos: integer;
begin
  pos := p - Aw;
  if pos < 0 then pos := 0;
  if pos > Width - Aw - 1 then pos := Width - Aw - 1;
  Result := pos;
end;

function TmbTrackBarPicker.YToArrowPos(p: integer): integer;
var
  pos: integer;
begin
  pos := p - Aw;
  if pos < 0 then pos := 0;
  if pos > Height - Aw - 1 then pos := Height - Aw - 1;
  Result := pos;
end;


{ TmbHSLVTrackbarPicker }

constructor TmbHSLVTrackbarPicker.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FBrightnessMode := bmLuminance;
  FMaxHue := 360;
  FMaxSat := 255;
  FMaxVal := 255;
  FMaxLum := 255;
end;

procedure TmbHSLVTrackbarPicker.ColorToHSLV(c: TColor; var H, S, L, V: Double);
begin
  case FBrightnessMode of
    bmLuminance : ColorToHSL(c, H, S, L);
    bmValue     : ColorToHSV(c, H, S, V);
  end;
end;

function TmbHSLVTrackbarPicker.GetHue: Integer;
begin
  Result := round(FHue * FMaxHue);
end;

function TmbHSLVTrackbarPicker.GetLum: Integer;
begin
  Result := round(FLum * FMaxLum);
end;

function TmbHSLVTrackbarPicker.GetSat: Integer;
begin
  Result := round(FSat * FMaxSat);
end;

function TmbHSLVTrackbarPicker.GetSelectedColor: TColor;
begin
  Result := HSLVtoColor(FHue, FSat, FLum, FVal);
end;

function TmbHSLVTrackbarPicker.GetVal: Integer;
begin
  Result := round(FVal * FMaxVal);
end;

function TmbHSLVTrackbarPicker.HSLVtoColor(H, S, L, V: Double): TColor;
begin
  case FBrightnessMode of
    bmLuminance : Result := HSLToColor(H, S, L);
    bmValue     : Result := HSVtoColor(H, S, V);
  end;
  if WebSafe then
    Result := GetWebSafe(Result);
end;

procedure TmbHSLVTrackbarPicker.SetBrightnessMode(AMode: TBrightnessMode);
var
  c: TColor;
  S, L, V: Double;
begin
  c := HSLVtoColor(FHue, FSat, FLum, FVal);
  FBrightnessMode := AMode;
  (*
  ColorToHSLV(c, FHue, S, L, V);
  SetRelSat(S);
  case AMode of
    bmLuminance: SetRelLum(L);
    bmValue    : SetRelVal(V);
  end;
  *)
  ColorToHSLV(c, FHue, FSat, FLum, FVal);
  CreateGradient;
  Invalidate;
  DoChange;
end;

procedure TmbHSLVTrackbarPicker.SetHue(H: Integer);
begin
  SetRelHue(H / FMaxHue);
end;

procedure TmbHSLVTrackbarPicker.SetLum(L: Integer);
begin
  SetRelLum(L / FMaxLum);
end;

procedure TmbHSLVTrackbarPicker.SetMaxHue(h: Integer);
begin
  if h = FMaxHue then
    exit;
  FMaxHue := h;
  FGradientWidth := FMaxHue;   // we don't want to access H=360, i.e. don't use FMaxHue+1
  //CreateGradient;
  Invalidate;
end;

procedure TmbHSLVTrackbarPicker.SetMaxLum(L: Integer);
begin
  if L = FMaxLum then
    exit;
  FMaxLum := L;
  if FBrightnessMode = bmLuminance then begin
    //CreateGradient;
    Invalidate;
  end;
end;

procedure TmbHSLVTrackbarPicker.SetMaxSat(S: Integer);
begin
  if S = FMaxSat then
    exit;
  FMaxSat := S;
  //CreateGradient;
  Invalidate;
end;

procedure TmbHSLVTrackbarPicker.SetMaxVal(V: Integer);
begin
  if V = FMaxVal then
    exit;
  FMaxVal := V;
  if FBrightnessMode = bmValue then begin
    //CreateGradient;
    Invalidate;
  end;
end;

procedure TmbHSLVTrackbarPicker.SetRelHue(H: Double);
begin
  Clamp(H, 0, 1 - 1/FMaxHue);  // don't go up to 360 because this will flip back to the start
  if (FHue <> H) then
  begin
    FHue := H;
    CreateGradient;
    Invalidate;
    DoChange;
  end;
end;

procedure TmbHSLVTrackbarPicker.SetRelLum(L: Double);
begin
  Clamp(L, 0, 1.0);
  if (FLum <> L) then
  begin
    FLum := L;
    if BrightnessMode = bmLuminance then begin
      CreateGradient;
      Invalidate;
    end;
    DoChange;
  end;
end;

procedure TmbHSLVTrackbarPicker.SetRelSat(S: Double);
begin
  Clamp(S, 0, 1.0);
  if FSat <> S then
  begin
    FSat := S;
    CreateGradient;
    Invalidate;
    DoChange;
  end;
end;

procedure TmbHSLVTrackbarPicker.SetRelVal(V: Double);
begin
  Clamp(V, 0, 1.0);
  if FVal <> V then
  begin
    FVal := V;
    if BrightnessMode = bmValue then
    begin
      CreateGradient;
      Invalidate;
    end;
    DoChange;
  end;
end;

procedure TmbHSLVTrackbarPicker.SetSat(S: Integer);
begin
  SetRelSat(S / FMaxSat);
end;

procedure TmbHSLVTrackbarPicker.SetVal(V: Integer);
begin
  SetRelVal(V / FMaxVal);
end;

end.