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

interface

uses
  {$IFDEF Linux}
  QControls, QGraphics,
  {$ELSE}
  Controls,
  Windows,
  Graphics,
  {$ENDIF}
  Classes,
  IWControl, IWTypes, SysUtils,
  IWPicCntnr,
  IWTMSImg,
  IWHTMLTag, IWFont,
  IWCompEdit, IWCompLabel, IWCompCheckBox, IWExtCtrls, Menus, Dialogs;

type
  TTIWTMSWebPanels = class;
  TIWGroups = class;
  TIWGroup = class;
  TIWItem = class;
  TIWSubItem = class;
  //----------------------------------------------------------
  TIWItemClick = procedure(ASender: TObject; Group: TIWGroup; Item: TIWItem) of object;
  TIWSubItemClick = procedure(ASender: TObject; Group: TIWGroup;
    Item: TIWItem; SubItem: TIWSubItem) of object;
  TIWGroupClick = procedure(ASender: TObject; Group: TIWGroup) of object;

  //----------------------------------------------------------
  TIWSubItem = class(TCollectionItem)
  private
    FSubItemClick: TIWSubItemClick;
    FCaption: string;
    procedure SetSubItemClick(const Value: TIWSubItemClick);
    procedure SetCaption(const Value: string);
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
  published
    property OnSubItemClick: TIWSubItemClick read FSubItemClick write SetSubItemClick;
    property Caption: string read FCaption write SetCaption;
  end;
  //----------------------------------------------------------
  TIWSubItems = class(TOwnedCollection)
  private
    FOwner: TIWItem;
    function GetSubItem(Index: integer): TIWSubItem;
    procedure SetSubItem(Index: integer; const Value: TIWSubItem);
  protected
    procedure Update(Item: TCollectionItem); override;
  public
    function CreateItemClass: TCollectionItemClass; virtual;
    constructor Create(AOwner: TIWItem);
    function Add: TIWSubItem;
    function Insert(index: integer): TIWSubItem;
    property Items[Index: integer]: TIWSubItem read GetSubItem write SetSubItem; default;
  published
  end;

  //----------------------------------------------------------
  TIWItem = class(TCollectionItem)
  private
    FItemClick: TIWItemClick;
    FCaption: string;
    FSubItems: TIWSubItems;
    FSubItemColor: TColor;
    FSubItemFont: TIWfont;
    FHeader: string;
    FHeaderColor: TColor;
    FHeaderFont: TIWfont;
    procedure SetItemClick(const Value: TIWItemClick);
    procedure SetCaption(const Value: string);
    procedure SetSubItems(const Value: TIWSubItems);
    procedure SetSubItemColor(const Value: TColor);
    procedure SetSubItemFont(const Value: TIWfont);
    procedure SetHeader(const Value: string);
    procedure SetHeaderColor(const Value: TColor);
    procedure SetHeaderFont(const Value: TIWfont);

  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
  published
    property OnItemClick: TIWItemClick read FItemClick write SetItemClick;
    property SubItems: TIWSubItems read FSubItems write SetSubItems;
    property Caption: string read FCaption write SetCaption;
    property SubItemFont: TIWfont read FSubItemFont write SetSubItemFont;
    property SubItemColor: TColor read FSubItemColor write SetSubItemColor default clInfoBk;
    property Header: string read FHeader write SetHeader;
    property HeaderFont: TIWfont read FHeaderFont write SetHeaderFont;
    property HeaderColor: TColor read FHeaderColor write SetHeaderColor default clBlue;
  end;
  //----------------------------------------------------------
  TIWItems = class(TOwnedCollection)
  private
    FOwner: TIWGroup;
    function GetItem(Index: integer): TIWItem;
    procedure SetItem(Index: integer; const Value: TIWItem);
  protected
    procedure Update(Item: TCollectionItem); override;
  public
    function CreateItemClass: TCollectionItemClass; virtual;
    constructor Create(AOwner: TIWGroup);
    function Add: TIWItem;
    function Insert(index: integer): TIWItem;
    property Items[Index: integer]: TIWItem read GetItem write SetItem; default;
  published
  end;
  //----------------------------------------------------------

  TIWGroup = class(TCollectionItem)
  private
    FCaption: string;
    FItems: TIWItems;
    FGroupColor: TColor;
    FGroupFont: TIWfont;
    Fclosed: boolean;
    FGroupClick: TIWGroupClick;
    procedure SetCaption(const Value: string);
    procedure SetItems(const Value: TIWItems);
    procedure SetGroupFont(const Value: TIWfont);
    procedure SetGroupColor(const Value: TColor);
    procedure Setclosed(const Value: boolean);
    procedure SetGroupClick(const Value: TIWGroupClick);
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
  published
    property Caption: string read FCaption write SetCaption;
    property Items: TIWItems read FItems write SetItems;
    property GroupFont: TIWfont read FGroupFont write SetGroupFont;
    property GroupColor: TColor read FGroupColor write SetGroupColor default 15658734;
    property OnGroupClick :TIWGroupClick read FGroupClick Write SetGroupClick;
    property Closed:boolean read Fclosed write Setclosed default false;
  end;
  //----------------------------------------------------------
  TIWGroups = class(TOwnedCollection)
  private
    FOwner: TTIWTMSWebPanels;
    function GetItem(Index: integer): TIWGroup;
    procedure SetItem(Index: integer; const Value: TIWGroup);
  protected
    procedure Update(Item: TCollectionItem); override;
  public
    function CreateItemClass: TCollectionItemClass; virtual;
    constructor Create(AOwner: TTIWTMSWebPanels);
    function Add: TIWGroup;
    function Insert(index: integer): TIWGroup;
    property Items[Index: integer]: TIWGroup read GetItem write SetItem; default;
  published
  end;
  //----------------------------------------------------------

  TTIWTMSWebPanels = class(TIWControl)
  private
    FButtonBackgroundColor: TColor;
    FGroups: TIWGroups;
    FButtonFont: TIWFont;
    FUpImage: Tbitmap;
    FDownImage: Tbitmap;
    FButtonInactiveBackgroundColor: TColor;
    FHeightScrollArea: integer;
    FWidthScrollArea: integer;
    procedure SetGroups(const Value: TIWGroups);
    procedure SetButtonFont(const Value: TIWfont);
    procedure SetButtonBackgroundColor(const Value: TColor);
    procedure SetButtonInactiveBackgroundColor(const Value: TColor);
    procedure SetDownImage(const Value: Tbitmap);
    procedure SetUpImage(const Value: Tbitmap);
  protected
    procedure Submit(const AValue: string); override;
    function HTMLClr(color: TColor): string;
    function Makestyle(bgcolor: Tcolor; stylefont: TIWFont;
      hand, closetag: boolean): string;
    function Htmlbmp(var bmp: TBitmap): string;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Paint; override;
    function RenderHTML: TIWHTMLTag; override;
  published
    property ButtonBackgroundColor: TColor 
      read FButtonBackgroundColor write SetButtonBackgroundColor default clNavy;
    property ButtonFont: TIWfont read FButtonFont write SetButtonFont;
    property Groups: TIWGroups read FGroups write SetGroups;
    property ButtonInactiveBackgroundColor: TColor 
      read FButtonInactiveBackgroundColor write SetButtonInactiveBackgroundColor default clGray;
    property UpImage: Tbitmap read FUpImage write SetUpImage;
    property DownImage: Tbitmap read FDownImage write SetDownImage;
    property WidthScrollArea: integer read FWidthScrollArea write FWidthScrollArea
      default 150;
    property HeightScrollArea: integer read FHeightScrollArea write FHeightScrollArea
      default 150;
    property Color;
  end;

