unit mbColorPalette;

{$IFDEF FPC}
  {$MODE DELPHI}
{$ENDIF}

interface

{$I mxs.inc}

uses
  {$IFDEF FPC}
  LCLIntf, LCLType, LMessages,
  {$ELSE}
  Windows, Messages,
  {$ENDIF}
  SysUtils, Classes, Controls, Graphics, {$IFDEF DELPHI_7_UP} Themes, {$ENDIF}
  Forms, HTMLColors, PalUtils, Dialogs;

type
  TMouseLoc = (mlNone, mlOver, mlDown);
  TTransparentStyle = (tsPhotoshop, tsPhotoshop2, tsCorel, tsMicroangelo, tsNone);
  TCellStyle = (csDefault, csCorel);
  TColorCellState = (ccsNone, ccsOver, ccsDown, ccsChecked, ccsCheckedHover);
  TMoveDirection = (mdLeft, mdRight, mdUp, mdDown);
  TPaintCellEvent = procedure (ACanvas: TCanvas; ACellRect: TRect; AColor: TColor; Index: integer; AState: TColorCellState; var AStyle: TTransparentStyle; var PaintingHandled: boolean) of object;
  TCellClickEvent = procedure (Button: TMouseButton; Shift: TShiftState; Index: integer; AColor: TColor; var DontCheck: boolean) of object;
  TGetHintTextEvent = procedure (AColor: TColor; Index: integer; var HintStr: string; var Handled: boolean) of object;
  TArrowKeyEvent = procedure (Key: Word; Shift: TShiftState) of object;

  TmbColorPalette = class(TCustomControl)
  private
   FMouseLoc: TMouseLoc;
   FMouseOver, FMouseDown, FAutoHeight: boolean;
   FColCount, FRowCount, FTop, FLeft, FIndex, FCheckedIndex, FCellSize, FTotalCells: integer;
   FTempBmp, PBack: TBitmap;
   FState: TColorCellState;
   FColors, FNames: TStrings;
   FPalette: TFileName;
   FHintFormat: string;
   FOnChange, FOnColorsChange: TNotifyEvent;
   FMinColors, FMaxColors: integer;
   FSort: TSortMode;
   FOrder: TSortOrder;
   FOld: TColor;
   FOnPaintCell: TPaintCellEvent;
   FTStyle: TTransparentStyle;
   FOnCellClick: TCellClickEvent;
   FOldIndex: integer;
   FOnGetHintText: TGetHintTextEvent;
   FCellStyle: TCellStyle;
   FOnArrowKey: TArrowKeyEvent;

   function GetMoveCellIndex(move: TMoveDirection): integer;
   function GetSelColor: TColor;
   procedure SetCellStyle(s: TCellStyle);
   procedure SetTStyle(s: TTransparentStyle);
   procedure SetCellSize(s: integer);
   procedure SetSortMode(s: TSortMode);
   procedure SetSortOrder(s: TSortOrder);
   procedure SetMinColors(m: integer);
   procedure SetMaxColors(m: integer);
   procedure SetAutoHeight(auto: boolean);
   procedure LoadPalette(FileName: TFileName);
   procedure SetStrings(s: TStrings);
   procedure SetNames(n: TStrings);
   procedure SetSelColor(k: TColor);
   procedure SortColors;
   procedure CalcAutoHeight;
   function GetTotalRowCount: integer;
  protected
   procedure Paint; override;
   procedure PaintTransparentGlyph(ACanvas: TCanvas; R: TRect);
   procedure DrawCell(clr: string);
   procedure DrawCellBack(ACanvas: TCanvas; R: TRect; AIndex: integer);
   procedure ColorsChange(Sender: TObject);
   procedure Click; override;
   procedure Resize; override;
   procedure SelectCell(i: integer);
   procedure PaintParentBack;
   procedure CreateWnd; override;
   procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
   procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
   procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
   {$IFDEF DELPHI}
   procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
   procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
   procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
   procedure CNKeyDown(var Message: TWMKeyDown); message CN_KEYDOWN;
   procedure CMGotFocus(var Message: TCMGotFocus); message CM_ENTER;
   procedure CMLostFocus(var Message: TCMLostFocus); message CM_EXIT;
   procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
   procedure CMHintShow(var Message: TMessage); message CM_HINTSHOW;
   {$ELSE}
   procedure WMEraseBkgnd(var Message: TLMEraseBkgnd); message LM_ERASEBKGND;
   procedure CMMouseEnter(var Message: TLMessage); message CM_MOUSEENTER;
   procedure CMMouseLeave(var Message: TLMessage); message CM_MOUSELEAVE;
   procedure CNKeyDown(var Message: TLMKeyDown); message CN_KEYDOWN;
   procedure CMGotFocus(var Message: TLMessage); message CM_ENTER;
   procedure CMLostFocus(var Message: TLMessage); message CM_EXIT;
   procedure CMEnabledChanged(var Message: TLMessage); message CM_ENABLEDCHANGED;
   procedure CMHintShow(var Message: TLMessage); message CM_HINTSHOW;
   {$ENDIF}
  public
   constructor Create(AOwner: TComponent); override;
   destructor Destroy; override;
   function GetColorUnderCursor: TColor;
   function GetSelectedCellRect: TRect;
   function GetIndexUnderCursor: integer;

   property ColorUnderCursor: TColor read GetColorUnderCursor;
   property VisibleRowCount: integer read FRowCount;
   property RowCount: integer read GetTotalRowCount;
   property ColCount: integer read FColCount;
   property IndexUnderCursor: integer read GetIndexUnderCursor;
   procedure SaveColorsAsPalette(FileName: TFileName);
   procedure GeneratePalette(BaseColor: TColor);
   procedure GenerateGradientPalette(Colors: array of TColor);
  published
   property Align;
   property Anchors;
   property Enabled;
   property SortMode: TSortMode read FSort write SetSortMode default smNone;
   property SortOrder: TSortOrder read FOrder write SetSortOrder default soAscending;
   property MinColors: integer read FMinColors write SetMinColors default 0;
   property MaxColors: integer read FMaxColors write SetMaxColors default 0;
   property SelectedCell: integer read FCheckedIndex write SelectCell default -1;
   property SelectedColor: TColor read GetSelColor write SetSelColor default clNone;
   property Colors: TStrings read FColors write SetStrings;
   property Palette: TFileName read FPalette write LoadPalette;
   property HintFormat: string read FHintFormat write FHintFormat;
   property AutoHeight: boolean read FAutoHeight write SetAutoHeight default false;
   property CellSize: integer read FCellSize write SetCellSize default 18;
   property TransparentStyle: TTransparentStyle read FTStyle write SetTStyle default tsNone;
   property CellStyle: TCellStyle read FCellStyle write SetCellStyle default csDefault;
   property ColorNames: TStrings read FNames write SetNames;
   {$IFDEF DELPHI_7_UP} {$IFDEF DELPHI}
   property ParentBackground default true;
   {$ENDIF} {$ENDIF}
   property TabStop default true;
   property TabOrder;
   property ShowHint default false;
   property Constraints;
   property Color;
   property ParentColor;
   property ParentShowHint default true;
   property PopupMenu;
   property Visible;

   property DragCursor;
   property DragKind;
   property DragMode;
   property OnDragDrop;
   property OnDragOver;
   property OnEndDock;
   property OnEndDrag;
   property OnStartDock;
   property OnStartDrag;
   property OnSelColorChange: TNotifyEvent read FOnChange write FOnChange;
   property OnColorsChange: TNotifyEvent read FOnColorsChange write FOnColorsChange;
   property OnPaintCell: TPaintCellEvent read FOnPaintCell write FOnPaintCell;
   property OnCellClick: TCellClickEvent read FOnCellClick write FOnCellClick;
   property OnGetHintText: TGetHintTextEvent read FOnGetHintText write FOnGetHintText;
   property OnArrowKey: TArrowKeyEvent read FOnArrowKey write FOnArrowKey;
   property OnContextPopup;
   property OnMouseMove;
   property OnMouseDown;
   property OnMouseUp;
   property OnKeyDown;
   property OnKeyUp;
   property OnKeyPress;
   property OnResize;
   property OnClick;
  end;

