/// ORM-driven Office 2007 Toolbar for mORMot
// - this unit is a part of the freeware Synopse mORMot framework,
// licensed under a MPL/GPL/LGPL tri-license; version 1.18
unit mORMotToolBar;

interface

{

    This file is part of Synopse mORMot framework.

    Synopse mORMot framework. Copyright (C) 2022 Arnaud Bouchez
      Synopse Informatique - https://synopse.info

  *** BEGIN LICENSE BLOCK *****
  Version: MPL 1.1/GPL 2.0/LGPL 2.1

  The contents of this file are subject to the Mozilla Public License Version
  1.1 (the "License"); you may not use this file except in compliance with
  the License. You may obtain a copy of the License at
  http://www.mozilla.org/MPL

  Software distributed under the License is distributed on an "AS IS" basis,
  WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
  for the specific language governing rights and limitations under the License.

  The Original Code is Synopse mORMot framework.

  The Initial Developer of the Original Code is Arnaud Bouchez.

  Portions created by the Initial Developer are Copyright (C) 2022
  the Initial Developer. All Rights Reserved.

  Contributor(s):
  - kevinday

  Alternatively, the contents of this file may be used under the terms of
  either the GNU General Public License Version 2 or later (the "GPL"), or
  the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
  in which case the provisions of the GPL or the LGPL are applicable instead
  of those above. If you wish to allow use of your version of this file only
  under the terms of either the GPL or the LGPL, and not to allow others to
  use your version of this file under the terms of the MPL, indicate your
  decision by deleting the provisions above and replace them with the notice
  and other provisions required by the GPL or the LGPL. If you do not delete
  the provisions above, a recipient may use your version of this file under
  the terms of any one of the MPL, the GPL or the LGPL.

  ***** END LICENSE BLOCK *****


        Handle a Toolbar for CRUD/ORM actions
       ***************************************

      - full Office 2007 Ribbon menus are created directly from code
      - every database table has its own Ribbon tab
      - every Ribbon tab has its own buttons, corresponding to actions, as
        defined in the code in a custom enumeration type

        Initial version: 2008 March, by Arnaud Bouchez

    Version 1.1 - 14 January 2009
    - attempt to reach Delphi 2009/2010 compilation (string=UnicodeString):
      the UNICODE conditional will adapt the framework to these compilers
      (you shouldn't have to set any other conditional define)

    Version 1.4 - February 8, 2010
    - whole Synopse SQLite3 database framework released under the GNU Lesser
      General Public License version 3, instead of generic "Public Domain"

    Version 1.8
    - possibility to add a background picture to the ribbon pages
     (creating a TSQLAdvPage class from TAdvPage with a BackgroundPicture
     property, or directly by supplied a CSV resource name to SetToolBarGroups)

    Version 1.9
    - improved Delphi 2009/2010 UnicodeString compatibility
    - add TMS components stylers coherency update
    - added TSQLRibbon to factorize most used Ribbon-related User Interface
      data, functions and events in one class

    Version 1.9.2
    - allow TSQLRibbon.CreateReport() method not to delete the current content
      of the report (useful to specify a custom header/footer before calling
      the default CreateReport implementation)
    - new TSQLRibbon.Refresh method added
    - new AddToReport method to append the specified database Table Content
      to the report

    Version 1.13
    - now uses TSQLRecord.RecordProps instead of lowest level RTTI calls
    - by default, will use only VCL components to create the Ribbon; can use
      proprietary TMS component pack if USETMSPACK global conditional is defined

    Version 1.15
    - TSQLRibbon.AddToReport method can work with self=nil

    Version 1.16
    - includes new TSynAnsiConvert classes for handling Ansi charsets

    Version 1.18
  	- renamed SQLite3ToolBar.pas as mORMotToolBar.pas
    - introducing TSQLPropInfo* classes to decouple ORM definitions from RTTI
    - added aHeaderCheckboxSelectsInsteadOfSort optional parameter to
      TSQLLister, TSQLRibbon and TSQLRibbonTab constructors - see [a41b5dd805]

}

uses
  Windows, Consts, Dialogs, ShellAPI,
  SysUtils, Forms, Classes, Messages, Graphics,
  ImgList, Controls, Grids, ExtCtrls, Menus,
{$ifdef USETMSPACK}
  AdvOfficePager, AdvToolBar, AdvGlowButton, AdvMenus, AdvShapeButton, AdvPreviewMenu,
  AdvToolBarStylers, AdvPreviewMenuStylers, AdvOfficePagerStylers,
  AdvOfficeStatusBarStylers, AdvPanel,
  TaskDialog, TaskDialogEx, GDIPicture,
{$else}
  StdCtrls, ComCtrls, SynTaskDialog, Buttons, CommCtrl,
{$endif USETMSPACK}
  SynCommons, SynTable, SynGdiPlus, SynZip,
  mORMot, mORMotReport, mORMotUI, mORMoti18n, mORMotUILogin;


type
  /// used to mark which shortcut keys have already been affected
  TFreeShortCutSet = set of ord('A')..ord('Z');

  /// a simple object to get one char shortcuts from caption value
  {$ifdef USERECORDWITHMETHODS}TFreeShortCut = record
    {$else}TFreeShortCut = object{$endif}
  public
    /// bit set for already used short cut, from 'A' to 'Z'
    Values: TFreeShortCutSet;
    /// attempt to create free shortcut of one char length, from
    // a Caption: try every character of aCaption, from left to right
    // - returns '' if no shortcut calculation was possible
    function FindFreeShortCut(const aCaption: string): string;
  end;


{$ifndef USETMSPACK}
type
  /// a Vista-enabled TForm descendant
  // - this form will have a button in the TaskBar
  // - this form will hide the default Delphi application virtual form
  TSynForm = TVistaForm;

  /// a popup menu to be displayed
  TSynPopupMenu = TPopupMenu;

  /// a button on the Ribbon toolbars, corresponding to one action
  TSynToolButton = class(TToolButton)
  private
  public
    /// this class will have AutoSize set to true
    constructor Create(aOwner: TComponent); override;
    /// display drop down menu
    procedure DoDropDown;
    /// the associated image list, i.e. TToolBar(Owner).Images
    function Images: TCustomImageList;
  end;

  /// a toolbar on a Ribbon page
  TSynToolBar = class(TToolBar)
  public
    /// create a button on the toolbar
    function CreateToolButton(ButtonClick: TNotifyEvent;
      iAction, ImageListFirstIndex: integer; const ActionName, ActionHints: string;
      var ShortCutUsed: TFreeShortCut; ButtonWidth: integer;
      Images: TCustomImageList): TSynToolButton;
  end;

  /// a Ribbon page, which will contain some toolbars for a TSQLRecord class
  TSynPage = class(TTabSheet)
  protected
    fToolBar: array of TSynToolBar;
    fToolBarCaptionsCount: integer;
    function GetToolBarCount: integer;
    function GetToolBar(aIndex: integer): TSynToolBar;
    function GetToolBarNextLeft(var Last: TSynToolBar): integer;
  public
    /// add a TSynToolBar to the page list
    // - then call TSynToolBar.CreateToolButton to add some buttons
    function CreateToolBar(AddToList: boolean=true): TSynToolBar;
    /// call this event when all toolbars have been created
    // - it will create the captions under the toolbars
    // - can be call multiple times, when a toolbar has been added and filled
    // will all its buttons
    procedure ToolBarCreated;
    /// number of TSynToolBar in the page list
    property ToolBarCount: integer read GetToolBarCount;
    /// access to the TSynToolBar list of this page
    property ToolBars[aIndex: integer]: TSynToolBar read GetToolBar;
  end;

  /// the ribbon pager, which will contain one page per TSQLRecord class
  TSynPager = class(TPageControl)
  private
    function GetActivePageIndex: integer;
    procedure SetActivePageIndex(const Value: integer);
    function GetHelpButton: TSynToolButton;
    function GetCaption: TLabel;
  protected
    fHelpToolBar: TSynToolBar;
    fHelpButton: TSynToolButton;
    fTopMostPanel, fTopPanel: TPanel;
    procedure Change; override;
    function GetSynPage(aIndex: integer): TSynPage; {$ifdef HASINLINE}inline;{$endif}
    procedure GroupLabelClick(Sender: TObject);
  public
    /// create the ribbon pager on a form
    // - reserve some above space for groups, caption and min/max/close buttons,
    // so that FormNoCaption method can be called later
    class function CreatePager(aOwner: TCustomForm; NoTabVisible: boolean=false): TSynPager;
    /// add a page instance
    function AddPage(aPage: TSynPage): integer; overload;
    /// create a new page with the specified caption
    function AddPage(const aCaption: string): integer; overload;
    /// create a group label starting for the given page indexes
    function TabGroupsAdd(TabIndexStart, TabIndexEnd: integer; const aCaption: string): TLabel;
    /// hide TSynForm caption bar and put caption and buttons at groups right
    procedure FormNoCaption;
    /// mimic TTabSheet.Pages property
    property Pages[aIndex: Integer]: TSynPage read GetSynPage;
    /// force OnChange event to be triggered
    property ActivePageIndex: integer read GetActivePageIndex write SetActivePageIndex;
    /// the help button to be available on the ribbon
    property HelpButton: TSynToolButton read GetHelpButton;
    /// the label on TopMostPanel, i.e. the TSynForm(Owner).NoCaption
    property Caption: TLabel read GetCaption;
    /// the panel added above the pager, containing groups, caption and buttons
    property TopMostPanel: TPanel read fTopMostPanel;
    /// the panel containing this TSynPager
    property TopPanel: TPanel read fTopPanel;
  published
    /// publish this property, e.g. to close a tab by a double click
    property OnDblClick;
  end;

  /// body pager used to display the list and the report on the client screen
  TSynBodyPager = TSynPager;

  /// body page used to display the list and the report on the client screen
  TSynBodyPage = TSynPage;


const
  bsCheck = tbsCheck;

  TOOLBAR_HEIGHT = 114;
  TOOLBAR_GROUPS_HEIGHT = 20;
  TOOLBAR_TAB_HEIGHT = 22;


{$else USETMSPACK}
type
  TSynToolButton = TAdvGlowButton;
  TSynPopupMenu = TAdvPopupMenu;
  TSynBodyPage = TAdvOfficePage;
  TSynBodyPager = TAdvOfficePager;

  /// Vista-enabled TAdvToolBarForm descendant
  // - this form will have a button in the TaskBar
  // - this form will hide the default Delphi application virtual form
  TSynForm = class(TAdvToolBarForm)
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure WMSyscommand(var M: TMessage); message WM_SYSCOMMAND;
  end;

  /// a TMS toolbar
  TSynToolBar = class(TAdvToolBar)
  public
    function CreateToolButton(ButtonClick: TNotifyEvent;
      iAction, ImageListFirstIndex: integer; const ActionName, ActionHints: string;
      var ShortCutUsed: TFreeShortCut; ButtonWidth: integer;
      Images: TCustomImageList): TSynToolButton;
  end;

  /// a TMS ribbon page with an optional background picture
  // - the background picture is right-aligned
  // - if the bitmap width is not wide enough for the page, it's tiled
  TSynPage = class(TAdvPage)
  private
    fBackgroundPicture: TGDIPPicture;
    fBackgroundPictureStored: boolean;
    fBackgroundPictureTiledWidth: integer;
  protected
    procedure Paint; override;
    function GetToolBar(aIndex: integer): TSynToolBar;
  public
    destructor Destroy; override;
    /// add a TSynToolBar to the page list
    // - then call TSynToolBar.CreateToolButton to add some buttons
    function CreateToolBar: TSynToolBar;
    function ToolBarCount: integer;
    property ToolBars[aIndex: integer]: TSynToolBar read GetToolBar;
    /// set a picture to this property to draw it on background
    // - the picture must be available and freed when the page is no longer
    // needed: another possibility is to set the BackgroundPictureStored
    // property to TRUE
    property BackgroundPicture: TGDIPPicture read fBackgroundPicture write fBackgroundPicture;
    /// if this property is TRUE, the corresponding picture will be freed
    // when the instance will be released
    property BackgroundPictureStored: boolean read fBackgroundPictureStored write fBackgroundPictureStored;
    /// the pixel widths used for left-tiling the background bitmap
    // - default value is 200 pixels
    property BackgroundPictureTiledWidth: integer read fBackgroundPictureTiledWidth
      write fBackgroundPictureTiledWidth;
  end;

  /// a TMS pager
  TSynPager = class(TAdvToolBarPager)
  protected
    function GetSynPage(aIndex: integer): TSynPage;
      {$ifdef HASINLINE}inline;{$endif}
    function GetSynPageCount: integer;
      {$ifdef HASINLINE}inline;{$endif}
  public
    /// create the ribbon pager on a form
    class function CreatePager(aOwner: TCustomForm; NoTabVisible: boolean=false): TSynPager;
    /// add page instance
    function AddPage(aPage: TSynPage): integer; overload;
    /// create a new page with the specified caption
    function AddPage(const aCaption: string): integer; overload;
    /// mimic TTabSheet.Pages property
    property Pages[aIndex: Integer]: TSynPage read GetSynPage;
    /// mimic TTabSheet.PageCount property
    property PageCount: Integer read GetSynPageCount;
  end;

{$endif USETMSPACK}

type
  TSQLLister = class;

  /// this event is called when a button is pressed
  // - here ActionValue contains the ordinal value of the custom button
  TSQLListerEvent = procedure(Sender: TObject;
    RecordClass: TSQLRecordClass;
    ActionValue: integer) of object;

  /// this event is called after actMark*/actUnmarkAll has been executed
  TMarkActionEvent = procedure(Sender: TObject;
    RecordClass: TSQLRecordClass;
    MarkAction: TSQLAction) of object;

  /// a hidden component, used for handling toolbar buttons of actions
  // to be performed on a TSQLRecordClass list
  TSQLLister = class(TComponent)
  private
    fClient: TSQLRestClient;
    fPager: TSynPager;
    fPage: TSynPage;
    fOnButtonClick: TSQLListerEvent;
    fOnMarkAction: TMarkActionEvent;
    fClass: TSQLRecordClass;
    fActionMax: cardinal;
    fActionHints: string;
    fGrid: TDrawGrid;
    fTableToGrid: TSQLTableToGrid;
    fMenu: TSynPopupMenu;
    fImageList16: TImageList;
    fImageList32: TImageList;
    fReportDetailedIndex: integer;
    fCreateSubMenuLastAction: integer;
    fCreateSubMenuLastButton: TSynToolButton;
    fCreateSubMenuLastMenu: TMenuItem;
  protected
    fShortCutUsed: TFreeShortCut;
    fCurrentSelectedRow: integer;
    function isActionButton(One: TObject): integer;
    procedure ActionButtonClick(Sender: TObject);
    procedure OnRightClickCell(Sender: TSQLTable; ACol, ARow, MouseX, MouseY: Integer);
    procedure OnSelectCell(Sender: TObject; ACol, ARow: Longint; var CanSelect: Boolean);
  public
    /// retrieve the page index from a TSQLRecordClass
    // - the TSynPage tag property contains integer(aClass)
    class function FindPage(aOwner: TSynPager; aClass: TSQLRecordClass): integer;
    /// add a page (if not already) for a corresponding TSQLRecordClass
    // - the TSynPage tag property will contain integer(aClass)
    // - the TSynPage caption is expanded and translated from aClass with
    // LoadResStringTranslate(aClass.SQLTableName) or taken directly from
    // CustomCaption if a value is specified (with translation if CustomCaptionTranslate
    // is set)
    class function AddPage(aOwner: TSynPager; aClass: TSQLRecordClass;
      const CustomCaption: string; CustomCaptionTranslate: boolean): TSynPage;