procedure Register;

implementation
{$R IWTMSWebPanels.res}

uses
  ImgList, ShellAPI, CommCtrl, IWApplication, IWServerControllerBase,
  SWStrings, SWSystem, IWAppForm;

const
  clikitem    = 'ItemClick';
  clikgroup   = 'GroupClick';
  cliksubitem = 'SubItemClick';


procedure Register;
begin
  RegisterComponents('TMS IW', [TTIWTMSWebPanels]);
end;

{ TTIWTMSWebPanels }

constructor TTIWTMSWebPanels.Create(AOwner: TComponent);
begin
  inherited;
  Width := 250;
  FWidthScrollArea := 150;
  FHeightScrollArea := 150;
  FSupportsInput := True;
  FSupportsSubmit := True;
  FButtonBackgroundColor := clNavy;
  FButtonInactiveBackgroundColor := clGray;
  FUpImage := TBitmap.Create;
  FUpImage.Handle := LoadBitmap(HInstance, 'ARROWUP');
  FUPImage.Transparent := True;
  FDownImage := TBitmap.Create;
  FDownImage.Handle := LoadBitmap(HInstance, 'ARROWDOWN');
  FDownImage.Transparent := True;
  FGroups := TIWGroups.Create(Self);
  FButtonFont := TIWFont.Create;
  FButtonFont.FontName := 'Arial';
  FButtonFont.Color := clWhite;
  FButtonFont.Size := 18;
  FButtonFont.Style := [fsBold, fsItalic];
end;

destructor TTIWTMSWebPanels.Destroy;
begin
  inherited;
  FGroups.Free;
  FButtonFont.Free;
  FUpImage.Free;
  FDownImage.Free;