procedure Register;

implementation

{$IFDEF FPC}
  {$R mbColorPalette.dcr}
{$ENDIF}

procedure Register;
begin
  RegisterComponents('mbColor Lib', [TmbColorPalette]);
end;

constructor TmbColorPalette.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);
 ControlStyle := ControlStyle - [csAcceptsControls] + [csOpaque];
 DoubleBuffered := true;
 PBack := TBitmap.Create;
 PBack.PixelFormat := pf32bit;
 {$IFDEF DELPHI_7_UP} {$IFDEF DELPHI}
 ParentBackground := true;
 {$ENDIF} {$ENDIF}
 TabStop := true;
 ParentShowHint := true;
 ShowHint := false;
 Width := 180;
 Height := 126;
 FMouseLoc := mlNone;
 FMouseOver := false;
 FMouseDown := false;
 FColCount := 0;
 FRowCount := 0;
 FIndex := -1;
 FCheckedIndex := -1;
 FTop := 0;
 FLeft := 0;
 FCellSize := 18;
 FState := ccsNone;
 FNames := TStringList.Create;
 FColors := TStringList.Create;
 (FColors as TStringList).OnChange := ColorsChange;
 FTotalCells := 0;
 FHintFormat := 'RGB(%r, %g, %b)'#13'Hex: %hex';
 FAutoHeight := false;
 FMinColors := 0;
 FMaxColors := 0;
 FSort := smNone;
 FOrder := soAscending;
 FOld := clNone;
 FTStyle := tsNone;
 FCellStyle := csDefault;
end;

destructor TmbColorPalette.Destroy;
begin
 PBack.Free;
 FNames.Free;
 FColors.Free;
 inherited Destroy;
end;

