{***************************************************************************}
{ 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 IWTMSPopup;
{$I TMSDEFS.INC}

interface
{$R tmsiwpopupmenuxp.res}
{$R tmsiwdocpopupmenu.res}

uses
  {$IFDEF LINUX}
  QControls, QGraphics, QIWPicCntnr, QMenus,
  {$ELSE}
  Controls, Windows, Graphics, IWPicCntnr, IWTMSImg, Menus,
  {$ENDIF}
  {$IFDEF DELPHI6_LVL}
  Types,
  {$ENDIF}
  Classes,
  IWControl, IWTypes, SysUtils,
  IWHTMLTag, IWFont,
  IWCompEdit, IWCompLabel, IWCompCheckbox, IWExtCtrls, IWTMSBase
  {$IFDEF TMSIW51}
  , IWColor
  {$ENDIF}
  {$IFDEF TMSIW6}
  , IWRenderContext
  {$ENDIF}
  {$IFDEF TMSIW9}
  , IWXMLTag
  {$ENDIF}
  ;

type
  TStaticMenuLayout = (smlVertical,smlHorizontal);

  TIWMenuClickEvent = procedure(Sender: TObject; ItemIdx: Integer) of object;

  {$IFDEF TMSIW9}
  TIWAsyncMenuEvent = procedure (Sender: TObject; EventParams: TStringList; AMenuItem: TMenuItem) of object;
  {$ENDIF}

  TIWMenuOpen = (moHover,moClick);

  TTIWFade = (fdNone, fdSlow, fdMedium, fdFast);
  TTIWGradientDirection = (gdVertical, gdHorizontal);

    TMenuClientEvent = class(TCollectionItem)
  private
    FItemName: string;
    FItemScript: string;
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    procedure Assign(source: TPersistent); override;

  published
    property ItemName: string read FItemName write FItemName;
    property ItemScript: string read FItemScript write FItemScript;
  end;

  TMenuClientEvents = class(TCollection)
  private
    function GetItem(Index: Integer): TMenuClientEvent;
    procedure SetItem(Index: Integer; const Value: TMenuClientEvent);

  public
    constructor Create;
    function Add: TMenuClientEvent;
    function Insert(index: Integer): TMenuClientEvent;
    function IndexOf(ItemName: string): Integer;
    property Items[Index: Integer]: TMenuClientEvent read GetItem write SetItem; default;
  end;

  TTIWCustomPopupMenu = class(TIWControl)
  private
    FAutoHiding : Boolean;
    FBackgroundImage: TIPicture;
    FBorder: Boolean;
    FBorderColor: TIWColor;
    FClientEvents: TMenuClientEvents;
    FFade : TTIWFade;
    FHoverBorderColor: TIWColor;
    FHoverColor: TIWColor;
    FHoverColorTo : TIWColor;
    FHoverFontColor: TIWColor;
    FHoverGradientDirection : TTIWGradientDirection;
    FIconBackgroundColor : TIWColor;
    FIconBackgroundColorTo : TIWColor;
    FItemColor : TIWColor;
    FItemHeight : Integer;
    FItemSpacing: Integer;
    FMenu: TMenu;
    FOpacity : Integer;
    FOpen: TIWMenuOpen;
    FSeparatorColor : TIWColor;
    FShowIcons : Boolean;
    FSubMenuGlyph: TIPicture;
    FTextAlignment : TAlignment;
    FUseBorder : Boolean;

    FDesignMode: Boolean;

    arMenuId : TStringList;
    arMenuName : TStringList;
    Tiers : TStringList;
    MenuCode : string;
    Level : integer;
    AutoNumber : integer;
    FCacheDir : string;
    Javascript : string;
    FSelectedItem: string;

    {$IFDEF TMSIW9}
    FOnAsyncMenuClick: TIWAsyncMenuEvent;
    procedure DoAsyncMenuClick(AParams: TStringList);
    {$ENDIF}
    function StringToMenuItem(Value: string) : TMenuItem;

    procedure BackgroundChanged(Sender: TObject);
    procedure SetAutoHiding(const Value : boolean);
    procedure SetBackgroundImage(const Value: TIPicture);
    {$IFNDEF TMSIW71}
    procedure SetDesignMode(const Value: Boolean);
    {$ENDIF}
    procedure SetFade(const Value : TTIWFade);
    procedure SetHoverGradientDirection(const Value : TTIWGradientDirection);
    procedure SetIconBackgroundColor(const Value : TIWColor);
    procedure SetIconBackgroundColorTo(const Value : TIWColor);
    procedure SetItemColor(const Value : TIWColor);
    procedure SetItemHeight(const Value : Integer);
    procedure SetMenu(const Value: TMenu);
    procedure SetOpacity(const Value : Integer);
    procedure SetTextAlignment(const Value : TAlignment);
    procedure SetSeparatorColor(const Value: TIWColor);
    procedure SetSubMenuGlyph(const Value: TIPicture);
    procedure SetUseBorder(const value : boolean);
    function FontToCSS(AFont : TIWFont) : string;
    function TextAlignToStr(Alignment : TAlignment) : string;
    function MakeMenu(AName : string; AItem : TMenuItem) : string;
    procedure CacheDir;
//    procedure DrawGradient(Canvas: TCanvas; FromColor, ToColor: TIWColor; Steps: Integer; r:TRect; Direction: Boolean);
  protected
    procedure Submit(const AValue: string); override;
    function HTMLClr(Color: TIWColor): string;
    function HTMLClrEx(Color: TIWColor): string;
    {$IFDEF TMSIW51}
    function CursorToHtml(Cursor : TIWCursor) : string;
    {$ELSE}
    function CursorToHtml(Cursor : TCursor) : string;
    {$ENDIF}
    function GradDirToStr(GradDir : TTIWGradientDirection) : string;
    function FadeToStr(FadeSpeed : TTIWFade) : string;
    procedure CopyMenu(aItem : TMenuItem; DefaultItem: TMenuItem; IndexDefaultItem: integer);
  public
    {$IFDEF TMSIW6}
    function RenderCustomHTML(AContext: TIWBaseComponentContext): string;
    {$ELSE}
    function RenderCustomHTML: string;
    {$ENDIF}
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure SetValue(const value:string); override;    
    {$IFDEF TMSIW9}
    function RenderAsync(AContext: TIWBaseHTMLComponentContext): TIWXMLTag; override;
    {$ENDIF}
  published
    property AutoHiding : boolean read FAutoHiding write SetAutoHiding;
    property BackgroundImage: TIPicture read FBackgroundImage write SetBackgroundImage;
    property Border: Boolean read FBorder write FBorder;
    property BorderColor: TIWColor read FBorderColor write FBorderColor;
    property Caption;
    property ClientEvents: TMenuClientEvents read FClientEvents write FClientEvents;
    property Color;
    {$IFNDEF TMSIW71}
    property DesignMode: Boolean read FDesignMode write SetDesignMode;
    {$ENDIF}
    property Fade : TTIWFade read FFade write SetFade;
    property Font;
    property HoverBorderColor: TIWColor read FHoverBorderColor write FHoverBorderColor;
    property HoverColor: TIWColor read FHoverColor write FHoverColor;
    property HoverColorTo : TIWColor read FHoverColorTo write FHoverColorTo;
    property HoverFontColor: TIWColor read FHoverFontColor write FHoverFontColor;
    property HoverGradientDirection : TTIWGradientDirection read FHoverGradientDirection write SetHoverGradientDirection;
    property IconBackgroundColor : TIWColor read FIconBackgroundColor write SetIconBackgroundColor;
    property IconBackgroundColorTo : TIWColor read FIconBackgroundColorTo write SetIconBackgroundColorTo;
    property ItemColor : TIWColor read FItemColor write SetItemColor;
    property ItemHeight : Integer read FItemHeight write SetItemHeight;
    property ItemSpacing: Integer read FItemSpacing write FItemSpacing;
    property Menu: TMenu read FMenu write SetMenu;
    property Opacity : Integer read FOpacity write SetOpacity;
    property Open: TIWMenuOpen read FOpen write FOpen;
    property SeparatorColor : TIWColor read FSeparatorColor write SetSeparatorColor;
    property ShowIcons : Boolean read FShowIcons write FShowIcons;
    property SubMenuGlyph: TIPicture read FSubMenuGlyph write SetSubMenuGlyph;
    property TextAlignment : TAlignment read FTextAlignment write SetTextAlignment;
    property UseBorder : boolean read FUseBorder write SetUseBorder;
    {$IFDEF TMSIW9}
    property OnAsyncMenuClick: TIWAsyncMenuEvent read FOnAsyncMenuClick write FOnAsyncMenuClick;
    {$ENDIF}    
  end;

   TTIWPopupMenuButton= class(TTIWCustomPopupMenu)
   private
     FButtonFont:TIWfont;
     FButtonColor:TColor;
     procedure SetButtonFont(const Value: TIWfont);
     procedure SetButtonColor(const Value: TColor);
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy;override;
     {$IFDEF TMSIW6}
     function RenderHTML(AContext: TIWBaseComponentContext): TIWHTMLTag;  override;
     procedure IWPaint;override;
     {$ELSE}
     function RenderHTML: TIWHTMLTag;  override;
     procedure Paint;override;
     {$ENDIF}
   published
     property ButtonFont:TIWfont read FButtonFont write SetButtonFont;
     property ButtonColor:TColor read FButtonColor write SetButtonColor default clSilver;
     property Border;
     property BorderColor;
     property Caption;
     property Color;
     {$IFNDEF TMSIW71}
     property DesignMode;
     {$ENDIF}
     property Font;
     property HoverBorderColor;
     property HoverColor;
     property HoverFontColor;
     property ItemSpacing;
     property Menu;
     property Open;
     property SubMenuGlyph;
   end;

   TTIWPopupMenuLabel= class(TTIWCustomPopupMenu)
   private
     FLabelFont:TIWfont;
     FLabelColor:Tcolor;
     procedure SetLabelColor(const Value: TColor);
     procedure SetLabelFont(const Value: TIWfont);
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy;override;
     {$IFDEF TMSIW6}
     function RenderHTML(AContext: TIWBaseComponentContext): TIWHTMLTag;  override;
     procedure IWPaint;override;
     {$ELSE}
     function RenderHTML: TIWHTMLTag;  override;
     procedure Paint;override;
     {$ENDIF}
   published
     property LabelFont:TIWfont read FLabelFont write SetLabelFont;
     property LabelColor:TColor read FLabelColor write SetLabelColor default clWhite;
     property Border;
     property BorderColor;
     property Caption;
     property Color;
     {$IFNDEF TMSIW71}
     property DesignMode;
     {$ENDIF}
     property Font;
     property HoverBorderColor;
     property HoverColor;
     property HoverFontColor;
     property ItemSpacing;
     property Menu;
     property Open;
     property SubMenuGlyph;
   end;

   TTIWDocumentPopupMenu = class(TTIWCustomPopupMenu)
   private
     FEnableRightClick : Boolean;
     procedure SetEnableRightClick(const Value : Boolean);
   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 Border;
     property BorderColor;
     property Color;
     {$IFNDEF TMSIW71}
     property DesignMode;
     {$ENDIF}
     property EnableRightClick : Boolean read FEnableRightClick write SetEnableRightClick;
     property Font;
     property HoverBorderColor;
     property HoverColor;
     property HoverFontColor;
     property ItemSpacing;
     property Menu;
     property Open;
     property SubMenuGlyph;
   end;

implementation

uses
  {$IFDEF LINUX}
  QImgList,
  {$ELSE}
  ImgList, ShellAPI, CommCtrl,
  {$ENDIF}
  IWApplication, IWServerControllerBase,
  SWStrings, SWSystem, IWAppForm, 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}

