{***************************************************************************}
{ TMS IntraWeb Component Pack Pro                                           }
{ for Delphi & C++Builder                                                   }
{                                                                           }
{ written by TMS Software                                                   }
{            copyright © 2002 - 2009                                        }
{            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 IWAdvToolButton;

{$I TMSDEFS.INC}

interface

{$R advtoolbutton.res}

uses
  {$IFDEF LINUX}
  QControls, QGraphics, QIWPicCntnr, QForms,
  {$ELSE}
  Windows, Graphics, Controls, IWPicCntnr, Forms,
  {$ENDIF}
  {$IFDEF DELPHI6_LVL}
  Types,
  {$ENDIF}
  Classes,
  IWControl, IWTypes, IWCompEdit, IWFont, IWTMSImg,
  IWCompLabel, IWExtCtrls, IWHTMLTag, IWTMSBase, IWColor
  {$IFDEF TMSIW6}
  , IWRenderContext
  {$ENDIF}
  {$IFDEF TMSIW9}
  , IWXMLTag
  {$ENDIF}
  ;


type
  TTIWGradientDirection = (gdHorizontal, gdVertical);

  TTIWAdvToolButton = class(TIWControl)
  private
    FText: String;
    FEnabled: boolean;
    FGlyph: TIPicture;
    FGlyphURL: string;
    FFont: TIWfont;

    FBackColor: TIWColor;
    FBackColorTo: TIWColor;
    FBackColorGradientDirection: TTIWGradientDirection;
    FBorderColor: TIWColor;

    FHotColor: TIWColor;
    FHotColorTo: TIWColor;
    FHotColorGradientDirection: TTIWGradientDirection;
    FHotBorderColor: TIWColor;

    FDownColor: TIWColor;
    FDownColorTo: TIWColor;
    FDownColorGradientDirection: TTIWGradientDirection;
    FDownBorderColor: TIWColor;

    FDisabledColor: TIWColor;
    FDisabledColorTo: TIWColor;
    FDisabledColorGradientDirection: TTIWGradientDirection;

    FClientEvent: TStringList;

    procedure SetFont(const Value: TIWfont);
    procedure SetText(const Value: String); reintroduce;
    procedure SetGlyph(const Value: TIPicture);
    procedure SetGlyphURL(const Value: String);    
    procedure SetClientEvent(const Value: TStringList);
    procedure SetOnClick(const value: tnotifyevent);
    function GetOnClick: tnotifyevent;
    {$IFDEF TMSIW9}
    procedure DoOnAsyncClick(AParams: TStringList);
    {$ENDIF}    
  protected
    procedure Submit(const AValue: string); override;
  public
    {$IFDEF TMSIW6}
    procedure IWPaint; override;
    function RenderHTML(AContext: TIWBaseComponentContext): TIWHTMLTag; override;
    {$ELSE}
    procedure Paint; override;
    function RenderHTML: TIWHTMLTag; override;
    {$ENDIF}
    {$IFDEF TMSIW9}
    function RenderAsync(AContext: TIWBaseHTMLComponentContext): TIWXMLTag; override;
    {$ENDIF}
    constructor Create(AOwner: TComponent); override;
    procedure DrawGradient(Canvas: TCanvas; FromColor, ToColor: TIWColor; Steps: Integer; r:TRect; Direction: Boolean);
    destructor Destroy; override;
  published
    property Text: String read FText write SetText;
    property Enabled: boolean read FEnabled write FEnabled;
    property Glyph: TIPicture read FGlyph write SetGlyph;
    property GlyphURL: string read FGlyphURL write SetGlyphURL;
    property Font : TIWfont read FFont write SetFont;
    property TabOrder;

    property BackColor: TIWColor read FBackColor write FBackColor;
    property BackColorTo: TIWColor read FBackColorTo write FBackColorTo;
    property BackColorGradientDirection: TTIWGradientDirection read FBackColorGradientDirection write FBackColorGradientDirection;
    property BorderColor: TIWColor read FBorderColor write FBorderColor;

    property HotColor: TIWColor read FHotColor write FHotColor;
    property HotColorTo: TIWColor read FHotColorTo write FHotColorTo;
    property HotColorGradientDirection: TTIWGradientDirection read FHotColorGradientDirection write FHotColorGradientDirection;
    property HotBorderColor: TIWColor read FHotBorderColor write FHotBorderColor;

    property DownColor: TIWColor read FDownColor write FDownColor;
    property DownColorTo: TIWColor read FDownColorTo write FDownColorTo;
    property DownColorGradientDirection: TTIWGradientDirection read FDownColorGradientDirection write FDownColorGradientDirection;
    property DownBorderColor: TIWColor read FDownBorderColor write FDownBorderColor;

    property DisabledColor: TIWColor read FDisabledColor write FDisabledColor;
    property DisabledColorTo: TIWColor read FDisabledColorTo write FDisabledColorTo;
    property DisabledColorGradientDirection: TTIWGradientDirection read FDisabledColorGradientDirection write FDisabledColorGradientDirection;

    property ClientEvent: TStringList read FClientEvent write SetClientEvent;

    property OnClick: TNotifyEvent read GetOnClick write SetOnClick;
    {$IFDEF TMSIW9}
    property OnAsyncClick;
    {$ENDIF}
  end;


implementation

uses
  {$IFDEF LINUX}
  QImgList,
  {$ELSE}
  ImgList, ShellAPI, CommCtrl,
  {$ENDIF}
  IWApplication, IWServerControllerBase,
  SWStrings, SWSystem, IWAppForm, SysUtils, IWServer;

{$IFNDEF DELPHI7_LVL}
function BoolToStr(B: Boolean; UseBoolStrs: Boolean = False): string;
const
  cSimpleBoolStrs: array [boolean] of String = ('0', '-1');
begin
  Result := cSimpleBoolStrs[B];
end;
{$ENDIF}
  

function TTIWAdvToolButton.GetOnClick: TNotifyEvent;
begin
  Result := inherited OnClick;
end;

procedure TTIWAdvToolButton.SetOnClick(const value: tnotifyevent);
begin
  inherited OnClick := value;
end;

procedure TTIWAdvToolButton.DrawGradient(Canvas: TCanvas; FromColor, ToColor: TIWColor; Steps: Integer; r:TRect; Direction: Boolean);
var
  diffr,startr,endr: Integer;
  diffg,startg,endg: Integer;
  diffb,startb,endb: Integer;
  iend: Integer;
  rstepr,rstepg,rstepb,rstepw: Real;
  i,stepw: Word;

begin
  if Steps = 0 then
    Steps := 1;

  FromColor := ColorToRGB(FromColor);
  ToColor := ColorToRGB(ToColor);

  startr := (FromColor and $0000FF);
  startg := (FromColor and $00FF00) shr 8;
  startb := (FromColor and $FF0000) shr 16;
  endr := (ToColor and $0000FF);
  endg := (ToColor and $00FF00) shr 8;
  endb := (ToColor and $FF0000) shr 16;

  diffr := endr - startr;
  diffg := endg - startg;
  diffb := endb - startb;

  rstepr := diffr / steps;
  rstepg := diffg / steps;
  rstepb := diffb / steps;

  if Direction then
    rstepw := (R.Right - R.Left) / Steps
  else
    rstepw := (R.Bottom - R.Top) / Steps;

  with Canvas do
  begin
    for i := 0 to Steps - 1 do
    begin
      endr := startr + Round(rstepr*i);
      endg := startg + Round(rstepg*i);
      endb := startb + Round(rstepb*i);
      stepw := Round(i*rstepw);
      Pen.Color := endr + (endg shl 8) + (endb shl 16);
      Brush.Color := Pen.Color;
      if Direction then
      begin
        iend := R.Left + stepw + Trunc(rstepw) + 1;
        if iend > R.Right then
          iend := R.Right;
        Rectangle(R.Left + stepw,R.Top,iend,R.Bottom)
      end
      else
      begin
        iend := R.Top + stepw + Trunc(rstepw)+1;
        if iend > r.Bottom then
          iend := r.Bottom;
        Rectangle(R.Left, R.Top+stepw,R.Right,iend);
      end;
    end;
  end;
end;


{ TTIWAdvToolButton }
{$IFDEF TMSIW9}
procedure TTIWAdvToolButton.DoOnAsyncClick(AParams: TStringList);
begin
  if Assigned(OnAsyncClick) then
    OnAsyncClick(Self, AParams);
end;

function TTIWAdvToolButton.RenderAsync(
  AContext: TIWBaseHTMLComponentContext): TIWXMLTag;
var
  ImgPath, ImgName: string;
begin
  Result := TIWXMLTag.CreateTag('control');
  try
    Result.AddStringParam('id', HTMLName);
    Result.AddStringParam('type', 'TTIWADVTOOLBUTTON');
    RenderAsyncCommonProperties(AContext, Result);

   if GlyphURL <> EmptyStr then
     ImgPath := GlyphURL
   else if FGlyph.Empty then
     ImgPath := ''
   else
   begin
     {$IFDEF TMSIW71}
     ImgName := TIWServerControllerBase.NewCacheFile('bmp',true);
     {$ELSE}
     ImgName := TIWServerControllerBase.NewCacheFile('bmp');
     {$ENDIF}

     FGlyph.SaveToFile(ImgName);

     ImgPath := GetCacheDir(Self) + ExtractFileName(ImgName);
   end;

    GGetWebApplicationThreadVar.CallBackResponse.AddJavaScriptToExecute('<![CDATA['
      + 'document.getElementById("' + HTMLName + 'value").innerHTML = "' + Text + '";'#13
      + 'el = document.getElementById("' + HTMLName + 'glyph");'#13
      + 'if (el)'#13
      + '  el.src = "' + ImgPath + '";'#13
      +']]>');
  except
    FreeAndNil(Result);
  end;
end;
{$ENDIF}

constructor TTIWAdvToolButton.Create(AOwner: TComponent);
begin
  inherited;

  {$IFDEF TMSIW6}
  SetRenderSize(True);
  {$ELSE}
  FRenderSize := True;
  {$ENDIF}
//  FNeedsFormTag := True;
  {$IFDEF TMSIW6}
  {TODO}
  {$ELSE}
  FSupportedScriptEvents := 'OnClick';
  FSupportsInput := true;
  FSupportsSubmit := true;
  {$ENDIF}

  FText := EmptyStr;
  FEnabled := true;
  FGlyph := TIPicture.Create;

  FBackColor := clWebLIGHTCYAN;
  FBackColorTo := clWebLIGHTSTEELBLUE;
  FBackColorGradientDirection := gdVertical;
  FBorderColor := clWebLIGHTCYAN;

  FHotColor := clWebAZURE;
  FHotColorTo := clNone;
  FHotColorGradientDirection := gdVertical;
  //FHotBorderColor := clWebSTEELBLUE;

  FDownColor := clWebLIGHTSTEELBLUE;
  FDownColorTo := clNone;
  FDownColorGradientDirection := gdVertical;
  //FDownBorderColor := clWebSTEELBLUE;

  FDisabledColor := clWebSilver;
  FDisabledColorTo := clWebGRAY;
  FDisabledColorGradientDirection := gdVertical;

  FHotBorderColor := clNone;
  FDownBorderColor := clNone;

  FClientEvent := TStringList.Create;

  FFont := TIWFont.Create;
  FFont.FontName := 'Arial';
  FFont.Color := clBlack;
  FFont.Size := 10;

  if not (csDesigning in Componentstate) then
  begin
    {$IFDEF TMSIW51}
    TIWServer.AddInternalFile('IW_JS_ATBTN','/js/atbtn.js');
    {$ELSE}
    GIWServer.AddInternalFile('IW_JS_ATBTN');
    {$ENDIF}
  end;

end;

destructor TTIWAdvToolButton.Destroy;
begin
  inherited;
  FFont.Free;
  FClientEvent.Free;
  FGlyph.Free;
end;


{$IFDEF TMSIW6}
procedure TTIWAdvToolButton.IWPaint;
{$ELSE}
procedure TTIWAdvToolButton.Paint;
{$ENDIF}
var
  r : TRect;
begin
  Canvas.Font.Name := Font.FontName; 
  Canvas.Font.Size := Font.Size;
  Canvas.Font.Color := Font.Color;
  Canvas.Font.Style := Font.Style;

  with Canvas do
  begin

    r.Left := 0;
    r.Top := 0;
    r.Right := Width;
    r.Bottom := Height;
    if BackColorGradientDirection = gdVertical then
      DrawGradient(Canvas,FBackColor, FBackColorTo,80,r,False)
    else
      DrawGradient(Canvas,FBackColor, FBackColorTo,80,r,True);
    Brush.Style := bsClear;
    TextOut(Width div 2 - TextWidth(Text) div 2,Height div 2 - TextHeight(Text) div 2,Text);
  end;
end;

procedure TTIWAdvToolButton.SetGlyph(const Value: TIPicture);
begin
  FGlyph.Assign(Value);
  Invalidate;
end;

procedure TTIWAdvToolButton.SetGlyphURL(const Value: String);
begin
  FGlyphURL := Value;
  Invalidate;
end;

procedure TTIWAdvToolButton.SetText(const Value: String);
begin
  FText := Value;
  Invalidate;
end;

procedure TTIWAdvToolButton.SetClientEvent(const Value: TStringList);
begin
  FClientEvent.Assign(Value);
  Invalidate;
end;

procedure TTIWAdvToolButton.SetFont(const Value: TIWfont);
begin
  FFont.Assign(Value);
  Invalidate;
end;

procedure TTIWAdvToolButton.Submit(const AValue: string);
var
  s: string;
begin
  inherited;
  s := AValue;

  DoClick;

//  if Assigned(OnClick) then
//    OnClick(Self);
end;


{$IFDEF TMSIW6}
function TTIWAdvToolButton.RenderHTML(AContext: TIWBaseComponentContext): TIWHTMLTag;
{$ELSE}
function TTIWAdvToolButton.RenderHTML: TIWHTMLTag;
{$ENDIF}
var
  htmlres, ImgName, ImgPath: string;
  backColorStr, backColorToStr, bcGD, dcGD, hcGD, ceStr, eStr: string;
  ajaxcall, submitclick, fontname: string;
begin

  {$IFDEF TMSIW6}
  TIWComponent40Context(AContext).AddScriptFile('/js/atbtn.js');
  {$ELSE}
  AddScriptFile('/js/atbtn.js');
  {$ENDIF}

    backColorStr := '';
    backColorToStr := '';
    bcGD := '';

    if enabled then
    begin

      if BackColor <> clNone then
      begin
        backColorStr := ColorToRGBString(BackColor);
        if not BackColorTo <> clNone then
          backColorToStr := ColorToRGBString(BackColorTo);
      end;

      if BackColorGradientDirection = gdHorizontal then
        bcGD := '1'
      else
        bcGD := '0';

    end
    else
    begin

      backColorStr := ColorToRGBString(DisabledColor);
      if not DisabledColorTo <> clNone then
        backColorToStr := ColorToRGBString(DisabledColorTo);

      if DisabledColorGradientDirection = gdHorizontal then
        bcGD := '1'
      else
        bcGD := '0';

    end;


   dcGD := '';
   if DownColorGradientDirection = gdHorizontal then
    dcGD := '1'
   else
    dcGD := '0';

   hcGD := '';
   if HotColorGradientDirection = gdHorizontal then
    hcGD := '1'
   else
    hcGD := '0';

   //if ClientEvent.GetText = '' then
   // ceStr := ''
   //else
    ceStr := HTMLName;

   eStr := '';
   if Assigned(OnClick) or (ClientEvent.Text <> '') then
    eStr := HTMLName;                            

   if GlyphURL <> EmptyStr then
     ImgPath := GlyphURL
   else if FGlyph.Empty then
     ImgPath := ''
   else
   begin
     {$IFDEF TMSIW71}
     ImgName := TIWServerControllerBase.NewCacheFile('bmp',true);
     {$ELSE}
     ImgName := TIWServerControllerBase.NewCacheFile('bmp');
     {$ENDIF}

     FGlyph.SaveToFile(ImgName);

     ImgPath := GetCacheDir(Self) + ExtractFileName(ImgName);
   end;

   fontname := Font.FontName;
   if (Font.FontFamily <> EmptyStr) then
     fontname := Font.FontFamily;

    htmlres := '<script>atb_Create("'+Text+'","'+ ImgPath + '","font-family:'+
    fontname+';'+iif(fsBold in Font.Style, 'font-weight:bold;', '')
    + iif(fsItalic in Font.Style, 'font-style:italic;', '') +'color:'
    +ColorToRGBString(Font.Color)+';font-size:'+IntToStr(Font.Size)+'pt","'+
    backColorStr+'","'+backColorToStr+'","'+bcGD+'","'+ColorToRGBString(HotColor)+'","'+
    ColorToRGBString(HotColorTo)+'","'+
    hcGD+'","'+
    ColorToRGBString(HotBorderColor)+'","'+
    ColorToRGBString(DownColor) + '","'+
    ColorToRGBString(DownColorTo) + '","'+
    dcGD+'","'+
    ColorToRGBString(DownBorderColor)
    + '","center","'+IntToStr(Width)+'","'+IntToStr(Height)+'","'+eStr+'","'+ceStr+'",'+BoolToStr(Enabled)+',"'+ iif((BorderColor = clNone), ColorToRGBString(BackColor), ColorToRGBString(BorderColor)) +'");</script>';

    if Assigned(OnClick) then
      submitclick :=
        '  if ( (clk != '''') && (clk != undefined) && (! submitdone) ) '#13
        + '  {'#13
//          + '    submitdone = true;'#13                                                                                    
//          + '    tbclick = clk;'#13
//          + '    return setTimeout("SubmitClick(tbclick,''click'');",1500);'#13
//          + '    return SubmitClick(clk,"click");'#13
          + '    return SubmitClickConfirm("' + HTMLName + '", "", true, "");'#13
        + '  }'#13;

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

      submitclick := '';
    end;

    Acontext.WebApplication.RegisterCallBack(HTMLName+'.DoOnAsyncClick', DoOnAsyncClick);
    {$ENDIF}

    htmlres := htmlres
      + '<script>'#13
//        + 'var tbclick;'#13
      + 'var submitdone = false;'#13
      + 'function '+HTMLName+'cef(clk){'#13
      + ClientEvent.Text
      + ajaxcall
      + submitclick
      + '}'#13
      + '</script>'#13;

  Result := TIWHTMLTag.CreateTag('DIV');
  Result.AddStringParam('onkeyup', 'if ((event.keyCode == 13) || (event.keyCode == 32)) ' + HTMLName + 'cef(''' + HTMLName + ''')');
  Result.Contents.AddText(htmlres);
end;



end.