procedure TmbColorPalette.CalcAutoHeight;
begin
 if Parent = nil then
  exit;
 FColCount := Width div FCellSize;
 if FAutoHeight and (FColCount <> 0) then
  begin
   if FColors.Count mod FColCount > 0 then
    Height := (FColors.Count div FColCount + 1) * FCellSize
   else
    Height := (FColors.Count div FColCount) * FCellSize;
  end;
 if Height = 0 then Height := FCellSize;
 FRowCount := Height div FCellSize;
 Width := FColCount * FCellSize;
end;

function TmbColorPalette.GetTotalRowCount: integer;
begin
if FColCount <> 0 then
 Result := FTotalCells div FColCount
else
 Result := 0;
end;

procedure TmbColorPalette.CreateWnd;
begin
 inherited;
 CalcAutoHeight;
 Invalidate;
end;

procedure TmbColorPalette.PaintParentBack;
{$IFDEF DELPHI_7_UP}
var
 MemDC: HDC;
 OldBMP: HBITMAP;
{$ENDIF}
begin
 if PBack = nil then
  begin
   PBack := TBitmap.Create;
   PBack.PixelFormat := pf32bit;
  end;
 PBack.Width := Width;
 PBack.Height := Height;
 {$IFDEF FPC}
 if Color = clDefault then
  PBack.Canvas.Brush.Color := clForm
 else
 {$ENDIF}
 PBack.Canvas.Brush.Color := Color;
 PBack.Canvas.FillRect(PBack.Canvas.ClipRect);
 {$IFDEF DELPHI_7_UP} {$IFDEF DELPHI}
 if ParentBackground then
  with ThemeServices do
   if ThemesEnabled then
    begin
     MemDC := CreateCompatibleDC(0);
     OldBMP := SelectObject(MemDC, PBack.Handle);
     DrawParentBackground(Handle, MemDC, nil, False);
     if OldBMP <> 0 then SelectObject(MemDC, OldBMP);
     if MemDC <> 0 then DeleteDC(MemDC);
    end;
 {$ENDIF} {$ENDIF}
end;

procedure TmbColorPalette.Paint;
var
 i: integer;
begin
 PaintParentBack;
 //make bmp
 FTempBmp := TBitmap.Create;
 try
  FTempBmp.PixelFormat := pf32bit;
  FTempBmp.Width := Width;
  FTempBmp.Height := Height;

  {$IFDEF FPC}
  if Color = clDefault then
   FTempBmp.Canvas.Brush.Color := clForm
  else
  {$ENDIF}
  FTempBmp.Canvas.Brush.Color := Color;

  {$IFDEF DELPHI_7_UP} {$IFDEF DELPHI}
  if not ParentBackground then
  {$ENDIF} {$ENDIF}
   FTempBmp.Canvas.FillRect(FTempBmp.Canvas.ClipRect)
  {$IFDEF DELPHI_7_UP}{$IFDEF DELPHI}
  else
   FTempBmp.Canvas.Draw(0, 0, PBack){$ENDIF} {$ENDIF};

  FTotalCells := FColors.Count - 1;
  //reset counters
  FTop := 0;
  FLeft := 0;
  //draw the cells
  for i := 0 to FColors.Count - 1 do
   begin
    if FColors.Strings[i] <> '' then
    DrawCell(FColors.Strings[i]);
    Inc(FLeft);
   end;
  //draw the result
  Canvas.Draw(0, 0, FTempBmp);
  //csDesiginng border
  if csDesigning in ComponentState then
   begin
    Canvas.Brush.Style := bsClear;
    Canvas.Pen.Style := psDot;
    Canvas.Pen.Color := clBtnShadow;
    Canvas.Rectangle(ClientRect);
    Canvas.Brush.Style := bsSolid;
    Canvas.Pen.Style := psSolid;
   end;
 finally
  FTempBmp.Free;
 end;
end;

procedure TmbColorPalette.DrawCell(clr: string);
var
 R: Trect;
 FCurrentIndex: integer;
 c: TColor;
 Handled: boolean;