{ TMenuClientEvent }

procedure TMenuClientEvent.Assign(Source: TPersistent);
begin
  FItemName := (Source as TMenuClientEvent).ItemName;
  FItemScript := (Source as TMenuClientEvent).ItemScript;
end;

constructor TMenuClientEvent.Create(Collection: TCollection);
begin
  inherited;
end;

destructor TMenuClientEvent.Destroy;
begin
  inherited;
end;

{ TMenuClientEvents }

function TMenuClientEvents.Add: TMenuClientEvent;
begin
  Result := TMenuClientEvent(inherited Add);
end;

constructor TMenuClientEvents.Create;
begin
  inherited Create(TMenuClientEvent);
end;

function TMenuClientEvents.GetItem(Index: Integer): TMenuClientEvent;
begin
  Result := TMenuClientEvent(inherited Items[Index]);
end;

function TMenuClientEvents.IndexOf(ItemName: string): Integer;
var
  i: integer;
begin
  Result := -1;
  for i := 1 to Count do
  begin
    if Items[i - 1].ItemName = ItemName then
    begin
      Result := i - 1;
      Break;
    end;
  end;
end;

function TMenuClientEvents.Insert(Index: Integer): TMenuClientEvent;
begin
  Result := TMenuClientEvent(inherited Insert(Index));
end;

procedure TMenuClientEvents.SetItem(Index: Integer;
  const Value: TMenuClientEvent);
begin
  inherited SetItem(Index,Value);
end;

{ TTIWCustomPopupMenu }
function TTIWCustomPopupMenu.StringToMenuItem(Value: string): TMenuItem;
var
  Decode, Sub: string;
  i,err: Integer;
  Menu: TMenuItem;
begin
  Menu := nil;

  Decode := Value;
  Delete(decode,1,length(HTMLName));

  if Assigned(FMenu) then
  begin
    Menu := nil;
    while length(decode) > 0 do
    begin
      sub := decode;
      if pos('_',sub) > 0 then
        Sub := copy(sub,1,pos('_',sub) - 1);
      val(sub,i,err);

      if (i > 0) then
      begin
        if Assigned(Menu) then
          Menu := Menu.Items[i - 1]
        else
          Menu := FMenu.Items[i - 1];
      end;

      delete(decode,1,length(sub) + 1);
    end;
  end;
  Result := Menu;
end;
{$IFDEF TMSIW9}
procedure TTIWCustomPopupMenu.DoAsyncMenuClick(AParams: TStringList);
begin
  if Assigned(OnAsyncMenuClick) then
    OnAsyncMenuClick(Self, AParams, StringToMenuItem(FSelectedItem));
end;

function TTIWCustomPopupMenu.RenderAsync(
  AContext: TIWBaseHTMLComponentContext): TIWXMLTag;
begin
  Result := TIWXMLTag.CreateTag('control');
  try
    Result.AddStringParam('id', HTMLName);
    Result.AddStringParam('type', 'TTIWCUSTOMPOPUPMENU');
    RenderAsyncCommonProperties( AContext, Result );
  except
    FreeAndNil(Result);
  end;
end;
{$ENDIF}

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

 {$IFDEF TMSIW6}
  {TODO}
  {$ELSE}
  FSupportsInput := True;
  FSupportsSubmit := True;
  {$ENDIF}
  Font.Color := clWindowText;
  Font.Size := 11;
  Font.FontName := 'Verdana';
  FAutoHiding := true;
  FBackgroundImage := TIPicture.Create;
  FBackgroundImage.OnChange := BackgroundChanged;
  FBorder := true;
  FClientEvents := TMenuClientEvents.Create;
  FDesignMode := True;
  FFade := fdNone;
  FHoverBorderColor := clHighlight;
  FHoverColor := $F0CAA6;
  FHoverColorTo := clNone;
  FHoverFontColor := clBlack;
  FHoverGradientDirection := gdHorizontal;
  FIconBackgroundColor := clBtnFace;
  FIconBackgroundColorTo := clNone;
  FItemColor := clWhite;
  FItemHeight := 20;
  FItemSpacing := 3;
  FOpacity := 100;
  FOpen := moClick;
  FSeparatorColor := clBtnFace;
  FSubMenuGlyph := TIPicture.Create;
  FUseBorder := true;
  FShowIcons := true;
  FTextAlignment := taLeftJustify;
  Self.Height := 20;
  Self.Width := 150;
  Self.BorderColor := clBtnFace;
  Self.Color := clBtnFace;
  Zindex := 10;

  arMenuId := TStringList.Create;
  arMenuName := TStringList.Create;
  Tiers := TStringList.Create;
  MenuCode := '';
  Level := 0;
  AutoNumber := 0;
  FCacheDir := '';
  Javascript := '';

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