end;

procedure TTIWTMSWebPanels.Paint;
var
  R: Trect;
  OfsY, TY, i, j: integer;
  s: string;
begin
  with FCanvas do
  begin
    Pen.Width := 1;
    OfsY := 0;
    for i := 0 to FGroups.Count - 1 do
    begin
      with FGroups do
      begin
        if FGroups.items[i].Fclosed
          then
            begin
              Brush.Color := FButtonInactiveBackgroundColor;
              Pen.Color := FButtonInactiveBackgroundColor;
            end
          else
            begin
              Brush.Color := FButtonBackgroundColor;
              Pen.Color := FButtonBackgroundColor;
            end;
        Font.Color := FButtonFont.Color;
        Font.Name := FButtonFont.FontName;
        Font.Size := FButtonFont.Size;
        Font.Style := FButtonFont.Style;

        s := Items[i].FCaption;
        TY := TextHeight('hg');
        r := rect(0, OfsY, Width, OfsY + TY);
        Rectangle(r);
        if FGroups.items[i].Fclosed then
          begin
            if assigned(FDownImage) then
               begin
                 draw(r.Right - FDownImage.Width, r.top, FDownImage);
                 if FDownImage.Height > ty then  ty := FDownImage.Height;
            end;
          end                       else
          begin
            if assigned(FUpImage) then
               begin
                 draw(r.Right - FUpImage.Width, r.top, FUpImage);
                 if FUpImage.Height > ty then  ty := FUpImage.Height;
            end;
          end;

        TextOut(2, OfsY, s);
        inc(OfsY, TY);
        if not (items[i].Fclosed) then
        begin
        for j := 0 to items[i].FItems.Count - 1 do
        begin
          Brush.Color := items[i].FGroupColor;
          Pen.Color := items[i].FGroupColor;
          Font.Color := items[i].FGroupFont.Color;
          Font.Name := items[i].FGroupFont.FontName;
          Font.Size := items[i].FGroupFont.Size;
          Font.Style := items[i].FGroupFont.Style;

          s := Items[i].items[j].FCaption;
          TY := TextHeight('hg');
          r := rect(0, OfsY, Width, OfsY + TY);
          Rectangle(r);
          TextOut(2, OfsY, s);
          if Groups[i].Items[j].FSubItems.Count > 0 then
          begin
            //          r := Rect(,OfsY,width-2,OfsY+TY);
            //          DrawFrameControl(Fcanvas.Handle,r, DFC_SCROLL,DFCS_SCROLLRIGHT );
            TextOut(Width - TY - 2, OfsY, '>');
          end;
          inc(OfsY, TY);
          if j = items[i].FItems.Count - 1 then inc(OfsY, 15);
        end;
       end
       else inc(OfsY, 15);
      end;
    end;
  end;
  if FGroups.Count > 0 then Height := OfsY
  else
  begin
    inherited;
    Fcanvas.textout(ClientRect.left, ClientRect.top, Name);
  end;
end;

function TTIWTMSWebPanels.HTMLClr(color: TColor): string;
begin
  Result := ColorToRGBString(color);
end;

function TTIWTMSWebPanels.RenderHTML: TIWHTMLTag;
var
  script1, script2, head, html, localid: string;
  i, j, k: integer;