begin
 // set props
 if (FLeft + 1) * FCellSize > FTempBmp.width then
  begin
   Inc(FTop);
   FLeft := 0;
  end;
 FCurrentIndex := FTop * FColCount + FLeft;
 R := Rect(FLeft * FCellSize, FTop * FCellSize, (FLeft + 1) * FCellSize, (FTop + 1) * FCellSize);
 //start drawing
 with FTempBmp.Canvas do
  begin
   {$IFDEF FPC}
   if Color = clDefault then
    Brush.Color := clForm else
   {$ENDIF}
   Brush.Color := Color;
   //get current state
   if FCurrentIndex = FCheckedIndex then
    begin
     if FCheckedIndex = FIndex then
      begin
       if FMouseDown then
        FState := ccsDown
       else
        FState := ccsCheckedHover;
      end
     else
      FState := ccsChecked;
    end
   else
    if FIndex = FCurrentIndex then
     case FMouseLoc of
      mlNone: FState := ccsNone;
      mlOver: FState := ccsOver;
     end
    else
     FState := ccsNone;

   //paint
   DrawCellBack(FTempBmp.Canvas, R, FCurrentIndex);

   // fire the event
   Handled := false;
   if Assigned(FOnPaintCell) then
    case FCellStyle of
     csDefault: FOnPaintCell(FTempBmp.Canvas, R, mbStringToColor(clr), FCurrentIndex, FState, FTStyle, Handled);
     csCorel:
      if FColCount = 1 then
       FOnPaintCell(FTempBmp.Canvas, R, mbStringToColor(clr), FCurrentIndex, FState, FTStyle, Handled)
      else
       FOnPaintCell(FTempBmp.Canvas, Rect(R.Left, R.Top, R.Right + 1, R.Bottom), mbStringToColor(clr), FCurrentIndex, FState, FTStyle, Handled);
    end;
   if not Handled then
    begin
     // if standard colors draw the rect
     if not SameText(clr, 'clCustom') and not SameText(clr, 'clTransparent') then
      case FCellStyle of
       csDefault:
        begin
         InflateRect(R, -3, -3);
         c := mbStringToColor(clr);
         if Enabled then
          begin
           Brush.Color := c;
           Pen.Color := clBtnShadow;
          end
         else
          begin
           Brush.Color := clGray;
           Pen.Color := clGray;
          end;
         Rectangle(R);
         Exit;
        end;
       csCorel:
        begin
         if (FState <> ccsNone) then
          InflateRect(R, -2, -2)
         else
          begin
           Inc(R.Left);
           Dec(R.Bottom);
           if R.Top <= 1 then
            Inc(R.Top);
           if R.Right = Width then
            Dec(R.Right);
          end;
         c := mbStringToColor(clr);
         if Enabled then
          Brush.Color := c
         else
          Brush.Color := clGray;
         FillRect(R);
         Exit;
        end;
      end;

     //if transparent draw the glyph
     if SameText(clr, 'clTransparent') then PaintTransparentGlyph(FTempBmp.Canvas, R);
    end;
  end;
end;

procedure TmbColorPalette.DrawCellBack(ACanvas: TCanvas; R: TRect; AIndex: integer);
begin
 case FCellStyle of
  csDefault:
   begin
    {$IFDEF DELPHI_7_UP}
    if ThemeServices.ThemesEnabled then
     begin
       with ThemeServices do
        if Enabled then
         case FState of
          ccsNone: ACanvas.CopyRect(R, PBack.Canvas, R);
          ccsOver: DrawElement(ACanvas.Handle, GetElementDetails(ttbButtonHot), R);
          ccsDown: DrawElement(ACanvas.Handle, GetElementDetails(ttbButtonPressed), R);
          ccsChecked: DrawElement(ACanvas.Handle, GetElementDetails(ttbButtonChecked), R);
          ccsCheckedHover: DrawElement(ACanvas.Handle, GetElementDetails(ttbButtonCheckedHot), R);
         end
        else
         DrawElement(ACanvas.Handle, GetElementDetails(ttbButtonDisabled), R);
     end
    else
    {$ENDIF}
     if Enabled then
      case FState of
       ccsNone: ACanvas.FillRect(R);
       ccsOver: DrawEdge(ACanvas.Handle, R, BDR_RAISEDINNER, BF_RECT);
       ccsDown, ccsChecked, ccsCheckedHover: DrawEdge(ACanvas.Handle, R, BDR_SUNKENOUTER, BF_RECT);
      end
     else
       DrawFrameControl(ACanvas.Handle, R, DFC_BUTTON, 0 or DFCS_BUTTONPUSH or DFCS_FLAT or DFCS_INACTIVE);
   end;
  csCorel:
   begin
    if Enabled then
     begin
      {$IFDEF DELPHI_7_UP}
      if ThemeServices.ThemesEnabled then
       case FState of
        ccsNone:
         begin
          ACanvas.Brush.Color := clWhite;
          ACanvas.Pen.Color := clBlack;
          //left
          ACanvas.MoveTo(R.Left, R.Top);
          ACanvas.LineTo(R.Left, R.Bottom-1);
          //bottom
          ACanvas.MoveTo(R.Left, R.Bottom-1);
          ACanvas.LineTo(R.Right, R.Bottom-1);
          //top
          if R.Top = 0 then
           begin
            ACanvas.MoveTo(R.Left, R.Top);
            ACanvas.LineTo(R.Right, R.Top);
           end;
          //right
          if (R.Right = Width) then
           begin
            ACanvas.MoveTo(R.Right-1, R.Top);
            ACanvas.LineTo(R.Right-1, R.Bottom-1);
           end
          else
           if (AIndex = FTotalCells) then
            begin
             ACanvas.MoveTo(R.Right, R.Top);
             ACanvas.LineTo(R.Right, R.Bottom);
            end;
         end;
        ccsOver: ThemeServices.DrawElement(ACanvas.Handle, ThemeServices.GetElementDetails(ttbButtonHot), R);
        ccsDown: ThemeServices.DrawElement(ACanvas.Handle, ThemeServices.GetElementDetails(ttbButtonPressed), R);
        ccsChecked: ThemeServices.DrawElement(ACanvas.Handle, ThemeServices.GetElementDetails(ttbButtonChecked), R);
        ccsCheckedHover: ThemeServices.DrawElement(ACanvas.Handle, ThemeServices.GetElementDetails(ttbButtonCheckedHot), R);
       end
      else
      {$ENDIF}
       case FState of
        ccsNone:
         begin
          ACanvas.Brush.Color := clWhite;
          ACanvas.Pen.Color := clBlack;
          ACanvas.Brush.Color := clWhite;
          ACanvas.Pen.Color := clBlack;
          //left
          ACanvas.MoveTo(R.Left, R.Top);
          ACanvas.LineTo(R.Left, R.Bottom-1);
          //bottom
          ACanvas.MoveTo(R.Left, R.Bottom-1);
          ACanvas.LineTo(R.Right, R.Bottom-1);
          //top
          if R.Top = 0 then
           begin
            ACanvas.MoveTo(R.Left, R.Top);
            ACanvas.LineTo(R.Right, R.Top);
           end;
          //right
          if (R.Right = Width) then
           begin
            ACanvas.MoveTo(R.Right-1, R.Top);
            ACanvas.LineTo(R.Right-1, R.Bottom-1);
           end
          else
           if (AIndex = FTotalCells) then
            begin
             ACanvas.MoveTo(R.Right, R.Top);
             ACanvas.LineTo(R.Right, R.Bottom);
            end;
         end;
        ccsOver:
         begin
          OffsetRect(R, 1,1);
          DrawEdge(ACanvas.Handle, R, BDR_RAISED, BF_RECT);
         end;
        ccsDown, ccsChecked, ccsCheckedHover: DrawEdge(ACanvas.Handle, R, BDR_SUNKENOUTER, BF_RECT);
       end;
     end
    else
     {$IFDEF DELPHI_7_UP}
     if ThemeServices.ThemesEnabled then
      ThemeServices.DrawElement(ACanvas.Handle, ThemeServices.GetElementDetails(ttbButtonDisabled), R)
     else
     {$ENDIF}
      begin
       ACanvas.Brush.Color := Color;
       ACanvas.FillRect(R);
      end;
   end;
 end;