end;

destructor TTIWCustomPopupMenu.Destroy;
begin
  FClientEvents.Free;
  FSubMenuGlyph.Free;
  FBackgroundImage.Free;
  arMenuId.Free;
  arMenuName.Free;
  Tiers.Free;
  inherited;
end;

function TTIWCustomPopupMenu.HTMLClr(color: TIWColor):string;
begin
  Result := ColorToRGBString(ColorToRGB(color));
end;

function TTIWCustomPopupMenu.HTMLClrEx(color: TIWColor):string;
begin
  if (color = clNone) then
    Result := ''
  else
    Result := ColorToRGBString(ColorToRGB(color));
end;

{$IFDEF TMSIW51}
function TTIWCustomPopupMenu.CursorToHtml(Cursor : TIWCursor):string;
{$ELSE}
function TTIWCustomPopupMenu.CursorToHtml(Cursor : TCursor):string;
{$ENDIF}
begin
  case Cursor of
    {$IFDEF TMSIW51}
    crCrossHair: Result := 'crosshair';
    crDefault: Result := 'default';
    crWait: Result := 'wait';
    crAuto: Result := 'auto';
    crPointer: Result := 'pointer';
    crMove: Result := 'move';
    crEResize: Result := 'e-resize';
    crNEResize: Result := 'ne-resize';
    crNWResize: Result := 'nw-resize';
    crNResize: Result := 'n-resize';
    crSEResize: Result := 'se-resize';
    crSWResize: Result := 'sw-resize';
    crSResize: Result := 's-resize';
    crWResize: Result := 'w-resize';
    crText: Result := 'text';
    crHelp: Result := 'help';
    {$ELSE}
    crAppStart : Result := 'wait';
    crCross : Result := 'crosshair';
    crDefault : Result := 'default';
    crHandPoint : Result := 'pointer';
    crHelp : Result := 'help';
    crHourGlass : Result := 'wait';
    criBeam : Result := 'auto';
    crSizeAll : Result := 'move';
    crSizeNESW : Result := 'ne-resize';
    crSizeNS : Result := 'n-resize';
    crSizeNWSE : Result := 'nw-resize';
    crSizeWE : Result := 'e-resize';
    {$ENDIF}
  else
    Result := 'default';
  end;
end;

function TTIWCustomPopupMenu.GradDirToStr(GradDir : TTIWGradientDirection) : string;
begin
  if GradDir = gdHorizontal then
    Result := '1'
  else
    Result := '0';
end;

function TTIWCustomPopupMenu.FadeToStr(FadeSpeed : TTIWFade) : string;
begin
  case FadeSpeed of
    fdNone : Result := '0';
    fdSlow : Result := '10';
    fdMedium : Result := '7';
    fdFast : Result := '4';
  else
    Result := '0';
  end;
end;

function TTIWCustomPopupMenu.FontToCSS(AFont : TIWFont) : string;
var
  Weight, Res : string;
begin
  Weight := '';
  Res := '';

  if fsBold in AFont.Style then
    Weight := #13'font-weight: bold;'#13;

  if (AFont.FontName <> '') then
    Res := '  font-family:' + AFont.FontName + ';'#13;

  if (AFont.Color <> clNone) then
    Res := Res
      + '  color:' + HTMLClr(AFont.Color) + ';'#13
  else
    Res := Res
      + '  color:black;'#13;

  if (fsItalic in AFont.Style) then
    Res := Res
      + ' font-style:italic;'#13;

  Res := Res
    + Weight
    + '  font-size:' + IntToStr(AFont.Size) + ';'#13;

  Result := Res;
end;

function TTIWCustomPopupMenu.TextAlignToStr(Alignment : TAlignment) : string;
begin
  case Alignment of
    taLeftJustify:
      Result := 'text-align:left;';
    taCenter:
      Result := 'text-align:center;';
    taRightJustify:
      Result := 'text-align:right;';
    else
      Result := 'text-align:left;';
  end;
end;

function TTIWCustomPopupMenu.MakeMenu(AName : string; AItem : TMenuItem) : string;
var
  i, l, x, Idx : integer;
  Name, CleanedID, URLBack, URL, ItemSP, IconColorTo, Cap : string;
  ID : array of integer;
  UseImage : boolean;
  SubItem : TMenuItem;
  BMP : TBitmap;