begin
  //--------------------------------------------------------
  script2:='';
  script1 := '<script language='#39'JavaScript'#39'>'#13 +
    'function ' + HTMLName + 'PartWrapperToggle(GPS) {'#13 +
    'window.event.cancelBubble = true;'#13 +
    'return SubmitClick('#39 + HTMLName + #39 + ',' + #39 + clikgroup +
      #39 + '+GPS,'#39'false'#39');'#13 +
    '}'#13'</script>';

  html := '';
  for i := 0 to FGroups.Count - 1 do
  begin
    html := html +
      '<script>'#13 +
      'function ' + HTMLName + 'GRP' + IntToStr(i) + 'Highlight(HR,loc,tbl) {'#13 +
      'var ' + HTMLName + '_calcul = null;'#13 +
      'var ' + HTMLName + '_local = null;'#13 +
      'var ' + HTMLName + '_ButUP = null;'#13 +
      'var ' + HTMLName + '_ButDown = null;'#13 +
      'if(document.getElementsByName) {'#13 +
      HTMLName + '_calcul = document.getElementsByName("scrolltable"+loc);'#13 +
      HTMLName + '_local = document.getElementsByName(loc);'#13 +
      HTMLName + '_local[0].style.visibility="visible";'#13 +
      'HR.style.backgroundColor="' + HTMLClr(clNavy) + '";HR.style.color="#FFFFFF";'#13 +
      'if (' + HTMLName + '_calcul[0]){'#13 +
      'if (parseInt(tbl.style.height)>' + HTMLName + '_calcul[0].offsetHeight)'#13 +
      ' {tbl.style.height=' + HTMLName + '_calcul[0].offsetHeight;'#13 +
      HTMLName + '_ButUP    =document.getElementsByName(loc+"ButonScrollUP");'#13 +
      HTMLName + '_ButDown = document.getElementsByName(loc+"ButonScrollDown");'#13 +
      '  if (' + HTMLName + '_ButDown[0]){' + HTMLName +
      '_ButDown[0].style.display="none";}'#13 +
      '  if (' + HTMLName + '_ButUP[0]){' + HTMLName + '_ButUP[0].style.display="none"}'#13 +
      '}'#13 +
      '}'#13 +
      '}'#13 +
      '}'#13 +
      'function ' + HTMLName + 'GRP' + IntToStr(i) +
      'Normal(HR,loc)    {HR.style.backgroundColor="' + HTMLClr(FGroups.Items[i].FGroupColor) +
      '";HR.style.color="' + HTMLClr(FGroups.Items[i].FGroupFont.Color) + '";'#13 +
      'loc.style.visibility="hidden";'#13 +
      '}'#13 +
      'function ' + HTMLName + 'GRP' + IntToStr(i) + clikitem + '(GPS,GP)    {' +
      'return SubmitClick('#39 + HTMLName + #39 + ',' + #39 + clikitem +
      #39 + '+GPS+","+GP,'#39'false'#39');}'#13 +
      'function ' + HTMLName + 'GRPS' + IntToStr(i) + cliksubitem + '(GPS,GP,SUBITEM)    {' +
      'return SubmitClick('#39 + HTMLName + #39 + ',' + #39 + cliksubitem +
      #39 + '+GPS+","+GP+","+SUBITEM,'#39'false'#39');}'#13 +
      '</script>'#13;
    html := html + #13 +
      '<Table id="' + HTMLName + 'GRP' + IntToStr(i) + 'Header" width="' +
      IntToStr(Width) + '"px border="0" cellspacing="0" cellpadding="0" ' +
      IIF(FGroups.items[i].fclosed,
      Makestyle(FButtonInactiveBackgroundColor, ButtonFont, True,True),
      Makestyle(FButtonBackgroundColor, ButtonFont, True,True)
      ) +
      //FButtonInactiveBackgroundColor=close
      '><tr>'#13 +
      '<td  onclick="' + HTMLName + 'PartWrapperToggle('+IntToStr(i) +');">'#13 +
      FGroups.Items[i].FCaption +
      '</td>'#13 +
      '<td onclick="' + HTMLName + 'PartWrapperToggle('+ IntToStr(i)+');">'#13 +
      //none=close block=open. If change status swap images style.display
      '<img  id="' + HTMLName + 'GRP' + IntToStr(i) + 'Up" src="' +
      Htmlbmp(FUPImage) + '" align="right" BORDER="0" ALT="hide option" style="display:'+IIF(FGroups.items[i].fclosed,'none','block')+'">'#13 +
      '<img  id="' + HTMLName + 'GRP' + IntToStr(i) + 'Down" src="' +
      Htmlbmp(FDownImage) + '" align="right" BORDER="0" ALT="option" style="display:'+   IIF(FGroups.items[i].fclosed,'block','none')+'">'#13 +
      '</td>'#13 +
      '</tr>'#13 +

      '</Table>'#13 +

      '<Table width="' + IntToStr(Width) + 'px;" cellpadding="0" cellspacing="0" border="0" ' +
      'id="' + HTMLName + 'GRP' + IntToStr(i) +
      'Body" BORDER="0" CELLSPACING="0" CELLPADDING="0" width="' + IntToStr(Width) + '" ' +
      Makestyle(FGroups.Items[i].FGroupColor, FGroups.Items[i].FGroupFont,
      True, False) + ';display:'+IIF(FGroups.items[i].fclosed,'none','block')+';">'#13;//none=close

    for j := 0 to FGroups.Items[i].FItems.Count - 1 do
    begin
      localid := '_GRP' + IntToStr(i) + 'GP' + IntToStr(j);
      html := html +
        ' <tr onmouseover="' + HTMLName + 'GRP' + IntToStr(i) + 'Highlight(this,'#39 +
        htmlname + localid + #39',' + htmlname + 'RescaleGP' + localid + ')"'#13 +
        ' onmouseout="' + HTMLName + 'GRP' + IntToStr(i) + 'Normal(this,' +
        htmlname + localid + ');"' +
        ' style="cursor: hand">'#13 +
  		    '<td onclick="' + HTMLName + 'GRP' + IntToStr(i) + clikitem + '(' +
        IntToStr(i) + ',' + IntToStr(j) + ');" style="border: solid 1px;border-width:0">'#13 +
  		    FGroups.Items[i].FItems[j].FCaption +
  		    '</td>'#13 +
  		    '<td onclick="' + HTMLName + 'GRP' + IntToStr(i) + clikitem +
        '(' + IntToStr(i) + ',' + IntToStr(j) +
        ');" style="border: solid 1px;border-width:0;" align="right">'#13 +
        IIF(FGroups.Items[i].FItems[j].FSubItems.Count > 0,
        '>', '') + #13 +
  		    '</td><td>'#13 +
        '<div id="' + htmlname + localid + '" ' +
        'style="POSITION:absolute; left:' +
        IntToStr(Width - 20) + '; VISIBILITY: hidden;">';

      head := '<table width="' + IntToStr(FWidthScrollArea)
        + '" style="border-width:0;cursor:default;background-color:' +
        HTMLClr(clSilver) + ';display:block">'#13 +
        '<tr ' + Makestyle(FGroups.Items[i].FItems[j].FHeaderColor,
        FGroups.Items[i].FItems[j].FHeaderFont, False, True) + '>'#13 +
        '<td>' + FGroups.Items[i].FItems[j].FHeader +
        '</td></tr>'#13 +
        '<tr onmouseover="' + HTMLName + localid +
        'scrollup();" ' +
        ' onmouseout="' + HTMLName + localid + 'stop();">'#13 +
        '<td id="' + HTMLNAME + localid +
        'ButonScrollUP" align=center>^</td></tr></table>'#13 +
        '<div id="' + htmlname + 'RescaleGP' +
        localid + '" style="position:relative;width:' + IntToStr(FWidthScrollArea) +
        'px;height:' + IntToStr(FHeightScrollArea) + 'px;overflow:hidden;">' +
        '<table id="scrolltable' + HTMLName +
        localid + '" width="' + IntToStr(FWidthScrollArea) + 'px" ' +
        Makestyle(Groups.items[i].FItems[j].FSubItemColor,
        FGroups.items[i].FItems[j].FSubItemFont, True, False) + 'position:relative;">' + #13;
      html := html + IIF(FGroups.Items[i].FItems[j].FSubItems.Count > 0,
        head, '<div id="' + htmlname + 'RescaleGP' + localid + '"><!-- only for id--></div>');

      script2 := script2 + '<script>'#13 +

        'var ' + HTMLName + localid + 'pz = 0;'#13 +
        'var ' + HTMLName + localid + 'fo_killTimer = null'#13 +
        'function ' + HTMLName + localid + 'move(y)'#13 +
        '{'#13 +
        //DEBUG                'alert('+HTMLName+localid+'pz)'#13+
        HTMLName + localid + 'pz=' + HTMLName + localid + 'pz+y;'#13 +
        'scrolltable' + HTMLName + localid + '.style.top=' +
        HTMLName + localid + 'pz;'#13 +
        '}'#13 +
        'function ' + HTMLName + localid + 'kill_flyout()'#13 +
        '{'#13 +
        HTMLName + localid + 'fo_killTimer = null'#13 +
        '}'#13 +
        'function ' + HTMLName + localid +
        'subitemHighlight(HR) {HR.style.backgroundColor="' + HTMLClr(clNavy)
        + '";HR.style.color="#FFFFFF";}'#13 +
        'function ' + HTMLName + localid +
        'subitemNORMAL(HR) {HR.style.backgroundColor="' +
        HTMLClr(FGroups.items[i].FItems[j].FSubItemColor) + '";HR.style.color="' +
        HTMLClr(FGroups.items[i].FItems[j].FSubItemFont.color) + '";}'#13 +
        'function ' + HTMLName + localid + 'scrollup()'#13 +
        '{'#13 +
        'if (' + HTMLName + localid + 'kt = ' + HTMLName + localid +
        'fo_killTimer) //not a == typo'#13 +
        '{'#13 +
        'clearTimeout(' + HTMLName + localid + 'kt)'#13 +
  	     HTMLName + localid + 'fo_killTimer = null'#13 +
        '} else'#13 +
        '{'#13 +
        'if (' + HTMLName + localid + 'pz-10>-scrolltable' + HTMLName +
        localid + '.offsetHeight+' + IntToStr(FHeightScrollArea) + ')'#13 +
        '{'#13 +
        HTMLName + localid + 'move(-10);'#13 +
        '}'#13 +
        'else {' +
        'if (' + HTMLName + localid + 'pz-1>-scrolltable' + HTMLName +
        localid + '.offsetHeight+' + IntToStr(FHeightScrollArea) + ')'#13 +
        HTMLName + localid + 'move(-1);'#13 +
        '}'#13 +
        'setTimeout(' + HTMLName + localid + 'scrollup, 100)'#13 +
  	     '}'#13 +
        '}'#13 +
        'function ' + HTMLName + localid + 'stop()'#13 +
        '{'#13 +
        HTMLName + localid + 'fo_killTimer = setTimeout(' +
        HTMLName + localid + 'kill_flyout, 300)'#13 +
        '}'#13 +
        'function ' + HTMLName + localid + 'scrolldown()'#13 +
        '{'#13 +
        'if (' + HTMLName + localid + 'kt = ' + HTMLName +
        localid + 'fo_killTimer) //not a == typo'#13 +
  	     '{'#13 +
        'clearTimeout(' + HTMLName + localid + 'kt)'#13 +
  	     HTMLName + localid + 'fo_killTimer = null'#13 +
        '}'#13 +
        'else'#13 +
        '{'#13 +
        'if (parseInt(scrolltable' + HTMLName + localid + '.style.top)+10<0)'#13 +
        '{'#13 +
        HTMLName + localid + 'move(+10);'#13 +
        '}'#13 +
        'else {' +
        'if (parseInt(scrolltable' + HTMLName + localid + '.style.top)+1<0)'#13 +
        HTMLName + localid + 'move(+1);'#13 +
        '}'#13 +
        'setTimeout(' + HTMLName + localid + 'scrolldown, 100)'#13 +
        '}'#13 +
        '}'#13 +
        '</script>';

      for k := 0 to FGroups.Items[i].FItems[j].FSubItems.Count - 1 do
      begin
        html := html + '<tr onclick="' + HTMLName + 'GRPS' + IntToStr(i) +
          cliksubitem + '(' + IntToStr(i) + ',' + IntToStr(j) + ',' + IntToStr(k) + ');"' +
          'onmouseover="' + HTMLName + localid + 'subitemHighlight(this);" ' +
          'onmouseout ="' + HTMLName + localid + 'subitemNORMAL(this);" >' +
          '<td>' + FGroups.Items[i].FItems[j].FSubItems[k].FCaption + '</td></tr>';
      end;
      head := '</td></tr></table></div>'#13 +
        ' <table id="' + HTMLNAME + localid + 'ButonScrollDown" width="' +
        IntToStr(FWidthScrollArea) +
        '" style="border: solid 1px;border-width:0;cursor:default;background-color:' +
        HTMLClr(clSilver) + ';display:block">'#13 +
        '<tr onmouseover="' + HTMLName + localid + 'scrolldown();" ' +
        ' onmouseout="' + HTMLName + localid + 'stop();">'#13 +
        '<td align=center>v</td></tr></table>'#13;
      html := html + IIF(FGroups.Items[i].FItems[j].FSubItems.Count > 0,
        head, '') + '</div></td></tr>'#13;
    end;
    //for between Groups space
    html := html + '<table height="15"><tr><td></td></tr></table>'#13;
  end;

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

