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

{$I TMSDEFS.INC}
interface
{$R tmsiwht.res}                       
{$R tmsiwhtcss.res}                                           
                                                               
uses                                           
  {$IFDEF LINUX}                                             
  QControls, QGraphics, QIWPicCntnr,                         
  {$ELSE}
  Controls, Windows, Graphics, IWPicCntnr, IWTMSImg,
  {$ENDIF}
  {$IFDEF DELPHI6_LVL}
  Types,
  {$ENDIF}
  {$IFDEF TMSIW51}
  IWColor,
  {$ENDIF}
  Classes,
  IWControl, IWTypes, SysUtils, IWHTMLTag,
  IWCompEdit, IWCompLabel, IWCompCheckbox, IWExtCtrls, IWTMSBase, IWFont
  {$IFDEF TMSIW6}
  ,IWRenderContext
  {$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
    {$IFDEF TMSIW6}
    procedure IWPaint; override;
    {$ELSE}
    procedure Paint; override;
    {$ENDIF}
    {$IFDEF TMSIW72_NEW}
    function get_ShouldRenderTabOrder: Boolean; override;
    {$ENDIF}
    procedure Submit(const AValue: string); override;
    function HTMLClr(Color: TIWColor):string;
    procedure InitLinesText;
  public
    {$IFDEF TMSIW72}
    function get_HasTabOrder: boolean; override;
    {$ENDIF}
    //procedure SetValue(const AValue: String); override;
    {$IFDEF TMSIW6}
    function RenderHTML(AContext: TIWBaseComponentContext): TIWHTMLTag; override;
    {$ELSE}
    function RenderHTML: TIWHTMLTag; override;
    {$ENDIF}
    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
  {$IFDEF LINUX}
  QImgList,
  {$ELSE}
  ImgList, ShellAPI, CommCtrl,
  {$ENDIF}
  IWApplication, IWServerControllerBase,
  SWStrings, SWSystem, 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;

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

  {$IFDEF TMSIW6}
  SetRenderSize(True);
  {$ELSE}
  FRenderSize := True;
  {$ENDIF}
  {$IFDEF TMSIW6}
  {TODO}
  {$ELSE}
  FSupportsInput := True;
  FSupportsSubmit := True;
  FEditable := True;
  {$ENDIF}

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;

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

{$IFDEF TMSIW6}
function TTIWHelpTip.RenderHTML(AContext: TIWBaseComponentContext): TIWHTMLTag;
{$ELSE}
function TTIWHelpTip.RenderHTML: TIWHTMLTag;
{$ENDIF}
var
  CssCode : string;
  StrFilter : string;
  GradDir : string;
  Html : string;
  Url : string;
  LinesT : string;
  LinesH : string;
  i : Integer;
  tabidx : string;
begin

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

  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]);

  {$IFDEF TMSIW6}
  if (Font.FontFamily <> EmptyStr) then
      CssCode := StringReplace(CssCode, '<#FONTLINK>', Font.FontFamily,[rfReplaceAll, rfIgnoreCase])
  else
  {$ENDIF}
  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';
        if (GradientDirection = gdVertical) then
          GradDir := '0';

        StrFilter := 'filter : progid:DXImageTransform.Microsoft.Gradient(GradientType='
        + GradDir + ', StartColorStr=' + HTMLClr(BackgroundColor) + ',EndColorStr=' + HTMLClr(BackgroundColorTo) + ');';
      end
      else
        StrFilter := '';
    end;
    fiShadow:  StrFilter := 'filter: progid:DXImageTransform.Microsoft.Shadow(color="#777777", Direction=135, Strength=3);';
    fiTransparency : StrFilter := '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 = ''' + LinesH + ''';'#13
    + '</script>'#13
    + '<script> function ' + HTMLName + 'displayText() {'#13;

  if not (Image.Empty) then
  begin
    if (Image.IsGIF) then
    {$IFDEF TMSIW71}
      Url := TIWServerControllerBase.NewCacheFile('gif',true)
    {$ELSE}
      Url := TIWServerControllerBase.NewCacheFile('gif')
    {$ENDIF}
    else
    {$IFDEF TMSIW71}
      Url := TIWServerControllerBase.NewCacheFile('jpg',true);
    {$ELSE}
      Url := TIWServerControllerBase.NewCacheFile('jpg');
    {$ENDIF}

    Image.SaveToFile(Url);

    Html := Html
       + 'document.write(''<img align="middle" src="' + GetCachedir(Self) + ExtractFileName(Url) + '" border="0">&nbsp;'');'#13;
  end;

  LinesT := '';

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

    tabidx := '';
//    {$IFDEF TMSIW72_NEW}
    if (TabOrder >= 0) then
      tabidx := ' tabindex="'+IntToStr(TabOrder+1)+'" '
    else
      tabidx := ' tabindex="-1" ';
  //  {$ENDIF}

  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;

{$IFDEF TMSIW72}
function TTIWHelpTip.get_HasTabOrder: Boolean;
begin
  {$IFDEF TMSIW72_NEW}
  Result := true;
  {$ELSE}
  Result := false;
  {$ENDIF}
end;
{$ENDIF}

{$IFDEF TMSIW72_NEW}
function TTIWHelpTip.get_ShouldRenderTabOrder: boolean;
begin
  Result := false;
end;
{$ENDIF}

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;

end.