    /// initialize the lister for a specified Client and Class
    // - the possible actions are retrieved from the Client TSQLModel
    // - a single page is used for a list of records, specified by their unique class
    // - a single page can share multiple toolbars
    // - both TImagelist will be used to display some images in Action buttons
    // (32 pixels wide) and Popup Menu (16 pixels wide)
    // - if aGrid has no associated TSQLTableToGrid, a default one is created
    // retrieving a list of records with aGridSelect about the aClass Table
    // from aClient, with the ID column hidden
    // (no TSQLTableToGrid will be created if aGridSelect is '')
    // - aOnButtonClick is called with a specified action if a button is clicked,
    // or with ActionValue=0 each time a row is selected
    constructor Create(aOwner: TComponent; aClient: TSQLRestClientURI;
      aClass: TSQLRecordClass; aGrid: TDrawGrid; aIDColumnHide: boolean;
      aPager: TSynPager; aImageList32,aImageList16: TImageList;
      aOnButtonClick: TSQLListerEvent; aOnValueText: TValueTextEvent;
      const aGridSelect: RawUTF8= '*';
      aHideDisabledButtons: boolean=false;
      aHeaderCheckboxSelectsInsteadOfSort: Boolean=false); reintroduce; overload;
    /// same as above, but with a specified TSQLTable
    constructor Create(aOwner: TComponent; aClient: TSQLRestClientURI;
      aClass: TSQLRecordClass; aGrid: TDrawGrid; aIDColumnHide: boolean;
      aPager: TSynPager; aImageList32,aImageList16: TImageList;
      aOnButtonClick: TSQLListerEvent; aOnValueText: TValueTextEvent;
      aTable: TSQLTable; aHideDisabledButtons, aHeaderCheckboxSelectsInsteadOfSort: boolean); reintroduce; overload;

    /// add or update a ToolBar with a specific actions set
    // - a single page can share multiple toolbars, which caption name must be
    // identical between calls for geniune buttons
    // - if the ToolBar is already existing, the status of its Action buttons
    // is enabled or disabled according to the actions set
    // - aActions must point to a set of enumerates, as defined by
    // Client.Model.SetActions(TypeInfo(..))
    // - first call once this procedure to create the toolbar buttons, then
    // call it again to update the enable/disable status of the buttons
    function SetToolBar(const aToolBarName: string; const aActions;
      ActionIsNotButton: pointer): TSynToolBar;
    /// can be used by any TSQLTableToGrid
    // - to draw marked rows with a highlighted color
    // - with respect to the Toolbar theming
    procedure OnDrawCellBackground(Sender: TObject; ACol, ARow: Longint;
      Rect: TRect; State: TGridDrawState);
    /// create a menu item, and add it to a menu
    function NewMenuItem(Menu: TPopupMenu; const aCaption: string;
      ImageIndex: integer=-1; SubMenu: TMenuItem=nil; OnClick: TNotifyEvent=nil;
      itemEnabled: boolean=true): TMenuItem;
    /// find associate Button for an action
    function FindButton(ActionIndex: integer): TSynToolButton;
    /// retrieve a ready to be displayed hint for a specified action
    // - returns the Hint caption of the corresponding button, or '' if not existing
    function ActionHint(const Action): string;
    /// find associate popup Menu item for an action
    function FindMenuItem(ActionIndex: integer): TMenuItem;
    /// create a sub menu item to both button and menu item for an action
    // - if aCaption is '', erase any previous menu
    procedure CreateSubMenuItem(const aCaption: string; ActionIndex: integer;
      OnClick: TNotifyEvent; ImageIndex: integer=-1; Tag: integer=0;
      itemEnabled: boolean=true);

    /// the associated Client
    property Client: TSQLRestClient read fClient;
    /// the associated record class
    property RecordClass: TSQLRecordClass read fClass;
    /// the associated Grid display
    property Grid: TDrawGrid read fGrid;
    /// the associated TSQLTableToGrid hidden component
    property TableToGrid: TSQLTableToGrid read fTableToGrid;
    /// the associated Page on the Office 2007 menu
    property Page: TSynPage read fPage;
    /// TImagelist used to display some images in Action buttons
    property ImageList32: TImageList read fImageList32;
    /// TImagelist used to display some images in Action buttons
    property ImageList16: TImageList read fImageList16;
    /// the Popup Menu, displayed with the Grid
    property Menu: TSynPopupMenu read fMenu;
    /// the Hints captions to be displayed on the screen
    // - must be set before SetToolBar() method call
    // - one action (starting with actMark) each line
    property ActionHints: string read fActionHints write fActionHints;
    /// set to to a "Details" level, according to the bsCheck button pushed
    // - set to the Action index which is currently available
    property ReportDetailedIndex: integer read fReportDetailedIndex;
    /// a callback event, triggerred after actMark*/actUnmarkAll has been executed
    property OnMarkAction: TMarkActionEvent read fOnMarkAction write fOnMarkAction;
  end;

  /// create one or more toolbars in a ribbon page, according to an enumeration
  // of actions
  // - use a similar layout and logic as TSQLLister.SetToolBar() method above
  // - to be used for custom forms (e.g. preview or edit) or to add some
  // custom buttons to a previously created one by TSQLLister.SetToolBar()
  // - simply set the associated objects via the Init() method, then call
  // AddToolBar() for every toolbar which need to be created
  {$ifdef USERECORDWITHMETHODS}TSQLCustomToolBar = record
    {$else}TSQLCustomToolBar = object{$endif}
  public
    Page: TSynPage;
    ActionHints: string;
    ActionsEnum: PEnumType;
    ButtonClick: TNotifyEvent;
    ShortCutUsed: TFreeShortCut;
    ImageList: TImageList;
    Buttons: array of TSynToolButton;
    Toolbars: array of TSynToolBar;
    ImageListFirstIndex: integer;
    /// call this method first to initialize the ribbon
    // - if aToolbarOrPage is a TCustomForm, this form will became a
    // - if aToolbarOrPage is a TSynPager descendant, a new page is created
    // and added to this TSynPager, and used for toolbars adding
    // - if aToolbarOrPage is a TSynPage descendant, the toolbar is added to
    // this specified Page
    procedure Init(aToolbarOrPage: TControl; aEnum: PTypeInfo;
      aButtonClick: TNotifyEvent; aImageList: TImageList; const aActionHints: string;
      aImageListFirstIndex: integer=0);
    /// call this method for every toobar, with appropriate bits set for its buttons
    function AddToolBar(const ToolBarName: string; ActionsBits: pointer=nil;
      ButtonWidth: integer=60): TSynToolBar;
    /// create a popup menu item for a button
    // - call with aCaption void to clear the menu first
    // - then call it for every menu entry
    function CreateSubMenuItem(aButtonIndex: integer; const aCaption: string;
      aOnClick: TNotifyEvent; aTag: integer=0): TMenuItem;
  end;

  /// this event provide the action values for a specified toolbar
  // - first call is to test the action presence, with TestEnabled=false
  // - a special call is made with ToolBarIndex=-1, in which A should be
  // filled with the marking actions
  // - second call is to test the action enable/disable state, with
  // TestEnabled=true
  // - in all cases, should return any customized toolbar caption name, or ''
  TSQLRibbonSetActionEvent = function(TabIndex, ToolbarIndex: integer;
    TestEnabled: boolean; var A): string of object;

  /// used to store the options status
  TPBooleanDynArray = array of PBoolean;


  /// store the UI elements and data, one per each Table
  TSQLRibbonTab = class
  private
    function GetCurrentID: TID;
  protected
    /// event called by ReportClick(), set by CustomReportPopupMenu()
    FReportPopupClick: TNotifyEvent;
    /// used by ReportPopup() method:
    FReportPopupParams: PEnumType;
    FReportPopupParamsEnabled: pointer;
    FReportPopupValues: TPBooleanDynArray;
    /// triggered when a report popup menu is displayed
    procedure ReportPopup(Sender: TObject);
    /// used internaly to display the report popup menu via the "View" options
    // - can be used to display the same popup menu from another toolbar
    procedure ReportOptionEvent(Sender: TObject; ClientPoint, ScreenPoint: TPoint);
  public
    /// associated TSQLRecord
    Table: TSQLRecordClass;
    /// associated TSQLRecord index in database Model
    TableIndex: integer;
    /// associated Tab settings used to create this Ribbon Tab
    Parameters: PSQLRibbonTabParameters;
    /// associate Tab in the Ribbon
    Tab: TSynPage;
    /// the "View" toolbar on the associated Ribbon Tab
    ViewToolBar: TSynToolBar;
    /// associate Client Body Page
    Page: TSynBodyPage;
    /// the frame containing associated the List, left side of the Page
    FrameLeft: TFrame;
    /// associated table list
    List: TDrawGrid;
    /// allows List resizing
    FrameSplit: TSplitter;
    /// to provide the List with data from Client
    TableToGrid: TSQLTableToGrid;
    /// to associate Class, Actions, Ribbon and Toolbars
    Lister: TSQLLister;
    /// the frame containing associated Details, right side to the list
    FrameRight: TFrame;
    /// the associated Report, to display the page
    // - exists if aTabParameters.Layout is not llClient, and if
    // aTabParameters.NoReport is false
    Report: TGDIPages;
    /// a current record value
    CurrentRecord: TSQLRecord;
    /// create all the UI elements for a specific Table/Class
    // - create a new page for this Table/Class
    // - populate this page with available Toolbars
    // - populate all Toolbars with action Buttons
    constructor Create(ToolBar: TSynPager; Body: TSynBodyPager;
      aImageList32,aImageList16: TImageList; var aPagesShortCuts: TFreeShortCut;
      const aTabParameters: TSQLRibbonTabParameters;
      Client: TSQLRestClientURI; aUserRights: TSQLFieldBits;
      aOnValueText: TValueTextEvent;
      SetAction: TSQLRibbonSetActionEvent;
      const ActionsTBCaptionCSV, ActionsHintCaption: string; ActionIsNotButton: pointer;
      aOnActionClick: TSQLListerEvent; ViewToolbarIndex: integer;
      aHideDisabledButtons, aHeaderCheckboxSelectsInsteadOfSort: boolean);
    /// retrieve CurrentRecord from server
    function Retrieve(Client: TSQLRestClient; ARow: integer; ForUpdate: boolean=false): boolean;
    /// ask the User where to perform an Action
    // - return 100 if "Apply to Selected" was choosen
    // - return 101 if "Apply to Marked" was choosen
    // - return any other value if Cancel or No was choosen
    function AskForAction(const ActionCaption, aTitle: string; Client: TSQLRest;
      DontAskIfOneRow, ReturnMarkedIfSomeMarked: boolean): integer;
    /// release associated memory
    destructor Destroy; override;
    /// used to customize the popup menu of the associated Report
    // - this method expect two standard handlers, and a custom enumeration type
    // together with its (bit-oriented) values for the current Ribbon Tab
    // - caller must supply an array of boolean pointers to reflect the
    // checked state of every popup menu item entry
    procedure CustomReportPopupMenu(OnClick: TNotifyEvent;
      ParamsEnum: PTypeInfo; ParamsEnabled: pointer; const Values: array of PBoolean);
    /// add the report options to the specified menu
    procedure AddReportPopupMenuOptions(Menu: TPopupMenu; OnClick: TNotifyEvent);
    /// triggered when a report popup menu item is clicked
    procedure ReportClick(Sender: TObject);
    { /// retrieve the Hint value for a particular action
    function ActionHint(const Action): string; }
    /// pointers to every popup meu items data
    property ReportPopupValues: TPBooleanDynArray read FReportPopupValues;
    /// pointer to the set of available popup menu parameters for this report
    property ReportPopupParamsEnabled: pointer read FReportPopupParamsEnabled;
    /// retrieve the current selected ID of the grid
    // - returns 0 if no row is selected
    property CurrentID: TID read GetCurrentID;
  end;

  /// Event used to customize screen text of property names
  TOnCaptionName = function(const Action: RawUTF8; Obj: TObject=nil; Index: integer=-1): string of object;

   /// store some variables common to all pages, i.e. for the whole ribbon
  TSQLRibbon = class
  public
    /// the pages array
    Page: array of TSQLRibbonTab;
    /// store the keyboard shortcuts for the whole ribbon
    ShortCuts: TFreeShortCut;
    /// initialize the Pages properties for this ribbon
    // - this constructor must be called in the Owner.OnCreate handler (not in
    // OnShow)
    // - most parameters are sent back to the SQLRibbonTab.Create constructor
    // - if BackgroundPictureResourceNameCSV is set, the corresponding
    // background pictures will be extracted from resources and displayed behind
    // the ribbon toolbar, according to the group
    constructor Create(Owner: TCustomForm; ToolBar: TSynPager; Body: TSynBodyPager;
      aImageList32,aImageList16: TImageList;
      Client: TSQLRestClientURI; aUserRights: TSQLFieldBits;
      aOnValueText: TValueTextEvent; SetAction: TSQLRibbonSetActionEvent;
      const ActionsTBCaptionCSV, ActionsHintCaption: string; ActionIsNotButton: pointer;
      aOnActionClick: TSQLListerEvent; RefreshActionIndex, ViewToolbarIndex: integer;
      aHideDisabledButtons: boolean;
      PagesCount: integer; TabParameters: PSQLRibbonTabParameters; TabParametersSize: integer;
      const GroupCSV: string; const BackgroundPictureResourceNameCSV: string='';
      aHeaderCheckboxSelectsInsteadOfSort: boolean=false); reintroduce; virtual;
    /// release associated memory
    destructor Destroy; override;
    /// retrieve the index of a given Pages[]
    // - returns -1 if this page was not found
    function GetPage(aRecordClass: TSQLRecordClass): integer;
    /// retrieve the current TSQLRibbonTab instance on the screen
    // - returns nil if no page is currently selected
    function GetActivePage: TSQLRibbonTab;
    /// retrieve the TSQLRibbonTabParameters associated to a Ribbon tab, from its index
    // - returns nil if the specified page index is not valid
    function GetParameter(aPageIndex: Integer): PSQLRibbonTabParameters; overload;
    /// get the the TSQLRibbonTabParameters associated to a Ribbon tab, from its table
    // - returns nil if the specified table is not valid
    function GetParameter(aTable: TSQLRecordClass): PSQLRibbonTabParameters; overload;
    /// retrieve the reference of a given button of the ribbon
    // - useful to customize the Ribbon layout, if automatic generation from RTTI
    // don't fit exactly your needs, or even worse marketing's know-how ;)
    // - called by SetButtonHint method
    function FindButton(aTable: TSQLRecordClass; aActionIndex: integer): TSynToolButton;
    /// customize the Hint property of any button
    // - will test the button is available (avoid any GPF error)
    procedure SetButtonHint(aTable: TSQLRecordClass; aActionIndex: integer; const aHint: string);