procedure TTIWTMSWebPanels.SetButtonBackgroundColor(const Value: TColor);
begin
  FButtonBackgroundColor := Value;
  invalidate;
end;

procedure TTIWTMSWebPanels.SetButtonFont(const Value: TIWfont);
begin
  FButtonFont.Assign(Value);
  Invalidate;
end;

procedure TTIWTMSWebPanels.SetButtonInactiveBackgroundColor(const Value: TColor);
begin
  FButtonInactiveBackgroundColor := Value;
  invalidate;
end;

procedure TTIWTMSWebPanels.SetDownImage(const Value: Tbitmap);
begin
  FDownImage.Assign(Value);
  invalidate;
end;


procedure TTIWTMSWebPanels.SetGroups(const Value: TIWGroups);
begin
  FGroups := Value;
end;



procedure TTIWTMSWebPanels.SetUpImage(const Value: Tbitmap);
begin
  FUpImage.Assign(Value);
  invalidate;
end;

procedure TTIWTMSWebPanels.Submit(const AValue: string);
var
  Decode, Sub: string;
  i, j, k, err: integer;
begin
  Decode := AValue;
  //  MessageDlg('SUBMIT=>'+AValue, mtWarning, [mbYes], 0);
  if ansipos(clikitem, Decode) = 1 then
  begin
    Delete(decode, 1, length(clikitem));
    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 (err <> 0) or (i < 0) or (FGroups.Count <= i) then exit;
      Delete(decode, 1, length(sub) + 1);
      val(decode, j, err);
      if (err <> 0) or (j < 0) or (FGroups.items[i].FItems.Count <= j) then exit;
      if assigned(FGroups.items[i].FItems[j].FItemClick) then
        FGroups.items[i].FItems[j].FItemClick(Self, FGroups.items[i],
          FGroups.items[i].FItems[j]);
    end;
  end
  else
  begin
    if ansipos(cliksubitem, Decode) = 1 then
    begin
      Delete(decode, 1, length(cliksubitem));
      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 (err <> 0) or (i < 0) or (FGroups.Count <= i) then exit;
        Delete(decode, 1, length(sub) + 1);
        sub := decode;
        if pos(',', sub) > 0 then
          Sub := copy(sub, 1, pos(',', sub) - 1);
        val(sub, j, err);
        if (err <> 0) or (j < 0) or (FGroups.items[i].FItems.Count <= j) then exit;
        Delete(decode, 1, length(sub) + 1);
        val(decode, k, err);
        if (err <> 0) or (k < 0) or (FGroups.items[i].FItems[j].FSubItems.Count <= k) then
          exit;
        if assigned(FGroups.items[i].FItems[j].FSubItems[k].FSubItemClick) then
          FGroups.items[i].FItems[j].FSubItems[k].FSubItemClick(self,
            FGroups.items[i], FGroups.items[i].FItems[j], FGroups.items[i].FItems[j].FSubItems[k]);
      end;
    end
    else
     begin
        if ansipos(clikgroup, Decode) = 1 then
          begin
            Delete(decode, 1, length(clikgroup));
            if length(decode) > 0 then
            begin
              val(decode, i, err);
              if (err <> 0) or (i < 0) or (FGroups.Count <= i) then exit;
              FGroups.items[i].Fclosed:=not(FGroups.items[i].Fclosed);
              if assigned(FGroups.items[i].FGroupClick) then
                 FGroups.items[i].FGroupClick(Self, FGroups.items[i]);
             end;
          end;
     end;
  end;