end;

procedure TmbColorPalette.PaintTransparentGlyph(ACanvas: TCanvas; R: TRect);
begin
 InflateRect(R, -3, -3);
 if FCellStyle = csCorel then
  begin
   if FState <> ccsNone then
    InflateRect(R, -2, -2)
   else
    if FColCount > 1 then
     Inc(R.Right);
  end;
 with ACanvas do
  case FTStyle of
   tsPhotoshop:
    begin
     if Enabled then
      Pen.Color := clBtnShadow
     else
      Pen.Color := clGray;
     Brush.Color := clWhite;
     Rectangle(R);
     Brush.Color := clSilver;
     FillRect(Rect(R.Left + (R.Right - R.Left) div 2, R.Top + 1, R.Right - 1, R.Top + (R.Bottom - R.Top) div 2));
     FillRect(Rect(R.Left + 1, R.Top + (R.Bottom - R.Top) div 2, R.Left + (R.Right - R.Left) div 2, R.Bottom - 1));
    end;
   tsPhotoshop2:
    begin
     InflateRect(R, -1, -1);
     Brush.Color := clWhite;
     Rectangle(R);
     Pen.Color := clRed;
     Pen.Width := 2;
     InflateRect(R, 1, 1);
     MoveTo(R.Left, R.Top);
     LineTo(R.Right - 1, R.Bottom - 1);
     Pen.Width := 1;
     Pen.Color := clBlack;
    end;
   tsCorel:
    begin
     if FCellStyle = csCorel then
      begin
       Pen.Color := clBlack;
       InflateRect(R, 3, 3);
       Brush.Color := clWhite;
       Rectangle(R);
       //the \ line
       MoveTo(R.Left, R.Top);
       LineTo(R.Right, R.Bottom);
       //the / line
       MoveTo(R.Right-1, R.Top);
       LineTo(R.Left-1, R.Bottom);
      end
     else
      begin
       if Enabled then
        Pen.Color := clBtnShadow
       else
        Pen.Color := clGray;
       Brush.Color := clWhite;
       Rectangle(R);
       MoveTo(R.Left, R.Top);
       LineTo(R.Right, R.Bottom);
       MoveTo(R.Right - 1, R.Top);
       LineTo(R.Left - 1, R.Bottom);
      end;
    end;
   tsMicroangelo:
    begin
     InflateRect(R, -1, -1);
     Dec(R.Bottom);
     Pen.Color := clBlack;
     Brush.Color := clTeal;
     Rectangle(R);
     Pixels[R.Left + 2, R.Top + 2] := clWhite;
     Pixels[R.Left + (R.Right - R.Left) div 2, R.Bottom] := clBlack;
     MoveTo(R.Left + (R.Right - R.Left) div 2 - 2, R.Bottom + 1);
     LineTo(R.Left + (R.Right - R.Left) div 2 + 3, R.Bottom + 1);
    end;
  end;
end;