    /// trigger this event when a page changed on screen
    // - will free GDI resources and unneeded memory
    procedure ToolBarChange(Sender: TObject);
    /// resize the lists according to the body size
    procedure BodyResize(Sender: TObject);
    /// handle a ribbon button press
    // - returns TRUE if a Refresh command has been processed (caller should exit)
    // and a refresh timer command has been set
    // - returns FALSE if the caller must handle the action
    function RefreshClickHandled(Sender: TObject; RecordClass: TSQLRecordClass;
      ActionValue: integer; out Tab: TSQLRibbonTab): boolean;
    /// must be called by the main form to handle any WM_TIMER message
    // - will refresh the screen as necessary
    procedure WMRefreshTimer(var Msg: TWMTimer);
{$ifdef USETMSPACK}
    /// change the style of the ribbon and all associated stylers
    // - TMS style is not coherent between stylers: this method will
    // synchronize the color scheme accross all stylers, at once
    procedure ChangeColorScheme(const ColorScheme: TToolBarStyle;
      PanelStyler: TAdvPanelStyler=nil;
      StatusBarStyler: TAdvOfficeStatusBarOfficeStyler=nil;
      CustomStyle: TMemoryStream=nil);
{$endif USETMSPACK}
    /// create a report for the specified page index
    // - the report must be created from the Page[aPageIndex].CurrentRecord
    // record content
    // - call the CreateReport virtual method
    procedure CreateReport(aPageIndex: Integer); overload;
    /// create a report for the specified page index
    // - this default method create a report with the content of all fields,
    // except those listed in the corrresponding
    // TSQLRibbonTabParameters.EditFieldNameToHideCSV value
    procedure CreateReport(aTable: TSQLRecordClass; aID: TID;
      aReport: TGDIPages; AlreadyBegan: boolean=false); overload; virtual;
    /// add the specified fields content to the report
    // - by default, all main fields are displayed, but caller can specify custom
    // field names as Comma-Separated-Values
    // - retrieve the main Caption of this record (e.g. the "Name" field value)
    function AddToReport(aReport: TGDIPages; aRecord: TSQLRecord; WithTitle: Boolean;
      CSVFieldNames: PUTF8Char=nil; CSVFieldNameToHide: PUTF8Char=nil;
      OnCaptionName: TOnCaptionName=nil;
      ColWidthName: Integer=40; ColWidthValue: integer=60): string; overload;
    /// add the specified database Table Content to the report
    // - if ColWidths are not specified (that is set to []),
    // their values are caculated from the Table content columns
    procedure AddToReport(aReport: TGDIPages; Table: TSQLTable;
      const ColWidths: array of integer); overload;
    /// generic method which print the all marked entries of the supplied table
    function MarkedEntriesToReport(aTable: TSQLRecordClass;
      const ColWidths: array of integer; aRep: TGDIPages=nil): TGDIPages;
    /// make a specified record available to the UI
    // - select tab and record index
    // - if ActionToPerform is set, the corresponding action is launched
    procedure GotoRecord(aTable: TSQLRecordClass; aID: TID;
      ActionToPerform: integer=0); overload;
    /// make a specified record available to the UI
    // - select tab and record index
    // - if ActionToPerform is set, the corresponding action is launched
    procedure GotoRecord(aRecord: TSQLRecord; ActionToPerform: integer=0); overload;
    /// refresh the specified page content
    // - by default, refresh the current page content
    // - calls internaly RefreshClickHandled method
    procedure Refresh(aTable: TSQLRecordClass=nil);
    /// generic method which delete either the current selected entry,
    // either all marked entries
    // - returns TRUE if deletion was successful, or FALSE if any error occured
    function DeleteMarkedEntries(aTable: TSQLRecordClass; const ActionHint: string): Boolean;
    /// generic method which export the supplied record
    // - display the save dialog before
    // - only two formats are available here: Acrobat (.pdf) and plain text (.txt)
    // - returns the exported file name if export was successful, or '' if any error occured
    // - by default, the report is created by using the CreateReport method
    function ExportRecord(aTable: TSQLRecordClass; aID: TID;
      const ActionHint: string; OpenAfterCreation: boolean=true): TFileName;
  protected { private properties set by Init method }
    fTabParameters: PSQLRibbonTabParameters;
    fTabParametersSize: integer;
    fForm: TCustomForm;
    fToolBar: TSynPager;
{$ifdef USETMSPACK}
    fPreviewMenuButton: TAdvShapeButton;
    fPreviewMenu: TAdvPreviewMenu;
{$endif USETMSPACK}
    fBody: TSynBodyPager;
    fOnActionClick: TSQLListerEvent;
    fRefreshActionIndex: integer;
    fLastActiveTab: integer;
    fClient: TSQLRestClientURI;
    fActionType: PTypeInfo;
    fEventType: PTypeInfo;
    fActionsHintCaption: string;
    fReportAutoFocus: boolean;
    procedure RefreshPage(Page: TSQLRibbonTab);
  public
    /// the associated Client connection
    property Client: TSQLRestClientURI read fClient write fClient;
    /// the associated Form on scren
    property Form: TCustomForm read fForm;
    /// the Toolbar component used to display the Ribbon on the Form
    property ToolBar: TSynPager read fToolBar;
{$ifdef USETMSPACK}
    /// the Preview Menu button displayed on the Ribbon
    property PreviewMenuButton: TAdvShapeButton read fPreviewMenuButton;
    /// the Preview Menu to be displayed by pressing the Ribbon Preview Menu button
    property PreviewMenu: TAdvPreviewMenu read fPreviewMenu write fPreviewMenu;
{$endif USETMSPACK}
    /// the main Pager component used to display the main data (i.e. records list
    // and report) on the Form
    property Body: TSynBodyPager read fBody;
    /// if set to TRUE, the right-sided report is focused instead of
    // the left-sided records list
    property ReportAutoFocus: boolean read fReportAutoFocus write fReportAutoFocus;
  end;


/// retrieve the ready to be displayed text of the given property
function CaptionName(OnCaptionName: TOnCaptionName;
  const Action: RawUTF8; Obj: TObject=nil; Index: integer=-1): string;

/// draw the cell of a TDrawGrid according to the current Theming of TabAppearance
procedure NewDrawCellBackground(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState;
  {$ifdef USETMSPACK} TabAppearance: TTabAppearance;{$endif} Marked: boolean);

/// create a report containing all icons for a given action enumeration
// - useful e.g. for marketing or User Interface review purposes
procedure CreateReportWithIcons(ParamsEnum: PTypeInfo; ImgList: TImageList;
  const Title, Hints: string; StartIndexAt: integer);

/// load a bitmap from a .png/.jpg file embedded as a resource to the executable
// - you can specify a library (dll) resource instance handle, if needed
function LoadBitmapFromResource(const ResName: string; Instance: THandle=0): TBitmap;

/// fill a TImageList from the content of another TImageList
// - stretching use GDI+ so is smooth enough for popup menu display
procedure ImageListStretch(ImgListSource, ImgListDest: TImageList;
   BkColor: TColor=clSilver);

/// load TImageList bitmaps from an .zip archive embedded as a ZIP resource
procedure LoadImageListFromEmbeddedZip(ImgList: TCustomImageList; const ZipName: TFileName);

/// load TImageList bitmaps from a TBitmap
// - warning Bmp content can be modified: it could be converted from multi-line
// (e.g. IDE export format) into one-line (as expected by TImageList.AddMasked)
procedure LoadImageListFromBitmap(ImgList: TCustomImageList; Bmp: TBitmap);

/// add an Icon to the supplied TImageList
// - return the newly created index in the image list
// - the HIcon handle is destroyed before returning
function AddIconToImageList(ImgList: TCustomImageList; Icon: HIcon): integer;

resourcestring
{$ifdef USETMSPACK}
  sPerformToSelected = 'Apply to the selected entry:<br><br><font color="clnavy">%s</font> ?'#13;
  sPerformToMarkedOrSelected =
    'Apply to the <b>Selected entry</b>:<br>  <font color="clnavy">%s</font><br><br>'+
    'Or apply to all <b>Marked entries</b>:<font color="clnavy">';
{$else}
  sPerformToSelected = 'Apply to the selected entry:\n\n%s ?\n';
  sPerformToMarkedOrSelected =
    'Apply to the Selected entry:\n  %s\n\nOr apply to all Marked entries:';
{$endif}
  sApplyToSelected = 'Selected entry';
  sApplyToMarked = 'Marked entries';
  sDeleteN = 'About to Delete %d record(s)';
  sTextFile = 'Text File';

implementation

procedure CreateReportWithIcons(ParamsEnum: PTypeInfo; ImgList: TImageList;
  const Title, Hints: string; StartIndexAt: integer);
var Dest: TGDIPages;
    A: integer;
    P: PEnumType;
    PS: PShortString;
    Bmp: TBitmap;
    R: TRect;
    PC: PChar;
begin
  Bmp := TBitmap.Create;
  Dest := TGDIPages.Create(nil);
  try
    Dest.BeginDoc;
    Dest.Caption := Title;
    Dest.DrawTitle(Title+' - Icons list',true);
    Bmp.Width := ImgList.Width;
    Bmp.Height := ImgList.Height;
    P := ParamsEnum^.EnumBaseType;
    PS := @P^.NameList;
    PC := pointer(Hints);
    R.Left := Dest.LeftMargin;
    R.Right := R.Left+12;
    Dest.LeftMargin := R.Right+10;
    for A := StartIndexAt to P^.MaxValue do begin // start at 1 (0=noAction)
      Bmp.Canvas.FillRect(Rect(0,0,Bmp.Width,Bmp.Height));
      if A-StartIndexAt<ImgList.Count then
        ImgList.Draw(Bmp.Canvas,0,0,A-StartIndexAt);
      if not Dest.HasSpaceFor(20) then
        Dest.NewPage;
      R.Top := Dest.CurrentYPos;
      R.Bottom := R.Top+12;
      Dest.DrawBMP(R,Bmp);
      Dest.Font.Style := [fsBold];
      Dest.DrawText(IntToStr(A)+' - '+P^.GetCaption(A));
      Dest.Font.Style := [];
      Dest.DrawText(GetNextItemString(PC,#13));
      while Dest.CurrentYPos<R.Bottom+5 do
        Dest.NewHalfLine;
      inc(PByte(PS),ord(PS^[0])+1);
    end;
    Dest.EndDoc;
    Dest.ShowPreviewForm;
  finally
    Bmp.Free;
    Dest.Free;
  end;
end;


{ TSQLLister }

class function TSQLLister.AddPage(aOwner: TSynPager;
  aClass: TSQLRecordClass; const CustomCaption: string;
  CustomCaptionTranslate: boolean): TSynPage;
var i: integer;
    Cap: string;
begin
  i := FindPage(aOwner,aClass);
  if i<0 then begin
    if CustomCaption='' then
      // get expanded caption
      if aClass=nil then
        Cap := '' else
        Cap := aClass.CaptionName else begin
      // translate specified caption if necessary
      Cap := CustomCaption;
      if CustomCaptionTranslate and Assigned(LoadResStringTranslate) then
        LoadResStringTranslate(Cap);
    end;
    result := TSynPage.Create(aOwner);
    result.Caption := Cap;
    aOwner.AddPage(result);
  end else
    result := aOwner.Pages[i];
  result.Tag := integer(aClass);
end;

class function TSQLLister.FindPage(aOwner: TSynPager;
  aClass: TSQLRecordClass): integer;
begin
  if aClass<>nil then
  for result := 0 to aOwner.PageCount-1 do
    if aOwner.Pages[result].Tag=integer(aClass) then
      exit;
  result := -1;
end;

procedure TSQLLister.ActionButtonClick(Sender: TObject);
var aAction: integer;
    A: TSQLAction absolute aAction;
    submenuact: TSQLAction;
    Btn: TSynToolButton absolute Sender;
    iTB,iGB: integer;
    TB: TSynToolBar;
    GB: TSynToolButton;
begin
  if fReportDetailedIndex<0 then
    exit; // avoid recursive call after GB.Down := false below
  aAction := isActionButton(Sender);
  case A of
    actNoAction: exit;
    actUnMarkAll: begin
      TableToGrid.SetMark(A); // unmarking as standard action
      if Assigned(fOnMarkAction) then
        fOnMarkAction(Sender,fClass,A);
    end;
    actMark:
      if Sender.InheritsFrom(TSynToolButton) then
        Btn.DoDropDown else
      if Sender.InheritsFrom(TMenuItem) then begin
        // actMarkAllEntries..actMarkBeforeOneYear are stored in the Menu.Tag,
        // and gathered under the aAction=actMark button
        submenuact := TSQLAction(TMenuItem(Sender).Tag);
        TableToGrid.SetMark(submenuact);
        if Assigned(fOnMarkAction) then
          fOnMarkAction(Sender,fClass,submenuact);
      end;
    else begin // custom (not actMark*) buttons
      if Sender.InheritsFrom(TSynToolButton) and
         (Btn.Style=bsCheck) then begin
        if Btn.Down then begin
          fReportDetailedIndex := -1; // avoid recursive call
          for iTB := 0 to fPage.ToolBarCount-1 do begin
            TB := fPage.ToolBars[iTB];
            for iGB := 0 to TB.ComponentCount-1 do begin
              GB := TSynToolButton(TB.Components[iGB]);
              if (GB<>Sender) and
                 GB.InheritsFrom(TSynToolButton) and
                 (GB.Style=bsCheck) then
                 GB.Down := false;
            end;
          end;
          fReportDetailedIndex := aAction;
        end else
          fReportDetailedIndex := 0;
      end;
      if Assigned(fOnButtonClick) then
        fOnButtonClick(Sender,fClass,aAction);
    end;
  end;
end;

procedure TSQLLister.OnSelectCell(Sender: TObject; ACol, ARow: Integer;
  var CanSelect: Boolean);
begin
  if Assigned(fOnButtonClick) {and (ARow<>fCurrentSelectedRow)} then begin
    fCurrentSelectedRow := ARow;
    fOnButtonClick(nil,fClass,ARow); // Sender=nil for Cell select
  end;
end;

constructor TSQLLister.Create(aOwner: TComponent; aClient: TSQLRestClientURI;
  aClass: TSQLRecordClass; aGrid: TDrawGrid; aIDColumnHide: boolean;
  aPager: TSynPager; aImageList32,aImageList16: TImageList;
  aOnButtonClick: TSQLListerEvent; aOnValueText: TValueTextEvent;
  const aGridSelect: RawUTF8; aHideDisabledButtons, aHeaderCheckboxSelectsInsteadOfSort: boolean);
var T: TSQLTable;
begin
  if (aClient=nil) or (aGridSelect='') then
    T := nil else
    T := aClient.List([aClass],aGridSelect);
  Create(aOwner,aClient,aClass,aGrid,aIDColumnHide,aPager,
    aImageList32,aImageList16,aOnButtonClick,aOnValueText,T,aHideDisabledButtons,
    aHeaderCheckboxSelectsInsteadOfSort);
end;

constructor TSQLLister.Create(aOwner: TComponent; aClient: TSQLRestClientURI;
  aClass: TSQLRecordClass; aGrid: TDrawGrid; aIDColumnHide: boolean;
  aPager: TSynPager; aImageList32, aImageList16: TImageList;
  aOnButtonClick: TSQLListerEvent; aOnValueText: TValueTextEvent;
  aTable: TSQLTable; aHideDisabledButtons, aHeaderCheckboxSelectsInsteadOfSort: boolean);
var i: integer;
    C: TSQLRestClientURI;
begin
{$ifdef USETMSPACK}
  if aPager.Parent.InheritsFrom(TSynForm) then
    aPager.MinimizeApp := false; // so WMSyscommand method will be called below
{$endif}
  inherited Create(aOwner);
  if (aClient=nil) or (aPager=nil) or (aClass=nil) then
    raise EComponentError.Create(ClassName);
  fClient := aClient;
  fPager := aPager;
  fClass := aClass;
  fGrid := aGrid;
  if aTable<>nil then begin
    fTableToGrid := TSQLTableToGrid.From(fGrid);
    if fTableToGrid=nil then begin
      // this Grid has no associated TSQLTableToGrid -> create default one
      if fClient.InheritsFrom(TSQLRestClientURI) then
        C := TSQLRestClientURI(fClient) else
        C := nil;
      fTableToGrid := TSQLTableToGrid.Create(fGrid,aTable,C);
      fTableToGrid.HeaderCheckboxSelectsInsteadOfSort := aHeaderCheckboxSelectsInsteadOfSort;
      if aIDColumnHide then
        fTableToGrid.IDColumnHide;
    end;
    fTableToGrid.OnRightClickCell := OnRightClickCell;
    TableToGrid.OnValueText := aOnValueText;
    fGrid.DefaultDrawing := false; // we force full redraw
    TableToGrid.OnDrawCellBackground := OnDrawCellBackground;
    TableToGrid.OnSelectCell := OnSelectCell;
  end;
  i := FindPage(fPager,fClass);
  if i>=0 then
     fPage := fPager.Pages[i];
  fImageList32 := aImageList32;
  fImageList16 := aImageList16;
  fOnButtonClick := aOnButtonClick;
  if fClient.Model.Actions<>nil then
    fActionMax := fClient.Model.Actions^.MaxValue;
end;

function TSQLLister.SetToolBar(const aToolBarName: string; const aActions;
  ActionIsNotButton: pointer): TSynToolBar;
var TypeName: PShortString;
    A,iTB,iGB,iM,img: integer;
    GB: TSynToolButton;
    iAction: cardinal;
    M: TMenuItem;
    EN: boolean;
    A2: TSQLAction;
    ActionNames: TStringDynArray;

  procedure InsertSubMenu(A2: TSQLAction);
  begin
    CreateSubMenuItem(fClass.CaptionNameFromRTTI(
      PTypeInfo(TypeInfo(TSQLAction))^.EnumBaseType^.GetEnumName(A2)),
      iAction,nil,iAction-1,integer(A2));
  end;

begin
  result := nil;
  if fPage=nil then
    exit;
  // on existing Toolbar: update its buttons from aActions, and exit
  for iTB := 0 to fPage.ToolBarCount-1 do
    // test exact match, not with SameText(), since Caption can be translated
    if fPage.ToolBars[iTB].Caption=aToolBarName then begin
      result := fPage.ToolBars[iTB];
      for iGB := 0 to result.ComponentCount-1 do begin
        GB := TSynToolButton(result.Components[iGB]);
        if isActionButton(GB)<>0 then begin
          img := GB.ImageIndex;
          EN := GetBitPtr(@aActions,img+1);
          GB.Enabled := EN;  // enable or disable buttons
          for iM := 0 to fMenu.Items.Count-1 do
          with fMenu.Items[iM] do
            if ImageIndex=img then
              Enabled := EN; // enable or disable popup menu item
        end;
      end;
      break;
    end;
  if result<>nil then
     exit; // we have found the toolbar
  // no Toolbar: create one with its buttons; also create associated popup menu
  EN := false;
  for A := 0 to fActionMax do
    if GetBitPtr(@aActions,A) then begin
      EN := true;
      break;
    end;
  if not EN then
    exit; // aActions=[] -> no toolbar to add
  if fMenu=nil then begin
    fMenu := TSynPopupMenu.Create(fGrid);
    fMenu.Images := ImageList16;
  end;
  result := fPage.CreateToolBar;
  try
{$ifdef USETMSPACK}
    result.BeginUpdate;
    result.AutoPositionControls := true;
    result.ShowOptionIndicator := false;
    result.AutoSize := true;
{$else}
    result.Images := ImageList32;
{$endif}
    result.Caption := aToolBarName;
    SetLength(ActionNames,fActionMax+1);
    TypeName := @fClient.Model.Actions^.NameList;
    for iAction := 0 to fActionMax do begin
      ActionNames[iAction] := fClass.CaptionNameFromRTTI(TypeName); // expanded caption
      inc(PByte(TypeName),ord(TypeName^[0])+1); // next enumerate value name
{$ifndef USETMSPACK}
    end;
    for iAction := fActionMax downto 0 do begin // TToolBar adds at 1st position
{$endif}
      if GetBitPtr(@aActions,iAction) then // is this enumerate value inside aActions?
        with result.CreateToolButton(ActionButtonClick,iAction,1,ActionNames[iAction],
           ActionHints,fShortCutUsed,60,ImageList32) do begin
          if GetBitPtr(@ActionIsNotButton,iAction) then
            Style := bsCheck;
          // create associated sub menu entry
          if Style<>bsCheck then begin
            NewMenuItem(fMenu,Caption,iAction-1);
            if TSQLAction(iAction)=actMark then begin // Mark sub-menu
              InsertSubMenu(actmarkAllEntries);
              InsertSubMenu(actmarkInverse);
              if TableToGrid.FieldIndexTimeLogForMark>=0 then
                for A2 := actmarkToday to actmarkOlderThanOneYear do begin
                  if A2 in [actmarkToday,actmarkOlderThanOneDay] then
                    CreateSubMenuItem('-',iAction,nil);
                  InsertSubMenu(A2);
                end;
            end;
          end;
        end;
    end;
    M := TMenuItem.Create(fMenu);
    M.Caption := '-';
    fMenu.Items.Add(M);
  finally
{$ifdef USETMSPACK}
    result.EndUpdate;
{$endif}
  end;
end;

function TSQLLister.isActionButton(One: TObject): integer;
var GB: TSynToolButton absolute One;
    M: TMenuItem absolute One;
begin
  result := -1; // not an action buton or menu
  if One.InheritsFrom(TSynToolButton) then
    if ((GB.Images=ImageList32) or (GB.Images=ImageList16)) and
      Assigned(GB.OnClick) and (TMethod(GB.OnClick).Data=Self) then
        result := GB.ImageIndex;
  if One.InheritsFrom(TMenuItem) then
    if Assigned(M.OnClick) and (TMethod(M.OnClick).Data=Self) then
      result := M.ImageIndex;
  if cardinal(result)>=fActionMax then
    result := 0 else
    inc(result);
end;

procedure TSQLLister.OnRightClickCell(Sender: TSQLTable;
  ACol, ARow, MouseX, MouseY: Integer);
var P: TPoint;
begin
  if (self=nil) or (fMenu=nil) then
    exit;
  P.X := MouseX;
  P.Y := MouseY;
  P := fGrid.ClientToScreen(P);
  fMenu.Popup(P.X,P.Y);
end;


{.$define MARKEDROWSCOLORED}
// if defined, all Marked[] rows are highligted with a different background color

procedure NewDrawCellBackground(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState;
  {$ifdef USETMSPACK} TabAppearance: TTabAppearance;{$endif} Marked: boolean);
var Grid: TDrawGrid absolute Sender;
begin
  if not Sender.InheritsFrom(TDrawGrid) then
    exit;
{$ifdef USETMSPACK}
  if TabAppearance<>nil then
  with TabAppearance, Grid.Canvas do begin
    Font := Grid.Font;
    if (gdFixed in State) then begin
      Brush.Color := BackGround.Color;
      Font.Color := TextColor;
      Pen.Color := ShadowColor;
      inc(Rect.Bottom,1);
      MoveTo(Rect.Right,Rect.Top);
      LineTo(Rect.Right,Rect.Bottom);
    end else
    if Marked then
      if (gdSelected in State) then begin
        Brush.Color := HighLightColorSelected;
        Font.Color := TextColorHot;
      end else
        Brush.Color := HighLightColor else
      if (gdSelected in State) then begin
        Brush.Color := ColorHot;
        Font.Color := TextColorHot;
      end else
        Brush.Color := ColorTo;
{$else}
  with Grid.Canvas do begin
    Font := Grid.Font;
    if gdFixed in State then begin
      Font.Color := clCaptionText;
      Brush.Color := clGradientInactiveCaption;
      Pen.Color := clGrayText;
      inc(Rect.Bottom,1);
      MoveTo(Rect.Right,Rect.Top);
      LineTo(Rect.Right,Rect.Bottom);
    end else
    if (gdSelected in State) then begin
      Font.Color := clHighlightText;
      Brush.Color := clHighlight;
    end else begin
      Font.Color := clWindowText;
      Brush.Color := clWindow;
    end;
{$endif}
    FillRect(Rect);
  end;
end;

procedure TSQLLister.OnDrawCellBackground(Sender: TObject; ACol,
  ARow: Integer; Rect: TRect; State: TGridDrawState);
begin // draw the cell of a TDrawGrid according to the current Theming of Page
  if (self=nil) or (Page=nil) then
    exit;
  NewDrawCellBackground(Sender,ACol,ARow,Rect,State,
    {$ifdef USETMSPACK}TAdvToolBarOfficeStyler(Page.AdvToolBarPager.ToolBarStyler).TabAppearance,{$endif}
    {$ifdef MARKEDROWSCOLORED}TableToGrid.Marked[ARow]{$else}false{$endif});
end;

function TSQLLister.NewMenuItem(Menu: TPopupMenu; const aCaption: string;
  ImageIndex: integer=-1; SubMenu: TMenuItem=nil; OnClick: TNotifyEvent=nil;
  itemEnabled: boolean=true): TMenuItem;
begin
  result := TMenuItem.Create(Menu);
  result.Caption := aCaption;
  if not itemEnabled then
    result.Enabled := false;
  if Assigned(OnClick) then
    result.OnClick := OnClick else
    result.OnClick := ActionButtonClick;
  if ImageIndex>=0 then
    result.ImageIndex := ImageIndex;
  if SubMenu=nil then
    Menu.Items.Add(result) else
    SubMenu.Add(result);
end;

function TSQLLister.FindButton(ActionIndex: integer): TSynToolButton;
var iTB, iGB: integer;
begin
  dec(ActionIndex);
  for iTB := 0 to fPage.ToolBarCount-1 do
  with fPage.ToolBars[iTB] do
    for iGB := 0 to ComponentCount-1 do begin
      result := TSynToolButton(Components[iGB]);
      if result.InheritsFrom(TSynToolButton) and (result.ImageIndex=ActionIndex) then
        exit;
    end;
  result := nil;
end;

function TSQLLister.ActionHint(const Action): string;
var B: TSynToolButton;
begin
  B := FindButton(Byte(Action));
  if B=nil then
    result := '' else
    result := B.Hint;
end;

function TSQLLister.FindMenuItem(ActionIndex: integer): TMenuItem;
var i: integer;
begin
  dec(ActionIndex);
  for i := 0 to fMenu.Items.Count-1 do begin
    result := fMenu.Items[i];
    if result.ImageIndex=ActionIndex then
      exit;
  end;
  result := nil;
end;

procedure TSQLLister.CreateSubMenuItem(const aCaption: string;
  ActionIndex: integer; OnClick: TNotifyEvent; ImageIndex, Tag: integer;
  itemEnabled: boolean);
begin
  if (fCreateSubMenuLastMenu=nil) or (fCreateSubMenuLastAction<>ActionIndex) then begin
    fCreateSubMenuLastMenu := nil;
    fCreateSubMenuLastButton := FindButton(ActionIndex);
    if fCreateSubMenuLastButton=nil then exit; // avoid GPF
    if fCreateSubMenuLastButton.DropDownMenu=nil then begin
      fCreateSubMenuLastButton.DropDownMenu := TSynPopupMenu.Create(fGrid);
      fCreateSubMenuLastButton.DropDownMenu.Images := fMenu.Images;
    end;
    fCreateSubMenuLastMenu := FindMenuItem(ActionIndex);
    fCreateSubMenuLastAction := ActionIndex;
  end;
  if (fCreateSubMenuLastMenu=nil) or (fCreateSubMenuLastButton=nil) then exit;
  if aCaption='' then begin // erase any previous menu content
    fCreateSubMenuLastButton.DropDownMenu.Items.Clear;
    fCreateSubMenuLastMenu.Clear; // erase any previous menu content
  end else begin
    NewMenuItem(fMenu,aCaption,ImageIndex,fCreateSubMenuLastMenu,
      OnClick,itemEnabled).Tag := Tag;
    NewMenuItem(fCreateSubMenuLastButton.DropDownMenu,aCaption,ImageIndex,nil,
      OnClick,itemEnabled).Tag := Tag;
  end;
end;


{ TSQLRibbonTab }

function TSQLRibbonTab.AskForAction(const ActionCaption, aTitle: string;
  Client: TSQLRest; DontAskIfOneRow, ReturnMarkedIfSomeMarked: boolean): integer;
var i: integer;
{$ifdef USETMSPACK}
    Capt, Txt: string; // generic VCL string
{$else}
    TaskDialog: TTaskDialog;
    CommonButtons: TCommonButtons;
    DefaultButton: integer;
{$endif}
begin
  if TableToGrid.Table.RowCount<1 then
    result := 0 else
  if DontAskIfOneRow and
     (TableToGrid.Table.RowCount=1) and (TDrawGrid(TableToGrid.Owner).Row=1)  then
    result := 100 else // one Row (only one workstation) -> "apply to selected"
  if ReturnMarkedIfSomeMarked and TableToGrid.MarkAvailable then
    result := 101 else // force "Apply to Marked"
{$ifdef USETMSPACK}
  with CreateAdvTaskDialog do
  try
    if aTitle='' then
      Title := SMsgDlgConfirm else
      Title := aTitle;
    Instruction := ActionCaption;
    Icon := tiQuestion;
    Capt := '';
    with TableToGrid do
    if MarkAvailable and not MarkedIsOnlyCurrrent then begin
      for i := 1 to Table.RowCount do
        if Marked[i] then
          if length(Capt)>500 then begin
            Capt := Capt+'<br>   ...';
            break;
          end else
            Capt := Capt+'<br>   '+ExpandRowAsString(i,Client);
    end;
    if Capt<>'' then begin
      // we have some marked entries -> ask if perform on them, or selected only
      CommonButtons := [cbCancel];
      Custombuttons.Add(sApplyToSelected);
      Custombuttons.Add(sApplyToMarked);
      Capt := sPerformToMarkedOrSelected+Capt;
      DefaultButton := integer(mrCancel);
    end else begin
      // we have no marked entry -> confirm action on selected
      CommonButtons := [cbYes,cbNo];
      DefaultButton := integer(mrNo);
      Capt := sPerformToSelected;
    end;
    Txt := TableToGrid.ExpandRowAsString(TDrawGrid(TableToGrid.Owner).Row,Client);
    Content := format(Capt,[Txt]);
    result := Execute;
    if (DefaultButton=integer(mrNo)) and (result=IDYES) then
       // "Apply to Selected" was choosen
      result := 100;
  finally
    Free;
  end;
{$else}
  with TaskDialog do begin
    if aTitle='' then
      Title := SMsgDlgConfirm else
      Title := aTitle;
    Inst := ActionCaption;
    with TableToGrid do
    if MarkAvailable and not MarkedIsOnlyCurrrent then begin
      for i := 1 to Table.RowCount do
        if Marked[i] then
          if length(Content)>500 then begin
            Content := Content+'\n   ...';
            break;
          end else
            Content := Content+'\n   '+ExpandRowAsString(i,Client);
    end;
    if Content<>'' then begin
      // we have some marked entries -> ask if perform on them, or selected only
      CommonButtons := [cbCancel];
      Buttons := sApplyToSelected+#13#10+sApplyToMarked;
      Content := sPerformToMarkedOrSelected+Content;
      DefaultButton := integer(mrCancel);
    end else begin
      // we have no marked entry -> confirm action on selected
      CommonButtons := [cbYes,cbNo];
      DefaultButton := integer(mrNo);
      Content := sPerformToSelected;
    end;
    Content := format(Content,
      [TableToGrid.ExpandRowAsString(TDrawGrid(TableToGrid.Owner).Row,Client)]);
    result := Execute(CommonButtons,DefaultButton,[],tiQuestion);
    if (DefaultButton=integer(mrNo)) and (result=IDYES) then
       // "Apply to Selected" was choosen
      result := 100;
  end;
{$endif USETMSPACK}
end;

destructor TSQLRibbonTab.Destroy;
begin
  FreeAndNil(CurrentRecord);
  inherited;
end;

{.$define CREATEICONSREPORT}
// if defined, a report is created containing all icons for this toolbar
// -> not working yet

constructor TSQLRibbonTab.Create(ToolBar: TSynPager; Body: TSynBodyPager;
  aImageList32,aImageList16: TImageList; var aPagesShortCuts: TFreeShortCut;
  const aTabParameters: TSQLRibbonTabParameters;
  Client: TSQLRestClientURI; aUserRights: TSQLFieldBits;
  aOnValueText: TValueTextEvent; SetAction: TSQLRibbonSetActionEvent;
  const ActionsTBCaptionCSV, ActionsHintCaption: string; ActionIsNotButton: pointer;
  aOnActionClick: TSQLListerEvent; ViewToolbarIndex: integer;
  aHideDisabledButtons, aHeaderCheckboxSelectsInsteadOfSort: boolean);
var W: string;
    U: RawUTF8;
    i, LW: integer;
    PC: PChar;
    TestEnabled: boolean;
    A: array[0..31] of byte; // enough space for a set of 256 elements
    TB: TSynToolBar;
    Act: TSQLActions absolute A;
    OK: boolean;
{$ifdef CREATEICONSREPORT}
    IcoRep: TGDIPages;
{$endif}
begin
  Table := aTabParameters.Table;
  TableIndex := Client.Model.GetTableIndex(Table);
  Parameters := @aTabParameters;
  assert(TableIndex>=0);
  // create tab on ribbon
  if aTabParameters.CustomCaption<>nil then
    W := LoadResString(aTabParameters.CustomCaption) else // do the translation
    W := '';
  Tab := TSQLLister.AddPage(ToolBar,Table,W,false);
  assert(TableIndex=Tab.PageIndex); // as expected in SetAction()
  // create Body page
{$ifdef USETMSPACK}
  Page := Body.AdvPages[Body.AddAdvPage(Table.ClassName)]; {$else}
  Page := Body.Pages[Body.AddPage(Table.ClassName)];
{$endif}
  Page.TabVisible := false;
  if not (TableIndex in aUserRights) then begin
    Tab.TabVisible := false;
    exit; // this Table won't be visible in the client area
  end;
{$ifdef USETMSPACK}
  Tab.ShortCutHintPos := shpBottom;
  Tab.ShortCutHint := aPagesShortCuts.FindFreeShortCut(Tab.Caption);
{$endif}
  Tab.ShowHint := true;
  FrameLeft := TFrame.Create(Body);
  FrameLeft.Parent := Page;
  List := TDrawGrid.Create(Body);
  List.Parent := FrameLeft;
  List.Align := alClient;
  Lister := TSQLLister.Create(Page,Client,Table,List,not aTabParameters.ShowID,
    Toolbar,aImageList32,aImageList16,aOnActionClick,aOnValueText,
    'ID,'+aTabParameters.Select,aHideDisabledButtons,aHeaderCheckboxSelectsInsteadOfSort);
  TableToGrid := Lister.TableToGrid;
  U := aTabParameters.FieldWidth;
  if aTabParameters.ShowID then
    U := 'b'+U; // ID is shown centered in first column
  if assigned(SetAction) then
    SetAction(Tab.PageIndex,-1,false,A) else // -1 -> A := mark toolbar
    fillchar(A,sizeof(A),0);
  if TableToGrid<>nil then begin
    TableToGrid.SetFieldLengthMean(U,actMark in Act); // actMark -> add checkboxes
    if cardinal(aTabParameters.OrderFieldIndex)<cardinal(TableToGrid.Table.FieldCount) then begin
      TableToGrid.SortForce(
        aTabParameters.OrderFieldIndex,not aTabParameters.ReverseOrder);
      List.Row := 1;
    end;
  end;
  if aTabParameters.Layout=llClient then begin
    FrameLeft.Align := alClient;
    // no FrameSplit nor FrameRight necessary
  end else begin // llLeft, llUp, llLeftUp:
    FrameRight := TFrame.Create(Body);
    FrameRight.Parent := Page;
    FrameRight.Align := alClient;
    FrameSplit := TSplitter.Create(Body);
    FrameSplit.Parent := Page;
    LW := aTabParameters.ListWidth;
    if LW=0 then
      LW := 30; // default list width is 30%
    case aTabParameters.Layout of
    llLeft, llLeftUp: begin
      FrameLeft.Width := (Page.ClientWidth*LW)div 100;
      FrameLeft.Align := Controls.alLeft;
      FrameSplit.Left:= FrameLeft.Width;
    end;
    llUp: begin
      FrameLeft.Height := (Page.ClientHeight*LW)div 100;
      FrameLeft.Align := Controls.alTop;
      FrameSplit.Top := FrameLeft.Height;
    end;
    end;
    FrameSplit.Align := FrameLeft.Align;
    if TableToGrid<>nil then
      FrameRight.OnResize := TableToGrid.Resize;
    if not aTabParameters.NoReport then begin
      Report := TGDIPages.Create(Body);
      Report.ForceScreenResolution := true;
      Report.Parent := FrameRight;
      Report.Align := alClient;
      Report.Zoom := PAGE_WIDTH;
{$ifdef USETMSPACK}
      Report.Color := (Toolbar.ToolBarStyler as TAdvToolBarOfficeStyler).
        DockColor.Color;
{$endif}
    end;
  end;
  // create toolbars on ribbon for this tab
  // TestEnabled := false -> first create all buttons
  // TestEnabled := true -> then enabled or disable the buttons,
  //  according to user rights
  if assigned(SetAction) then begin
{$ifdef CREATEICONSREPORT}
    IcoRep := TGDIPages.Create(nil);
    IcoRep.BeginDoc;
    IcoRep.DrawTitle(Page.Caption,true);
{$endif}
    Lister.ActionHints := ActionsHintCaption;
    for TestEnabled := false to true do begin
      PC := pointer(ActionsTBCaptionCSV);
      i := 0;
      while PC<>nil do begin
        if aHideDisabledButtons then
          OK := true else
          OK := TestEnabled;
        W := SetAction(Tab.PageIndex,i,OK,A); // actions for this toolbar
        if W='' then begin
          W := GetNextItemString(PC);
          if W='%' then  // display the Tab name as Toolbar caption
            W := Tab.Caption else
          if W='%%' then // display the table name as Toolbar caption
            W := Table.CaptionName;
        end else
          GetNextItemString(PC); // customized caption -> just ignore default
{$ifdef CREATEICONSREPORT}
        if TestEnabled then begin
          IcoRep.DrawTitle('"'+W+'" Toolbar');
        end;
{$endif}TB := Lister.SetToolBar(W,A,ActionIsNotButton);
        if i=ViewToolbarIndex then
          ViewToolbar := TB;
        inc(i);
      end;
    end;
{$ifdef CREATEICONSREPORT}
    IcoRep.EndDoc;
    IcoRep.ShowPreviewForm;
    IcoRep.Free;
{$endif}
  end;
  // update Report popup menu
  if (Report<>nil) and (ViewToolbar<>nil) then begin
    Report.PopupMenu := TSynPopupMenu.Create(Report);
{$ifdef USETMSPACK}
    ViewToolBar.ShowOptionIndicator := true;
    ViewToolbar.OnOptionClick := ReportOptionEvent;
{$endif}
  end;
{$ifndef USETMSPACK}
  Lister.Page.ToolBarCreated;
{$endif}
end;

function TSQLRibbonTab.Retrieve(Client: TSQLRestClient; ARow: integer; ForUpdate: boolean=false): boolean;
var ID: integer;
begin
  FreeAndNil(CurrentRecord); // force Destroy: private fields MUST be reset
  if (Client=nil) or (ARow<=0) then
    result := false else begin
    CurrentRecord := Table.Create;
    ID := TableToGrid.Table.IDColumnHiddenValue(ARow);
    if ID<=0 then
      result := false else
      result := Client.Retrieve(ID,CurrentRecord,ForUpdate);
  end;
end;

procedure TSQLRibbonTab.ReportOptionEvent(Sender: TObject; ClientPoint,
  ScreenPoint: TPoint);
begin
  Report.PopupMenu.Popup(ScreenPoint.X,ScreenPoint.Y);
end;

procedure TSQLRibbonTab.CustomReportPopupMenu(OnClick: TNotifyEvent;
  ParamsEnum: PTypeInfo; ParamsEnabled: pointer; const Values: array of PBoolean);
begin
  if (ParamsEnum=nil) or not (ParamsEnum^.Kind=tkEnumeration) then
    exit;
  Report.OnPopupMenuPopup := ReportPopup;
  Report.OnPopupMenuClick := ReportClick;
  FReportPopupClick := OnClick;
  FReportPopupParams := ParamsEnum^.EnumBaseType;
  FReportPopupParamsEnabled := ParamsEnabled;
  SetLength(FReportPopupValues,FReportPopupParams.MaxValue+1);
  move(Values[0],FReportPopupValues[0],length(Values)*sizeof(Values[0]));
end;

procedure TSQLRibbonTab.AddReportPopupMenuOptions(Menu: TPopupMenu; OnClick: TNotifyEvent);
var P: PShortString;
    i: integer;
function AddReportMenu(const Caption: string): TMenuItem;
begin
  result := Lister.NewMenuItem(Menu,Caption,-1,nil,OnClick);
  result.Tag := 1000+i;
end;
begin
  if (self=nil) or (FReportPopupParams=nil) or (FReportPopupParamsEnabled=nil) then
    exit;
  if not Assigned(OnClick) and (Report<>nil) then
    OnClick := Report.PopupMenuItemClick;
  AddReportMenu('-'); // separator
  P := @FReportPopupParams^.NameList;
  for i := 0 to FReportPopupParams^.MaxValue do begin
    if GetBitPtr(FReportPopupParamsEnabled,i) then
      with AddReportMenu(Table.CaptionNameFromRTTI(P)) do
        Checked := (FReportPopupValues[i]<>nil) and FReportPopupValues[i]^;
    inc(PByte(P),ord(P^[0])+1); // next enumeration item
  end;
end;

procedure TSQLRibbonTab.ReportPopup(Sender: TObject);
begin
  AddReportPopupMenuOptions(Report.PopupMenu,nil);
end;

procedure TSQLRibbonTab.ReportClick(Sender: TObject);
var M: TMenuItem absolute Sender;
    i: integer;
begin
  if (Sender<>nil) and not Sender.InheritsFrom(TMenuItem) then
    exit;
  if FReportPopupValues=nil then
    exit; // avoid GPF
  i := M.Tag-1000;
  if (cardinal(i)<=cardinal(high(FReportPopupValues))) and
     (FReportPopupValues[i]<>nil) then begin
    FReportPopupValues[i]^ := not FReportPopupValues[i]^;
    M.Checked := FReportPopupValues[i]^;
    if Assigned(FReportPopupClick) then
      FReportPopupClick(Sender);
  end;
end;

function TSQLRibbonTab.GetCurrentID: TID;
begin
  if (self=nil) or (TableToGrid=nil) or (List=nil) then
    result := 0 else
    result := TableToGrid.Table.IDColumnHiddenValue(List.Row);
end;

{ TFreeShortCut }

function TFreeShortCut.FindFreeShortCut(const aCaption: string): string;
var c: AnsiChar;
    i: integer;
begin
  for i := 1 to length(aCaption) do begin
{$ifdef UNICODE}
    if word(aCaption[i])>255 then
      continue;
{$endif}
    c := NormToUpper[AnsiChar(aCaption[i])];
    if (c in ['A'..'Z']) and not (ord(c) in Values) then begin
      Include(Values,ord(c)); // one char shortcut
      result := string(c);
      exit;
    end;
  end;
  result := '';
end;


{ TSQLCustomToolBar }

function TSQLCustomToolBar.AddToolBar(const ToolBarName: string;
  ActionsBits: pointer=nil; ButtonWidth: integer=60): TSynToolBar;
var TypeName: PShortString;
    iAction: integer;
    ActionNames: TStringDynArray;
begin
  if (ActionsEnum=nil) or (ActionsBits=nil) then
    // no enum -> add a void toolbar
    result := Page.CreateToolBar else begin
    result := nil;
    for iAction := 0 to ActionsEnum^.MaxValue do
      if GetBitPtr(ActionsBits,iAction) then begin
        result := Page.CreateToolBar;
        break;
      end;
  end;
  SetLength(ToolBars,length(ToolBars)+1); // ToolBars[] index is OK
  if result=nil then
    exit; // only create the toolbar if any button to put inside ;)
  ToolBars[high(ToolBars)] := result;
  try
{$ifdef USETMSPACK}
    result.BeginUpdate;
    result.AutoPositionControls := true;
    result.ShowOptionIndicator := false;
    result.AutoSize := true;
{$else}
    result.Images := ImageList;
{$endif}
    result.Caption := ToolBarName;
    if ActionsEnum=nil then
      exit;
    SetLength(ActionNames,ActionsEnum^.MaxValue+1);
    TypeName := @ActionsEnum^.NameList;
    for iAction := 0 to ActionsEnum^.MaxValue do begin
      ActionNames[iAction] := TSQLRecord.CaptionNameFromRTTI(TypeName); // expanded caption
      inc(PByte(TypeName),ord(TypeName^[0])+1); // next enumerate value name
{$ifndef USETMSPACK}
    end; // TToolBar adds at 1st position -> downto
    for iAction := ActionsEnum^.MaxValue downto 0 do begin
{$endif}
      if (ActionsBits=nil) or GetBitPtr(ActionsBits,iAction) then
        Buttons[iAction] := result.CreateToolButton(ButtonClick,iAction,
         ImageListFirstIndex,ActionNames[iAction],ActionHints,ShortCutUsed,
         ButtonWidth,ImageList);
    end;
  finally
{$ifdef USETMSPACK}
    result.EndUpdate;
{$else}
   Page.ToolBarCreated; // create Caption label under toolbar
{$endif}
  end;
end;

function TSQLCustomToolBar.CreateSubMenuItem(aButtonIndex: integer;
  const aCaption: string; aOnClick: TNotifyEvent; aTag: integer): TMenuItem;
begin
  result := nil;
  if (@self<>nil) and (cardinal(aButtonIndex)<=cardinal(high(Buttons))) then
    with Buttons[aButtonIndex] do begin
      if DropDownMenu=nil then
        DropDownMenu := TSynPopupMenu.Create(Page);
      if aCaption='' then // erase any previous menu content
        DropDownMenu.Items.Clear else begin // or add item
        result := TMenuItem.Create(DropDownMenu);
        result.Caption := aCaption;
        result.OnClick := aOnClick;
        result.Tag := aTag;
        DropDownMenu.Items.Add(result);
      end;
    end;
end;

procedure TSQLCustomToolBar.Init(aToolbarOrPage: TControl; aEnum: PTypeInfo;
  aButtonClick: TNotifyEvent; aImageList: TImageList; const aActionHints: string;
  aImageListFirstIndex: integer);
var ToolBar: TSynPager absolute aToolbarOrPage;
begin
  if aToolbarOrPage.InheritsFrom(TCustomForm) then begin
    ToolBar := TSynPager.CreatePager(TCustomForm(aToolbarOrPage),true);
{$ifndef USETMSPACK}
    ToolBar.FormNoCaption;
{$endif}
  end;
  if aToolbarOrPage.InheritsFrom(TSynPager) then begin
    Page := TSQLLister.AddPage(ToolBar,nil,'',False);
{$ifdef USETMSPACK}
    if ToolBar.Parent.InheritsFrom(TSynForm) then
      ToolBar.MinimizeApp := false; // so WMSyscommand method will be called below
{$endif}
    ToolBar.ActivePageIndex := 0;
  end else
  if aToolbarOrPage.InheritsFrom(TSynPage) then
    Page := pointer(aToolbarOrPage) else
    assert(false);
  if aEnum^.Kind=tkEnumeration then begin
    ActionsEnum := aEnum^.EnumBaseType;
    SetLength(Buttons,ActionsEnum^.MaxValue+1);
  end;
  ButtonClick := aButtonClick;
  ImageList := aImageList;
  ActionHints := aActionHints;
  ImageListFirstIndex := aImageListFirstIndex;
end;


{$ifdef USETMSPACK}

{ TSynForm }

procedure TSynForm.CreateParams(var Params: TCreateParams);
begin
  HideAppFormTaskBarButton; // check if not already hidden
  inherited CreateParams(Params);
  Params.ExStyle := Params.ExStyle and not WS_EX_TOOLWINDOW or
    WS_EX_APPWINDOW;  // this form will appear in the TaskBar
end;

procedure TSynForm.WMSyscommand(var M: TMessage);
begin
  case (M.WParam and $FFF0) of
    SC_MINIMIZE, SC_RESTORE, SC_MAXIMIZE: begin
       M.Result := DefWindowProc(self.Handle, M.Msg, M.WParam, M.LParam);
       ShowWindow(Application.Handle, SW_HIDE);
     end;
  else
    inherited;
  end;
end;

{$endif USETMSPACK}

function LoadBitmapFromResource(const ResName: string; Instance: THandle): TBitmap;
var Pic: TSynPicture;
begin
  if Instance=0 then
    Instance := HInstance;
  result := TBitmap.Create;
  try
    Pic := TSynPicture.Create;
    try
      Pic.LoadFromResourceName(Instance,ResName); // *.png
      result.Width := Pic.Width;
      result.Height := Pic.Height;
      result.Canvas.Draw(0,0,Pic);
    finally
      Pic.Free;
    end;
  except
    on Exception do
      FreeAndNil(result);
  end;
end;

procedure ImageListStretch(ImgListSource, ImgListDest: TImageList;
   BkColor: TColor=clSilver);
var BmpSource, BmpDest: TBitmap;
    i: integer;
    Pic: TSynPicture;
    RS,RD: TRect;
begin
  ImgListDest.Clear;
  if Gdip=nil then
    Gdip := TGDIPlusFull.Create;
  Pic := TSynPicture.Create;
  BmpSource := TBitmap.Create;
  BmpDest := TBitmap.Create;
  try
    RS.Left := 0;
    RS.Top := 0;
    RS.Right := ImgListSource.Width;
    RS.Bottom := ImgListSource.Height;
    BmpSource.Width := RS.Right;
    BmpSource.Height := RS.Bottom;
    RD.Left := 0;
    RD.Top := 0;
    RD.Right := ImgListDest.Width;
    RD.Bottom := ImgListDest.Height;
    BmpDest.Width := RD.Right;
    ImgListDest.Masked := false;
    BmpDest.Height := RD.Bottom;
    for i := 0 to ImgListSource.Count-1 do begin
      BmpSource.Canvas.Brush.Color := BkColor;
      BmpSource.Canvas.Brush.Style := bsSolid;
      BmpSource.Canvas.FillRect(RS);
      ImgListSource.Draw(BmpSource.Canvas,0,0,i);
      Pic.Assign(BmpSource);
      Pic.Draw(BmpDest.Canvas,RD); // GDI+ smooth draw
      ImgListDest.Add(BmpDest,nil);
    end;
  finally
    BmpDest.Free;
    BmpSource.Free;
    Pic.Free;
  end;
end;

function AddIconToImageList(ImgList: TCustomImageList; Icon: HIcon): integer;
var Bmp: TBitmap;
begin
  Bmp := TBitmap.Create;
  try
    Bmp.Transparent := true;
    Bmp.Canvas.Brush.Color := clWhite;
    Bmp.Width := ImgList.Width;
    Bmp.Height := ImgList.Height;
    DrawIconEx(Bmp.Canvas.Handle,0,0,Icon,ImgList.Width,ImgList.Height,0,
      Bmp.Canvas.Brush.Handle,DI_NORMAL);
    DestroyIcon(Icon);
    result := ImgList.AddMasked(Bmp,clWhite);
  finally
    Bmp.Free;
  end;
end;

procedure LoadImageListFromBitmap(ImgList: TCustomImageList; Bmp: TBitmap);
var i: integer;
    BW,BH,W,H: integer;
begin
  // from multi-line (i.e. IDE export) into one-line (for AddMasked)
  BW := Bmp.Width;
  BH := Bmp.Height;
  W := (BW div ImgList.Width);
  H := (BH div ImgList.Height);
  Bmp.Width := W*H*ImgList.Width;
  BH := ImgList.Height;
  for i := 2 to H do
    Bmp.Canvas.CopyRect(Rect((i-1)*BW,0,i*BW,BH),
      Bmp.Canvas,Rect(0,(i-1)*BH,BW,i*BH));
  Bmp.Height := BH;
  // add these images to the image list
  ImgList.AddMasked(Bmp,Bmp.Canvas.Pixels[0,0]);
end;

procedure LoadImageListFromEmbeddedZip(ImgList: TCustomImageList; const ZipName: TFileName);
var i: integer;
    Bmp: TBitmap;
    Stream: TSynMemoryStream;
begin
  with TZipRead.Create(HInstance,'Zip','ZIP') do
  try
    i := NameToIndex(ZipName);
    if i<0 then exit;
    Stream := TSynMemoryStream.Create(UnZip(i)); // uncompress
    try
      Bmp := TBitmap.Create;
      try
        Bmp.LoadFromStream(Stream);
        LoadImageListFromBitmap(ImgList,Bmp);
      finally
        Bmp.Free;
      end;
    finally
      Stream.Free;
    end;
  finally
    Free;
  end;
end;



{$ifndef USETMSPACK}

{ TSynToolButton }

constructor TSynToolButton.Create(aOwner: TComponent);
begin
  inherited;
  AutoSize := true;
end;

procedure TSynToolButton.DoDropDown;
begin
  CheckMenuDropdown;
end;

function TSynToolButton.Images: TCustomImageList;
begin
  if Owner.InheritsFrom(TToolBar) then
    result := TToolBar(Owner).Images else
    result := nil;
end;


{ TSynPage }

const
  TOOLBAR_SPACE = 20;

function TSynPage.GetToolBarNextLeft(var Last: TSynToolBar): integer;
var n, W: integer;
begin
  n := length(fToolBar);
  if n>0 then begin
    Last := fToolBar[n-1];
    with Last.Buttons[Last.ButtonCount-1] do
      W := Left+Width+2;
    Last.Width := W;
    result := Last.Left+W+TOOLBAR_SPACE;
  end else begin
    result := 4;
    Last := nil;
  end;
end;

function TSynPage.CreateToolBar(AddToList: boolean): TSynToolBar;
var n: integer;
    Last: TSynToolBar;
begin
  result := TSynToolBar.Create(self);
  result.Parent := self;
  result.Align := alNone;
  result.AutoSize := false;
  result.ShowCaptions := true;
  result.ButtonHeight := 58;
  result.ButtonWidth := 60;
  result.Height := 57;
  result.Top := 7;
  result.Font := DefaultFont;
  result.Font.Size := result.Font.Size-1;
  result.Left := GetToolBarNextLeft(Last);
  if (Last<>nil) and (Last.Images<>nil) then
    result.Images := Last.Images;
  if AddToList then begin
    n := length(fToolBar);
    SetLength(fToolBar,n+1);
    fToolBar[n] := result;
  end;
end;

function TSynPage.GetToolBar(aIndex: integer): TSynToolBar;
begin
  if cardinal(aIndex)<cardinal(length(fToolBar)) then
    result := fToolBar[aIndex] else
    result := nil;
end;

function TSynPage.GetToolBarCount: integer;
begin
  result := length(fToolBar);
end;

procedure TSynPage.ToolBarCreated;
var n, i: integer;
    Lab: TLabel;
    Bev: TBevel;
    Last: TSynToolBar;
begin
  n := length(fToolBar);
  if fToolBarCaptionsCount=n then
    exit;
  GetToolBarNextLeft(Last);
  for i := fToolBarCaptionsCount to n-1 do begin
     Lab := TLabel.Create(Self);
     Lab.Parent := Self;
     Lab.AutoSize := false;
     Lab.Alignment := Classes.taCenter;
     Lab.Font.Color := clGrayText;
     Lab.Transparent := true;
     Bev := TBevel.Create(Self);
     Bev.Parent := Self;
     with fToolBar[i] do begin
       Lab.Font.Size := Font.Size;
       Lab.SetBounds(Left,Top+Height+3,Width,20);
       Bev.SetBounds(Left,Top+Height+1,Width,2);
       Lab.Caption := Caption;
     end;
     Bev.Shape := bsTopLine;
  end;
  fToolBarCaptionsCount := n;
end;


{ TSynPager }

function TSynPager.AddPage(aPage: TSynPage): integer;
begin
  aPage.PageControl := self;
  result := PageCount-1;
  if TabHeight=0 then
    aPage.TabVisible := false;
end;

function TSynPager.AddPage(const aCaption: string): integer;
var aPage: TSynPage;
begin
  aPage := TSynPage.Create(self);
  aPage.Parent := self;
  result := AddPage(aPage);
end;

function TSynPager.GetSynPage(aIndex: integer): TSynPage;
begin
  result := inherited Pages[aIndex] as TSynPage;
end;

function TSynPager.GetActivePageIndex: integer;
begin
  result := inherited ActivePageIndex;
end;

procedure TSynPager.SetActivePageIndex(const Value: integer);
begin
  inherited ActivePageIndex := Value;
  Change;
  if Assigned(OnChange) then
    OnChange(self);
end;

procedure TSynPager.Change;
var Pag: TSynPage;
    Last: TSynToolBar;
begin
  inherited;
  if fHelpToolBar<>nil then begin
    Pag := ActivePage as TSynPage;
    fHelpToolBar.Parent := Pag;
    fHelpToolBar.Left := Pag.GetToolBarNextLeft(Last);
  end;
end;

function TSynPager.TabGroupsAdd(TabIndexStart, TabIndexEnd: integer; const aCaption: string): TLabel;
begin
  assert(TopMostPanel<>nil,'expect TSynPager.CreatePager');
  result := TLabel.Create(TopMostPanel);
  result.Font := DefaultFont;
  result.Parent := TopMostPanel;
  result.Font.Color := clGrayText;
  result.Font.Size := Font.Size-1;
  result.Alignment := Classes.taCenter;
  result.Transparent := true;
  result.Caption := aCaption;
  result.Left := TabWidth*TabIndexStart+8;
  result.Top := 2;
  result.Tag := TabIndexStart; // for GroupLabelClick to select the page
  result.OnClick := GroupLabelClick;
  result.Width := TabWidth*TabIndexEnd-result.Left;
  with TBevel.Create(TopMostPanel) do begin
    Parent := TopMostPanel;
    SetBounds(result.Left+result.Width+1,2,2,result.Height+2);
    Shape := bsLeftLine;
  end;
end;

procedure TSynPager.FormNoCaption;
begin
  if Owner.InheritsFrom(TSynForm) and (TopMostPanel<>nil) then begin
    TSynForm(Owner).SetNoCaption(TopMostPanel,TabWidth*PageCount);
    TSynForm(Owner).NoCaptionLabel.Font := DefaultFont;
  end;
end;

procedure TSynPager.GroupLabelClick(Sender: TObject);
begin
  if Sender.InheritsFrom(TLabel) then
    ActivePageIndex := TLabel(Sender).Tag;
end;

class function TSynPager.CreatePager(aOwner: TCustomForm; NoTabVisible: boolean=false): TSynPager;
var H: integer;
begin
  if NoTabVisible then
    H := TOOLBAR_HEIGHT-TOOLBAR_TAB_HEIGHT else
    H := TOOLBAR_HEIGHT;
  result := TSynPager.Create(aOwner);
  result.fTopMostPanel := TPanel.Create(aOwner);
  with result.fTopMostPanel do begin
    Parent := aOwner;
    Height := H+TOOLBAR_GROUPS_HEIGHT;
    Align := alTop;
  end;
  result.fTopPanel := TPanel.Create(aOwner);
  with result.fTopPanel do begin
    Parent := result.fTopMostPanel;
    Height := result.fTopMostPanel.ClientHeight-TOOLBAR_GROUPS_HEIGHT;
    Align := alBottom;
  end;
  result.Parent := result.fTopPanel;
  result.Height := H;
  result.HotTrack := true;
  if not NoTabVisible then begin
    result.TabHeight := TOOLBAR_TAB_HEIGHT;
    result.TabWidth := 85;
  end;
  result.Font := DefaultFont;
  result.Align := alTop;
end;

function TSynPager.GetHelpButton: TSynToolButton;
var Pag: TSynPage;
begin
  if fHelpButton=nil then begin
    fHelpButton := TSynToolButton.Create(self);
    Pag := ActivePage as TSynPage;
    fHelpToolBar := Pag.CreateToolBar(false);
    fHelpButton.Parent := fHelpToolBar;
    fHelpButton.Caption := SMsgDlgHelpHelp;
    fHelpButton.ImageIndex :=
      AddIconToImageList(fHelpToolBar.Images,LoadIcon(0,IDI_QUESTION));
    fHelpToolBar.Width := fHelpButton.Width+3;
    Pag.ToolBarCreated;
  end;
  result := fHelpButton;
end;

function TSynPager.GetCaption: TLabel;
begin
  if Owner.InheritsFrom(TSynForm) then
    result := TSynForm(Owner).NoCaptionLabel else
    result := nil;
end;

{$else USETMSPACK}

{ TSynPage }

function TSynPage.CreateToolBar: TSynToolBar;
begin
  result := TSynToolBar(CreateAdvToolBar);
end;

destructor TSynPage.Destroy;
begin
  if BackgroundPictureStored then
    FreeAndNil(fBackgroundPicture);
  inherited;
end;

function TSynPage.GetToolBar(aIndex: integer): TSynToolBar;
begin
  result := TSynToolBar(AdvToolBars[aIndex]);
end;

procedure TSynPage.Paint;
var Bmp: TBitmap;
    W,BW: integer;
begin
  inherited Paint;
  if BackgroundPicture=nil then
    Exit;
  W := Width-BackgroundPicture.Width-4;
  Canvas.Draw(W, 4, BackgroundPicture);
  if W<=4 then
    exit; // no tiling necessary
  Bmp := TBitmap.Create;
  try // need to tile for filling the left side of the page
    if BackgroundPictureTiledWidth<10 then
      BW := 200 else
      BW := BackgroundPictureTiledWidth;
    if BW>BackgroundPicture.Width then
      BW := BackgroundPicture.Width;
    Bmp.Width := BW;
    Bmp.Height := BackgroundPicture.Height;
    Bmp.Canvas.Draw(0,0,BackgroundPicture);
    repeat
      dec(W,Bmp.Width);
      Canvas.Draw(W,4,Bmp); // replicate leftmost of the bitmap
    until W<=4;
  finally
    Bmp.Free;
  end;
end;

function TSynPage.ToolBarCount: integer;
begin
  result := AdvToolBarCount;
end;


{ TSynPager }

class function TSynPager.CreatePager(aOwner: TCustomForm; NoTabVisible: boolean=false): TSynPager;
begin
  result := TSynPager.Create(aOwner);
  result.Parent := aOwner;
  if NoTabVisible then begin
    result.TabSettings.Height := 0;
    result.Height := 119;
    result.HelpButton.Hide;
  end else
    result.Height := 145;
  result.ToolBarStyler := TAdvToolBarOfficeStyler.Create(aOwner);
  TAdvToolBarOfficeStyler(result.ToolBarStyler).Style := bsOffice2007Luna;
end;

function TSynPager.AddPage(aPage: TSynPage): integer;
begin
  result := AddAdvPage(aPage);
end;

function TSynPager.AddPage(const aCaption: string): integer;
begin
  result := AddAdvPage(aCaption);
end;

function TSynPager.GetSynPage(aIndex: integer): TSynPage;
begin
  result := TSynPage(AdvPages[aIndex]);
end;

function TSynPager.GetSynPageCount: integer;
begin
  result := AdvPageCount;
end;

{$endif USETMSPACK}


{ TSynToolBar }

function TSynToolBar.CreateToolButton(ButtonClick: TNotifyEvent;
  iAction, ImageListFirstIndex: integer; const ActionName, ActionHints: string;
  var ShortCutUsed: TFreeShortCut; ButtonWidth: integer; Images: TCustomImageList): TSynToolButton;
begin
  result := TSynToolButton.Create(self);
  result.Caption := ActionName;
{$ifdef USETMSPACK}
  result.Height := (ClientHeight-CaptionHeight)-4;
  result.Width := ButtonWidth;
  result.Layout := blGlyphTop;
  result.ShortCutHint := ShortCutUsed.FindFreeShortCut(result.Caption);
  result.ShortCutHintPos := shpBottom;
  result.Images := Images;
{$endif}
  result.Parent := self;
  result.OnClick := ButtonClick;
  result.ImageIndex := iAction-ImageListFirstIndex; // store the button enumerate value in ImageIndex
  result.Tag := iAction;
  result.Hint := GetCSVItemString(pointer(ActionHints),result.ImageIndex,#13);
  if result.Hint<>'' then
    result.ShowHint := true;
end;


{ TSQLRibbon }

function CaptionName(OnCaptionName: TOnCaptionName;
  const Action: RawUTF8; Obj: TObject=nil; Index: integer=-1): string;
begin
  if Assigned(OnCaptionName) then begin
    result := OnCaptionName(Action,Obj,Index);
    if result<>'' then
      exit;
  end;
  // default implementation uses RTTI
  if Obj=nil then
    result := TSQLRecord.CaptionName(@Action) else
    if Obj.InheritsFrom(TSQLRecord) then
      result := TSQLRecord(Obj).CaptionName else
      result := TSQLRecord.CaptionNameFromRTTI(ClassNameShort(Obj));
  if Index>=0 then
    result := result+' '+IntToStr(Index);
end;

procedure TSQLRibbon.BodyResize(Sender: TObject);
var P: integer;
begin
  for P := 0 to high(Page) do
  if Page[P]<>nil then
    Page[P].TableToGrid.Resize(Sender);
end;


{$ifdef USETMSPACK}

const // bulky TMS styles don't match :(
  TToolBarStyleToPanel: array[TToolBarStyle] of TAdvPanelStyle =
  (psOffice2003Blue, psOffice2003Silver, psOffice2003Olive, psOffice2003Classic,
   psOffice2007Luna, psOffice2007Obsidian, psWindowsXP, psWhidbey,
   psOffice2003Olive {=bsCustom}, psOffice2007Silver, psXP, psWindowsVista,
   psWindows7, psTerminal, psOffice2010Blue, psOffice2010Silver, psOffice2010Black);

procedure TSQLRibbon.ChangeColorScheme(
  const ColorScheme: TToolBarStyle;
  PanelStyler: TAdvPanelStyler;
  StatusBarStyler: TAdvOfficeStatusBarOfficeStyler;
  CustomStyle: TMemoryStream);
var PreviewStyle: TPreviewMenuStyle;
    StatusStyle: TOfficeStatusBarStyle;
    TBStyler: TAdvToolBarOfficeStyler;
    i, curr: Integer;
    C: TComponent;
begin
  if not fToolBar.ToolBarStyler.InheritsFrom(TAdvToolBarOfficeStyler) then
    exit;
  TBStyler := TAdvToolBarOfficeStyler(ToolBar.ToolBarStyler);
  if TBStyler=nil then
    exit;
  TBStyler.Style := ColorScheme;
  case ColorScheme of // bulky TMS styles don't match :(
    bsCustom: begin
      if CustomStyle<>nil then begin
        CustomStyle.Seek(0,soFromBeginning);
        CustomStyle.ReadComponent(TBStyler);
      end;
      PreviewStyle := AdvPreviewMenuStylers.psOffice2003Olive;
      StatusStyle := AdvOfficeStatusBarStylers.psOffice2003Olive;
    end;
    bsOffice2007Silver: begin
      PreviewStyle := AdvPreviewMenuStylers.psOffice2007Silver;
      StatusStyle := AdvOfficeStatusBarStylers.psOffice2007Silver;
    end;
    bsOfficeXP: begin
      PreviewStyle := AdvPreviewMenuStylers.psOfficeXP;
      StatusStyle := AdvOfficeStatusBarStylers.psWindowsXP;
    end;
    bsWindowsVista..high(TToolBarStyle): begin
      PreviewStyle := TPreviewMenuStyle(ColorScheme);
      StatusStyle := TOfficeStatusBarStyle(pred(ColorScheme));
    end;
    else begin
      PreviewStyle := TPreviewMenuStyle(ColorScheme);
      StatusStyle := TOfficeStatusBarStyle(ColorScheme);
    end;
  end;
  if (PreviewMenu<>nil) and
     PreviewMenu.Styler.InheritsFrom(TAdvPreviewMenuOfficeStyler) then
    TAdvPreviewMenuOfficeStyler(PreviewMenu.Styler).Style := PreviewStyle;
  if StatusBarStyler<>nil then
    StatusBarStyler.Style := StatusStyle;
  if PanelStyler<>nil then
    PanelStyler.Style := TToolBarStyleToPanel[ColorScheme];
  TBStyler.CaptionAppearance.Assign(TBStyler.GroupAppearance.CaptionAppearance);
  with TBStyler.GroupAppearance.TabAppearance do begin
    TBStyler.PagerCaption.TextColor := TextColor;
    TBStyler.PagerCaption.TextColorExtended := TextColorSelected;
  end;
  if (Body<>nil) and Body.AdvOfficePagerStyler.InheritsFrom(TAdvOfficePagerOfficeStyler) then
    TAdvOfficePagerOfficeStyler(Body.AdvOfficePagerStyler).Style :=
      TOfficePagerStyle(StatusStyle);
  // update colors for windows
  for i := 0 to Application.ComponentCount-1 do begin
    C := Application.Components[i];
    if C.InheritsFrom(TCustomForm) then
      SetStyle(C,TBStyler); // will set style for all embedded components
  end;
  // update report colors on every ribbon page
  curr := fToolBar.ActivePageIndex;
  for i := 0 to high(Page) do
  with Page[i] do begin
    if Report<>nil then
      Report.Color := TBStyler.QATAppearance.ColorTo;
    if i=curr then
      List.Invalidate; // repaint list first row with new colors
  end;
  if Form<>nil then
    Form.Invalidate; // whole form redraw
end;
{$endif USETMSPACK}

constructor TSQLRibbon.Create(Owner: TCustomForm; ToolBar: TSynPager; Body: TSynBodyPager;
      aImageList32,aImageList16: TImageList;
      Client: TSQLRestClientURI; aUserRights: TSQLFieldBits;
      aOnValueText: TValueTextEvent; SetAction: TSQLRibbonSetActionEvent;
      const ActionsTBCaptionCSV, ActionsHintCaption: string; ActionIsNotButton: pointer;
      aOnActionClick: TSQLListerEvent; RefreshActionIndex, ViewToolbarIndex: integer;
      aHideDisabledButtons: boolean;
      PagesCount: integer; TabParameters: PSQLRibbonTabParameters; TabParametersSize: integer;
      const GroupCSV: string; const BackgroundPictureResourceNameCSV: string='';
      aHeaderCheckboxSelectsInsteadOfSort: boolean=false);
{$ifdef USETMSPACK}
var Pic: TGDIPPicture;
    PicUsed: boolean;
    ResName: string;
    PS: TSynPage;
    PB: PChar;
{$else}
var aPageFirst: integer;
{$endif}
    aGroup: integer;
    PC: PChar;
    aPage: integer;
    ActionsHints: string;
    TP: PSQLRibbonTabParameters;
begin
  if (Owner=nil) or (TabParameters=nil) or (Client=nil) then
    exit;
  fActionsHintCaption := ActionsHintCaption;
  fTabParameters := TabParameters;
  fTabParametersSize := TabParametersSize;
  fClient := Client;
  fForm := Owner;
  if ToolBar=nil then begin
    ToolBar := TSynPager.CreatePager(Owner);
{$ifdef USETMSPACK}
    fPreviewMenu := TAdvPreviewMenu.Create(Owner);
    fPreviewMenu.Styler := TAdvPreviewMenuOfficeStyler.Create(Owner);
    TAdvPreviewMenuOfficeStyler(fPreviewMenu.Styler).Style :=
      AdvPreviewMenuStylers.psOffice2007Luna;
    fPreviewMenuButton := TAdvShapeButton.Create(Owner);
    fPreviewMenuButton.Appearance.Shape := bsOrb;
    fPreviewMenuButton.Parent := ToolBar;
    fPreviewMenuButton.SetBounds(6,6,45,45);
    fPreviewMenuButton.AdvPreviewMenu := fPreviewMenu;
{$endif}
  end;
  fToolBar := ToolBar;
  if Body=nil then begin
    Body := TSynBodyPager.Create(Owner);
    Body.Parent := Owner;
{$ifdef USETMSPACK}
    Body.AdvOfficePagerStyler := TAdvOfficePagerOfficeStyler.Create(Owner);
    TAdvOfficePagerOfficeStyler(Body.AdvOfficePagerStyler).Style :=
      AdvOfficePagerStylers.psOffice2007Luna;
    Body.TabSettings.Height := 0;
{$endif}
  end;
  fBody := Body;
  fOnActionClick := aOnActionClick;
  fRefreshActionIndex:= RefreshActionIndex;
  Body.Align := alClient;
  SetLength(Page,PagesCount);
  TP := TabParameters;
  for aPage := 0 to PagesCount-1 do begin
    if TP^.CustomHint<>nil then
      ActionsHints := LoadResString(TP^.CustomHint) else
      ActionsHints := TP^.Table.CaptionName(nil,true); // ForHint=true
    ActionsHints := StringReplace(ActionsHintCaption,'%s',ActionsHints,[rfReplaceAll]);
    Page[aPage] := TSQLRibbonTab.Create(ToolBar, Body, aImageList32, aImageList16,
      ShortCuts, TP^, Client, aUserRights, aOnValueText,
      SetAction, ActionsTBCaptionCSV, ActionsHints, ActionIsNotButton,
      aOnActionClick, ViewToolbarIndex, aHideDisabledButtons, aHeaderCheckboxSelectsInsteadOfSort);
    Inc(PtrInt(TP),TabParametersSize);
  end;
  aPage := 0;
  aGroup := 0;
  PC := pointer(GroupCSV);  // 'Tab 1,Tab 2,Tab 3'
{$ifdef USETMSPACK}
  PB := pointer(BackgroundPictureResourceNameCSV);
  while PC<>nil do
    with ToolBar.TabGroups.Add do begin
      Caption := GetNextItemString(PC);
      CaptionAlignment := Classes.taCenter;
      TabIndexStart := aPage;
      PicUsed := false;
      ResName := GetNextItemString(PB);
      if (ResName='') or
         (FindResource(HInstance,pointer(ResName),RT_RCDATA)=0) then
        Pic := nil else
        Pic := TGDIPPicture.Create;
        if Pic<>nil then
          Pic.LoadFromResourceName(HInstance,ResName);
      try
        while (aPage<PagesCount) and (TabParameters^.Group=aGroup) do begin
          if Pic<>nil then begin
            PS := TSynPage(ToolBar.AdvPages[aPage]);
            if PS.InheritsFrom(TSynPage) then begin
              PS.BackgroundPicture := Pic;
              if not PicUsed then begin
                PS.BackgroundPictureStored := True;
                PicUsed := true;
              end;
            end;
          end;
          inc(PtrInt(TabParameters),TabParametersSize);
          inc(aPage);
        end;
      finally
        if (Pic<>nil) and not PicUsed then
          Pic.Free;
      end;
      TabIndexEnd := aPage-1;
      inc(aGroup);
    end;
{$else}
  while PC<>nil do begin
    aPageFirst := aPage;
    while (aPage<PagesCount) and (TabParameters^.Group=aGroup) do begin
      inc(PtrInt(TabParameters),TabParametersSize);
      inc(aPage);
    end;
    ToolBar.TabGroupsAdd(aPageFirst,aPage,GetNextItemString(PC));
    inc(aGroup);
  end;
  ToolBar.FormNoCaption;
{$endif}
  ToolBar.OnChange := ToolBarChange;
  Body.OnResize := BodyResize;
  BodyResize(nil);
end;


destructor TSQLRibbon.Destroy;
var P: integer;
begin
  if Form<>nil then begin
    KillTimer(Form.Handle,WM_TIMER_REFRESH_SCREEN); // avoid GPF
    KillTimer(Form.Handle,WM_TIMER_REFRESH_REPORT);
  end;
  for P := 0 to high(Page) do
    FreeAndNil(Page[P]);
  inherited;
end;

function TSQLRibbon.GetActivePage: TSQLRibbonTab;
var P: Integer;
begin
  result := nil;
  if (Self=nil) or (ToolBar=nil) then
    exit;
  P := Toolbar.ActivePageIndex;
  if cardinal(P)<=cardinal(high(Page)) then
    result := Page[P];
end;

function TSQLRibbon.GetPage(aRecordClass: TSQLRecordClass): integer;
begin
  if self<>nil then
    for result := 0 to high(Page) do
      if (Page[result]<>nil) and (Page[result].Table=aRecordClass) then
        exit;
  result := -1;
end;

function TSQLRibbon.GetParameter(aPageIndex: Integer): PSQLRibbonTabParameters;
begin
  if (Self=nil) or (fTabParameters=nil) or (fTabParametersSize=0) or
     (cardinal(aPageIndex)>cardinal(high(Page)) )then
    result := nil else
    result := Pointer(PtrInt(fTabParameters)+fTabParametersSize*aPageIndex);
end;

procedure TSQLRibbon.GotoRecord(aTable: TSQLRecordClass; aID: TID;
  ActionToPerform: integer);
var P,R: integer;
begin
  if (self=nil) or (aTable=nil) or (aID<=0) then
    exit; // no record to jump in
  P := GetPage(aTable);
  if P>=0 then
    with Page[P] do
    if TableToGrid<>nil then begin
      R := TableToGrid.Table.RowFromID(aID);
      if R<0 then exit;
      if ToolBar.ActivePageIndex<>P then begin
        ToolBar.ActivePageIndex := P;
        Application.ProcessMessages;
      end;
      TableToGrid.Refresh;
      R := TableToGrid.Table.RowFromID(aID); // do it now after Grid refresh
      if R<0 then exit;
      List.Row := R;
      Application.ProcessMessages;
      Form.BringToFront;
      Application.ProcessMessages;
      if (ActionToPerform<>0) and Assigned(fOnActionClick) then
        // Sender needs to be <> nil
        fOnActionClick(self,Table,ActionToPerform);
    end;
end;

procedure TSQLRibbon.GotoRecord(aRecord: TSQLRecord; ActionToPerform: integer);
begin
  if (self<>nil) and (aRecord<>nil) then
    GotoRecord(aRecord.RecordClass,aRecord.ID);
end;

function TSQLRibbon.RefreshClickHandled(Sender: TObject;
  RecordClass: TSQLRecordClass; ActionValue: integer;
  out Tab: TSQLRibbonTab): boolean;
var aP: integer;
begin
  result := true; // caller must exit now
  aP := GetPage(RecordClass);
  if aP<0 then
    exit;
  Tab := Page[aP];
  if (Sender<>nil) and (fRefreshActionIndex<>0) and
     (ActionValue=fRefreshActionIndex) and not Tab.TableToGrid.Refresh then begin
    Sender := nil;
    ActionValue := Tab.List.Row;
  end;
  if Sender=nil then begin
    if Tab.FrameRight<>nil then begin
      if Tab.Retrieve(Client,ActionValue) then begin
        Tab.FrameRight.Show;
        if Tab.Report<>nil then begin
          if ReportAutoFocus and
             (Form.Focused or Tab.List.Focused) and Tab.Report.CanFocus then
            Tab.Report.SetFocus;
          SetTimer(Form.Handle,WM_TIMER_REFRESH_REPORT,200,nil);
        end;
      end else
        Tab.FrameRight.Hide;
    end;
    exit;
  end;
  result := false; // caller must handle the action
end;

procedure TSQLRibbon.RefreshPage(Page: TSQLRibbonTab);
var P: TSQLRibbonTab;
begin
  if (self=nil) or (Page=nil) or (fRefreshActionIndex=0) then
    exit;
  if Assigned(fOnActionClick) then
    fOnActionClick(Page.Lister,Page.Table,fRefreshActionIndex) else
    RefreshClickHandled(Page.Lister,Page.Table,fRefreshActionIndex,P);
end;

procedure TSQLRibbon.ToolBarChange(Sender: TObject);
var aPage: integer;
begin
  KillTimer(Form.Handle,WM_TIMER_REFRESH_SCREEN);
  KillTimer(Form.Handle,WM_TIMER_REFRESH_REPORT);
  aPage := fToolBar.ActivePageIndex;
  if cardinal(aPage)>cardinal(high(Page)) then
    exit;
  with Page[fLastActiveTab] do begin
    TableToGrid.PageChanged;
    if Report<>nil then // release some unused GDI resources
      FreeAndNil(Report.PreviewSurfaceBitmap);
  end;
  fLastActiveTab := aPage;
  fBody.ActivePageIndex := aPage;
  if fBody.Visible and (fRefreshActionIndex<>0) then begin
    RefreshPage(Page[aPage]);
    if (Form<>nil) and GetParameter(aPage)^.AutoRefresh then
      // set Timer to refresh the screen every second
      SetTimer(Form.Handle,WM_TIMER_REFRESH_SCREEN,1000,nil);
  end;
end;

procedure TSQLRibbon.WMRefreshTimer(var Msg: TWMTimer);
var i: integer;
begin
  if (self=nil) or (Form=nil) or (csDestroying in Form.ComponentState) then
    exit; // avoid GPF
  i := ToolBar.ActivePageIndex;
  if cardinal(i)>cardinal(high(Page)) then
    exit;
  if fClient.OnIdleBackgroundThreadActive then
    exit; // avoid endless loop
  case Msg.TimerID of // action from Timer ID
  WM_TIMER_REFRESH_SCREEN: // used to send a Refresh command (default every second)
    if (fRefreshActionIndex<>0) and
      GetParameter(i)^.AutoRefresh then // refresh Workstation content
      RefreshPage(Page[i]);
  WM_TIMER_REFRESH_REPORT: with Page[i] do
    if (FrameRight<>nil) and (Report<>nil) and
       Retrieve(Client,List.Row) then begin
      // used to recreate the current selected report
      // use a timer, otherwise marking is buggy and UI experience is poor
      KillTimer(Form.Handle,WM_TIMER_REFRESH_REPORT); // only refresh once
      try
        Report.BeginDoc;
        CreateReport(i);
      finally
        Report.EndDoc; // so we ignore any reporting errors
      end;
    end;
  end;
end;

function TSQLRibbon.AddToReport(aReport: TGDIPages; aRecord: TSQLRecord;
  WithTitle: Boolean; CSVFieldNames, CSVFieldNameToHide: PUTF8Char;
  OnCaptionName: TOnCaptionName;
  ColWidthName, ColWidthValue: integer): string;
var OldWordWrapLeftCols: boolean;
    i: integer;
    aName: RawUTF8;
    RibbonParams: PSQLRibbonTabParameters;
    PHint: PChar; // map FieldHints
    aHint, aCaption: string;
begin
  result := '';
  if (Self=nil) or (aReport=nil) or (aRecord=nil) or (Client=nil) then
    exit;
  PHint := nil;
  RibbonParams := GetParameter(aRecord.RecordClass);
  if RibbonParams<>nil then
    with RibbonParams^ do
      if EditFieldHintsToReport and (EditFieldHints<>nil) then
        PHint := pointer(LoadResString(EditFieldHints));
  result := U2S(Client.MainFieldValue(aRecord.RecordClass,aRecord.ID,true));
  if WithTitle then begin
    aReport.DrawTitle(aRecord.CaptionName+' : '+result,true);
    aReport.NewHalfLine;
  end;
  OldWordWrapLeftCols := aReport.WordWrapLeftCols;
  aReport.WordWrapLeftCols := true; // automatic word wrap and #13 for next line
  aReport.AddColumns([ColWidthName,ColWidthValue]);
  aReport.SetColumnBold(0);
  aReport.AddColumnHeaders([],true);
  with aRecord.RecordProps.Fields do begin
    for i := 0 to Count-1 do begin
      aHint := GetNextItemString(PHint,'|'); // ALL fields are listed: do it now
      aName := List[i].Name;
      if ((CSVFieldNameToHide<>nil) and
          (FindCSVIndex(CSVFieldNameToHide,aName,',',false)>=0)) or
         ((CSVFieldNames<>nil) and
          (FindCSVIndex(CSVFieldNames,aName,',',false)<0)) then
        continue; // display properties listed in optional CSVFieldNames parameter
      if aHint<>'' then begin
        aReport.Font.Color := clNavy;
        aReport.DrawText(aHint);
        aReport.Font.Color := clBlack;
      end;
      if assigned(OnCaptionName) then
        aCaption := OnCaptionName(aName) else
        aCaption := '';
      if aCaption='' then
        GetCaptionFromPCharLen(TrimLeftLowerCase(aName),aCaption);
      aReport.DrawTextAcrossCols([aCaption,
       Language.PropToString(List[i],aRecord,Client)]); // PropToString do all the magic
      if aHint<>'' then
        aReport.NewLine else
        aReport.NewHalfLine;
    end;
  end;
  aReport.WordWrapLeftCols := oldWordWrapLeftCols;
end;

function TSQLRibbon.DeleteMarkedEntries(aTable: TSQLRecordClass; const ActionHint: string): boolean;
var Tab: TSQLRibbonTab;
    aP, n, i: integer;
begin
  result := True; // success by default
  if (self=nil) or (aTable=nil) or (Client=nil)  then
    exit;
  aP := GetPage(aTable);
  if aP<0 then
    exit;
  Tab := Page[aP];
  with Tab.TableToGrid do begin
     n := MarkedTotalCount;
     if n=0 then
       if (Tab.List.Row<1) or (YesNo(ActionHint,
         U2S(Client.MainFieldValue(aTable,Tab.CurrentID,true)),false)=ID_NO) or
          not Client.Delete(aTable,Tab.CurrentID) then begin
         result := false;
         exit;
       end else
         GotoRecord(aTable,Table.IDColumnHiddenValue(Tab.List.Row+1)) else
     if YesNo(ActionHint,Format(sDeleteN,[n]),false)=ID_NO then
       exit else
     if Client.TransactionBegin(aTable) then
     try
       for i := Table.RowCount downto 1 do
         if Marked[i] then
           if not Client.Delete(aTable,Table.IDColumnHiddenValue(i)) then begin
             Client.RollBack;
             result := false;
             break;
           end;
       SetMark(actUnmarkAll);
       Tab.List.Row := 0;
       Refresh;
     finally
       Client.Commit; // will do nothing if Client.RollBack has been called
     end;
  end;
end;

function TSQLRibbon.ExportRecord(aTable: TSQLRecordClass; aID: TID;
  const ActionHint: string; OpenAfterCreation: boolean): TFileName;
var i: integer;
    aName, ext: TFileName;
    Rep: TGDIPages;
    Content: string;
begin
  result := '';
  if (self=nil) or (aTable=nil) or (Client=nil)  then
    exit;
  if GetPage(aTable)<0 then
    exit; // CreateReport need a known record type
  if aID>0 then
    aName := U2S(Client.MainFieldValue(aTable,aID,true)) else
    aName := aTable.CaptionName;
  with TSaveDialog.Create(Application.MainForm) do
  try
    Title := ActionHint;
    Options := [ofOverwritePrompt,ofHideReadOnly,ofEnableSizing];
    Filter := sPDFFile+' (*.pdf)|*.pdf|'+sTextFile+' (*.txt)|*.txt';
    DefaultExt := '.pdf';
    FileName := aName;
    if not Execute then
      exit;
    aName := FileName;
  finally
    Free;
  end;
  ext := ExtractFileExt(aName);
  Rep := TGDIPages.Create(nil); // use a temp report to create text
  try
    Screen.Cursor := crHourGlass;
    Rep.ForceCopyTextAsWholeContent := true; // headers copied once
    CreateReport(aTable,aID,Rep);
    Rep.EndDoc;
    if SameText(ext,'.PDF') then begin
      Rep.Caption := aName;
      if not Rep.ExportPDF(aName,false) then
        exit;
    end else
    if SameText(ext,'.TXT') then begin
      for i := 0 to high(Rep.Pages) do
        Content := Content+Rep.Pages[i].Text; // append content of every page
      // export as ANSI text file, in the current code page
        if not FileFromString(
          {$ifdef UNICODE}
          CurrentAnsiConvert.UnicodeBufferToAnsi(pointer(Content),length(Content))
          {$else}
          Content
          {$endif} ,aName) then
          exit;
    end else
      exit; // invalid extension
    if OpenAfterCreation then
      ShellExecute(Application.DialogHandle,nil,pointer(aName),nil,nil,SW_SHOWNORMAL);
    result := aName; // mark success
  finally
    Screen.Cursor := crDefault;
    Rep.Free;
  end;
end;

function TSQLRibbon.GetParameter(aTable: TSQLRecordClass): PSQLRibbonTabParameters;
begin
  result := GetParameter(GetPage(aTable));
end;

function TSQLRibbon.MarkedEntriesToReport(aTable: TSQLRecordClass;
  const ColWidths: array of integer; aRep: TGDIPages): TGDIPages;
var P, R, F: integer;
    ColText: TSynUnicodeDynArray;
    ColWidth: TIntegerDynArray;
begin
  P := GetPage(aTable);
  if (P<0) or (Page[P].TableToGrid.MarkedTotalCount=0) then begin
    result := nil;
    exit;
  end;
  if aRep<>nil then
    result := aRep else
    result := TGDIPages.Create(nil);
  result.WordWrapLeftCols := true; // word wrap so that we won't loose any data
  CreateReport(aTable,-1,result); // create footer
  result.DrawTitle(aTable.CaptionName,true);
  with Page[P].TableToGrid do begin
    if length(ColWidths)=Table.FieldCount then begin
      SetLength(ColWidth,Table.FieldCount);
      move(ColWidths[0],ColWidth[0],Table.FieldCount*sizeof(integer));
    end else
      Table.CalculateFieldLengthMean(ColWidth,true); // FromDisplay=true
    result.AddColumns(ColWidth);
    SetLength(ColText,Table.FieldCount);
    for F := 0 to Table.FieldCount-1 do
      Table.ExpandAsSynUnicode(0,F,Client,ColText[F]);
    result.AddColumnHeaders(ColText,true,true); // true = with gray bottom line
    for R := 1 to Table.RowCount do
    if Marked[R] then begin
      for F := 0 to Table.FieldCount-1 do
        Table.ExpandAsSynUnicode(R,F,Client,ColText[F]);
      result.DrawTextAcrossCols(ColText);
    end;
  end;
end;

procedure TSQLRibbon.CreateReport(aPageIndex: Integer);
var P: TSQLRibbonTab;
begin
  if cardinal(aPageIndex)>cardinal(high(Page)) then
    exit;
  P := Page[aPageIndex];
  if P<>nil then
    CreateReport(P.Table,P.CurrentRecord.ID,P.Report,false);
end;

procedure TSQLRibbon.CreateReport(aTable: TSQLRecordClass; aID: TID;
  aReport: TGDIPages; AlreadyBegan: boolean=false);
var P: integer;
begin
  if (aReport<>nil) and (aTable<>nil) and (self<>nil) then
    if aID=0 then
      MarkedEntriesToReport(aTable,[],aReport) else
    with aReport do begin
      if not AlreadyBegan then begin
        Clear;
        BeginDoc;
      end;
      if (aID>0) and (Caption='') then
        Caption := U2S(Client.MainFieldValue(aTable,aID,true));
      Font.Size := 9;
      AddPagesToFooterAt(FormatString('% - % %',[sPageN,aTable.CaptionName,Caption]),LeftMargin);
      Font.Size := 10;
      P := GetPage(aTable);
      if (P<0) or (aID<=0) then
        exit;
      with self.Page[P] do
        if CurrentRecord.ID=aID then
          AddToReport(aReport,CurrentRecord,True,nil,
              pointer(GetParameter(P)^.EditFieldNameToHideCSV));
    end;
end;

function TSQLRibbon.FindButton(aTable: TSQLRecordClass; aActionIndex: integer): TSynToolButton;
var P: integer;
begin
  P := GetPage(aTable);
  if P<0 then
    result := nil else
    result := Page[P].Lister.FindButton(aActionIndex);
end;

procedure TSQLRibbon.SetButtonHint(aTable: TSQLRecordClass;
  aActionIndex: integer; const aHint: string);
var Btn: TSynToolButton;
begin
  Btn := FindButton(aTable,aActionIndex);
  if Btn<>nil then
    Btn.Hint := aHint;
end;

procedure TSQLRibbon.Refresh(aTable: TSQLRecordClass);
var Tab: TSQLRibbonTab;
begin
  if aTable=nil then begin
    Tab := GetActivePage;
    if Tab=nil then
      exit;
    aTable := Tab.Table;
  end;
  RefreshClickHandled(self,aTable,fRefreshActionIndex,Tab);
end;

procedure TSQLRibbon.AddToReport(aReport: TGDIPages; Table: TSQLTable;
  const ColWidths: array of integer);
var R,F: integer;
    ColText: TSynUnicodeDynArray;
    ColWidth: TIntegerDynArray;
    aClient: TSQLRest;
begin
  if (aReport=nil) or (Table=nil) or (Table.FieldCount=0) then
    exit;
  if self=nil then
    aClient := nil else
    aClient := Client;
  if length(ColWidths)=Table.FieldCount then begin
    SetLength(ColWidth,Table.FieldCount);
    move(ColWidths[0],ColWidth[0],Table.FieldCount*sizeof(integer));
  end else
    Table.CalculateFieldLengthMean(ColWidth,true); // FromDisplay=true
  aReport.AddColumns(ColWidth);
  SetLength(ColText,Table.FieldCount);
  for F := 0 to Table.FieldCount-1 do
    Table.ExpandAsSynUnicode(0,F,aClient,ColText[F]);
  aReport.AddColumnHeaders(ColText,true,true); // true = with gray bottom line
  for R := 1 to Table.RowCount do begin
    for F := 0 to Table.FieldCount-1 do
      Table.ExpandAsSynUnicode(R,F,aClient,ColText[F]);
    aReport.DrawTextAcrossCols(ColText);
  end;
end;


end.