end;

function TTIWTMSWebPanels.Makestyle(bgcolor: Tcolor;
  stylefont: TIWFont; hand, closetag: boolean): string;
begin
  Result := 'style="background-color: ' + HTMLClr(bgcolor) +
    ';color:' + HTMLClr(stylefont.Color) + ';' +
    IIF(stylefont.FontName <> '', 'font-family:' + stylefont.FontName + '; ',
    '') + stylefont.CSSStyle + ' font-size:' + IntToStr(stylefont.Size) +
    '; ' + IIF((fsBold in stylefont.Style),
    'font-weight:bold;', '') + IIF(hand, 'cursor: hand;',
    'cursor: default;') + IIF(closetag, '"', '') + #13;
end;

function TTIWTMSWebPanels.Htmlbmp(var bmp: TBitmap): string;
var
  spath: string;
begin
  Result := '';
  if not Assigned(bmp) then
    Exit;
  if bmp.Empty then
    Exit;
  spath := TIWServerControllerBase.NewCacheFile('bmp');
  bmp.SaveToFile(spath);
  spath := WebApplication.URLBase + '/cache/' + ExtractFileName(spath);
  Result := spath;
end;

{ TIWGroups }

function TIWGroups.Add: TIWGroup;
begin
  Result := TIWGroup(inherited Add);
