{***************************************************************************}
{ TMS IntraWeb Component Pack Pro                                           }
{ for Delphi & C++Builder                                                   }
{                                                                           }
{ written by TMS Software                                                   }
{            copyright © 2002 - 2007                                        }
{            Email : info@tmssoftware.com                                   }
{            Web : http://www.tmssoftware.com                               }
{                                                                           }
{ The source code is given as is. The author is not responsible             }
{ for any possible damage done due to the use of this code.                 }
{ The component can be freely used in any application. The complete         }
{ source code remains property of the author and may not be distributed,    }
{ published, given or sold in any form as such. No parts of the source      }
{ code can be included in any other component or application without        }
{ written authorization of the author.                                      }
{***************************************************************************}

unit IWTMSColorPicker;

{$I TMSDEFS.INC}

interface                                

uses
  {$IFDEF LINUX}
  QControls, QGraphics,
  {$ELSE}
  Controls, Windows, Graphics,
  {$ENDIF}
  {$IFDEF DELPHI6_LVL}
  Types,
  {$ENDIF}
  Classes,
  IWControl, IWTypes, SysUtils, IWTMSBase,
  IWHTMLTag, IWFont
  {$IFDEF TMSIW6}
  , IWRenderContext, IWColor
  {$ENDIF}
  {$IFDEF TMSIW9}
  , IWXMLTag
  {$ENDIF}
  ;

type
  TColorChangeEvent = procedure(Sender:Tobject;index:byte;ColorChanged:TColor) of object;

  TIWColors = class(Tpersistent)
  private
    FOnColorChange: TcolorChangeEvent;
    procedure Setcolor1(const Value: Tcolor);
    procedure Setcolor10(const Value: Tcolor);
    procedure Setcolor11(const Value: Tcolor);
    procedure Setcolor12(const Value: Tcolor);
    procedure Setcolor13(const Value: Tcolor);
    procedure Setcolor14(const Value: Tcolor);
    procedure Setcolor15(const Value: Tcolor);
    procedure Setcolor16(const Value: Tcolor);
    procedure Setcolor2(const Value: Tcolor);
    procedure Setcolor3(const Value: Tcolor);
    procedure Setcolor4(const Value: Tcolor);
    procedure Setcolor5(const Value: Tcolor);
    procedure Setcolor6(const Value: Tcolor);
    procedure Setcolor7(const Value: Tcolor);
    procedure Setcolor8(const Value: Tcolor);
    procedure Setcolor9(const Value: Tcolor);
  protected
    FColor1:Tcolor;
    FColor2:Tcolor;
    FColor3:Tcolor;
    FColor4:Tcolor;
    FColor5:Tcolor;
    FColor6:Tcolor;
    FColor7:Tcolor;
    FColor8:Tcolor;
    FColor9:Tcolor;
    FColor10:Tcolor;
    FColor11:Tcolor;
    FColor12:Tcolor;
    FColor13:Tcolor;
    FColor14:Tcolor;
    FColor15:Tcolor;
    FColor16:Tcolor;
    procedure Dochange(index:byte;ColorChanged:Tcolor);
  public
    constructor Create;
  published
    property Color1 : Tcolor read FColor1   write Setcolor1   default clBlack;
    property Color2 : Tcolor read FColor2   write Setcolor2   default clMaroon;
    property Color3 : Tcolor read FColor3   write Setcolor3   default clGreen;
    property Color4 : Tcolor read FColor4   write Setcolor4   default clOlive;
    property Color5 : Tcolor read FColor5   write Setcolor5   default clNavy;
    property Color6 : Tcolor read FColor6   write Setcolor6   default clPurple;
    property Color7 : Tcolor read FColor7   write Setcolor7   default clTeal;
    property Color8 : Tcolor read FColor8   write Setcolor8   default clSilver;
    property Color9 : Tcolor read FColor9   write Setcolor9   default clGray;
    property Color10:Tcolor  read  FColor10 write Setcolor10 default clRed;
    property Color11:Tcolor  read  FColor11 write Setcolor11 default clLime;
    property Color12:Tcolor  read  FColor12 write Setcolor12 default clYellow;
    property Color13:Tcolor  read  FColor13 write Setcolor13 default clBlue;
    property Color14:Tcolor  read  FColor14 write Setcolor14 default clFuchsia;
    property Color15:Tcolor  read  FColor15 write Setcolor15 default clAqua;
    property Color16:Tcolor  read  FColor16 write Setcolor16 default clWhite;
    Property OnColorChange: TColorChangeEvent read FOnColorChange write FOnColorChange;
  end;

  TIWTMSButton = class(TPersistent)
  private
    FCaption: string;
    FWidth: Word;
    FHeight: Word;
    FFont: TIWFont;
    FOnButtonChange: TNotifyEvent;
    FColor: TColor;
    procedure SetCaption(const Value: String);
    procedure SetHeight(const Value: Word);
    procedure SetWidth(const Value: Word);
    procedure SetFont(const Value: TIWFont);
    procedure FontChanged(Sender: TObject);
    procedure DoButtonChange;
    procedure SetColor(const Value: TColor);
  public
    constructor Create;
    destructor Destroy;override;
  published
    property Caption: string read FCaption write SetCaption;
    property Color: TColor read FColor write SetColor default clBtnFace;
    property Width: word read  FWidth write  SetWidth default 75;
    property Height: word read FHeight write SetHeight  default 25;
    property Font: TIWFont read FFont write SetFont;
    property OnButtonChange: TNotifyEvent read FOnButtonChange write FOnButtonChange;
  end;

  TTIWCustomColorPicker = class(TIWControl)
  private
    FLineWidth: byte;
    FColors: TIWColors;
    FColor: TColor;
    FLineColor: TColor;
    FOnColorChanged: TNotifyEvent;
    FPickerVisible: boolean;
    FPreviewVisible: boolean;
    FRowCount: Word;
    FColCount: Word;
    FRectHeight: Word;
    FDefaultColWidth: Word;
    FDefaultRowHeight: Word;
    {$IFDEF TMSIW9}
    FOnAsyncColorChanged: TIWAsyncEvent;
    procedure DoOnAsyncColorChanged(AParams: TStringList);
    {$ENDIF}
    procedure SetColor(const Value: TColor);
    procedure SetLineColor(const Value: TColor);
    procedure SetLineWidth(const Value: byte);
    procedure SetOnColorChanged(const Value: TNotifyEvent);
    procedure SetColors(x, y: word; const Value: TColor);
    function  GetColors(x, y: word): TColor;
    procedure SetColCount(const Value: Word);
    procedure SetPickerVisible(const Value: boolean);
    procedure SetPreviewVisible(const Value: boolean);
    procedure SetRowCount(const Value: Word);
    procedure SetRectHeight(const Value: Word);
    procedure SetDefaultColWidth(const Value: Word);
    procedure SetDefaultRowHeight(const Value: Word);
    function ColorIndex(Color: TColor): Integer;
    { Private declarations }
  protected
    ColorArray:array of TColor;
    procedure DoColorChanged;
    procedure MoveColors(newColCount:Word);
    procedure HTMLColorChange(index:word);overload;
    procedure HTMLColorChange(x,y:word);overload;
    procedure Submit(const AValue: string); override;
    procedure SetValue(const Avalue: string); override;
    function  HTMLClr(color: TColor):string;
    procedure OnFirstColorsChange(Sender:Tobject;index:byte;ColorChanged:Tcolor);
  public
    Constructor Create(AOwner: TComponent);override;
    Destructor Destroy;override;
    {$IFDEF TMSIW6}
    procedure RenderCustomHTML(var html,picker:string;widthControl:Word; AContext: TIWBaseComponentContext);
    {$ELSE}
    procedure RenderCustomHTML(var html,picker:string;widthControl:Word);
    {$ENDIF}
    property  PaletteColors[x,y:word]: TColor read GetColors write SetColors;
    property ColCount:Word read FColCount write SetColCount default 4;
    property RowCount:Word read FRowCount write SetRowCount default 4;
    {$IFDEF TMSIW9}
    function RenderAsync(AContext: TIWBaseHTMLComponentContext): TIWXMLTag; override;
    {$ENDIF}
  published
    Property Colors: TIWColors read FColors write FColors;
    property LineColor: TColor read FLineColor write SetLineColor default clGray;
    property LineWidth: byte read FLineWidth write SetLineWidth default 1;
    property Color: TColor read FColor write SetColor default clWhite;
    property RectHeight: word read FRectHeight write SetRectHeight;
    property PickerVisible: Boolean read FPickerVisible write SetPickerVisible default false;
    property PreviewVisible: Boolean read FPreviewVisible write SetPreviewVisible default true;
    property DefaultColWidth: word read FDefaultColWidth write SetDefaultColWidth;
    property DefaultRowHeight: word read FDefaultRowHeight write SetDefaultRowHeight;
    property OnColorChanged: TNotifyEvent read FOnColorChanged write SetOnColorChanged;
    {$IFDEF TMSIW9}
    property OnAsyncColorChanged: TIWAsyncEvent read FOnAsyncColorChanged write FOnAsyncColorChanged;
    {$ENDIF}
  end;

  TTIWColorPicker = class(TTIWCustomColorPicker)
  private
    FButton: TIWTMSButton;
  protected
    procedure AdjustSize; override;
    procedure DrawButton;
    procedure DrawRect;
    procedure DrawPicker;
    Procedure ButtonChange(Sender:Tobject);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    {$IFDEF TMSIW6}
    procedure IWPaint; override;
    function  RenderHTML(AContext: TIWBaseComponentContext): TIWHTMLTag; override;
    {$ELSE}
    procedure Paint; override;
    function  RenderHtml: TIWHTMLTag; override;
    {$ENDIF}
  published
    property Button: TIWTMSButton read FButton write FButton;
    property LineColor;
    property LineWidth;
    property Color;
    property RectHeight;
    property PickerVisible;
    property PreviewVisible;
    property DefaultColWidth;
    property DefaultRowHeight;
    property OnColorChanged;
  end;

implementation

uses
  IWApplication, IWServerControllerBase,
  SWStrings, SWSystem, IWAppForm, Math;

const
  tagcol='Color';


{ TTIWCustomColorPicker }
{$IFDEF TMSIW9}
procedure TTIWCustomColorPicker.DoOnAsyncColorChanged(AParams: TStringList);
begin
  if Assigned(OnAsyncColorChanged) then
    OnAsyncColorChanged(Self, AParams);
end;

function TTIWCustomColorPicker.RenderAsync(
  AContext: TIWBaseHTMLComponentContext): TIWXMLTag;
begin
  Result := TIWXMLTag.CreateTag('control');
  try
    Result.AddStringParam('id', HTMLName);
    Result.AddStringParam('type', 'TTIWCUSTOMCOLORPICKER');
    RenderAsyncCommonProperties( AContext, Result );
  except
    FreeAndNil(Result);
  end;
end;
{$ENDIF}

constructor TTIWCustomColorPicker.Create(AOwner: TComponent);
begin
  inherited;
  {$IFDEF TMSIW6}
  {TODO}
  {$ELSE}
  FSupportsInput := True;
  FSupportsSubmit := True;
  {$ENDIF}
  FLineColor := clGray;
  FLineWidth := 1;
  FColor := clWhite;
  FPickerVisible := False;
  FPreviewVisible := true;
  FRectHeight := 25;
  Width := 75;
  Height := 50;
  FColCount := 4;
  FRowCount := 4;
  FDefaultColWidth := 25;
  FDefaultRowHeight := 25;
  FOnColorChanged := nil;
  SetLength(ColorArray,16);
  FColors := TIWColors.Create;
  ColorArray[0] := clBlack;
  ColorArray[1] := clMaroon;
  ColorArray[2] := clGreen;
  ColorArray[3] := clOlive;
  ColorArray[4] := clNavy;
  ColorArray[5] := clPurple;
  ColorArray[6] := clTeal;
  ColorArray[7] := clSilver;
  ColorArray[8] := clGray;
  ColorArray[9] := clRed;
  ColorArray[10] := clLime;
  ColorArray[11] := clYellow;
  ColorArray[12] := clBlue;
  ColorArray[13] := clFuchsia;
  ColorArray[14] := clAqua;
  ColorArray[15] := clWhite;
  Colors.OnColorChange := OnFirstColorsChange;
end;

destructor TTIWCustomColorPicker.Destroy;
begin
  Finalize(ColorArray);
  FreeandNil(FColors);
  inherited;
end;

function TTIWCustomColorPicker.GetColors(x, y: word): TColor;
var
  i: Integer;
begin
  i := y * FColCount + x;
  if i >= FColCount * FRowCount then
    Result := clNone
  else
    Result := ColorArray[i];
end;

procedure TTIWCustomColorPicker.SetColor(const Value: TColor);
begin
  FColor := Value;
  DoColorChanged;
  Invalidate;
end;

procedure TTIWCustomColorPicker.SetColors(x, y: word; const Value: TColor);
var
  i:Integer;
begin
  i := y * FColCount + x;
  if i < FColCount * FRowCount then
    ColorArray[i-1] := Value;
  Invalidate;
end;

procedure TTIWCustomColorPicker.SetColCount(const Value: Word);
begin
  if FColCount = Value then
    Exit;
  MoveColors(Value);
  FColCount := Value;
  Invalidate;
end;

procedure TTIWCustomColorPicker.SetLineColor(const Value: TColor);
begin
  if FLineColor = Value then
    Exit;
  FLineColor := Value;
  Invalidate;
end;

procedure TTIWCustomColorPicker.SetLineWidth(const Value: byte);
begin
  if FLineWidth = Value then
    Exit;
  FLineWidth := Value;
  Invalidate;
end;

procedure TTIWCustomColorPicker.SetOnColorChanged(const Value: TNotifyEvent);
begin
  FOnColorChanged := Value;
end;


procedure TTIWCustomColorPicker.SetPickerVisible(const Value: boolean);
begin
  if FPickerVisible = Value then
    Exit;
  FPickerVisible := Value;
  Invalidate;
end;

procedure TTIWCustomColorPicker.SetPreviewVisible(const Value: boolean);
begin
  if FPreviewVisible = Value then
    Exit;
  FPreviewVisible := Value;
  Invalidate;
end;

procedure TTIWCustomColorPicker.SetRowCount(const Value: Word);
begin
  if FRowCount = Value then
    Exit;
  FRowCount := Value;
  SetLength(ColorArray,FColCount*FRowCount);
  Invalidate;
end;

procedure TTIWCustomColorPicker.DoColorChanged;
begin
  if Assigned(FOnColorChanged)
    then FOnColorChanged(self);
end;


procedure TTIWCustomColorPicker.SetRectHeight(const Value: Word);
begin
  if FRectHeight = Value then
    Exit;
  FRectHeight := Value;
  Invalidate;
end;

procedure TTIWCustomColorPicker.MoveColors(newColCount: Word);
var
  i,j,minCol: Integer;
begin
  minCol := Min(FColCount,newColCount)-1;
  
  if FColCount < newColCount then
    SetLength(ColorArray,FRowCount*newColCount);

  for i := FRowCount - 1 downto 0 do
    for j := minCol downto 0 do
     ColorArray[i*newColCount+j] := ColorArray[i*FColCount+j];

  if FColCount < newColCount then
    for i := 0 to FRowCount-1 do
      for j := FColCount to newColCount - 1 do
        ColorArray[i*newColCount+j] := clNone
  else
    SetLength(ColorArray,FRowCount*newColCount);
end;



procedure TTIWCustomColorPicker.HTMLColorChange(index: word);
begin
  if index < (FRowCount*FColCount) then
  begin
    FColor := ColorArray[index];
    DoColorChanged;
  end;
end;

procedure TTIWCustomColorPicker.HTMLColorChange(x, y: word);
begin
  HTMLColorChange(y*FColCount+x);
end;

procedure TTIWCustomColorPicker.SetDefaultColWidth(const Value: Word);
begin
  FDefaultColWidth := Value;
  Invalidate;
end;

procedure TTIWCustomColorPicker.SetDefaultRowHeight(const Value: Word);
begin
  FDefaultRowHeight := Value;
  Invalidate;
end;

procedure TTIWCustomColorPicker.Submit(const AValue: string);
var
  Decode: string;
  cul:Tcolor;
begin
  Decode := AValue;
  if AnsiPos(HTMLName+tagcol,Decode) = 1 then
    Delete(decode,1,Length(HTMLName)+Length(tagcol));
  try
    cul := StrToInt(decode);
    HTMLColorChange(cul);
  except
    on Exception do;
  end;
end;

function TTIWCustomColorPicker.HTMLClr(color: TColor):string;
begin
  Result := ColorToRGBString(color);
end;

{$IFDEF TMSIW6}
procedure TTIWCustomColorPicker.RenderCustomHTML(var html,picker:string;Widthcontrol:word; AContext: TIWBaseComponentContext);
{$ELSE}
procedure TTIWCustomColorPicker.RenderCustomHTML(var html,picker:string;Widthcontrol:word);
{$ENDIF}
var
  i,j,WidthDiv,HeightDiv:integer;
  ajaxcall, submitclick: string;
begin
  WidthDiv := DefaultColWidth * ColCount;
  HeightDiv := DefaultRowHeight * RowCount + 4;

  {$IFDEF TMSIW6}
  TIWComponent40Context(AContext).AddToInitProc('FindElem(''' + HTMLName + ''').value="' + IntToStr(ColorIndex(Color)) + '";' + EOL);
  {$ELSE}
  TIWAppForm(Form).AddToInitProc('FindElem(''' + HTMLName + ''').value="' + IntToStr(ColorIndex(Color)) + '";' + EOL);
  {$ENDIF}

  html := '<SCRIPT>'#13
        + 'var ' + HTMLName + 'hideWindowedControls = true;'#13
        + 'var ' + HTMLName + 'DivStartLeft;'#13
        + 'var ' + HTMLName + 'DivEndLeft;'#13
        + 'var ' + HTMLName + 'DivStartTop;'#13
        + 'var ' + HTMLName + 'DivEndTop;'#13
        + 'var ' + HTMLName + 'isIE;'#13
        + 'var ' + HTMLName + 'BUTTONTop;'#13
        + 'var ' + HTMLName + 'BUTTONETop;'#13
        + 'var ' + HTMLName + 'BUTTONLeft;'#13
        + 'var ' + HTMLName + 'BUTTONELeft;'#13

        + 'function ' + HTMLName + 'showWindowedObjects(show) {'#13
        +   HTMLName + 'getPositionDiv();'#13
        +   HTMLName + 'isIE = navigator.appName.indexOf("Microsoft") != -1;'#13
        + ' if (' + HTMLName + 'hideWindowedControls) {'#13
        + '   var windowedObjectTags = new Array("SELECT", "IFRAME", "OBJECT", "APPLET","EMBED");'#13
        + '   var windowedObjects = new Array();'#13
        + '   var j=0;'#13
        + '   if (' + HTMLName + 'isIE == true) {'#13
        + '     for (var i=0; i<windowedObjectTags.length; i++) {'#13
        + '       var tmpTags = document.all.tags(windowedObjectTags[i]);'#13
        + '       if (tmpTags.length > 0) {'#13
        + '         for (var k=0; k<tmpTags.length; k++) {'#13
        + '           windowedObjects[j++] = tmpTags[k];'#13
        + '         }'#13
        + '       }'#13
        + '     }'#13
        + '   }'#13
        +    'else {'#13
        +      'for (var i=0; i<windowedObjectTags.length; i++) {'#13
        +        'var tmpTags = document.getElementsByTagName(windowedObjectTags[i]);'#13
        +        'if (tmpTags.length > 0) {'#13
        +          'for (var k=0; k<tmpTags.length; k++) {'#13
        + 			     'windowedObjects[j++] = tmpTags[k];'#13
        +          '}'#13
        +        '}'#13
        +      '}'#13
        +    '}'#13

        +	   'for (var i=0; i<windowedObjects.length; i++) {'#13
        + 	   'if (show)'#13
	      +        'windowedObjects[i].style.visibility = "visible";'#13
	      +      'else {'#13
		    +        'var topObject = document.getElementById(windowedObjects[i].id).style.top;'#13
		    +        'var leftObject = document.getElementById(windowedObjects[i].id).style.left;'#13
		    +        'var topInt = parseInt(topObject.substring(0,topObject.length - 2));'#13
        +        'var leftInt = parseInt(leftObject.substring(0,leftObject.length - 2));'#13

	      + 	     'if (' + HTMLName + 'isIE == true) {'#13
   	    + 	       'var widthObject = document.getElementById(windowedObjects[i].id).offsetWidth;'#13
        +          'var heightObject = document.getElementById(windowedObjects[i].id).offsetHeight;'#13
        +          'var rightInt = leftInt + parseInt(widthObject);'#13
        +          'var bottomInt = topInt + parseInt(heightObject);'#13
        +		     '}'#13
        +		     'else {'#13
        +          'var widthObject = document.getElementById(windowedObjects[i].id).offsetWidth;'#13
        +          'var heightObject = document.getElementById(windowedObjects[i].id).offsetHeight;'#13
        +          'var rightInt = leftInt + parseInt(widthObject);'#13
        +          'var bottomInt = topInt + parseInt(heightObject);'#13
	      +	       '}'#13

        + 	     'if ((((leftInt >= ' + HTMLName + 'DivStartLeft) && (leftInt <= ' + HTMLName + 'DivEndLeft)) | ((rightInt >= ' + HTMLName + 'DivStartLeft) && (rightInt <= ' + HTMLName + 'DivEndLeft)) | ((leftInt <= ' + HTMLName + 'DivStartLeft) && (rightInt >= ' + HTMLName + 'DivStartLeft))) && (((topInt >= ' + HTMLName + 'DivStartTop) && (topInt <= ' + HTMLName + 'DivEndTop)) | ((bottomInt >= ' + HTMLName + 'DivStartTop) && (bottomInt <= ' + HTMLName + 'DivEndTop))))'#13
        +          'windowedObjects[i].style.visibility = "hidden";'#13
        +      '}'#13
        +    '}'#13
        +  '}'#13
        +'}'#13;

    if Assigned(OnColorChanged) then
      submitclick := ' return SubmitClick('#39 + HTMLName + #39 + ',' + #39 + HTMLName + tagcol + #39'+colorpick,'#39'false'#39');'#13
    else
      submitclick := '';

    {$IFDEF TMSIW9}
    if Assigned(FOnAsyncColorChanged) then
    begin
      ajaxcall := 'processAjaxEvent(''onColorChanged'', '
        + HTMLControlImplementation.IWCLName
        + ',''' + HTMLName + '.' + 'DoOnAsyncColorChanged' + ''','
        + 'true' + ', null, '
        + 'true' + ');';

      Acontext.WebApplication.RegisterCallBack(HTMLName+'.DoOnAsyncColorChanged', DoOnAsyncColorChanged);

      submitclick := '';
    end;
    {$ENDIF}

html := html
    + 'function ' + HTMLName + 'ColorChange(color,colorpick)'#13
    + '{'#13
    + '  FindElem(''' + HTMLName + ''').value=colorpick;'#13
    + '  var pickerObj = document.getElementById("Picker' + HTMLName + '");'#13
    + '  pickerObj.style.visibility = "hidden";'#13
    + '  var divPickerObj = document.getElementById("DivPicker' + HTMLName + '");'#13
    + '  divPickerObj.style.height = "0px";'#13
    + '  divPickerObj.style.width = "0px";'#13
    + '  var rectObj = document.getElementById("Rect' + HTMLName + '");'#13
    + '  rectObj.style.backgroundColor = color;'#13
    + ajaxcall
    + submitclick
    + '}'#13

    + 'function ' + HTMLName + 'ShowPicker() {'#13
    + '  var obj = document.getElementById("Picker' + HTMLName + '");'#13
    + '  obj.style.visibility = "visible";'#13
    +    HTMLName + 'showWindowedObjects(false);'#13
    + '  var divObj = document.getElementById("DivPicker' + HTMLName + '");'#13
    + '  divObj.style.height = "' + IntToStr(HeightDiv) + 'px";'#13
    + '  divObj.style.width = "' + IntToStr(WidthDiv) + 'px";'#13
    + '  if (' + HTMLName + 'isIE == false) {'#13
    + '    document.captureEvents(Event.MOUSEUP);'#13
    +'   }'#13
    + '  document.onmouseup=' + HtmlName + 'onMouseUp;'#13
    + '}'#13

    + 'function ' + HTMLName + 'getPositionDiv() {'#13
    + '  var divObject = document.getElementById("Button' + HtmlName + '");'#13
    + '  var colorPicker = document.getElementById("Picker' + HTMLName + '");'#13
    +    HTMLName + 'DivStartLeft = parseInt(' + IntToStr(Left) + '+' + IntToStr(Width) + ');'#13
    +    HTMLName + 'DivStartTop = ' + IntToStr(Top) + ';'#13
    +    HTMLName + 'DivEndLeft = ' + HTMLName + 'DivStartLeft + colorPicker.offsetWidth;'#13
    +    HTMLName + 'DivEndTop = ' + HTMLName + 'DivStartTop + colorPicker.offsetHeight;'#13
    + '  var cell = document.getElementById("Button' + HTMLName + '");'#13
    + '  var leftBegin = 0;'#13
    + '  var topBegin = 0;'#13
    + '  var elem = cell;'#13
    + '  do '#13
    + '  {'#13
    + '    leftBegin += elem.offsetLeft;'#13
    + '    topBegin += elem.offsetTop;'#13
    + '  }'#13
    + '  while ((elem = elem.offsetParent));'#13
    + '  ' + HTMLName + 'BUTTONLeft = leftBegin;'#13
    + '  ' + HTMLName + 'BUTTONTop = topBegin;'#13
    + '  ' + HTMLName + 'BUTTONELeft = parseInt(leftBegin) + parseInt(cell.style.width);'#13
    + '  ' + HTMLName + 'BUTTONETop = parseInt(topBegin) + parseInt(cell.style.height);'#13
    + '}'#13

    + 'function ' + HTMLName + 'onMouseUp(e) {'#13
    + '  var pickerObj = document.getElementById("Picker' + HTMLName + '");'#13
    + '  var divPickerObj = document.getElementById("DivPicker' + HTMLName + '");'#13
    + '  if (' + HTMLName + 'isIE == true) {'#13
    + '    if ((pickerObj.style.visibility == "visible") & ((window.event.x < ' + HTMLName + 'DivStartLeft) | (' + HTMLName + 'DivEndLeft < window.event.x) | (window.event.y < ' + HTMLName + 'DivStartTop) | ('+ HTMLName + 'DivEndTop < window.event.y)))  {'#13
    + '      if (!window.opera) {'#13
    + '        pickerObj.style.visibility = "hidden";'#13
    + '        divPickerObj.style.height = "0px";'#13
    + '        divPickerObj.style.width = "0px";'#13
    + '      }'#13
    + '      else {'#13
    + '  		   if ((window.event.x < ' + HTMLName + 'BUTTONLeft) | (window.event.x > ' + HTMLName + 'BUTTONELeft) | (window.event.y < ' + HTMLName + 'BUTTONTop) | (window.event.y > ' + HTMLName + 'BUTTONETop)) {'#13
    + '          pickerObj.style.visibility = "hidden";'#13
		+ '          divPickerObj.style.height = "0px";'#13
    + '     		 divPickerObj.style.width = "0px";'#13
    + '        }'#13
    + '      }'#13
    + '    }'#13
    + '  }'#13
    + '  else {'#13
    + '    if ((pickerObj.style.visibility == "visible") & ((e.pageX < ' + HTMLName + 'DivStartLeft) | (' + HTMLName + 'DivEndLeft < e.pageX) | (e.pageY < ' + HTMLName + 'DivStartTop) | ('+ HTMLName + 'DivEndTop < e.pageY)))  {'#13
    + '      pickerObj.style.visibility = "hidden";'#13
    + '      divPickerObj.style.height = "0px";'#13
    + '      divPickerObj.style.width = "0px";'#13
    + '    }'#13
    + '  }'#13
    +    HTMLName + 'showWindowedObjects(true);'#13
    + '}'#13

    + '</SCRIPT>'#13

    + '<TABLE id="Rect' + HTMLName +'" border="' + IntToStr(FLineWidth)+'" '
    + 'bordercolor=' + HTMLClr(LineColor)+' style="height:' + IntToStr(RectHeight) + ';'#13
    + ' border-collapse:collapse; border-width:'+inttostr(FLineWidth) + '; background-color:' + HTMLClr(Color)+';'#13
    + ' width:' + IntToStr(WidthControl)+';'
    + IIF(PreviewVisible,'visibility:visible','visibility:hidden')
    + '">'#13
    + '<TR>'#13
    + '<TD>&nbsp;</TD>'#13
    + '</TR>'#13
    + '</TABLE>'#13;

  if PickerVisible then
    picker := '<div id="DivPicker' + HtmlName + '" style="overflow:hidden;height:' + IntToStr(HeightDiv)
    + 'px;width:' + IntToStr(WidthDiv) + 'px">'
  else
    picker := '<div id="DivPicker' + HtmlName + '" style="overflow:hidden;height:0px;width:0px">';

  picker := picker + '<DIV id="Picker' + HTMLName + '" style="background-color:#ffffff;'
    + IIF(PickerVisible,'visibility:visible','visibility:hidden') + ';'
    + 'zIndex:0;height:' + IntToStr(DefaultRowHeight * RowCount)
    + ';width:' + IntToStr(DefaultColWidth * ColCount) + ';">'
    + '<TABLE cellpadding="0" cellspacing="1" border="' + IntToStr(FLineWidth) + '" '#13
    + 'bordercolor="' + HTMLClr(LineColor) + '" '#13
    + 'style="'
    + 'height:' + IntToStr(DefaultRowHeight * RowCount)
    + ';width:' + IntToStr(DefaultColWidth * ColCount) + ';'#13
    + '">'#13;

    for j := 0 to RowCount - 1 do
    begin
      picker := picker + '  <TR>'#13;
      for i := 0 to ColCount - 1 do
      begin
//        picker := picker + '    <TD width="' + IntToStr(WidthDiv) + 'px" onclick="' + HTMLName + 'ColorChange(''' + HTMLClr(PaletteColors[i,j])+''','+inttostr(j*ColCount+i)+')" '
        picker := picker + '    <TD width="' + IntToStr(WidthDiv) + 'px" onclick="' + HTMLName + 'ColorChange('#39 + HTMLClr(PaletteColors[i,j]) + #39 + ',' + IntToStr(j * ColCount + i) + ')" '
          + 'style="cursor:hand;background-color:'+HTMLClr(PaletteColors[i,j])+';'#13
          + '"'
          + '>&nbsp;</TD>'#13
//          + '><span style="cursor:hand;" onclick="' + HTMLName + 'ColorChange(''' + HTMLClr(PaletteColors[i,j])+''','+inttostr(j*ColCount+i)+')"> &nbsp; &nbsp;</span></TD>'#13
      end;
      picker := picker + ' </TR>'#13;
   end;
   picker := picker + ' </TABLE></DIV></div>'#13;
end;


constructor TIWTMSButton.Create;
begin
  FWidth := 75;
  FHeight := 25;
  FCaption := 'Choose Color';
  FFont := TIWfont.Create;
  FFont.FontName := 'Arial';
  FFont.Color := clBlack;
  FFont.Size := 8;
  FFont.OnChange := FontChanged;
  Fcolor := clBtnFace;
end;

destructor TIWTMSButton.Destroy;
begin
  FreeAndNil(FFont);
end;

procedure TIWTMSButton.SetCaption(const Value: String);
begin
  FCaption := Value;
  DoButtonChange;
end;

procedure TIWTMSButton.SetHeight(const Value: Word);
begin
  if FHeight = Value then
    Exit;
  FHeight := Value;
  DoButtonChange;
end;

procedure TIWTMSButton.SetWidth(const Value: Word);
begin
  if FWidth = Value then
    Exit;
  FWidth := Value;
  DoButtonChange;
end;
procedure TIWTMSButton.SetFont(const Value: TIWFont);
begin
  FFont.Assign(Value);
  DoButtonChange;
end;
procedure TIWTMSButton.SetColor(const Value: Tcolor);
begin
  FColor := Value;
  DoButtonChange;
end;

procedure TIWTMSButton.FontChanged(Sender: TObject);
begin
  DoButtonChange;
end;

procedure TTIWColorPicker.AdjustSize;
begin
  inherited;
  if not Assigned(FButton) then
    Exit;

  if FPickerVisible then
  begin
    if FPreviewVisible then
      Height := Max(FRowCount*FDefaultRowHeight,FButton.Height+FRectHeight)
    else
      Height := Max(FRowCount*FDefaultRowHeight,FButton.Height);

    Width := FButton.Width + FColCount*FDefaultColWidth;
  end
  else
  begin
    if FPreviewVisible then
      Height := FButton.Height + FRectHeight
    else
      Height := FButton.Height;
    Width := Button.Width;
  end;
end;

{$IFDEF TMSIW6}
procedure TTIWColorPicker.IWPaint;
{$ELSE}
procedure TTIWColorPicker.Paint;
{$ENDIF}
begin
  inherited;
  AdjustSize;
  DrawButton;
  if FPreviewVisible then
    DrawRect;
  if FPickerVisible then
    DrawPicker;
  Canvas.Pen.Width := 1; //Bug IW draw rect
end;

procedure TTIWColorPicker.DrawPicker;
var
 i,j,StartX,medX,medY:Integer;
 r:TRect;
begin
  StartX := FButton.Width;
  if StartX > width then
    Exit;

  medX := (Width-StartX) div FColCount;
  medY := Height div FRowCount;

  Canvas.Pen.Color := clwhite;
  Canvas.Pen.Width := 1;
  Canvas.Brush.Style := bsSolid;

  for i := 0 to FRowCount - 1 do
    for j := 0 to FColCount - 1 do
    begin
      r.Left := StartX + j * medX;
      r.Top := i * medY;
      if j = (FColCount-1) then
        r.Right := Width
      else
        r.Right := r.Left + medX;

      if i = (FRowCount-1) then
        r.Bottom := Height
      else
        r.Bottom := r.Top +  medY;

      Canvas.Brush.Color := PaletteColors[j,i];
      Canvas.Rectangle(r);
    end;

  Canvas.Pen.Color := FLineColor;
  Canvas.Pen.Width := FLineWidth;
  Canvas.Brush.Style := bsClear;
  r.Left := StartX;
  r.Top := 0;
  r.Bottom := Height;
  r.Right := width;
  Canvas.Rectangle(r);
end;

procedure TTIWColorPicker.DrawRect;
var
  r: TRect;
begin
  with FButton do
    r := Rect(0,FButton.Height,FButton.Width,FButton.Height+FRectHeight);
  Canvas.Pen.Color := FLineColor;
  Canvas.Pen.Width := FLineWidth;
  Canvas.Brush.Color:=FColor;
  Canvas.Rectangle(r);
end;

procedure TTIWColorPicker.DrawButton;
var
  r: TRect;
  x,y: Integer;
begin
  with FButton do
    r := Rect(0,0,Button.Width,Button.Height);

  {$IFNDEF LINUX}
  DrawFrameControl(Canvas.Handle,r,DFC_Button,DFCS_ButtonPUSH);
  {$ENDIF}
  if FButton.Color <> clNone then
    Canvas.Brush.Color := FButton.Color
  else
    Canvas.Brush.Color := clBtnFace;

  with Canvas do
  begin
    Font.Color := FButton.Font.Color;
    Font.Name := FButton.Font.FontName;
    Font.Size := FButton.Font.Size;
    Font.Style := FButton.Font.Style;
  end;

  InflateRect(r,-1,-1);
  with FButton do
    x := (Button.Width-Canvas.TextWidth(FCaption)) div 2;

  if x < 0 then
    x := 0;

  with FButton do
    y:=(Button.Height-Canvas.TextHeight(FCaption)) div 2;
  if y < 0 then
    y := 0;


  with FButton do
    Canvas.TextRect(r,x,y,FCaption);
end;

constructor TTIWColorPicker.Create(AOwner: TComponent);
begin
  inherited;
  FButton := TIWTMSButton.Create;
  FButton.FOnButtonChange := ButtonChange;
end;

destructor TTIWColorPicker.Destroy;
begin
  FreeAndNil(FButton);
  inherited;
end;

procedure TIWTMSButton.DoButtonChange;
begin
  if Assigned(FOnButtonChange) then
    FOnButtonChange(Self);
end;

procedure TTIWColorPicker.ButtonChange(Sender: Tobject);
begin
  Invalidate;
end;

procedure TTIWCustomColorPicker.OnFirstColorsChange(Sender: Tobject;
  index: byte;ColorChanged:Tcolor);
begin
  if FRowCount*FColCount < Index then
    Exit;
  ColorArray[index-1] := ColorChanged;
  Invalidate;
end;

function TTIWCustomColorPicker.ColorIndex(Color: TColor): Integer;
begin
  Color := ColorToRGB(Color);
  Result := 0;
  if Color = ColorToRGB(Colors.FColor1) then
    Result := 0;
  if Color = ColorToRGB(Colors.FColor2) then
    Result := 1;
  if Color = ColorToRGB(Colors.FColor3) then
    Result := 2;
  if Color = ColorToRGB(Colors.FColor4) then
    Result := 3;
  if Color = ColorToRGB(Colors.FColor5) then
    Result := 4;
  if Color = ColorToRGB(Colors.FColor6) then
    Result := 5;
  if Color = ColorToRGB(Colors.FColor7) then
    Result := 6;
  if Color = ColorToRGB(Colors.FColor8) then
    Result := 7;
  if Color = ColorToRGB(Colors.FColor9) then
    Result := 8;
  if Color = ColorToRGB(Colors.FColor10) then
    Result := 9;
  if Color = ColorToRGB(Colors.FColor11) then
    Result := 10;
  if Color = ColorToRGB(Colors.FColor12) then
    Result := 11;
  if Color = ColorToRGB(Colors.FColor13) then
    Result := 12;
  if Color = ColorToRGB(Colors.FColor14) then
    Result := 13;
  if Color = ColorToRGB(Colors.FColor15) then
    Result := 14;
  if Color = ColorToRGB(Colors.FColor16) then
    Result := 15;
end;

procedure TTIWCustomColorPicker.SetValue(const Avalue: string);
var
  v,err:integer;
begin
  inherited;

  val(AValue,v,err);

  case v of
  0: Color := Colors.FColor1;
  1: Color := Colors.FColor2;
  2: Color := Colors.FColor3;
  3: Color := Colors.FColor4;
  4: Color := Colors.FColor5;
  5: Color := Colors.FColor6;
  6: Color := Colors.FColor7;
  7: Color := Colors.FColor8;
  8: Color := Colors.FColor9;
  9: Color := Colors.FColor10;
  10: Color := Colors.FColor11;
  11: Color := Colors.FColor12;
  12: Color := Colors.FColor13;
  13: Color := Colors.FColor14;
  14: Color := Colors.FColor15;
  15: Color := Colors.FColor16;
  end;

end;

{ TIWColors }

constructor TIWColors.Create;
begin
   FColor1  := clBlack;
   FColor2  := clMaroon;
   FColor3  := clGreen;
   FColor4  := clOlive;
   FColor5  := clNavy;
   FColor6  := clPurple;
   FColor7  := clTeal;
   FColor8  := clSilver;
   FColor9  := clGray;
   FColor10 := clRed;
   FColor11 := clLime;
   FColor12 := clYellow;
   FColor13 := clBlue;
   FColor14 := clFuchsia;
   FColor15 := clAqua;
   FColor16 := clWhite;
end;

procedure TIWColors.Dochange(index: byte;ColorChanged:Tcolor);
begin
  if Assigned(FOnColorChange) then
    FOnColorChange(Self,index,ColorChanged);
end;

procedure TIWColors.Setcolor1(const Value: Tcolor);
begin
  FColor1 := Value;
  Dochange(1,Value);
end;

procedure TIWColors.Setcolor10(const Value: Tcolor);
begin
  FColor10 := Value;
  Dochange(10,Value);
end;

procedure TIWColors.Setcolor11(const Value: Tcolor);
begin
  FColor11 := Value;
  Dochange(11,Value);
end;

procedure TIWColors.Setcolor12(const Value: Tcolor);
begin
  FColor12 := Value;
  Dochange(12,Value);
end;

procedure TIWColors.Setcolor13(const Value: Tcolor);
begin
  FColor13 := Value;
  Dochange(13,Value);
end;

procedure TIWColors.Setcolor14(const Value: Tcolor);
begin
  FColor14 := Value;
  Dochange(14,Value);
end;

procedure TIWColors.Setcolor15(const Value: Tcolor);
begin
  FColor15 := Value;
  Dochange(15,Value);
end;

procedure TIWColors.Setcolor16(const Value: Tcolor);
begin
  FColor16 := Value;
  Dochange(16,Value);
end;

procedure TIWColors.Setcolor2(const Value: Tcolor);
begin
  FColor2 := Value;
  Dochange(2,Value);
end;

procedure TIWColors.Setcolor3(const Value: Tcolor);
begin
  FColor3 := Value;
  Dochange(3,Value);
end;

procedure TIWColors.Setcolor4(const Value: Tcolor);
begin
  FColor4 := Value;
  Dochange(4,Value);
end;

procedure TIWColors.Setcolor5(const Value: Tcolor);
begin
  FColor5 := Value;
  Dochange(5,Value);
end;

procedure TIWColors.Setcolor6(const Value: Tcolor);
begin
  FColor6 := Value;
  Dochange(6,Value);
end;

procedure TIWColors.Setcolor7(const Value: Tcolor);
begin
  FColor7 := Value;
  Dochange(7,Value);
end;

procedure TIWColors.Setcolor8(const Value: Tcolor);
begin
  FColor8 := Value;
  Dochange(8,Value);
end;

procedure TIWColors.Setcolor9(const Value: Tcolor);
begin
  FColor9 := Value;
  Dochange(9,Value);
end;

{$IFDEF TMSIW6}
function TTIWColorPicker.RenderHTML(AContext: TIWBaseComponentContext): TIWHTMLTag;
{$ELSE}
function TTIWColorPicker.RenderHTML: TIWHTMLTag;
{$ENDIF}
var
  html,picker:string;
begin
  {$IFDEF TMSIW6}
  RenderCustomHTML(html,picker,FButton.Width,AContext);
  {$ELSE}
  RenderCustomHTML(html,picker,FButton.Width);
  {$ENDIF}

  html := '<INPUT type="button" id="Button' + HtmlName + '" value="' + FButton.caption + '" onclick="'+HTMLName+'ShowPicker()"'#13
    + 'style="'#13
    + 'height: '+IntToStr(Button.Height)+'; width:'+IntToStr(Button.Width)+#13+';'#13
    + IIF((FButton.Font.FontName <> '') and FButton.Font.Enabled,'font-family:'+FButton.Font.FontName+'; ','')
    {$IFNDEF TMSIW9}
    + FButton.Font.CSSStyle
    {$ENDIF}
    + ' font-size:'+IntToStr(FButton.Font.Size)+'; '
    + IIF((fsBold in FButton.Font.Style) and FButton.Font.Enabled,'font-weight:bold;','')
    + IIF(FButton.Font.Enabled,' color:'+HTMLClr(FButton.Font.Color)+'; cursor:hand;','')
    + IIF(FButton.Color <> clNone,' background-color:'+HTMLClr(FButton.Color)+';','')+#13
    + '">'#13

    + html
//    + '<DIV id="DIV' + HtmlName + '" style="position:relative; left:' + IntToStr(FButton.Width)+ ';top:-'+inttostr(FButton.Height+FRectHeight)+'">'
    + '<DIV id="DIV' + HtmlName + '" style="position:absolute;left:' + IntToStr(FButton.Width)+ ';top:0">'
    + picker
    +'</DIV>';

  Result := TIWHTMLTag.CreateTag('DIV');
  Result.Contents.AddText(html);
  with Result.Contents.AddTag('INPUT') do
  begin
    AddStringParam('TYPE','hidden');
    AddStringParam('NAME',HTMLName);
    AddStringParam('ID',HTMLName+'_INPUT');
  end;
end;


end.
