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

interface

{$I TMSDEFS.INC}


uses
  Controls, Graphics, Forms, Windows, IWPicCntnr, Types,
  Classes, IWBaseControl, IWColor, IWControl, IWTypes, SysUtils, IWCompButton,
  IWCompEdit, IWCompLabel, IWCompCheckbox, IWHTMLTag, IWCompListbox,
  IWTMSBase,IWCompRectangle, IWRenderContext, IWBaseHTMLControl, IWScriptEvents
  {$IFDEF TMSIW121}
  ,IWCompExtCtrls
  {$ELSE}
  ,IWExtCtrls
  {$ENDIF}
  {$IFDEF DELPHIXE2_LVL}
  , System.UITypes
  {$ENDIF}
  ;

type

  TTIWGradient = class(TIWCustomRectangle)
  private
    FColor : TIWColor;
    FColorTo : TIWColor;
    FDirection : TTIWGradientDirection;
    FAlignment: TAlignment;
    procedure SetColor(const Value : TIWColor);
    procedure SetColorTo(const Value : TIWColor);
    procedure SetDirection(const Value : TTIWGradientDirection);
    procedure SetAlignment(const Value : TAlignment);
    procedure DrawGradient(Canvas: TCanvas; FromColor, ToColor: TIWColor; Steps: Integer; r:TRect; Direction: Boolean);
  protected
    function HTMLClr(Color: TIWColor):string;
    procedure IWPaint; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function RenderHTML(AContext: TIWBaseComponentContext): TIWHTMLTag; override;
  published
    property Alignment : TAlignment read FAlignment write SetAlignment;
    property Color : TIWColor read FColor write SetColor;
    property ColorTo : TIWColor read FColorTo write SetColorTo;
    property Direction : TTIWGradientDirection read FDirection write SetDirection;
  end;

implementation

uses
  ShellAPI;


{ TTIWGradient }
constructor TTIWGradient.Create(AOwner: TComponent);
begin
  inherited;
  Height := 20;
  Color := clSilver;
  ColorTo := clWhite;
  Font.FontName := 'Verdana';
end;

destructor TTIWGradient.Destroy;
begin
  inherited;
end;

function TTIWGradient.HTMLClr(Color: TIWColor): string;
begin
  Result := ColorToRGBString(Color);
end;

procedure TTIWGradient.SetColor(const Value: TIWColor);
begin
  FColor := Value;
  Invalidate;
end;

procedure TTIWGradient.SetColorTo(const Value: TIWColor);
begin
  FColorTo := Value;
  Invalidate;
end;

procedure TTIWGradient.SetDirection(const Value : TTIWGradientDirection);
begin
  FDirection := Value;
  Invalidate;
end;

procedure TTIWGradient.SetAlignment(const Value : TAlignment);
begin
  FAlignment := Value;
end;

function TTIWGradient.RenderHTML(AContext: TIWBaseComponentContext): TIWHTMLTag;
var
  html, style, GradientType: string;

  function MakeAlign(AAlignment: TAlignment):string;
  begin
    Result := '';
    case AAlignment of
      taRightJustify: Result := 'text-align:right;';
      taCenter: Result := 'text-align:center;';
    end;
  end;

begin

  if Direction = gdHorizontal then
    GradientType := '1'
  else
    GradientType := '0';

  html :=
      '<table style="height:100%;width:100%;'
      + MakeAlign(Alignment)
      + Font.FontToStringStyle(AContext.WebApplication.Browser)
      + '" cellpadding="0" cellspacing="0">'
      + '<tr><td valign="middle">' + Text + '</td></tr></table>';

  style :=
  'height:' + IntToStr(Height) + 'px;'
  + 'overflow:hidden;background-color:' + HTMLClr(Color) +';';
//  + 'FILTER: progid:DXImageTransform.Microsoft.Gradient(GradientType=' + GradientType
//          + ', StartColorStr=' + HTMLClr(Color)+',EndColorStr='+HTMLClr(ColorTo)+')';

  style := style + GradientStyle(Color, Color, ColorTo, clNone, Direction, AContext, true);

  Result := TIWHTMLTag.CreateTag('DIV');
  Result.AddStringParam('style', style);
  Result.Contents.AddText(html);
end;

procedure TTIWGradient.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 Direction = gdVertical then
      DrawGradient(Canvas,FColor, FColorTo,80,r,False)
    else
      DrawGradient(Canvas,FColor, FColorTo,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 TTIWGradient.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;


end.