end;

constructor TIWGroups.Create(AOwner: TTIWTMSWebPanels);
begin
  inherited Create(AOwner, CreateItemClass);
  FOwner := AOwner;
end;

function TIWGroups.CreateItemClass: TCollectionItemClass;
begin
  Result := TIWGroup;
end;

function TIWGroups.GetItem(Index: integer): TIWGroup;
begin
  Result := TIWGroup(inherited Items[Index]);
end;

function TIWGroups.Insert(index: integer): TIWGroup;
begin
  Result := TIWGroup(inherited Insert(Index));
end;

procedure TIWGroups.SetItem(Index: integer; const Value: TIWGroup);
begin
  inherited Items[Index] := Value;
end;

procedure TIWGroups.Update(Item: TCollectionItem);
begin
  inherited;
  FOwner.Invalidate;
end;

{ TIWGroup }

constructor TIWGroup.Create(Collection: TCollection);
begin
  inherited;
  FItems := TIWItems.Create(self);
  Fclosed:=false;
  FGroupColor := 15658734;
  FGroupFont := TIWFont.Create;
  FGroupFont.FontName := 'Arial';
  FGroupFont.Color := clBlack;
  FGroupFont.Size := 14;
end;

destructor TIWGroup.Destroy;
begin
  inherited;
  FGroupFont.Free;
  FItems.Free;
end;

procedure TIWGroup.SetCaption(const Value: string);
begin
  FCaption := Value;
  Changed(False);
end;

procedure TIWGroup.Setclosed(const Value: boolean);
begin
  Fclosed := Value;
  Changed(False);
end;

