{***************************************************************************}
{ TMS IntraWeb Component Pack Pro                                           }
{ for Delphi & C++Builder                                                   }
{ version 2.2                                                               }
{                                                                           }
{ 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 IWHelpTip;

{$I TMSDEFS.INC}
interface
{$R tmsiwht.res}
{$R tmsiwhtcss.res}

uses
  Controls, Windows, Graphics, IWPicCntnr, IWTMSImg,
  {$IFDEF DELPHI6_LVL}
  Types,
  {$ENDIF}
  IWColor, Classes, IWControl, IWTypes, SysUtils, IWHTMLTag,
  IWCompEdit, IWCompLabel, IWCompCheckbox, IWTMSBase, IWFont,
  IWRenderContext
  {$IFDEF TMSIW121}
  ,IWCompExtCtrls
  {$ELSE}
  ,IWExtCtrls
  {$ENDIF}
  ;

type
  TGradientDirection = (gdHorizontal, gdVertical);

  TFilter = (fiGradient, fiShadow, fiTransparency, fiNone);

  TTIWHelpTip = class(TIWControl)
  private
    FBackgroundColor : TIWColor;
    FBackgroundColorTo : TIWColor;
    FFilter : TFilter;
    FFont : TIWFont;
    FGradientDirection : TGradientDirection;
    FHoverColor : TIWColor;
    FImage : TIPicture;
    FLinesHelp : TStringList;
    FLinesText : TStringList;
    FLinkColor : TIWColor;
    FTransparency : Integer;
    FTabOrder : Integer;

    procedure SetBackgroundColor(const Value : TIWColor);
    procedure SetBackgroundColorTo(const Value : TIWColor);
    procedure SetFilter(const Value : TFilter);
    procedure SetFont(const  Value : TIWFont);
    procedure SetGradientDirection(const Value : TGradientDirection);
    procedure SetHoverColor(const Value : TIWColor);
    procedure SetImage(const Value : TIPicture);
    procedure SetLinesHelp(const Value : TStringList);
    procedure SetLinesText(const Value : TStringList);
    procedure SetLinkColor(const Value : TIWColor);
    procedure SetTransparency(const Value : Integer);
  protected
    procedure IWPaint; override;
    function get_ShouldRenderTabOrder: Boolean; override;
    procedure Submit(const AValue: string); override;
    function HTMLClr(Color: TIWColor):string;
    procedure InitLinesText;
  public
    function get_HasTabOrder: boolean; override;
    //procedure SetValue(const AValue: String); override;
    function RenderHTML(AContext: TIWBaseComponentContext): TIWHTMLTag; override;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property BackgroundColor : TIWColor read FBackgroundColor write SetBackgroundColor;
    property BackgroundColorTo : TIWColor read FBackgroundColorTo write SetBackgroundColorTo;
    property Filter : TFilter read FFilter write SetFilter;
    property Font : TIWFont read FFont write SetFont;
    property GradientDirection : TGradientDirection read FGradientDirection write SetGradientDirection;
    property HoverColor : TIWColor read FHoverColor write SetHoverColor;
    property Image : TIPicture read FImage write SetImage;
    property LinesHelp : TStringList read FLinesHelp write SetLinesHelp;
    property LinesText : TStringList read FLinesText write SetLinesText;
    property LinkColor : TIWColor read FLinkColor write SetLinkColor;
    property Transparency : Integer read FTransparency write SetTransparency;
    property TabOrder : Integer read FTabOrder write FTabOrder default -1;
  end;

implementation

uses
  ImgList, ShellAPI, CommCtrl,
  IWApplication, IWServerControllerBase, TMSIWStrings, TMSIWSystem, IWAppForm, IWServer;

{ TTIWHelpTip }

constructor TTIWHelpTip.Create(AOwner: TComponent);
begin
  inherited;
  FBackgroundColor := clInfoBk;
  FBackgroundColorTo := clNone;
  FFilter := fiShadow;
  FFont := TIWFont.Create;
  FFont.Color := clBlack;
  FGradientDirection := gdVertical;
  FHoverColor := clRed;
  FImage := TIPicture.Create;
  FLinesHelp := TStringList.Create;
  FLinesText := TStringList.Create;
  FTabOrder := -1;
  FTransparency := 100;
  Self.Width := 120;
  Self.Height := 25;

  {$IFNDEF TMSIW121}
  SetRenderSize(true);
  {$ENDIF}
//  FSupportsInput := True;
//  FSupportsSubmit := True;
//  FEditable := True;
end;

destructor TTIWHelpTip.Destroy;
begin
  FFont.Free;
  FImage.Free;
  FLinesHelp.Free;
  FLinesText.Free;
  inherited;
end;

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

procedure TTIWHelpTip.IWPaint;
var
  i: Integer;
  txt: string;
  r: TRect;
begin
  txt := '';
  for i := 0 to LinesText.Count - 1 do
    txt := txt + LinesText[i];

  if (txt = '') then
    txt := 'HelpTip Control';


  r := GetClientRect;

  if not (Image.Empty) then
    Canvas.StretchDraw(r,Image)
  else
  begin
    Canvas.Font.Color := LinkColor;
    Canvas.Font.Size := 10;
    Canvas.TextRect(r,3,3,txt);
  end;
end;

procedure TTIWHelpTip.InitLinesText;
begin
  FLinesText.Clear;
  FlinesText.Add('HelpTip Control');
end;

function TTIWHelpTip.RenderHTML(AContext: TIWBaseComponentContext): TIWHTMLTag;
var
  CssCode : string;
  StrFilter : string;
//  GradDir : string;
  Html : string;
  Url : string;
  LinesT : string;
  LinesH : string;
  i : Integer;
  tabidx : string;
  GradDir: TTIWGradientDirection;
begin

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

  CssCode := GetResourceText('TMSIWHTCSS');
  CssCode := StringReplace(CssCode,'<#ID>', HTMLName,[rfReplaceAll, rfIgnoreCase]);

  if (Self.Image.Empty) then
  begin
    CssCode := StringReplace(CssCode, '<#LINKBORDER>', 'border-bottom: 1px dashed <#COLORLINK>;',[rfReplaceAll, rfIgnoreCase]);
    CssCode := StringReplace(CssCode, '<#HOVERBORDER>', 'border-bottom:1px dashed <#COLORHOVERLINK>;', [rfReplaceAll, rfIgnoreCase]);
  end
  else
  begin
    CssCode := StringReplace(CssCode, '<#LINKBORDER>', '', [rfReplaceAll, rfIgnoreCase]);
    CssCode := StringReplace(CssCode, '<#HOVERBORDER>', '', [rfReplaceAll, rfIgnoreCase]);
  end;

  if (BackgroundColor = clNone) then
    CssCode := StringReplace(CssCode, '<#BACKCOLOR>', HTMLClr(clInfoBk),[rfReplaceAll, rfIgnoreCase])
  else
    CssCode := StringReplace(CssCode, '<#BACKCOLOR>', HTMLClr(BackgroundColor), [rfReplaceAll, rfIgnoreCase]);

  if (Font.Color = clNone) then
    CssCode := StringReplace(CssCode, '<#FONTCOLORTOOLTIP>', HTMLClr(clBlack),[rfReplaceAll, rfIgnoreCase])
  else
    CssCode := StringReplace(CssCode, '<#FONTCOLORTOOLTIP>', HTMLClr(Font.Color),[rfReplaceAll, rfIgnoreCase]);

  if (HoverColor = clNone) then
    CssCode := StringReplace(CssCode, '<#COLORHOVERLINK>', HTMLClr(clRed),[rfReplaceAll, rfIgnoreCase])
  else
    CssCode := StringReplace(CssCode, '<#COLORHOVERLINK>', HTMLClr(HoverColor),[rfReplaceAll, rfIgnoreCase]);

  if (LinkColor = clNone) then
    CssCode := StringReplace(CssCode, '<#COLORLINK>', HTMLClr(clGreen),[rfReplaceAll, rfIgnoreCase])
  else
    CssCode := StringReplace(CssCode, '<#COLORLINK>', HTMLClr(LinkColor),[rfReplaceAll, rfIgnoreCase]);

  if (Font.FontFamily <> EmptyStr) then
      CssCode := StringReplace(CssCode, '<#FONTLINK>', Font.FontFamily,[rfReplaceAll, rfIgnoreCase])
  else

  if (Font.FontName <> EmptyStr)  then
      CssCode := StringReplace(CssCode, '<#FONTLINK>', Font.FontName,[rfReplaceAll, rfIgnoreCase])
  else
      CssCode := StringReplace(CssCode, '<#FONTLINK>', '',[rfReplaceAll, rfIgnoreCase]);

  CssCode := StringReplace(CssCode, '<#SIZELINK>', IntToStr(Font.Size) ,[rfReplaceAll, rfIgnoreCase]);


  StrFilter := '';
  case Filter of
    fiNone: StrFilter := '';
    fiGradient:
    begin
      if (not (BackgroundColor = clNone) and not (BackgroundColorTo = clNone)) then
      begin
//        GradDir := '1';
        GradDir := IWTMSBase.gdHorizontal;
        if (GradientDirection = gdVertical) then
//          GradDir := '0';
            GradDir := IWTMSBase.gdVertical;

//        StrFilter := 'filter : progid:DXImageTransform.Microsoft.Gradient(GradientType='
//        + GradDir + ', StartColorStr=' + HTMLClr(BackgroundColor) + ',EndColorStr=' + HTMLClr(BackgroundColorTo) + ');';
          StrFilter := GradientStyle(BackgroundColor, BackgroundColor, BackgroundColorTo, clNone, GradDir, AContext, true);
      end
      else
        StrFilter := '';
    end;
    fiShadow:  StrFilter := 'filter: progid:DXImageTransform.Microsoft.Shadow(color="#777777", Direction=135, Strength=3);';
    fiTransparency : StrFilter := 'opacity:' + StringReplace(FloatToStr(Transparency/100), ',', '.', [])  + '; filter : alpha(opacity=' + IntToStr(Transparency) + ');';
    else
      StrFilter := '';
  end;

  CssCode := StringReplace(CssCode,'<#FILTER>', StrFilter, [rfReplaceAll, rfIgnoreCase]);
  CssCode := '<style type="text/css">'
      + CssCode + '</style>';

  Html := '';

  if ((LinesText.Text = '') and (Image.Empty)) then
    InitLinesText();

  LinesH := '';
  for i := 0 to LinesHelp.Count - 1 do
    LinesH := LinesH + LinesHelp[i];

  Html := Html
    + '<script> var ' + HTMLName + 'textToDisplay = ''' + StringReplace(LinesH, '''', '&#39;', [rfReplaceAll]) + ''';'#13
    + '</script>'#13
    + '<script> function ' + HTMLName + 'displayText() {'#13;

  if not (Image.Empty) then
  begin
    Url := TIWAppCache.GraphicToCacheFile(Image, Image.GetImageType);
    Html := Html
       + 'document.write(''<img align="middle" src="' + Url + '" border="0">&nbsp;'');'#13;
  end;

  LinesT := '';

  for i:=0 to LinesText.Count - 1 do
    LinesT := LinesT + LinesText[i];

    tabidx := '';
    if (TabOrder >= 0) then
      tabidx := ' tabindex="'+IntToStr(TabOrder+1)+'" '
    else
      tabidx := ' tabindex="-1" ';

  Html := Html
    + 'document.write(''' + LinesT + ''');'#13
    + '}'
    + '</script>'#13

    + '<a '+tabidx+' id="' + HTMLName + '" class="'
    + HTMLName + 'helpLink" href="#*" onclick=''return showHelpTip("' + HTMLName
    + '",event,' + HTMLName + 'textToDisplay,true); return false;''><script>'
    + HTMLName + 'displayText();</script></a><br><br>';       

  Result := TIWHTMLTag.CreateTag('DIV');

  Result.Contents.AddText(cssCode);
  Result.Contents.AddText(Html);
  with Result.Contents.AddTag('INPUT') do
  begin
    AddStringParam('TYPE','hidden');
    AddStringParam('NAME',HTMLName);
    AddStringParam('ID',HTMLName+'_INPUT');
  end;
end;

function TTIWHelpTip.get_HasTabOrder: Boolean;
begin
  Result := true;
end;

function TTIWHelpTip.get_ShouldRenderTabOrder: boolean;
begin
  Result := false;
end;

procedure TTIWHelpTip.SetBackgroundColor(const Value: TIWColor);
begin
  FBackgroundColor := Value;
end;

procedure TTIWHelpTip.SetBackgroundColorTo(const Value: TIWColor);
begin
  FBackgroundColorTo := Value;
end;

procedure TTIWHelpTip.SetFilter(const Value: TFilter);
begin
  FFilter := Value;
end;

procedure TTIWHelpTip.SetFont(const Value: TIWFont);
begin
  FFont.Assign(Value);
end;

procedure TTIWHelpTip.SetGradientDirection(
  const Value: TGradientDirection);
begin
  FGradientDirection := Value;
end;

procedure TTIWHelpTip.SetHoverColor(const Value: TIWColor);
begin
  FHoverColor := Value;
end;

procedure TTIWHelpTip.SetImage(const Value: TIPicture);
begin
  FImage.Assign(Value);
end;

procedure TTIWHelpTip.SetLinesHelp(const Value: TStringList);
begin
  FLinesHelp.Assign(Value);
end;

procedure TTIWHelpTip.SetLinesText(const Value: TStringList);
begin
  FLinesText.Assign(Value);
end;

procedure TTIWHelpTip.SetLinkColor(const Value : TIWColor);
begin
  FLinkColor := Value;
end;

procedure TTIWHelpTip.SetTransparency(const Value: Integer);
begin
  FTransparency := Value;
end;

procedure TTIWHelpTip.Submit(const AValue: string);
begin
  inherited;

end;

initialization

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

end.
