{***************************************************************************}
{ TMS IntraWeb Component Pack Pro                                           }
{ for Delphi & C++Builder                                                   }
{                                                                           }
{ written by TMS Software                                                   }
{            copyright © 2002 - 2013                                        }
{            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
  Windows, Graphics, Controls, IWPicCntnr, Forms, Types,
  Classes,
  IWControl, IWTypes, IWCompEdit, IWFont, IWTMSImg,
  IWCompLabel, IWHTMLTag, IWTMSBase, IWColor, TypInfo,
  IWRenderContext, IWXMLTag
  {$IFDEF TMSIW121}
  ,IWCompExtCtrls
  {$ELSE}
  ,IWExtCtrls
  {$ENDIF}
  {$IFDEF DELPHIXE2_LVL}
  , System.UITypes
  {$ENDIF}
  ;

type

  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;
    FOnAsyncButtonClick: TIWAsyncEvent;

    procedure DoOnAsyncButtonClick(AParams: 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;
    procedure SetEnabledProperty(const Value: boolean);
  protected
    procedure Submit(const AValue: string); override;
  public
    procedure IWPaint; override;
    function RenderHTML(AContext: TIWBaseComponentContext): TIWHTMLTag; override;
    function RenderAsync(AContext: TIWBaseHTMLComponentContext): TIWXMLTag; override;
    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 SetEnabledProperty;
    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;
//    Fix: async click was called even with enabled set to false
//    property OnAsyncClick;
      property OnAsyncClick: TIWAsyncEvent read FOnAsyncButtonClick write FOnAsyncButtonClick;
  end;


implementation

uses
  ImgList, ShellAPI, CommCtrl,
  IWApplication, IWServerControllerBase, TMSIWStrings, TMSIWSystem,
  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 }
procedure TTIWAdvToolButton.DoOnAsyncButtonClick(AParams: TStringList);
begin
  if Assigned(OnAsyncClick) then
    OnAsyncClick(Self, AParams);
end;

function TTIWAdvToolButton.RenderAsync(
  AContext: TIWBaseHTMLComponentContext): TIWXMLTag;
var
  js, ImgPath: 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
     ImgPath := TIWAppCache.GraphicToCacheFile(FGlyph, FGlyph.GetImageType);

   js := 'document.getElementById("' + HTMLName + 'value").innerHTML = "' + Text + '";'#13
      + 'el = document.getElementById("' + HTMLName + 'glyph");'#13
      + 'if (el)'#13
      + '  el.src = "' + ImgPath + '";'#13;

   if Enabled then
     js := js + HTMLName + 'Enabled = true;'#13
   else
     js := js + HTMLName + 'Enabled = false;'#13;

    GGetWebApplicationThreadVar.CallBackResponse.AddJavaScriptToExecute('<![CDATA['+ js +']]>');
  except
    FreeAndNil(Result);
  end;
end;

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

  {$IFNDEF TMSIW121}
  SetRenderSize(true);
  {$ENDIF}
//  FNeedsFormTag := True;
//  FSupportedScriptEvents := 'OnClick';
//  FSupportsInput := true;
//  FSupportsSubmit := true;

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

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

procedure TTIWAdvToolButton.IWPaint;
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
    begin
      if FBackColorTo = clNone then
        DrawGradient(Canvas,FBackColor, FBackColor,80,r,False)
      else
        DrawGradient(Canvas,FBackColor, FBackColorTo,80,r,False)
    end
    else
    begin
      if FBackColorTo = clNone then
        DrawGradient(Canvas,FBackColor, FBackColor,80,r,True)
      else
        DrawGradient(Canvas,FBackColor, FBackColorTo,80,r,True)
    end;

    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.SetEnabledProperty(const Value: boolean);
begin
  FEnabled := 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;


function TTIWAdvToolButton.RenderHTML(AContext: TIWBaseComponentContext): TIWHTMLTag;
var
  htmlres, ImgPath: string;
  backColorStr, backColorToStr, bcGD, dcGD, hcGD, ceStr, eStr: string;
  ajaxcall, submitclick, fontname: string;
  bgcolor, bgcolorto: tiwcolor;
  bgcolordirection: TTIWGradientDirection;
//IW121
//  fbrowsertype: TIWBrowser;
  fbrowsertype: TTMSBrowser;
  browsername: string;
begin

  TIWComponent40Context(AContext).AddScriptFile('/js/atbtn.js');

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

    if enabled then
    begin
      bgcolor := BackColor;
      bgcolorto := BackColorTo;
      bgcolordirection := BackColorGradientDirection;

      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

      bgcolor := DisabledColor;
      bgcolorto := DisabledColorTo;
      bgcolordirection := DisabledColorGradientDirection;

      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 <> '') or Assigned(FOnAsyncButtonClick) then
    eStr := HTMLName;                            

   if GlyphURL <> EmptyStr then
     ImgPath := GlyphURL
   else if FGlyph.Empty then
     ImgPath := ''
   else
     ImgPath := TIWAppCache.GraphicToCacheFile(FGlyph, FGlyph.GetImageType);

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

    //IW121
    //FBrowserType := AContext.WebApplication.Browser;
    FBrowserType := GetTMSBrowser(AContext);

    browsername := GetEnumName(TypeInfo(TTMSBrowser),integer(FBrowserType));

    if IsBrowserIe10(AContext) then
      browsername := 'brIE10';

    htmlres := '<script>atb_Create("'