procedure TIWGroup.SetGroupClick(const Value: TIWGroupClick);
begin
  FGroupClick := Value;
end;

procedure TIWGroup.SetGroupColor(const Value: TColor);
begin
  FGroupColor := Value;
  Changed(False);
end;

procedure TIWGroup.SetGroupFont(const Value: TIWfont);
begin
  FGroupFont.Assign(Value);
  Changed(False);
end;


procedure TIWGroup.SetItems(const Value: TIWItems);
begin
  FItems := Value;
end;

{ TIWItem }

constructor TIWItem.Create(Collection: TCollection);
begin
  inherited;
  FHeaderColor := clBlue;
  FHeaderFont := TIWFont.Create;
  FHeaderFont.FontName := 'Arial';
  FHeaderFont.Color := clWhite;
  FHeaderFont.Size := 14;
  FHeaderFont.Style := [fsBold, fsItalic];

  FSubItems := TIWSubItems.Create(self);
  FSubItemColor := clInfoBk;
  FSubItemFont := TIWFont.Create;
  FSubItemFont.FontName := 'Arial';
  FSubItemFont.Color := clBlack;
  FSubItemFont.Size := 10;
end;

destructor TIWItem.Destroy;
begin
  FSubItems.Free;
  FSubItemFont.Free;
  FHeaderFont.Free;
  inherited;
end;

procedure TIWItem.SetCaption(const Value: string);
begin
  FCaption := Value;
  Changed(False);
end;

procedure TIWItem.SetHeader(const Value: string);
begin
  FHeader := Value;
  Changed(False);
end;

procedure TIWItem.SetHeaderColor(const Value: TColor);
begin
  FHeaderColor := Value;
  Changed(False);
end;

procedure TIWItem.SetHeaderFont(const Value: TIWfont);
begin
  FHeaderFont.Assign(Value);
  Changed(False);
end;

procedure TIWItem.SetItemClick(const Value: TIWItemClick);
begin
  FItemClick := Value;
end;

procedure TIWItem.SetSubItemColor(const Value: TColor);
begin
  FSubItemColor := Value;
  Changed(False);
end;

procedure TIWItem.SetSubItemFont(const Value: TIWfont);
begin
  FSubItemFont.Assign(Value);
  Changed(False);
end;

procedure TIWItem.SetSubItems(const Value: TIWSubItems);
begin
  FSubItems := Value;
end;

{ TIWItems }

function TIWItems.Add: TIWItem;
begin
  Result := TIWItem(inherited Add);
end;

constructor TIWItems.Create(AOwner: TIWGroup);
begin
  inherited Create(AOwner, CreateItemClass);
  FOwner := AOwner;
end;

function TIWItems.CreateItemClass: TCollectionItemClass;
begin
  Result := TIWItem;
end;

function TIWItems.GetItem(Index: integer): TIWItem;
begin
  Result := TIWItem(inherited Items[Index]);
end;

function TIWItems.Insert(index: integer): TIWItem;
begin
  Result := TIWItem(inherited Insert(Index));
end;

procedure TIWItems.SetItem(Index: integer; const Value: TIWItem);
begin
  inherited Items[Index] := Value;
end;

procedure TIWItems.Update(Item: TCollectionItem);
begin
  inherited;
  FOwner.Changed(False);
end;

{ TIWSubItems }
constructor TIWSubItem.Create(Collection: TCollection);
begin
  inherited;
end;

destructor TIWSubItem.Destroy;
begin
  inherited;
end;

procedure TIWSubItem.SetCaption(const Value: string);
begin
  FCaption := Value;
  Changed(False);
end;

procedure TIWSubItem.SetSubItemClick(const Value: TIWSubItemClick);
begin
  FSubItemClick := Value;
end;

{ TIWISubtems }

function TIWSubItems.Add: TIWSubItem;
begin
  Result := TIWSubItem(inherited Add);
end;

constructor TIWSubItems.Create(AOwner: TIWItem);
begin
  inherited Create(AOwner, CreateItemClass);
  FOwner := AOwner;
end;

function TIWSubItems.CreateItemClass: TCollectionItemClass;
begin
  Result := TIWSubItem;
end;

function TIWSubItems.GetSubItem(Index: integer): TIWSubItem;
begin
  Result := TIWSubItem(inherited Items[Index]);
end;

function TIWSubItems.Insert(index: integer): TIWSubItem;
begin
  Result := TIWSubItem(inherited Insert(Index));
end;

procedure TIWSubItems.SetSubItem(Index: integer; const Value: TIWSubItem);
begin
  inherited Items[Index] := Value;
end;

procedure TIWSubItems.Update(Item: TCollectionItem);
begin
  inherited;
  FOwner.Changed(False);
end;


end.