{***************************************************************************}
{ 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 IWGradient;

interface
                                                                
{$I TMSDEFS.INC}


uses
  Controls, Graphics, Forms, Windows, IWPicCntnr,
  {$IFDEF DELPHI6_LVL}
  Types,
  {$ENDIF}
  Classes,
  {$IFDEF TMSIW51}
  IWBaseControl, IWColor,
  {$ENDIF}
  IWControl, IWTypes, SysUtils, IWCompButton,
  IWCompEdit, IWCompLabel, IWCompCheckbox, IWExtCtrls, IWHTMLTag, IWCompListbox,
  IWTMSBase,IWCompRectangle
  {$IFDEF TMSIW6}
  , IWRenderContext
  {$ENDIF}
  {$IFDEF TMSIW7}
  , IWBaseHTMLControl, IWScriptEvents
  {$ENDIF}
  ;

type
  TTIWGradientDirection = (gdHorizontal, gdVertical);

  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;
    {$IFDEF TMSIW6}
    procedure IWPaint; override;
    {$ELSE}
    procedure Paint; override;
    {$ENDIF}
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    {$IFDEF TMSIW6}
    function RenderHTML(AContext: TIWBaseComponentContext): TIWHTMLTag; override;
    {$ELSE}
    function RenderHTML: TIWHTMLTag; override;
    {$ENDIF}
  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;

{$IFDEF TMSIW6}
function TTIWGradient.RenderHTML(AContext: TIWBaseComponentContext): TIWHTMLTag;
{$ELSE}
function TTIWGradient.RenderHTML: TIWHTMLTag;
{$ENDIF}
var
  html,GradientType: string;

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

begin
  {$IFDEF TMSIW6}
  if (AContext.WebApplication.Browser = brIE) then
  {$ELSE}
  if (WebApplication.Browser = brIE) then
  {$ENDIF}
  begin
    if Direction = gdHorizontal then
      GradientType := '1'
    else
      GradientType := '0';

    html := '<table height="' + IntToStr(Height) + 'px" width="' + IntToStr(Width)
          + 'px" cellpadding="0" cellspacing="0"><tr><td style="'
          {$IFDEF TMSIW6}
          + Font.FontToStringStyle(AContext.WebApplication.Browser) + '"'
          {$ELSE}
          + Font.FontToStringStyle(WebApplication.Browser) + '"'
          {$ENDIF}
          + MakeAlign(Alignment) + ' STYLE="FILTER: progid:DXImageTransform.Microsoft.Gradient(GradientType=' + GradientType
          + ', StartColorStr=' + HTMLClr(Color)+',EndColorStr='+HTMLClr(ColorTo)+')" ><div style="overflow:hidden;height:'
          + IntToStr(Height) + 'px;width:' + IntToStr(Width) + 'px">' + Text + '</div></td></tr></table>';
  end
  else
  begin
    html := '<table height="' + IntToStr(Height) + 'px" width="' + IntToStr(Width)
          + 'px" cellpadding="0" cellspacing="0"><tr><td style="'
          {$IFDEF TMSIW6}
          + Font.FontToStringStyle(AContext.WebApplication.Browser)
          {$ELSE}
          + Font.FontToStringStyle(WebApplication.Browser)
          {$ENDIF}
          + '; background-color:' + HTMLClr(Color) + '"'
          + MakeAlign(Alignment) + '><div style="overflow:hidden;height:'
          + IntToStr(Height) + 'px;width:' + IntToStr(Width) + 'px">' + Text + '</div></td></tr></table>';
  end;

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

{$IFDEF TMSIW6}
procedure TTIWGradient.IWPaint;
{$ELSE}
procedure TTIWGradient.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 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.