//    + GetEnumName(TypeInfo(TIWBrowser),integer(FBrowserType)) + '","'
    + browsername + '","'
    + GradientStyle(bgcolor, bgcolor, bgcolorto, clNone, bgcolordirection, AContext, false) + '","'
    + GradientStyle(HotColor, HotColor, HotColorTo, clNone, HotColorGradientDirection, AContext, false) + '","'
    + GradientStyle(DownColor, DownColor, DownColorTo, clNone, DownColorGradientDirection, AContext, false) + '","'
    +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 Enabled then
//    begin
      if Assigned(OnClick) then
        submitclick :=
          '  if ( (clk != '''') && (clk != undefined) && (! submitdone) ) '#13
          + '  {'#13
          //Fix the TIWFile.FileValue value is not submitted when using SubmitClick
          + ' if (typeof SubmitNextFile == "function") {'#13
          + ' SubmitNextFile(''' + HTMLName + ''','''');return true;'#13
          + ' } else '#13
          + '    return SubmitClickConfirm("' + HTMLName + '", "", true, "");'#13
          + '  }'#13;

      if Assigned(FOnAsyncButtonClick) then
      begin
        ajaxcall := 'processAjaxEvent(''onClick'', '
          + HTMLControlImplementation.IWCLName
          + ',''' + HTMLName + '.' + 'DoOnAsyncButtonClick' + ''','
          + 'true' + ', null, '
          + 'true' + ');';

        submitclick := '';
      end;

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

//    end;

    htmlres := htmlres
      + '<script>'#13
//        + 'var tbclick;'#13
      + 'var submitdone = false;'#13;

    if Enabled then
      htmlres := htmlres + 'var ' + HTMLName + 'Enabled = true;'#13
    else
      htmlres := htmlres + 'var ' + HTMLName + 'Enabled = false;'#13;

    htmlres := htmlres
      + 'function '+HTMLName+'cef(clk){'#13
      + '  if (' + HTMLName + 'Enabled){'#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 + ''')');

//Fix: async click was called even with enabled set to false
//  if Assigned(FOnAsyncButtonClick) then
//    Result.AddStringParam('onmouseup', '' + HTMLName + 'cef(''' + HTMLName + ''')');

  Result.Contents.AddText(htmlres);
end;

initialization

//  if not (csDesigning in Componentstate) then
//    TIWServer.AddInternalFile('IW_JS_ATBTN','/js/atbtn.js');
    TMSAddInternalFile('IW_JS_ATBTN','/js/atbtn.js');

end.