procedure TmbColorPalette.Resize;
begin
 inherited;
 CalcAutoHeight;
 Invalidate;
end;

procedure TmbColorPalette.CMMouseEnter(
  var Message: {$IFDEF DELPHI}TMessage{$ELSE}TLMessage{$ENDIF} );
begin
 FMouseOver := true;
 FMouseLoc := mlOver;
 Invalidate;
 inherited;
end;

procedure TmbColorPalette.CMMouseLeave(
  var Message: {$IFDEF DELPHI}TMessage{$ELSE}TLMessage{$ENDIF} );
begin
 FMouseOver := false;
 FMouseLoc := mlNone;
 FIndex := -1;
 Invalidate;
 inherited;
end;

procedure TmbColorPalette.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
 if FIndex <> (y div FCellSize)* FColCount + (x div FCellSize) then
  begin
   FIndex := (y div FCellSize)* FColCount + (x div FCellSize);
   if FIndex > FTotalCells then FIndex := -1;
   Invalidate;
  end;
 inherited;
end;

procedure TmbColorPalette.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then
 begin
  SetFocus;
  FMouseDown := true;
  FMouseLoc := mlDown;
  if (y div FCellSize)* FColCount + (x div FCellSize) <= FTotalCells then
   if FCheckedIndex <> (y div FCellSize)* FColCount + (x div FCellSize) then
    begin
     FOldIndex := FCheckedIndex;
     FCheckedIndex := (y div FCellSize)* FColCount + (x div FCellSize);
    end;
  Invalidate;
 end;
 inherited;
end;

procedure TmbColorPalette.Click;
begin
 inherited;
end;

procedure TmbColorPalette.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
 DontCheck: boolean;
 AColor: TColor;
begin
 FMouseDown := false;
 if FMouseOver then
  FMouseLoc := mlOver
 else
  FMouseLoc := mlNone;
 DontCheck := false;
 if (FCheckedIndex > -1) and (FCheckedIndex < FColors.Count) then
  AColor := mbStringToColor(FColors.Strings[FCheckedIndex])
 else
  AColor := clNone;
 if (Button = mbLeft) and PtInRect(ClientRect, Point(x, y)) then
  if Assigned(FOnCellClick) then
   FOnCellClick(Button, Shift, FCheckedIndex, AColor, DontCheck);
 if DontCheck then FCheckedIndex := FOldIndex;
 Invalidate;
 inherited;
 if Assigned(FOnChange) then FOnChange(Self);
end;

procedure TmbColorPalette.CMGotFocus(
  var Message: {$IFDEF DELPHI}TMessage{$ELSE}TLMessage{$ENDIF} );
begin
 inherited;
 Invalidate;
end;

procedure TmbColorPalette.CMLostFocus(
  var Message: {$IFDEF DELPHI}TMessage{$ELSE}TLMessage{$ENDIF} );
begin
 inherited;
 if FMouseOver then
  FMouseLoc := mlOver
 else
  FMouseLoc := mlNone;
 Invalidate;
end;

procedure TmbColorPalette.CMEnabledChanged(
  var Message: {$IFDEF DELPHI}TMessage{$ELSE}TLMessage{$ENDIF} );
begin
 inherited;
 Invalidate;
end;

procedure TmbColorPalette.WMEraseBkgnd(
  var Message: {$IFDEF DELPHI}TWMEraseBkgnd{$ELSE}TLMEraseBkgnd{$ENDIF});
begin
 Message.Result := 1;
end;

procedure TmbColorPalette.SelectCell(i: integer);
begin
 if i < FColors.Count - 1 then
  FCheckedIndex := i
 else
  FCheckedIndex := -1;
 Invalidate;
 if Assigned(FOnChange) then FOnChange(Self);
end;

function TmbColorPalette.GetSelColor: TColor;
begin
if (FCheckedIndex > -1) and (FCheckedIndex <= FTotalCells) then
 Result := mbStringToColor(FColors.Strings[FCheckedIndex])
else
 Result := FOld;
end;

function TmbColorPalette.GetColorUnderCursor: TColor;
begin
 Result := clNone;
 if FIndex > -1 then
  if FIndex < FColors.Count then
   Result := mbStringToColor(FColors.Strings[FIndex]);
end;

function TmbColorPalette.GetIndexUnderCursor: integer;
begin
 Result := -1;
 if FIndex > -1 then
  if FIndex < FColors.Count then
   Result := FIndex;
end;

procedure TmbColorPalette.SetTStyle(s: TTransparentStyle);
begin
 if FTStyle <> s then
  begin
   FTStyle := s;
   Invalidate;
  end;
end;

procedure TmbColorPalette.SetCellStyle(s: TCellStyle);
begin
 if FCellStyle <> s then
  begin
   FCellStyle := s;
   Invalidate;
  end;
end;

procedure TmbColorPalette.SetSelColor(k: TColor);
var
 s: string;
 i: integer;
begin
 s := mbColorToString(k);
 for i:= 0 to FColors.Count - 1 do
  if SameText(s, FColors.Strings[i]) then
   begin
    FCheckedIndex := i;
    Break;
   end
  else
   FCheckedIndex := -1;
 Invalidate;
 FOld := k;
 if Assigned(FOnChange) then FOnChange(Self);