begin
  SetLength(ID,AItem.Count);

  CleanedID := HTMLName;

  if (AItem.Count > 0) then
  begin
    if (Tiers.Count = 0) then
    begin
      for l := 0 to StrToInt(AName)- 1 do
        Tiers.Add('null');

      Tiers.Add(IntToStr(Level));
    end
    else
    begin
      if (StrToInt(AName) > Tiers.Count) then
      begin
        for x := Tiers.Count to StrToInt(AName) - 1 do
          Tiers.Add('null');

        Tiers.Add(IntToStr(Level));
      end
      else
      begin
        if (StrToInt(AName) = Tiers.Count) then
          Tiers.Add(IntToStr(Level))
        else
          Tiers[StrToInt(AName)] := IntToStr(Level);
      end;
    end;

    Idx := arMenuId.IndexOf(AName);
    URLBack := '';
    useImage := false;

    if not (FBackgroundImage.Empty) then
    begin
      UseImage := true;

      if FBackgroundImage.IsGIF then
      {$IFDEF TMSIW71}
      URLBack := TIWServerControllerBase.NewCacheFile('gif',true)
      {$ELSE}
      URLBack := TIWServerControllerBase.NewCacheFile('gif')
      {$ENDIF}
      else
      {$IFDEF TMSIW71}
      URLBack := TIWServerControllerBase.NewCacheFile('jpg',true);
      {$ELSE}
      URLBack := TIWServerControllerBase.NewCacheFile('jpg');
      {$ENDIF}

      FBackgroundImage.SaveToFile(URLBack);
      URLBack := FCacheDir + ExtractFileName(URLBack);
    end;

    MenuCode := MenuCode
      + 'p_startMenu(' + AName + ',150,' + IntToStr(Level) + ',''' + HTMLClr(FBorderColor) + ''','''
      + CleanedID + '_' + arMenuName[Idx] + ''',''' + IntToStr(100+ZIndex) + ''','''
      + URLBack + ''',''' + IntToStr(Opacity) + ''');'#13;

    for i := 1 to AItem.Count do
    begin
      SubItem := AItem.Items[i-1];

      if (SubItem.Visible) then
      begin

        if (SubItem.ImageIndex >= 0) and Assigned(FMenu.Images) and not (SubItem.Checked) then
        begin
          if (FMenu.Images.Count > SubItem.ImageIndex) then
          begin
            BMP := TBitmap.Create;
            FMenu.Images.BkColor := FIconBackgroundColor;
            FMenu.Images.GetBitmap(SubItem.ImageIndex,BMP);
            //URL := HTMLBmp(BMP);
            URL := '';
            {$IFDEF TMSIW71}
            URL := TIWServerControllerBase.NewCacheFile('bmp',true);
            {$ELSE}
            URL := TIWServerControllerBase.NewCacheFile('bmp');
            {$ENDIF}
            BMP.SaveToFile(URL);
            URL := FCacheDir + ExtractFileName(URL);
            BMP.Free;
          end;
        end;

        Name := arMenuName[Idx] + '_' + IntToStr(i);

        ItemSP := IntToStr(FItemSpacing);

        IconColorTo := '';

        if (FIconBackgroundColorTo <> clNone) then
          IconColorTo := HTMLClr(FIconBackgroundColorTo);

        if (SubItem.Caption = '-') then
        begin
          MenuCode := MenuCode
            + 'p_menuSpacer(''' + HTMLClr(FSeparatorColor) + ''',''' + CleanedID + '_' + Name + ''','''
            + IIF(FShowIcons,'True','False') + ''',''' + IntToStr(FOpacity) + ''',''' + ItemSP
            + ''',''' + HTMLClr(FItemColor) + ''',''' + HTMLClr(FIconBackgroundColor)
            + ''',''' + IconColorTo + ''');'#13;
        end
        else
        begin
          Cap := SubItem.Caption;
          Cap := StringReplace(Cap, '''', '&#39;', [rfReplaceAll, rfIgnoreCase]);
          Cap := StringReplace(Cap, '<', '&lt;', [rfReplaceAll, rfIgnoreCase]);
          Cap := StringReplace(Cap, '>', '&gt;', [rfReplaceAll, rfIgnoreCase]);

          if (SubItem.Count = 0) then
          begin
            if (FClientEvents.IndexOf(SubItem.Name) >= 0) then
            begin
              MenuCode := MenuCode
                + 'function ' + CleanedID + '_' + Name + '(el)  {'#13
                + '  p_hideAllMenus();'#13
                + '  ' + FClientEvents.Items[FClientEvents.IndexOf(SubItem.Name)].FItemScript + #13;

              if (Assigned(SubItem.OnClick)) then
              begin
                MenuCode := MenuCode
                  + HTMLName + 'SubmitValue(''' + CleanedID + '_' + Name + ''');';
              end;

              MenuCode := MenuCode
                + '}'#13;
            end;

            MenuCode := MenuCode
              + 'p_menuItem(''' + Cap + ''',''' + Name + ''','
              + IntToStr(Level) + ',''' + CleanedID + '_' + Name + ''',''' + URL + ''', '''
              + IIF(FShowIcons,'True','False') + ''',''' + HTMLClr(FIconBackgroundColor) + ''',''' + IntToStr(FItemHeight)
              + ''',''' + IntToStr(FOpacity) + ''',''' + IIF(UseImage,'True','False') + ''',''' + ItemSP
              + ''',''' + IIF((FClientEvents.IndexOf(SubItem.Name) >= 0),'True','False') + ''',''' + IIF(SubItem.Enabled,'True','False')
              + ''',''' + IIF(SubItem.Checked, 'True', 'False') + ''',''' + IconColorTo + ''');'#13
          end
          else
          begin
            if (FClientEvents.IndexOf(SubItem.Name) >= 0) then
            begin
              MenuCode := MenuCode
                + 'function ' + CleanedID + '_' + Name + '(el)  {'#13
                + '  ' + FClientEvents.Items[FClientEvents.IndexOf(SubItem.Name)].FItemScript + #13;

              if (Assigned(SubItem.OnClick)) then
              begin
                MenuCode := MenuCode
                  + HTMLName + 'SubmitValue(''' + CleanedID + '_' + Name + ''');';
              end;
              MenuCode := MenuCode

                + '}'#13;
            end;

            AutoNumber := AutoNumber + 1;
            MenuCode := MenuCode
              + 'p_subMenuLabel(''' + Cap + ''', ' + IntToStr(AutoNumber) + ',''' + Name + ''','
              + IntToStr(Level) + ', ''' + TextAlignToStr(TextAlignment) + ''','''
              + CleanedID + '_' + Name + ''',''' + URL + ''',''' + IIF(FShowIcons, 'True', 'False') + ''','''
              + HTMLClr(FIconBackgroundColor) + ''',''' + IntToStr(FItemHeight) + ''','''
              + IntToStr(Opacity) + ''',''' + IIF(UseImage, 'True', 'False') + ''',''' + ItemSP
              + ''',''' + IIF(SubItem.Enabled, 'True', 'False') + ''',''' + IconColorTo + ''');'#13;

            ID[i-1] := AutoNumber;
            arMenuId.Add(IntToStr(AutoNumber));
            arMenuName.Add(Name);
          end;
        end;
      end;
    end;                                                         

    MenuCode := MenuCode
      + 'p_endMenu();'#13
      + 'changeObjectVisibility(''' + CleanedID + '_' + arMenuName[idx] + ''',''hidden'');'#13
      ;

    for i := 1 to AItem.Count do
    begin
      SubItem := AItem.Items[i-1];

      if (SubItem.Visible) then
      begin
        if (SubItem.Count > 0) then
        begin
          Level := Level + 1;
          MakeMenu(IntToStr(ID[i-1]),SubItem);
        end;
      end;
    end;

    Level := Level - 1;
    
  end;
  Result := MenuCode;
end;

procedure TTIWCustomPopupMenu.CacheDir;
begin
  FCacheDir := GetCacheDir(Self);
end;

procedure TTIWCustomPopupMenu.CopyMenu(aItem : TMenuItem; DefaultItem : TMenuItem; indexDefaultItem : Integer);
var
  NewItem : TMenuItem;
  i : integer;
begin
  NewItem := TMenuItem.Create(DefaultItem);
  NewItem.Caption := aItem.Caption;
  NewItem.Checked := aItem.Checked;
  NewItem.Enabled := aItem.Enabled;
  NewItem.ImageIndex := aItem.ImageIndex;
  NewItem.Name := aItem.Name;
  NewItem.OnClick := aItem.OnClick;
  NewItem.Visible := aItem.Visible;

  DefaultItem.Insert(DefaultItem.Count, NewItem);

  if (aItem.Count > 0) then
  begin
    for i:= 1 to aItem.Count do
    begin
      CopyMenu(aItem[i-1], DefaultItem.Items[indexDefaultItem],i-1);
    end;
  end;
end;

{$IFDEF TMSIW6}
function TTIWCustomPopupMenu.RenderCustomHTML(AContext: TIWBaseComponentContext): string;
{$ELSE}
function TTIWCustomPopupMenu.RenderCustomHTML: string;
{$ENDIF}
var
  FImgName, StyleChecked, BdrWidth : string;
  r, r2, g, g2, b, b2 : integer;
  NewRed, NewRed2, NewGreen, NewGreen2, NewBlue, NewBlue2 : integer;
  Hovercolor3, HoverColor4 : TIWColor;
  weight, CleanedID, OpenMenu : string;
  ColorValue, ColorValue2, NewColor, NewColor2 : integer;
  IconColorTo, Cap: string;
  i: integer;
  HTML : string;
  DefaultItem : TMenuItem;
begin
  Result := '';
  HTML := '';
  CacheDir;

  CleanedID := HTMLName;
  BdrWidth := '-1';

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

  {$IFDEF TMSIW6}
  if not (AContext.WebApplication.Browser = brIE) then
    TIWComponent40Context(AContext).AddToInitProc('document.captureEvents(Event.MOUSEOVER | Event.MOUSEOUT | Event.CLICK);');
  {$ELSE}
  if not (WebApplication.Browser = brIE) then
    AddToInitProc('document.captureEvents(Event.MOUSEOVER | Event.MOUSEOUT | Event.CLICK);');
  {$ENDIF}

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

    FSubMenuGlyph.SaveToFile(FImgName);
    FImgName := FCacheDir + ExtractFileName(FImgName);
  end
  else
    FImgName := '';

	HTML := '';

	HTML := HTML
    + '<style type=text/css>'#13;

  HTML := HTML
    + '.' + CleanedID + 'textItem'#13
    + '{'#13
    + '  ' + TextAlignToStr(FTextAlignment) + ';'#13
    + '  height: ' + IntToStr(FItemHeight) + ';'#13
    + '  ' + FontToCSS(Font) + ';'#13;

  HTML := HTML
    + '}'#13;

  if (fsBold in Font.Style) then
    Weight := 'font-weight: bold;'#13;

  HTML := HTML
    + '.' + CleanedID + 'disabled'#13
    + '{'#13
    + '  color:buttonshadow;'#13
    + '  ' + TextAlignToStr(FTextAlignment) + ';'#13
    + '  font-family: ' + Font.FontName + ';'#13
    + '  font-size:' + IntToStr(Font.Size) + ';'#13
    + '  ' + Weight
    + '  valign: center;'#13
    + '}'#13;

  {$IFDEF TMSIW6}
  if ((TIWComponent40Context(AContext).WebApplication.Browser = brIE) and (FHoverColorTo <> clNone)) then
  {$ELSE}
  if ((WebApplication.Browser = brIE) and (FHoverColorTo <> clNone)) then
  {$ENDIF}
    StyleChecked := 'filter:progid:DXImageTransform.Microsoft.Gradient(GradientType=1, StartColorStr=' + HTMLClr(FHoverColor) + ',EndColorStr=' + HTMLClr(FHoverColorTo) + ')'
  else
    StyleChecked := 'background:' + HTMLClr(FHoverColor);

  HTML := HTML
    + '.' + CleanedID + 'checked'#13
    + '{'#13
    + '  ' + StyleChecked + ';'#13
    + '  border:1 solid darkblue;'#13
    + '  font-family: webdings;'#13
    + '  width: 20;'#13
    + '  text-align: center;'#13
    + '  valign: center;'#13
    + '}'#13;

  HTML := HTML
    + '.' + CleanedID + 'more'#13
    + '{'#13
    + '  color:' + HTMLClr(Font.Color) + ';'#13
    + '}'#13;

 	HTML := HTML
	  + '</style>'#13;

  DefaultItem := TMenuItem.Create(Self);
  DefaultItem.Caption := '';

  if (FMenu.Items.Count > 0) then
  begin
    for i := 1 to FMenu.Items.Count do
      CopyMenu(FMenu.Items[i-1],DefaultItem, i-1);

    Javascript := Javascript
      + 'var ' + CleanedID + 'array = new Array();'#13
			+ CleanedID + 'array[0] = "' + HTMLClr(FHoverColor) + '";'#13;

    {$IFDEF TMSIW6}
    if ((TIWComponent40Context(AContext).WebApplication.Browser <> brIE) or (FHoverColorTo = clNone)) then
    {$ELSE}
    if ((WebApplication.Browser <> brIE) or (FHoverColorTo = clNone)) then
    {$ENDIF}
		  Javascript := Javascript
        + CleanedID + 'array[1] = "null";'#13
  	else
			Javascript := Javascript
			  + CleanedID + 'array[1] = "' + HTMLClr(FHoverColorTo) + '"'#13;

		Javascript := Javascript
		  + CleanedID + 'array[2] = "' + HTMLClr(FItemColor) + '";'#13
      + CleanedID + 'array[3] = "' + HTMLClr(clNone) + '";'#13
  		+ CleanedID + 'array[4] = "' + HTMLClrEx(clNone) + '";'#13
			+ CleanedID + 'array[5] = "' + HTMLClr(clNone) + '";'#13;

		OpenMenu := '1';

		Javascript := Javascript
		  + CleanedID + 'array[6] = "' + OpenMenu + '";'#13
      + CleanedID + 'array[7] = "' + HTMLClr(FIconBackgroundColor) + '";'#13;

  	if (FHoverColorTo <> clNone) then
    begin
			if (FHoverGradientDirection = gdVertical) then
      begin
			  Javascript := Javascript
				  + CleanedID + 'array[8] = "none";'#13
					+ CleanedID + 'array[9] = "none";'#13
					+ CleanedID + 'array[10] = "0";'#13;
      end
			else
      begin
        ColorValue := ColorToRGB(FHoverColor);
        r := (ColorValue AND $FF);
        g := (ColorValue AND $FF00) shr 8;
        b := (ColorValue AND $FF0000) shr 16;
        ColorValue2 := ColorToRGB(HoverColorTo);
        r2 := (ColorValue2 AND $FF);
        g2 := (ColorValue2 AND $FF00) shr 8;
        b2 := (ColorValue2 AND $FF0000) shr 16;

        NewRed := Round(r * 0.9 + r2 * 0.1);
        NewGreen := Round(g * 0.9 + g2 * 0.1);
        NewBlue := Round(b * 0.9 + b2 * 0.1);
        NewColor := NewRed + (NewGreen shl 8) + (NewBlue shl 16);

        NewRed2 := Round(r * 0.1 + r2 * 0.9);
        NewGreen2 := Round(g * 0.1 + g2 * 0.9);
        NewBlue2 := Round(b * 0.1 + b2 * 0.9);
        NewColor2 := NewRed2 + (NewGreen2 shl 8) + (NewBlue2 shl 16);

        HoverColor3 := StringToColor(IntToStr(NewColor));
        HoverColor4 := StringToColor(IntToStr(NewColor2));

				Javascript := Javascript
				  + CleanedID + 'array[8] = "' + HTMLClr(HoverColor3) + '";'#13
					+ CleanedID + 'array[9] = "' + HTMLClr(HoverColor4) + '";'#13
					+ CleanedID + 'array[10] = "1";'#13;
      end;
    end
		else
    begin
		  Javascript := Javascript
			  + CleanedID + 'array[8] = "none";'#13
				+ CleanedID + 'array[9] = "none";'#13
				+ CleanedID + 'array[10] = "none";'#13;
    end;

    if (FAutoHiding) then
      Javascript := Javascript
        + CleanedID + 'array[11] = "true";'#13
    else
      Javascript := Javascript
        + CleanedID + 'array[11] = "false";'#13;

    {$IFDEF TMSIW6}
    if ((TIWComponent40Context(AContext).WebApplication.Browser <> brIE) or not(FBackgroundImage.Empty) or not (FUseBorder) or (FHoverColorTo <> clNone)) then
    {$ELSE}
    if ((WebApplication.Browser <> brIE) or (FHoverColorTo <> clNone) or not(FBackgroundImage.Empty) or not (FUseBorder)) then
    {$ENDIF}
      BdrWidth := '0';

    Javascript := Javascript
      + CleanedID + 'array[12] = "' + HTMLClr(FHoverFontColor) + '";'#13
      + CleanedID + 'array[13] = "' + HTMLClr(Font.Color) + '";'#13
      + CleanedID + 'array[14] = "' + BdrWidth + '";'#13
      + CleanedID + 'array[15] = "' + HTMLClr(FHoverBorderColor) + '";'#13;

    Javascript := Javascript
      + CleanedID + 'array[16] = "0";'#13;

    Javascript := Javascript
      + CleanedID + 'array[17] = "' + HTMLClr(clNone) + '";'#13
      + CleanedID + 'array[18] = "' + HTMLClr(clNone) + '";'#13
      + CleanedID + 'array[19] = "' + IntToStr(FOpacity) + '";'#13;

    {$IFDEF TMSIW6}
    if (TIWComponent40Context(AContext).WebApplication.Browser = brIE) then
    {$ELSE}
    if (WebApplication.Browser = brIE) then
    {$ENDIF}
      Javascript := Javascript
        + CleanedID + 'array[20] = "' + FadeToStr(Fade) + '";'#13
    else
      Javascript := Javascript
        + CleanedID + 'array[20] = "0";'#13;

    Javascript := Javascript
      + CleanedID + 'array[21] = "' + IIF(FShowIcons,'True','False') + '";'#13
      + CleanedID + 'array[22] = "' + IntToStr(ItemSpacing) + '";'#13;

    if not (FBackgroundImage.Empty) then
      Javascript := Javascript
        + CleanedID + 'array[23] = "True";'#13
    else
      Javascript := Javascript
        + CleanedID + 'array[23] = "False";'#13;

    IconColorTo := '';

    if (FIconBackgroundColorTo <> clNone) then
      IconColorTo := HTMLClr(FIconBackgroundColorTo);

    Javascript := Javascript
      + CleanedID + 'array[24] = "' + IconColorTo + '";'#13;

    Javascript := Javascript
	    + 'p_getBrowser();'#13
		  + 'p_setProperties(' + CleanedID + 'array,''' + CleanedID + ''');'#13
      + 'startPopupMenuBar(' + IntToStr(Width) + ',''' + CleanedID + 'arProp'',''' + CleanedID + 'array'',''' + FImgName + ''');'#13;

    Cap := DefaultItem.Caption;
    Cap := StringReplace(Cap,'''','&#39;',[rfReplaceAll, rfIgnoreCase]);
    Cap := StringReplace(Cap,'<','&lt;', [rfReplaceAll, rfIgnoreCase]);
    Cap := StringReplace(Cap, '>','&gt;', [rfReplaceAll, rfIgnoreCase]);

    i := 1;
    arMenuId.Add(IntToStr(i));
    arMenuName.Add(IntToStr(i));

    Javascript := Javascript
      + 'popupMenuLabel(''' + Cap + ''',' + IntToStr(i) + ',' + IntToStr(Width)
      + ',''' + TextAlignToStr(TextAlignment) + ''',''' + CleanedID + '_' + IntToStr(i) + ''',''0'',''' + CleanedID + 'array'','''
      + IIF((FClientEvents.IndexOf(DefaultItem.Name) >= 0),'True','False') + ''');'#13;

    Javascript := Javascript
      + 'endPopupMenuBar();'#13;
  end;
  Result := HTML;
end;

procedure TTIWCustomPopupMenu.BackgroundChanged(Sender: TObject);
begin
  Invalidate;
end;

{
procedure TTIWCustomPopupMenu.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;
}

procedure TTIWCustomPopupMenu.SetValue(const value:string);
begin
  FSelectedItem := value;
end;

procedure TTIWCustomPopupMenu.Submit(const AValue: string);
var
  Decode, Sub: string;
  i,err: Integer;
  Menu: TMenuItem;
begin
  Decode := AValue;
  Delete(decode,1,length(HTMLName));

  if Assigned(FMenu) then
  begin
    Menu := nil;
    while Length(Decode) > 0 do
    begin
      Sub := Decode;
      if pos('_',sub) > 0 then
      begin
        Sub := copy(sub,1,pos('_',sub) - 1);
      end;
      val(sub,i,err);

      if (i > 0) then
      begin
        if Assigned(Menu) then
          Menu := Menu.Items[i - 1]
        else
          Menu := FMenu.Items[i - 1];
      end;

      delete(Decode,1,length(Sub) + 1);
    end;

    if Assigned(Menu) then
    begin
      if Assigned(Menu.OnClick) then
         Menu.OnClick(Menu);
    end;
  end;
end;

procedure TTIWCustomPopupMenu.SetAutoHiding(const Value : Boolean);
begin
  FAutoHiding := Value;
end;

procedure TTIWCustomPopupMenu.SetBackgroundImage(const Value: TIPicture);
begin
  FBackgroundImage.Assign(Value);
  Invalidate;
end;

{$IFNDEF TMSIW71}
procedure TTIWCustomPopupMenu.SetDesignMode(const Value: Boolean);
begin
  FDesignMode := Value;
  Invalidate;
end;
{$ENDIF}

procedure TTIWCustomPopupMenu.SetFade(const Value : TTIWFade);
begin
  FFade := Value;
end;

procedure TTIWCustomPopupMenu.SetHoverGradientDirection(const Value : TTIWGradientDirection);
begin
  FHoverGradientDirection := Value;
end;

procedure TTIWCustomPopupMenu.SetIconBackgroundColor(const Value : TIWColor);
begin
  FIconBackgroundColor := Value;
end;

procedure TTIWCustomPopupMenu.SetIconBackgroundColorTo(const Value : TIWColor);
begin
  FIconBackgroundColorTo := Value;
end;

procedure TTIWCustomPopupMenu.SetItemColor(const Value: TIWColor);
begin
  FItemColor := Value;
end;

procedure TTIWCustomPopupMenu.SetItemHeight(const Value : Integer);
begin
  FItemHeight := Value;
end;

procedure TTIWCustomPopupMenu.SetMenu(const Value: TMenu);
begin
  FMenu := Value;
  Invalidate;
end;

procedure TTIWCustomPopupMenu.SetOpacity(const Value : Integer);
begin
  if (Value < 0) or (Value > 100) then
    raise Exception.Create('Value required between 0 and 100')
  else
  FOpacity := Value;
end;

procedure TTIWCustomPopupMenu.SetSeparatorColor(const Value : TIWColor);
begin
  FSeparatorColor := Value;
end;

procedure TTIWCustomPopupMenu.SetSubMenuGlyph(const value: TIPicture);
begin
  FSubMenuGlyph.Assign(Value);
end;

procedure TTIWCustomPopupMenu.SetTextAlignment(const Value : TAlignment);
begin
  FTextAlignment := Value;
end;

procedure TTIWCustomPopupMenu.SetUseBorder(const Value : Boolean);
begin
  FUseBorder := Value;
end;

{ TTIWPopupMenuButton }

constructor TTIWPopupMenuButton.Create(AOwner: TComponent);
begin
  inherited;
  FButtonFont := TIWfont.Create;
  FButtonFont.FontName := 'Arial';
  FButtonFont.Color := clBlack;
  FButtonFont.Size := 10;
  FButtonColor := clBtnFace;
end;

destructor TTIWPopupMenuButton.Destroy;
begin
  inherited;
  FButtonFont.free;
end;

procedure TTIWPopupMenuButton.SetButtonFont(const Value: TIWfont);
begin
  FButtonFont.assign(Value);
  invalidate;
end;

{$IFDEF TMSIW6}
function TTIWPopupMenuButton.RenderHTML(AContext: TIWBaseComponentContext): TIWHTMLTag;
{$ELSE}
function TTIWPopupMenuButton.RenderHTML: TIWHTMLTag;
{$ENDIF}
var
  ButtonWeight : string;
  StrBackgroundButton : string;
  HTML, JSSubMenu, TiersArray : string;
  Parent, Tag, Script : TIWHTMLTag;
  i,k : integer;
  AItem : TMenuItem;
  DefaultItem, newItem : TMenuItem;
  ajaxcall, submitclick: string;
begin
  HTML := '';
  ButtonWeight := '';
  StrBackgroundButton  := '';
  JSSubMenu := '';
  TiersArray := '';

  if (fsBold in ButtonFont.Style) then
  ButtonWeight := 'font-weight: bold;';

  if (ButtonColor <> clNone) then
    StrBackgroundButton := 'background-color: ' + HTMLClr(Self.ButtonColor) + ';';

  HTML := HTML
    + '<input type="button" value="' + Self.Caption + '" id="button' + HTMLName + '"'
    + ' onclick="p_setPropsTier(' + HTMLName + 'arProp); p_setProperties(' + HTMLName + 'array, ''' + HTMLName + ''');popupShowMenu(1, event, ''Left'', ''' + HTMLName + '_1'');"'
    + ' style="width:' + IntToStr(Width) + ';' + StrBackgroundButton + '; height:' + IntToStr(Height) + ';' + FontToCSS(ButtonFont) + '">';

  Tag := TIWHTMLTag.CreateTag('DIV');
  Tag.AddStringParam('class',HTMLName + 'CSS');
  Tag.AddStringParam('NAME',HTMLName);
  Tag.AddStringParam('ID',HTMLName);

  Parent := TIWHTMLTag.CreateTag('');
  Tag.Contents.AddText(HTML);
  {$IFDEF TMSIW6}
  Tag.Contents.AddText(RenderCustomHTML(AContext));
  {$ELSE}
  Tag.Contents.AddText(RenderCustomHTML);
  {$ENDIF}

	JSSubMenu := '';

  DefaultItem := TMenuItem.Create(Self);
  DefaultItem.Caption := '';

  NewItem := TMenuItem.Create(Self);
  NewItem.Caption := '';
  DefaultItem.Add(NewItem);

  if (Assigned(FMenu)) then
  begin
    for i := 1 to FMenu.Items.Count do
      CopyMenu(FMenu.Items[i-1],DefaultItem.Items[0], i-1);
  end;

  AutoNumber := 1;

  for i := 1 to DefaultItem.Count do
  begin
	 Level := 0;
    MenuCode := '';
	  AItem := DefaultItem.Items[i-1];
  	JSSubMenu := JSSubMenu
	    + MakeMenu(IntToStr(i), AItem);
  end;

  submitclick := ' return SubmitClick('#39+HTMLName+#39+',realName,' + #39 + 'false' + #39 + ');'#13;

  {$IFDEF TMSIW9}
  if Assigned(FOnAsyncMenuClick) then
  begin
    ajaxcall := 'processAjaxEvent(''onMenuClick'', '
      + HTMLControlImplementation.IWCLName
      + ',''' + HTMLName + '.' + 'DoAsyncMenuClick' + ''','
      + 'true' + ', null, '
      + 'true' + ');';

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

      submitclick := '';
  end;
 {$ENDIF}

	JSSubMenu := JSSubMenu
	  + 'function ' + HTMLName + 'SubmitValue(name)'#13
	  + '{'#13
    + '  var firstPart = "";'#13
    + '  firstPart = name.substring(0,name.indexOf(''_''));'#13
    + '  var lastPart = "";'#13
    + '  lastPart = name.substring(name.indexOf(''_'')+2, name.length);'#13
    + '  var realName = firstPart + lastPart;'#13
    + 'document.getElementById("'+HTMLName+'_INPUT").value = realName;'#13
    + ajaxcall
    + submitclick
		+ '}'#13;

  TiersArray := TiersArray
    + '  var ' + HTMLName + 'arProp = new Array();'#13;

  for k := 0 to Tiers.Count - 1 do
  begin
    if (Tiers[k] = 'null') then
		  TiersArray := TiersArray
				  + HTMLName + 'arProp[' + IntToStr(k) + '] = null;'#13
	  else
		  TiersArray := TiersArray
				+ HTMLName + 'arProp[' + IntToStr(k) + '] = ' + Tiers[k] + ';'#13;
  end;

  Script := TIWHTMLTag.CreateTag('SCRIPT');
  Script.Contents.AddText(TiersArray);
  Script.Contents.AddText(Javascript);
  Script.Contents.AddText(JSSubMenu);
  {$IFDEF TMSIW7}
  Parent.Contents.Add(Tag);
  Parent.Contents.Add(Script);
  {$ENDIF}
  Result := Parent;

  //clear arrays before refresh.
  //fixed: if some items are set to visible = false
  //after refresh the # of items in the array does no longer correspond to the
  //number of visible items and some subitems might not be displayed.
  arMenuId.Clear;
  arMenuName.Clear;  

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

end;

procedure TTIWPopupMenuButton.SetButtonColor(const Value: TColor);
begin
  FButtonColor := Value;
  invalidate;
end;

{$IFDEF TMSIW6}
procedure TTIWPopupMenuButton.IWPaint;
{$ELSE}
procedure TTIWPopupMenuButton.Paint;
{$ENDIF}
begin
  inherited;
  with Canvas do
  begin
    if FButtonColor <> clNone then
      Brush.Color := FButtonColor
    else
      Brush.Color := clSilver;

    FillRect(GetClientRect);
    Pen.Width := 1;
    Pen.Color := clWhite;
    MoveTo(1, Height-1);
    LineTo(1, 0 + 1);
    LineTo(Width - 2, 1);
    Pen.Color := clGray;
    LineTo(Width-2, Height-2);
    LineTo(1, Height-2);
    Font.Color := FButtonFont.Color;
    Font.Name := FButtonFont.FontName;
    Font.Size := FButtonFont.Size;
    Font.Style := FButtonFont.Style;
    TextOut(2,2,caption);
  end;
end;

{ TTIWPopupMenuLabel }

constructor TTIWPopupMenuLabel.Create(AOwner: TComponent);
begin
  inherited;
  FLabelFont := TIWFont.Create;
  FLabelFont.FontName := 'Arial';
  FLabelFont.Color := clBlack;
  FLabelFont.Size := 10;
  FLabelColor := clWhite;
end;

destructor TTIWPopupMenuLabel.Destroy;
begin
  inherited;
  FLabelFont.free;
end;

{$IFDEF TMSIW6}
procedure TTIWPopupMenuLabel.IWPaint;
{$ELSE}
procedure TTIWPopupMenuLabel.Paint;
{$ENDIF}
begin
  inherited;
  with Canvas do
  begin
    Brush.Color:= FLabelColor;
    FillRect(GetClientRect);
    Font.Color := FLabelFont.Color;
    Font.Name := FLabelFont.FontName;
    Font.Size := FLabelFont.Size;
    Font.Style := FLabelFont.Style;
    TextOut(2,2,caption);
  end;
end;

{$IFDEF TMSIW6}
function TTIWPopupMenuLabel.RenderHTML(AContext: TIWBaseComponentContext): TIWHTMLTag;
{$ELSE}
function TTIWPopupMenuLabel.RenderHTML: TIWHTMLTag;
{$ENDIF}
var
  LabelWeight : string;
  StrBackgroundLabel : string;
  HTML, JSSubMenu, TiersArray : string;
  Parent, Tag, Script : TIWHTMLTag;
  i,k : integer;
  AItem : TMenuItem;
  DefaultItem, newItem : TMenuItem;
  ajaxcall, submitclick: string;
begin
  HTML := '';
  LabelWeight := '';
  StrBackgroundLabel := '';
  JSSubMenu := '';
  TiersArray := '';

  if (fsBold in LabelFont.Style) then
  LabelWeight := 'font-weight: bold;';

  if (LabelColor <> clNone) then
    StrBackgroundLabel := 'background-color: ' + HTMLClr(Self.LabelColor) + ';';

  HTML := HTML
		+ '<span id="' + HTMLName + 'Label" style="width:' + IntToStr(Self.Width) + '; ' + StrBackgroundLabel
    + ' height: ' + IntToStr(Height) + ';' + FontToCSS(LabelFont)
		+ '" onclick="p_setPropsTier(' + HTMLName + 'arProp); p_setProperties(' + HTMLName + 'array,''' + HTMLName
    + ''');popupShowMenu(1,event,''Left'',''' + HTMLName + '_1'');">'
		+ Self.Caption + '</span>'#13;

  Tag := TIWHTMLTag.CreateTag('DIV');
  Tag.AddStringParam('class',HTMLName + 'CSS');
  Tag.AddStringParam('NAME',HTMLName);
  Tag.AddStringParam('ID',HTMLName);

  Parent := TIWHTMLTag.CreateTag('');
  Tag.Contents.AddText(HTML);
  {$IFDEF TMSIW6}
  Tag.Contents.AddText(RenderCustomHTML(AContext));
  {$ELSE}
  Tag.Contents.AddText(RenderCustomHTML);
  {$ENDIF}

	JSSubMenu := '';

  DefaultItem := TMenuItem.Create(Self);
  DefaultItem.Caption := '';

  NewItem := TMenuItem.Create(Self);
  NewItem.Caption := '';
  DefaultItem.Add(NewItem);

  if (Assigned(FMenu)) then
  begin
    for i := 1 to FMenu.Items.Count do
      CopyMenu(FMenu.Items[i-1],DefaultItem.Items[0], i-1);
  end;

  AutoNumber := 1;

  for i := 1 to DefaultItem.Count do
  begin
	 Level := 0;
    MenuCode := '';
	  AItem := DefaultItem.Items[i-1];
  	JSSubMenu := JSSubMenu
	    + MakeMenu(IntToStr(i), AItem);
  end;

  submitclick := ' return SubmitClick('#39+HTMLName+#39+',realName,' + #39 + 'false' + #39 + ');'#13;

  {$IFDEF TMSIW9}
  if Assigned(FOnAsyncMenuClick) then
  begin
    ajaxcall := 'processAjaxEvent(''onMenuClick'', '
      + HTMLControlImplementation.IWCLName
      + ',''' + HTMLName + '.' + 'DoAsyncMenuClick' + ''','
      + 'true' + ', null, '
      + 'true' + ');';

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

      submitclick := '';
  end;
 {$ENDIF}

	JSSubMenu := JSSubMenu
	  + 'function ' + HTMLName + 'SubmitValue(name)'#13
	  + '{'#13
    + '  var firstPart = "";'#13
    + '  firstPart = name.substring(0,name.indexOf(''_''));'#13
    + '  var lastPart = "";'#13
    + '  lastPart = name.substring(name.indexOf(''_'')+2, name.length);'#13
    + '  var realName = firstPart + lastPart;'#13
    + 'document.getElementById("'+HTMLName+'_INPUT").value = realName;'#13
    + ajaxcall
    + submitclick
		+ '}'#13;

  TiersArray := TiersArray
    + '  var ' + HTMLName + 'arProp = new Array();'#13;

  for k := 0 to Tiers.Count - 1 do
  begin
    if (Tiers[k] = 'null') then
		  TiersArray := TiersArray
				  + HTMLName + 'arProp[' + IntToStr(k) + '] = null;'#13
	  else
		  TiersArray := TiersArray
				+ HTMLName + 'arProp[' + IntToStr(k) + '] = ' + Tiers[k] + ';'#13;
  end;

  Script := TIWHTMLTag.CreateTag('SCRIPT');
  Script.Contents.AddText(TiersArray);
  Script.Contents.AddText(Javascript);
  Script.Contents.AddText(JSSubMenu);
  {$IFDEF TMSIW6}
  Parent.Contents.Add(Tag);
  Parent.Contents.Add(Script);
  {$ENDIF}
  {$IFNDEF TMSIW6}
  Parent.Contents.AddTagAsObject(Tag);
  Parent.Contents.AddTagAsObject(Script);
  {$ENDIF}
  Result := Parent;

  //clear arrays before refresh.
  //fixed: if some items are set to visible = false
  //after refresh the # of items in the array does no longer correspond to the
  //number of visible items and some subitems might not be displayed.
  arMenuId.Clear;
  arMenuName.Clear;  

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

end;

procedure TTIWPopupMenuLabel.SetLabelColor(const Value: TColor);
begin
  FLabelColor := Value;
  invalidate;
end;

procedure TTIWPopupMenuLabel.SetLabelFont(const Value: TIWfont);
begin
  FLabelFont.assign(Value);
  invalidate;
end;

{TTIWDocumentPopupMenu }

constructor TTIWDocumentPopupMenu.Create(AOwner: TComponent);
begin
  inherited;
  FEnableRightClick := true;
end;

destructor TTIWDocumentPopupMenu.Destroy;
begin

  inherited;
end;

procedure TTIWDocumentPopupMenu.SetEnableRightClick(const Value : Boolean);
begin
  FEnableRightClick := Value;
end;

{$IFDEF TMSIW6}
function TTIWDocumentPopupMenu.RenderHTML(AContext: TIWBaseComponentContext): TIWHTMLTag;
{$ELSE}
function TTIWDocumentPopupMenu.RenderHTML: TIWHTMLTag;
{$ENDIF}
var
  HTML, JSSubMenu, TiersArray : string;
  Parent, Tag, Script : TIWHTMLTag;
  i,k : integer;
  AItem : TMenuItem;
  DefaultItem, newItem : TMenuItem;
  ShowFunction, DocMouseDown : string;
  ajaxcall, submitclick: string;
begin
  HTML := '';
  JSSubMenu := '';
  TiersArray := '';
  ShowFunction := '';

  ShowFunction := ShowFunction
    + 'function ' + HTMLName + '_Show(coordX, coordY, evt) {'#13
    + '  p_setPropsTier(' + HTMLName + 'arProp);'#13
    + '  p_setProperties(' + HTMLName + 'array,''' + HTMLName + ''');'#13
    + '  docPopupShowMenu(1,''Left'',''' + HTMLName + '_1'',evt,coordX,coordY);'#13
    + '}'#13;

  Tag := TIWHTMLTag.CreateTag('DIV');
  Tag.AddStringParam('class',HTMLName + 'CSS');
  Tag.AddStringParam('NAME',HTMLName);
  Tag.AddStringParam('ID',HTMLName);

  Parent := TIWHTMLTag.CreateTag('');
  Tag.Contents.AddText(HTML);
  {$IFDEF TMSIW6}
  Tag.Contents.AddText(RenderCustomHTML(AContext));
  {$ELSE}
  Tag.Contents.AddText(RenderCustomHTML);
  {$ENDIF}

	JSSubMenu := '';

  DefaultItem := TMenuItem.Create(Self);
  DefaultItem.Caption := '';

  NewItem := TMenuItem.Create(Self);
  NewItem.Caption := '';
  DefaultItem.Add(NewItem);

  if (Assigned(FMenu)) then
  begin
    for i := 1 to FMenu.Items.Count do
      CopyMenu(FMenu.Items[i-1],DefaultItem.Items[0], i-1);
  end;

  AutoNumber := 1;

  for i := 1 to DefaultItem.Count do
  begin
	 Level := 0;
    MenuCode := '';
	  AItem := DefaultItem.Items[i-1];
  	JSSubMenu := JSSubMenu
	    + MakeMenu(IntToStr(i), AItem);
  end;

  submitclick := ' return SubmitClick('#39+HTMLName+#39+',realName,' + #39 + 'false' + #39 + ');'#13;

  {$IFDEF TMSIW9}
  if Assigned(FOnAsyncMenuClick) then
  begin
    ajaxcall := 'processAjaxEvent(''onMenuClick'', '
      + HTMLControlImplementation.IWCLName
      + ',''' + HTMLName + '.' + 'DoAsyncMenuClick' + ''','
      + 'true' + ', null, '
      + 'true' + ');';

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

      submitclick := '';
  end;
 {$ENDIF}

	JSSubMenu := JSSubMenu
	  + 'function ' + HTMLName + 'SubmitValue(name)'#13
	  + '{'#13
    + '  var firstPart = "";'#13
    + '  firstPart = name.substring(0,name.indexOf(''_''));'#13
    + '  var lastPart = "";'#13
    + '  lastPart = name.substring(name.indexOf(''_'')+2, name.length);'#13
    + '  var realName = firstPart + lastPart;'#13
    + 'document.getElementById("'+HTMLName+'_INPUT").value = realName;'#13
    + ajaxcall
    + submitclick
		+ '}'#13;

  TiersArray := TiersArray
    + '  var ' + HTMLName + 'arProp = new Array();'#13;

  for k := 0 to Tiers.Count - 1 do
  begin
    if (Tiers[k] = 'null') then
		  TiersArray := TiersArray
				  + HTMLName + 'arProp[' + IntToStr(k) + '] = null;'#13
	  else
		  TiersArray := TiersArray
				+ HTMLName + 'arProp[' + IntToStr(k) + '] = ' + Tiers[k] + ';'#13;
  end;

  Script := TIWHTMLTag.CreateTag('SCRIPT');
  Script.Contents.AddText(TiersArray);
  Script.Contents.AddText(Javascript);
  Script.Contents.AddText(JSSubMenu);
  Script.Contents.AddText(ShowFunction);
  {$IFDEF TMSIW6}
  Parent.Contents.Add(Tag);
  Parent.Contents.Add(Script);
  {$ENDIF}
  {$IFNDEF TMSIW6}
  Parent.Contents.AddTagAsObject(Tag);
  Parent.Contents.AddTagAsObject(Script);
  {$ENDIF}
  Result := Parent;

	DocMouseDown := '';
	DocMouseDown := DocMouseDown
	  + 'function disableMenu(evt) {'#13;

  {$IFDEF TMSIW6}
  if (AContext.WebApplication.Browser = brIE) then
  {$ELSE}
  if (WebApplication.Browser = brIE) then
  {$ENDIF}
  begin
	  DocMouseDown := DocMouseDown
		  + ' if (event.button != 1) {'#13
      + '   p_setPropsTier(' + HTMLName + 'arProp);'#13
      + '   p_setProperties(' + HTMLName + 'array,''' + HTMLName + ''');'#13
      + '   docPopupShowMenu(1,''Left'',''' + HTMLName + '_1'',evt,null,null);'#13;
  end
  else
	begin
		DocMouseDown := DocMouseDown
		  + ' if (evt.which != 1) {'#13
      + '   p_setPropsTier(' + HTMLName + 'arProp);'#13
      + '   p_setProperties(' + HTMLName + 'array,''' + HTMLName + ''');'#13
      + '   docPopupShowMenu(1,''Left'',''' + HTMLName + '_1'',evt,null,null);'#13;
  end;

	DocMouseDown := DocMouseDown
	  + '     return false;'#13
		+ '  }'#13
    + '}'#13;

  DocMouseDown := DocMouseDown
    + 'function disableContext(e) {'#13
    + '  return false;'#13
    + '}'#13;

  DocMouseDown := DocMouseDown
    + 'function ' + HTMLName + 'MouseDown() {'#13;

  if (Self.EnableRightClick) then
    DocMouseDown := DocMouseDown
      + '  document.onmousedown = disableMenu;'#13
      + '  document.oncontextmenu = disableContext;'#13;

  DocMouseDown := DocMouseDown
	+ '}'#13;

  {$IFDEF TMSIW6}
   TIWComponent40Context(AContext).AddToInitProc(DocMouseDown + HTMLName + 'MouseDown();'#13);
  {$ELSE}
   AddToInitProc(DocMouseDown + HTMLName + 'MouseDown();'#13);
  {$ENDIF}

  //clear arrays before refresh.
  //fixed: if some items are set to visible = false
  //after refresh the # of items in the array does no longer correspond to the
  //number of visible items and some subitems might not be displayed.
  arMenuId.Clear;
  arMenuName.Clear;  

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

end;

end.