end;

procedure TmbColorPalette.SetStrings(s: TStrings);
var
 i: integer;
begin
 FColors.Clear;
 FColors.AddStrings(s);
 if FColors.Count < FMinColors then
  for i := 0 to FMinColors - FColors.Count - 1 do
   FColors.Add('clNone');
 if (FColors.Count > FMaxColors) and (FMaxColors > 0) then
  for i := FColors.Count - 1 downto FMaxColors do
   FColors.Delete(i);
 CalcAutoHeight;
 SortColors;
 Invalidate;
end;

procedure TmbColorPalette.SetNames(n: TStrings);
var
 i: integer;
begin
 FNames.Clear;
 FNames.AddStrings(n);
 if (FNames.Count > FMaxColors) and (FMaxColors > 0) then
  for i := FNames.Count - 1 downto FMaxColors do
   FNames.Delete(i);
end;

function TmbColorPalette.GetMoveCellIndex(move: TMoveDirection): integer;
var
 FBefore: integer;
begin
 Result := -1;
 case move of
  mdLeft:
   if FCheckedIndex -1 < 0 then
    Result := FTotalCells
   else
    Result := FCheckedIndex - 1;
  mdRight:
   if FCheckedIndex + 1 > FTotalCells then
    Result := 0
   else
    Result := FCheckedIndex + 1;
  mdUp:
   if FCheckedIndex - FColCount < 0 then
    begin
     FBefore := (FTotalcells div FColCount) * FColCount;
     if FBefore + FCheckedIndex - 1 > FTotalCells then Dec(FBefore, FColCount);
     Result := FBefore + FCheckedIndex - 1;
    end
   else
    Result := FCheckedIndex - FColCount;
  mdDown:
   if FCheckedIndex + FColCount > FTotalCells then
    Result := FCheckedIndex mod FColCount + 1
   else
    Result := FCheckedIndex + FColCount;
 end;
 if Result > FColors.Count - 1 then
  Result := 0;
end;

procedure TmbColorPalette.CNKeyDown(
  var Message: {$IFDEF DELPHI}TWMKeyDown{$ELSE}TLMKeyDown{$ENDIF} );
var
 FInherited: boolean;
 Shift: TShiftState;
begin
 Shift := KeyDataToShiftState(Message.KeyData);
 Finherited := false;
 case Message.CharCode of
  VK_LEFT:
   begin
    FCheckedIndex := GetMoveCellIndex(mdLeft);
    if Assigned(FOnArrowKey) then FOnArrowKey(Message.CharCode, Shift);
   end;
  VK_RIGHT:
   begin
    FCheckedIndex := GetMoveCellIndex(mdRight);
    if Assigned(FOnArrowKey) then FOnArrowKey(Message.CharCode, Shift);
   end;
  VK_UP:
   begin
    FCheckedIndex := GetMoveCellIndex(mdUp);
    if Assigned(FOnArrowKey) then FOnArrowKey(Message.CharCode, Shift);
   end;
  VK_DOWN:
   begin
    FCheckedIndex := GetMoveCellIndex(mdDown);
    if Assigned(FOnArrowKey) then FOnArrowKey(Message.CharCode, Shift);
   end;
  VK_SPACE, VK_RETURN: if Assigned(FOnChange) then FOnChange(Self);
 else
  begin
   FInherited := true;
   inherited;
  end;
 end;
 if not FInherited then
  begin
   Invalidate;
   if Assigned(OnKeyDown) then OnKeyDown(Self, Message.CharCode, Shift);
   if Assigned(FOnChange) then FOnChange(Self);
  end;
end;

procedure TmbColorPalette.CMHintShow(
  var Message: {$IFDEF DELPHI}TMessage{$ELSE}TLMessage{$ENDIF} );
var
 clr: TColor;
 Handled: boolean;
begin
if (Colors.Count > 0) and (FIndex > -1) then
 with TCMHintShow(Message) do
  begin
   if not ShowHint then
    Message.Result := 1
   else
    begin
     with HintInfo^ do
      begin
       // show that we want a hint
       Result := 0;
       ReshowTimeout := 1;
       HideTimeout := 5000;
       clr := GetColorUnderCursor;
       //fire event
       Handled := false;
       if Assigned(FOnGetHintText) then FOnGetHintText(clr, GetIndexUnderCursor, HintStr, Handled);
       if Handled then Exit;
       //do default
       if FIndex < FNames.Count then
        HintStr := FNames.Strings[FIndex]
       else
        if SameText(FColors.Strings[GetIndexUnderCursor], 'clCustom') or SameText(FColors.Strings[GetIndexUnderCursor], 'clTransparent') then
         HintStr := StringReplace(FColors.Strings[GetIndexUnderCursor], 'cl', '', [rfReplaceAll])
        else
         HintStr := FormatHint(FHintFormat, GetColorUnderCursor);
      end;
    end;
  end;
end;

procedure TmbColorPalette.SetAutoHeight(auto: boolean);
begin
 FAutoHeight := auto;
 CalcAutoHeight;
 Invalidate;
end;

procedure TmbColorPalette.SetMinColors(m: integer);
var
 i: integer;
begin
 if (FMaxColors > 0) and (m > FMaxColors) then
  m := FMaxColors;
 FMinColors := m;
 if FColors.Count < m then
  for i := 0 to m - FColors.Count - 1 do
   FColors.Add('clNone');
 CalcAutoHeight;
 SortColors;
 Invalidate;
end;

procedure TmbColorPalette.SetMaxColors(m: integer);
var
 i: integer;
begin
 if m < 0 then m := 0;
 FMaxColors := m;
 if (m < FMinColors) and (m > 0) then
  SetMinColors(m);
 if (FColors.Count > FMaxColors) and (FMaxColors > 0) then
  for i := FColors.Count - 1 downto FMaxColors do
   FColors.Delete(i);
 CalcAutoHeight;
 SortColors;
 Invalidate;
end;

procedure TmbColorPalette.SetSortMode(s: TSortMode);
begin
 if FSort <> s then
  begin
   FSort := s;
   SortColors;
   Invalidate;
  end;
end;

procedure TmbColorPalette.SetSortOrder(s: TSortOrder);
begin
 if FOrder <> s then
  begin
   FOrder := s;
   SortColors;
   Invalidate;
  end;
end;

procedure TmbColorPalette.ColorsChange(Sender: TObject);
begin
 if Assigned(FOnColorsChange) then FOnColorsChange(Self);
 FTotalCells := FColors.Count - 1;
 CalcAutoHeight;
 Invalidate;
end;

procedure TmbColorPalette.SetCellSize(s: integer);
begin
 FCellSize := s;
 CalcAutoHeight;
 Invalidate;
end;

function TmbColorPalette.GetSelectedCellRect: TRect;
var
 row, fbottom, fleft: integer;
begin
 if FCheckedIndex > -1 then
  begin
   if FCheckedIndex mod FColCount = 0 then
    begin
     row := FCheckedIndex div FColCount;
     fleft := Width - FCellSize;
    end
   else
    begin
     row := FCheckedIndex div FColCount + 1;
     fleft := (FCheckedIndex mod FColCount - 1) * FCellSize;
    end;
   fbottom := row * FCellSize;
   Result := Rect(fleft, fbottom - FCellSize, fleft + FCellSize, fbottom);
  end
 else
  Result := Rect(0, 0, 0, 0);
end;

procedure TmbColorPalette.GeneratePalette(BaseColor: TColor);
begin
 FColors.Text := MakePalette(BaseColor, FOrder);
 CalcAutoHeight;
 SortColors;
 Invalidate;
 if Assigned(FOnChange) then FOnChange(Self);
end;

procedure TmbColorPalette.GenerateGradientPalette(Colors: array of TColor);
begin
 FColors.Text := MakeGradientPalette(Colors);
 CalcAutoHeight;
 SortColors;
 Invalidate;
 if Assigned(FOnChange) then FOnChange(Self);
end;

procedure TmbColorPalette.LoadPalette(FileName: TFileName);
var
 supported: boolean;
 a: AcoColors;
 i: integer;
begin
 supported := false;
 if SameText(ExtractFileExt(FileName), '.pal') then
  begin
   supported := true;
   FNames.Clear;
   FColors.Text := ReadJASCPal(FileName);
  end
 else
  if SameText(ExtractFileExt(FileName), '.aco') then
   begin
    supported := true;
    a := ReadPhotoshopAco(FileName);
    FColors.Clear;
    for i := 0 to Length(a.Colors) - 1 do
     FColors.Add(ColorToString(a.Colors[i]));
    FNames.Clear;
    if a.HasNames then
     for i := 0 to Length(a.Names) - 1 do
      FNames.Add(a.Names[i]);
   end
  else
   if SameText(ExtractFileExt(FileName), '.act') then
    begin
     supported := true;
     FNames.Clear;
     FColors.Text := ReadPhotoshopAct(FileName);
    end
   else
    Exception.Create('The file format you are trying to load is not supported in this version of the palette'#13'Please send a request to MXS along with the files of this format so'#13'loading support for this file can be added too');
 if supported then
  begin
   CalcAutoHeight;
   SortColors;
   Invalidate;
   if Assigned(FOnChange) then FOnChange(Self);
  end;
end;

procedure TmbColorPalette.SaveColorsAsPalette(FileName: TFileName);
begin
 if SameText(ExtractFileExt(FileName), '.pal') then
  SaveJASCPal(FColors, FileName)
 else
  raise Exception.Create('The file extension specified does not identify a supported file format!'#13'Supported files formats are: .pal .aco .act');
end;

procedure TmbColorPalette.SortColors;
var
 old: TColor;
begin
 if FSort <> smNone then
  begin
   if FColors.Count = 0 then Exit;
   old := GetSelColor;
   SortPalColors(FColors, FSort, FOrder);
   SetSelColor(old);
   Invalidate;
  end;
end;

end.