{ *************************************************************************** }
{                                                                             }
{ EControl Syntax Editor SDK                                                  }
{                                                                             }
{ Copyright (c) 2004 - 2008 EControl Ltd., Zaharov Michael                    }
{     www.econtrol.ru                                                         }
{     support@econtrol.ru                                                     }
{                                                                             }
{ *************************************************************************** }
{$I ecSyntEdit.INC}

unit ecPopupCtrl;

interface

uses Windows, Messages, Classes, Controls, Graphics, StdCtrls, Forms, ExtCtrls, ComCtrls,
     ecSyntMemo, ecSyntAnal, ecStrUtils, ecMemoStrings, ecComplRend, Grids,
     ecCmdConst, ecZRegExpr, ImgList;

const
  EP_ITEMCHANGED = WM_USER + $3140;
  EP_RETURNFOCUS = WM_USER + $3141;
  EP_SIZECHANGING = WM_USER + $3142;

type
  TLayoutSide = (lsLeft, lsTop, lsRight, lsBottom);

  TCloseUpEvent = procedure(Sender: TObject; var Accept: Boolean) of object;

  TecPopupContainer = class(TWinControl)
  private
    FSizable: Boolean;
    FShadow: Boolean;
    FBorderStyle: TBorderStyle;
    procedure SetSizable(const Value: Boolean);
    procedure WMMouseActivate(var Message: TWMMouseActivate); message WM_MOUSEACTIVATE;
    procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
    procedure SetShadow(const Value: Boolean);
    procedure SetBorderStyle(const Value: TBorderStyle);
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
    procedure Resize; override;

    property Sizable: Boolean read FSizable write SetSizable;
    property Shadow: Boolean read FShadow write SetShadow;
    property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle;
  public
    constructor Create(AOwner: TComponent); override;
  end;

  TecToolHint = class(THintWindow)
  private
    FComplRender: TComplexRender;
    FFormatted: Boolean;
    FActive: Boolean;
    FImages: TImageList;
    FStyles: TSyntStyles;
    FMinMaxWidth: integer;
    FLayoutSide: TLayoutSide;
    FText: ecString;
    procedure CMFontchanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
    procedure SetActive(const Value: Boolean);
    procedure SetFormatted(const Value: Boolean);
    procedure SetImages(const Value: TImageList);
    procedure SetStyles(const Value: TSyntStyles);
    function IntCalcSize(MaxWidth: integer): TSize;
    procedure SetLayoutSide(const Value: TLayoutSide);
    procedure SetText(const Value: ecString);
  protected
    procedure RefreshHintWnd;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Active: Boolean read FActive write SetActive default False;
    property Styles: TSyntStyles read FStyles write SetStyles;
    property Images: TImageList read FImages write SetImages;
    property Formatted: Boolean read FFormatted write SetFormatted default False;
    property MinMaxWidth: integer read FMinMaxWidth write FMinMaxWidth default 150;
    property LayoutSide: TLayoutSide read FLayoutSide write SetLayoutSide default lsRight;
    property Font;
    property Color default clInfoBk;
    property Text: ecString read FText write SetText;
    property Constraints;
  end;

  TecControlItem = class(TCollectionItem)
  private
    FControl: TControl;
    FCloseOnClick: Boolean;
    procedure SetControlClass(const Value: string);
    function GetControlClass: string;
    procedure SetControl(const Value: TControl);
    function GetAlign: TAlign;
    procedure SetAlign(const Value: TAlign);
    function CreateControl(const ControlClass: String): TControl;
  protected
    procedure ReleaseControl;
    function GetDisplayName: String; override;
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
  published
    property ControlClass: string read GetControlClass write SetControlClass;
    property Control: TControl read FControl write SetControl;
    property Align: TAlign read GetAlign write SetAlign stored False;
    property CloseOnClick: Boolean read FCloseOnClick write FCloseOnClick default True;
  end;

  TecControlEvent = procedure(Sender: TObject; Control: TControl) of object;

  TecControlCollection = class(TOwnedCollection)
  private
    FOnControlDestroyed: TecControlEvent;
    FOnControlCreated: TecControlEvent;
    function GetItem(Index: integer): TecControlItem;
  protected
    procedure ControlCreated(Control: TControl);
    procedure ControlDestroyed(Control: TControl);
    function CanCancelMode(Obj: TObject): Boolean;

    property OnControlCreated: TecControlEvent read FOnControlCreated write FOnControlCreated;
    property OnControlDestroyed: TecControlEvent read FOnControlDestroyed write FOnControlDestroyed;
  public
    constructor Create(AOwner: TComponent);

    function Add(const ControlClass: string = ''): TecControlItem;
    property Items[Index: integer]: TecControlItem read GetItem; default;
  end;

  {$IFDEF EC_DOTNET}
  TFNWndProcSv = IntPtr;//TFNWndProc;//LongInt;
  {$ELSE}
  TFNWndProcSv = TFNWndProc;
  {$ENDIF}

  TPopupControl = class(TComponent)
  private
    FParent: TWincontrol;
    FPopupContainer: TecPopupContainer;
    FPopup: TWinControl;
    FParentWndProc: TFNWndProc;
    FPopupWndProc: TFNWndProc;
    _FParentWndProc: TFNWndProcSv;
    _FPopupWndProc: TFNWndProcSv;
    FMinMaxWidth: integer;
    FClosing: Boolean;
    FOnChange: TNotifyEvent;
    FLayoutSide: TLayoutSide;
    FToolHint: TecToolHint;
    FOnCloseUp: TCloseUpEvent;
    FOnShow: TNotifyEvent;
    FControls: TecControlCollection;
    FAroundRect: TRect;
    // IPopupControl
    procedure SetParent(const Value: TWinControl);
    procedure SetPopup(const Value: TWinControl);
    function GetVisible: Boolean;
    function GetSizable: Boolean;
    procedure SetSizable(const Value: Boolean);
    function GetHeight: integer;
    function GetWidth: integer;
    procedure SetHeight(const Value: integer);
    procedure SetWidth(const Value: integer);
    function GetConstraints: TSizeConstraints;
    procedure SetConstraints(const Value: TSizeConstraints);
    function GetShadow: Boolean;
    procedure SetShadow(const Value: Boolean);
    procedure SetLayoutSide(const Value: TLayoutSide);
    procedure SetControls(const Value: TecControlCollection);
    procedure ControlAdded(Sender: TObject; Ctrl: TControl);
    function IntGetPopupSize(MaxWidth: integer): TSize;
    procedure SetWndProc(wnd: HWND; const Proc: TFNWndProcSv);
    function GetWndProc(wnd: HWND): TFNWndProcSv;
    procedure SendPopupFocus;
    procedure CallWndProc(wnd: HWND; Proc: TFNWndProcSv; var Message: TMessage);
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure ParentWndProc(var Message: TMessage); virtual;
    procedure PopupWndProc(var Message: TMessage); virtual;
    procedure ShowAround(const Rect: TRect);
    function CalcLayout(AroundRect: TRect; var Bnd: TRect): Boolean;
    function RecalculateBounds: Boolean;
    function GetPopupRect: TRect;

    function GetPopupSize(MaxWidth: integer): TSize; virtual;
    procedure DoShow; virtual;
    procedure DoAccept(Accept: Boolean); virtual;
    procedure ItemChanged; virtual;
    procedure PostItemChanged;

    property Parent: TWinControl read FParent write SetParent;
    property Popup: TWinControl read FPopup write SetPopup;
    property Container: TecPopupContainer read FPopupContainer;
    property AroundRect: TRect read FAroundRect; // Vilid only when visible

    property Sizable: Boolean read GetSizable write SetSizable;
    property Width: integer read GetWidth write SetWidth;
    property Height: integer read GetHeight write SetHeight;
    property Constraints: TSizeConstraints read GetConstraints write SetConstraints;
    property MinMaxWidth: integer read FMinMaxWidth write FMinMaxWidth default 150;
    property LayoutSide: TLayoutSide read FLayoutSide write SetLayoutSide default lsBottom;
    property Shadow: Boolean read GetShadow write SetShadow default True;
    property ToolHint: TecToolHint read FToolHint;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property OnCloseUp: TCloseUpEvent read FOnCloseUp write FOnCloseUp;
    property OnShow: TNotifyEvent read FOnShow write FOnShow;
    property Controls: TecControlCollection read FControls write SetControls;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure CloseUp(Accept: Boolean); virtual;

    property Visible: Boolean read GetVisible;
    property Closing: Boolean read FClosing;
  published
  end;

  TSyntMemoPopup = class(TPopupControl, {$IFNDEF EC_DOTNET}IUnknown,{$ENDIF}IecCommandHook)
  private
    FCommandID: integer;
    procedure SetSyntMemo(const Value: TCustomSyntaxMemo);
    function GetSyntMemo: TCustomSyntaxMemo;
    procedure SetCommandID(const Value: integer);
    procedure SkipRead(Reader: TReader);
  protected
    // IecCommandHook
    procedure BeforeCommand(Command: integer; Data: ecPointer; var Handled: Boolean); virtual;
    procedure AfterCommand(Command: integer; Data: ecPointer; var Handled: Boolean); virtual;
    procedure IsCommandEnabled(Command: integer; Data: ecPointer; var Enable: Boolean); virtual;

    property CommandID: integer read FCommandID write SetCommandID;
    procedure DefineProperties(Filer: TFiler); override;
  public
    function Execute: Boolean; virtual;
    procedure ShowPopup(cPos: TPoint);
  published
    property SyntMemo: TCustomSyntaxMemo read GetSyntMemo write SetSyntMemo;
    property Constraints;
    property MinMaxWidth;
    property LayoutSide;
    property Shadow;
    property ToolHint;
    property Controls;

    property OnChange;
    property OnCloseUp;
    property OnShow;
  end;

  TSyntMemoPopupList = class(TSyntMemoPopup)
  private
    FOnlyDblClick: Boolean;
    FDropDownCount: integer;
    FAutoSelect: Boolean;
    procedure ListMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure ListMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    function GetListBox: TListBox;
    function GetIntegralHeight: Boolean;
    function GetItemHeight: integer;
    function GetStyle: TListBoxStyle;
    procedure SetIntegralHeight(const Value: Boolean);
    procedure SetItemHeight(const Value: integer);
    procedure SetStyle(const Value: TListBoxStyle);
    procedure SetDropDownCount(const Value: integer);
    function GetFont: TFont;
    procedure SetFont(const Value: TFont);
    procedure ListItemChanged(Sender: TObject);
    function GetBgColor: TColor;
    procedure SetBgColor(const Value: TColor);
  protected
    procedure AcceptValue; virtual; abstract;
    procedure ParentWndProc(var Message: TMessage); override;
    procedure ListDblClick(Sender: TObject);
    procedure DoAccept(Accept: Boolean); override;

    property ListStyle: TListBoxStyle read GetStyle write SetStyle;
    property ItemHeight: integer read GetItemHeight write SetItemHeight;
    property IntegralHeight: Boolean read GetIntegralHeight write SetIntegralHeight;
    property OnlyDblClick: Boolean read FOnlyDblClick write FOnlyDblClick default False;
    property ListBox: TListBox read GetListBox;
    property DropDownCount: integer read FDropDownCount write SetDropDownCount default 0;
    property Font: TFont read GetFont write SetFont;
    property AutoSelect: Boolean read FAutoSelect write FAutoSelect default True;
    property BgColor: TColor read GetBgColor write SetBgColor;
  public
    constructor Create(AOwner: TComponent); override;
  end;

  TCodeTemplateOptions = set of (ctIncludeOwn, ctIncludeLexer, ctEnableSearch,
                     ctDisplayShortCut, ctDisplayDesc, ctDisablePopup, ctRightDesc,
                     ctFiltered, ctShowCodeHint);
  TCodeTemplateSort = (ctsNone, ctsName, ctsDescription);
  TBeforeInsertTemplate = procedure(Sender: TObject; var Text: ecString; var CaretPos: integer) of object;

  TTemplatePopup = class(TSyntMemoPopupList)
  private
    FTemplates: TCodeTemplates;
    FOptions: TCodeTemplateOptions;
    FExternSource: TSyntAnalyzer;
    FSortType: TCodeTemplateSort;
    FOnBeforeInsertTemplate: TBeforeInsertTemplate;
    FSearchText: string;
    FSearchTickCount: Longint;
    procedure DrawCodeTemplItem(Control: TWinControl;
           Index: Integer; Rect: TRect; State: TOwnerDrawState);
    procedure SetTemplates(const Value: TCodeTemplates);
    procedure SetExternSource(const Value: TSyntAnalyzer);
    procedure SearchKeyPress(Sender: TObject; var Key: Char);
  protected
    procedure AcceptValue; override;
    procedure ParentWndProc(var Message: TMessage); override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    function GetPopupSize(MaxWidth: integer): TSize; override;
    procedure DoInsertTemplate(Text: ecString; CarPos: integer);
    procedure ItemChanged; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure InsertTemplate(Templ: TCodeTemplate);
    function Execute: Boolean; override;
    function CurrentTemplate: TCodeTemplate;

    property Sizable;
    property Width;
    property Height;
    property ListBox;
  published
    property Templates: TCodeTemplates read FTemplates write SetTemplates;
    property Options: TCodeTemplateOptions read FOptions write FOptions
             default [ctIncludeOwn, ctIncludeLexer, ctEnableSearch, ctDisplayShortCut, ctDisplayDesc, ctShowCodeHint];
    property ExternSource: TSyntAnalyzer read FExternSource write SetExternSource;
    property SortType: TCodeTemplateSort read FSortType write FSortType default ctsNone;
    property OnBeforeInsertTemplate: TBeforeInsertTemplate read FOnBeforeInsertTemplate write FOnBeforeInsertTemplate;
    property CommandID default smCodeTemplate;

    property DropDownCount;
    property OnlyDblClick;
    property Font;
    property AutoSelect;
    property BgColor;
  end;

  TAutoCompletePopup = class;

  TAutoCompleteSort = (asNone, asItems, asDisplayItems, asDisplayText,
                       asItems_Desc, asDisplayItems_Desc, asDisplayText_Desc);
  TGetAutoCompleteList = procedure(Sender: TObject; aPos: TPoint; List, Display: TecStrings) of object;
  TBeforeAutoComplete = procedure(Sender: TObject; var Item: ecString) of object;
  TAfterAutoComplete = procedure(Sender: TObject; const Item: ecString) of object;
  TDefineStartPosition = procedure(Sender: TObject; var StartPos: TPoint) of object;

  TFilterItemEvent = procedure(Sender: TAutoCompletePopup; const Item, DisplayItem, Filter: string; var Accept: Boolean) of object;
  TSortItemsEvent = procedure(Sender: TAutoCompletePopup; Index: TecStrings) of object;
  TGetFilterStringEvent = procedure(Sender: TAutoCompletePopup; var Filter: ecString; var Accept: Boolean) of object;

  TAutoCompleteOption = (aoFormatted, aoWithColumns, aoExactClose, aoCaseSensitive);
  TAutoCompleteOptions = set of TAutoCompleteOption;
  TAutoCompleteFilter = (afNone, afCmpStart, afCmpSubStr, afCharSeq);

  TAutoCompletePopup = class(TSyntMemoPopupList, {$IFNDEF EC_DOTNET}IUnknown,{$ENDIF}IecTextClient, IecSyntMemoClient)
  private
    FOnGetAutoCompleteList: TGetAutoCompleteList;
    FDisplayItems: TSyntMemoStrings;
    FItems: TSyntMemoStrings;
    FTimer: TTimer;
    FStart: TPoint;
    FStyles: TSyntStyles;
    FStartString: string;
    FSortType: TAutoCompleteSort;
    FOnAfterComplete: TAfterAutoComplete;
    FOnBeforeComplete: TBeforeAutoComplete;
    FOnDefineStartPos: TDefineStartPosition;
    FAutoSize: Boolean;
    FOnCheckChar: TCheckCharEvent;
    FComplRender: TComplexRender;
    FOnKeyPress: TKeyPressEvent;
    FInputPos: integer;
    FEnabled: Boolean;
    FOnFilter: TFilterItemEvent;
    FItemsChanged: Boolean;
    FStartExpr: TecRegExpr;
    FOnSortItems: TSortItemsEvent;
    FOnGetFilterString: TGetFilterStringEvent;
    FOptions: TAutoCompleteOptions;
    FFilterType: TAutoCompleteFilter;
    procedure SetItems(const Value: TecStrings);
    function GetFilter(var S: ecString): Boolean;
    function GetStartPosition(const RefPos: TPoint): TPoint;
    function FillListBox: Boolean;
    procedure DoTimer(Sender: TObject);
    procedure SetDisplayItems(const Value: TecStrings);
    procedure SetImages(const Value: TCustomImageList);
    function GetDelay: integer;
    procedure SetDelay(const Value: integer);
    procedure SetStyles(const Value: TSyntStyles);
    function CaretPosChanged: Boolean; // IecSyntMemoClient
    procedure TextChanged(Sender: TObject; Pos, Count, LineChange: integer); // IecTextClient
    procedure DrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
    procedure MeasureItem(Control: TWinControl; Index: Integer; var Height: Integer);
    procedure SetStartString(const Value: string);
    function GetDisplayItems: TecStrings;
    function GetItems: TecStrings;
    procedure ItemsChanged(Sender: TObject; Pos, Count, LineChange: integer);
    procedure SetColumnSpace(const Value: integer);
    procedure SetSortType(const Value: TAutoCompleteSort);
    function GetStartExpr: ecString;
    procedure SetStartExpr(const Value: ecString);
    function GetImages: TCustomImageList;
    function GetColumnSpace: integer;
    procedure SetOptions(const Value: TAutoCompleteOptions);
    procedure SetFilterType(const Value: TAutoCompleteFilter);
    procedure SetFixedH(const Value: Boolean);
    function GetFixedH: Boolean;
  protected
    function ShowAutoComplete: Boolean; virtual;
    procedure AcceptValue; override;
    procedure ParentWndProc(var Message: TMessage); override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    function GetPopupSize(MaxWidth: integer): TSize; override;
    function IsValidChar(C: ecChar): Boolean;
    function FilterItem(Item: integer; Filter: ecString): Boolean; virtual;
    procedure DoGetAutoCompleteList(var Start: TPoint); virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Execute: Boolean; override;
    function GetListItem(Index: integer): ecString; // returns Item text associated with the list item
    function ListItemIndex(ListIndex: integer): integer;
    property ListBox;
  published
    property Items: TecStrings read GetItems write SetItems;
    property DisplayItems: TecStrings read GetDisplayItems write SetDisplayItems;
    property Images: TCustomImageList read GetImages write SetImages;
    property Delay: integer read GetDelay write SetDelay default 500;
    property Styles: TSyntStyles read FStyles write SetStyles;
    property StartString: string read FStartString write SetStartString;
    property SortType: TAutoCompleteSort read FSortType write SetSortType default asNone;
    property FixedItemHeight: Boolean read GetFixedH write SetFixedH default False;
    property ColumnSpace: integer read GetColumnSpace write SetColumnSpace default 8;
    property AutoSize: Boolean read FAutoSize write FAutoSize default False;
    property Enabled: Boolean read FEnabled write FEnabled default True;
    property StartExpr: ecString read GetStartExpr write SetStartExpr;
    property Options: TAutoCompleteOptions read FOptions write SetOptions
      default [aoFormatted, aoWithColumns, aoExactClose];
    property FilterType: TAutoCompleteFilter read FFilterType write SetFilterType default afCmpStart;

    property OnGetAutoCompleteList: TGetAutoCompleteList read FOnGetAutoCompleteList write FOnGetAutoCompleteList;
    property OnBeforeComplete: TBeforeAutoComplete read FOnBeforeComplete write FOnBeforeComplete;
    property OnAfterComplete: TAfterAutoComplete read FOnAfterComplete write FOnAfterComplete;
    property OnDefineStartPos: TDefineStartPosition read FOnDefineStartPos write FOnDefineStartPos;
    property OnCheckChar: TCheckCharEvent read FOnCheckChar write FOnCheckChar;
    property OnKeyPress: TKeyPressEvent read FOnKeyPress write FOnKeyPress;
    property OnFilter: TFilterItemEvent read FOnFilter write FOnFilter;
    property OnSortItems: TSortItemsEvent read FOnSortItems write FOnSortItems;
    property OnGetFilterString: TGetFilterStringEvent read FOnGetFilterString write FOnGetFilterString;

    property Width;
    property Height;
    property Font;
    property DropDownCount;
    property IntegralHeight default False;
    property ItemHeight default 17;
    property OnlyDblClick;
    property CommandID default smAutoComplete;
    property AutoSelect;
    property BgColor;
  end;

  TGetParamsEvent = procedure(Sender: TObject; const FuncName: ecString; aPos: integer) of object;
  TGetParamsEventEx = procedure(Sender: TObject; const FuncNames: TecStrings) of object;

  TParamCompletion = class(TSyntMemoPopup, IecTextClient, IecSyntMemoClient)
  private
    FItems: TecStrings;
    FOpenChar: ecChar;
    FSeparator: ecChar;
    FCloseChar: ecChar;
    FDeclSeparator: Char;
    FParamNumber: integer;
    FAutomatic: Boolean;
    FTerminateChar: ecChar;
    FParamStart: integer;
    FOnGetParams: TGetParamsEvent;
    FEnabled: Boolean;
    FInputPos: integer;
    FTimer: TTimer;
    FUseParserResults: Boolean;
    FFuncPathRule: string;
    FFuncNameRule: string;
    FOnGetParamsEx: TGetParamsEventEx;
    FFilterItems: Boolean;
    FUpDownSwitch: Boolean;
    FSelected: integer;
    FSeparatorPen: TPen;
    FFmtSelParamStyleIndex: integer;
    FFmtImages: TCustomImageList;
    FFmtStyles: TSyntStyles;
    FFmtEnable: Boolean;
    FFmtSelStartImage: TImageIndex;
    FFmtSelEndImage: TImageIndex;
    procedure SetItems(const Value: TecStrings);
    procedure SetOpenChar(const Value: ecChar);
    procedure SetCloseChar(const Value: ecChar);
    procedure SetSeparator(const Value: ecChar);
    procedure SetDeclSeparator(const Value: Char);
    procedure SetParamNumber(const Value: integer);
    function CaretPosChanged: Boolean; // IecSyntMemoClient
    procedure TextChanged(Sender: TObject; Pos, Count, LineChange: integer); // IecTextClient
    procedure SetTerminateChar(const Value: ecChar);
    function GetColor: TColor;
    function GetFont: TFont;
    procedure SetColor(const Value: TColor);
    procedure SetFont(const Value: TFont);
    function GetDelay: integer;
    procedure SetDelay(const Value: integer);
    procedure DoTimer(Sender: TObject);
    procedure SetSelected(const Value: integer);
    procedure SetUpDownSwitch(const Value: Boolean);
    procedure SetSeparatorPen(const Value: TPen);
    procedure SetFmtImages(const Value: TCustomImageList);
    procedure SetFmtSelParamStyleIndex(const Value: integer);
    procedure SetFmtStyles(const Value: TSyntStyles);
    procedure SetFmtEnable(const Value: Boolean);
    procedure SetFmtSelEndImage(const Value: TImageIndex);
    procedure SetFmtSelStartImage(const Value: TImageIndex);
    function GetUpDownWidth: integer;
    procedure SetUpDownWidth(const Value: integer);
    function GetUpDownOrientation: TUDOrientation;
    procedure SetUpDownOrientation(const Value: TUDOrientation);
  protected
    function GetPopupSize(MaxWidth: integer): TSize; override;
    function IsValideFunc(pos: integer): Boolean;
    procedure CanExecute(Pos: integer; var StartPos, ParamNum: integer);
    procedure ItemChanged; override;
    procedure ParentWndProc(var Message: TMessage); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ShowAt(pos: integer);
    function ExecuteAt(pos: integer): Boolean;
    function Execute: Boolean; override;

    procedure AddItem(const Item: ecString);
    function ItemCount: integer;

    property ParamNumber: integer read FParamNumber write SetParamNumber;
    property Selected: integer read FSelected write SetSelected;
    property Items: TecStrings read FItems write SetItems;
  published
    property OpenChar: ecChar read FOpenChar write SetOpenChar default '(';
    property CloseChar: ecChar read FCloseChar write SetCloseChar default ')';
    property Separator: ecChar read FSeparator write SetSeparator default ',';
    property DeclSeparator: Char read FDeclSeparator write SetDeclSeparator default ';';
    property TerminateChar: ecChar read FTerminateChar write SetTerminateChar default ';';
    property Automatic: Boolean read FAutomatic write FAutomatic default True;
    property Color: TColor read GetColor write SetColor;
    property Font: TFont read GetFont write SetFont;
    property OnGetParams: TGetParamsEvent read FOnGetParams write FOnGetParams;
    property Enabled: Boolean read FEnabled write FEnabled default True;
    property Delay: integer read GetDelay write SetDelay default 500;
    property UseParserResults: Boolean read FUseParserResults write FUseParserResults default True;
    property CommandID default smParameterHint;
    property LayoutSide default lsTop;
    // v2.50
    property FuncPathRule: string read FFuncPathRule write FFuncPathRule;
    property FuncNameRule: string read FFuncNameRule write FFuncNameRule;
    property OnGetParamsEx: TGetParamsEventEx read FOnGetParamsEx write FOnGetParamsEx;
    property FilterItems: Boolean read FFilterItems write FFilterItems default True;
    property SeparatorPen: TPen read FSeparatorPen write SetSeparatorPen;
    property UpDownSwitch: Boolean read FUpDownSwitch write SetUpDownSwitch default False;
    property UpDownWidth: integer read GetUpDownWidth write SetUpDownWidth default 24;
    property UpDownOrientation: TUDOrientation read GetUpDownOrientation write SetUpDownOrientation default udHorizontal;

    property FmtEnable: Boolean read FFmtEnable write SetFmtEnable default False;
    property FmtStyles: TSyntStyles read FFmtStyles write SetFmtStyles;
    property FmtImages: TCustomImageList read FFmtImages write SetFmtImages;
    property FmtSelParamStyleIndex: integer read FFmtSelParamStyleIndex write SetFmtSelParamStyleIndex default -1;
    property FmtSelStartImage: TImageIndex read FFmtSelStartImage write SetFmtSelStartImage default -1;
    property FmtSelEndImage: TImageIndex read FFmtSelEndImage write SetFmtSelEndImage default -1;
  end;

  TecSelCharPopup = class(TSyntMemoPopup)
  private
    FOnCanSelect: TSelectCellEvent;
    FShowCodeHint: Boolean;
    FAutoSelect: Boolean;
    procedure DrawCell(Sender: TObject; ACol, ARow: Longint;
                       Rect: TRect; State: TGridDrawState);
    procedure GridMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    function GetCellHeight: integer;
    function GetCellWidth: integer;
    function GetFont: TFont;
    procedure SetCellHeight(const Value: integer);
    procedure SetCellWidth(const Value: integer);
    procedure SetFont(const Value: TFont);
    procedure GridSelectCell(Sender: TObject; ACol, ARow: Longint; var CanSelect: Boolean);
    function GetSelChar: Char;
    procedure SetSelChar(const Value: Char);
    procedure GridMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    function GetBgColor: TColor;
    procedure SetBgColor(const Value: TColor);
  protected
    procedure ParentWndProc(var Message: TMessage); override;
    function Grid: TDrawGrid;
    function GetPopupSize(MaxWidth: Integer): TSize; override;
    procedure DoAccept(Accept: Boolean); override;
    procedure ItemChanged; override;
  public
    constructor Create(AOwner: TComponent); override;
    function Execute: Boolean; override;

    property SelChar: Char read GetSelChar write SetSelChar;
  published
    property Font: TFont read GetFont write SetFont;
    property CellWidth: integer read GetCellWidth write SetCellWidth;
    property CellHeight: integer read GetCellHeight write SetCellHeight;
    property CommandID default smSelCharacter;
    property OnCanSelect: TSelectCellEvent read FOnCanSelect write FOnCanSelect;
    property ShowCodeHint: Boolean read FShowCodeHint write FShowCodeHint default True;
    property ToolHint;
    property AutoSelect: Boolean read FAutoSelect write FAutoSelect default True;
    property BgColor: TColor read GetBgColor write SetBgColor;
  end;

procedure RegisterPopupControlClass(ControlClass: TControlClass);

var
  PopupControlClasses: TList = nil;

implementation

uses {$IFDEF EC_DOTNET}WinUtils, Types,{$ENDIF} SysUtils, math, Clipbrd, 
  TypInfo, ecSyntGramma, ecLists;

type
  TCalcSizeProc = function(MaxWidth: integer): TSize of object;

function CalculateLayout(Constraints: TSizeConstraints;
                         Side: TLayoutSide;
                         MinMaxWidth: integer;
                         CalcSize: TCalcSizeProc;
                         AroundRect: TRect;
                         var R: TRect): Boolean;
var p: TPoint;
    s: TSize;
    b1, b2: Boolean;
    MW, LH: integer;
    Monitor: TSize;
    Mon: TMonitor;

  function FindMonitor(const P: TPoint): TMonitor;
  var i: integer;
  begin
    for i := 0 to Screen.MonitorCount - 1 do
     with Screen.Monitors[i] do
      if PtInRect(Bounds(Left, Top, Width, Height), P) then
        begin
          Result := Screen.Monitors[i];
          Exit;
        end;
    Result := nil;
  end;

begin
  Result := False;

  p := AroundRect.TopLeft;
  Mon := FindMonitor(p);
  // Monitor Width
  if Assigned(Mon) then
    begin
      Monitor.cx := Mon.Width;
      Monitor.cy := Mon.Height;
      // MT BOM
      // on Left-side monitor, this changes nothing, on right side monitor, it does. In order
      // to get the sizing right
      p.X := p.X - Mon.Left;
      p.Y := p.Y - Mon.Top;
      // MT EOM
    end
  else
    begin
      Monitor.cx := Screen.Width;
      Monitor.cy := Screen.Height;
    end;

  with Constraints do
    begin
      // Maximum Width
      case Side of
        lsTop, lsBottom: MW := Monitor.cx - p.X;
        else MW := Max(p.X, Monitor.cx - p.X - (AroundRect.Right - AroundRect.Left));
      end;

      if MW < MinMaxWidth then
        MW := MinMaxWidth;
      if  (MaxWidth > 0) and (MaxWidth < MW) then
        MW := MaxWidth;
      if MW < MinWidth then
        MW := MinWidth;

      // Size calculation
      s := CalcSize(MW);

      // Check if showing is not allowed
      if (s.cx = 0) or (s.cy = 0) then
        Exit;

      // Constraint popup size
      if (MaxWidth > 0) and (s.cx > MaxWidth) then
        s.cx := MaxWidth;
      if s.cx < MinWidth then
        s.cx := MinWidth;
      if (MaxHeight > 0) and (s.cy > MaxHeight) then
        s.cy := MaxHeight;
      if s.cy < MinHeight then
        s.cy := MinHeight;
    end;

  if Side in [lsBottom, lsTop] then
    begin
      b1 := p.Y < s.cy;                    // Can not be placed at Top
      LH := AroundRect.Bottom - AroundRect.Top;
      b2 := p.Y + LH + s.cy > Monitor.cy;  // Can not be placed at Bottom
      if Side = lsBottom then
        begin
          if not b1 and b2 then Side := lsTop;
        end else
        begin
          if b1 and not b2 then Side := lsBottom;
        end;
    end else
    begin
      b1 := p.X < s.cx;                    // Can not be placed at Left
      LH := AroundRect.Right - AroundRect.Left;
      b2 := p.X + LH + s.cx > Monitor.cx;  // Can not be placed at Right
      if Side = lsRight then
        begin
          if not b1 and b2 then Side := lsLeft;
        end else
        begin
          if b1 and not b2 then Side := lsRight;
        end;
    end;

  // Move left if there is no place at right
  if (p.X + s.cx > Monitor.cx) and (Side in [lsBottom, lsTop]) then
    begin
      p.X := Monitor.cx - s.cx;
      if p.X < 0 then
        p.X := 0;
    end;

  // MT BOM
  if Assigned(Mon) then
    begin
      p.X := p.X + Mon.Left;
      p.Y := p.Y + Mon.Top;
    end;
  // MT EOM

  case Side of
    lsBottom: R := Bounds(p.X, p.Y + AroundRect.Bottom - AroundRect.Top, s.cx, s.cy);
    lsTop:    R := Bounds(p.X, p.Y - s.cy, s.cx, s.cy);
    lsLeft:   R := Bounds(p.X - s.cx, p.Y, s.cx, s.cy);
    else      R := Bounds(p.X + AroundRect.Right - AroundRect.Left, p.Y, s.cx, s.cy);
  end;
  Result := True;
end;

procedure RegisterPopupControlClass(ControlClass: TControlClass);
begin
  if not Assigned(PopupControlClasses) then
    PopupControlClasses := TList.Create;
  if PopupControlClasses.IndexOf(TObject(ControlClass)) = -1 then
    PopupControlClasses.Add(TObject(ControlClass));
end;

{ TecPopupContainer }

constructor TecPopupContainer.Create(AOwner: TComponent);
begin
  inherited;
  FBorderStyle := bsSingle;
end;

procedure TecPopupContainer.CreateParams(var Params: TCreateParams);
const
  Sizing: array[Boolean] of DWORD = (0, WS_SIZEBOX);
  Border: array[TBorderStyle] of DWORD = (0, WS_BORDER);
begin
  inherited;
  with Params do
  begin
    WndParent := Application.Handle;
    Style := WS_POPUP or Border[FBorderStyle] or Sizing[FSizable];
    ExStyle := WS_EX_TOOLWINDOW or WS_EX_TOPMOST;
    AddBiDiModeExStyle(ExStyle);
    WindowClass.Style := CS_SAVEBITS or CS_DBLCLKS;
    {$IFDEF EC_VCL7_UP}
    if FShadow and CheckWin32Version(5, 1) then // XP or above
       WindowClass.Style := WindowClass.style or $00020000{CS_DROPSHADOW};
    {$ENDIF}
  end;
end;

procedure TecPopupContainer.CreateWnd;
begin
  inherited;
  if Assigned(Parent) then
    Windows.SetFocus(Parent.Handle);
end;

procedure TecPopupContainer.Resize;
begin
  inherited;
  if Assigned(Parent) then
    PostMessage(Parent.Handle, EP_SIZECHANGING, 0, 0);
end;

procedure TecPopupContainer.SetBorderStyle(const Value: TBorderStyle);
begin
  if FBorderStyle <> Value then
    begin
      FBorderStyle := Value;
      RecreateWnd;
    end;
end;

procedure TecPopupContainer.SetShadow(const Value: Boolean);
begin
  if FShadow <> Value then
    begin
      FShadow := Value;
      RecreateWnd;
    end;
end;

procedure TecPopupContainer.SetSizable(const Value: Boolean);
begin
  if FSizable <> Value then
   begin
     FSizable := Value;
     RecreateWnd;
   end;
end;

procedure TecPopupContainer.WMMouseActivate(var Message: TWMMouseActivate);
begin
//  inherited;
  Message.Result := MA_NOACTIVATE;
end;

procedure TecPopupContainer.WMSetFocus(var Message: TWMSetFocus);
begin
  inherited;
  if Assigned(Parent) then
    PostMessage(Parent.Handle, EP_RETURNFOCUS, 0, 0);
end;

{ TPopupControl }

constructor TPopupControl.Create(AOwner: TComponent);
begin
  inherited;
  FParentWndProc := {$IFDEF EC_VCL6_UP}{$IFNDEF EC_DOTNET}Classes.{$ENDIF}{$ENDIF}MakeObjectInstance(ParentWndProc);
  FPopupWndProc := {$IFDEF EC_VCL6_UP}{$IFNDEF EC_DOTNET}Classes.{$ENDIF}{$ENDIF}MakeObjectInstance(PopupWndProc);
  FPopupContainer := TecPopupContainer.Create(nil);
  FPopupContainer.Enabled := False;
  FPopupContainer.Shadow := True;
  FPopupContainer.Visible := False;
  Width := 200;
  Height := 200;
  FMinMaxWidth := 150;
  FLayoutSide := lsBottom;
  FToolHint := TecToolHint.Create(Self);
  FToolHint.Name := 'Hint';
  {$IFDEF EC_VCL6_UP}
  FToolHint.SetSubComponent(True);
  {$ENDIF}
  FControls := TecControlCollection.Create(Self);
  FControls.OnControlCreated := ControlAdded;
end;

destructor TPopupControl.Destroy;
begin
  {$IFDEF EC_VCL6_UP}{$IFNDEF EC_DOTNET}Classes.{$ENDIF}{$ENDIF}FreeObjectInstance(FParentWndProc);
  {$IFDEF EC_VCL6_UP}{$IFNDEF EC_DOTNET}Classes.{$ENDIF}{$ENDIF}FreeObjectInstance(FPopupWndProc);
  FreeAndNil(FPopupContainer);
  FreeAndNil(FToolHint);
  FreeAndNil(FControls);
  inherited;
end;

procedure TPopupControl.SetWndProc(wnd: HWND; const Proc: TFNWndProcSv);
begin
  if IsWindowUnicode(wnd) then
    SetWindowLongW(wnd, GWL_WNDPROC, integer(Proc))
  else
    SetWindowLongA(wnd, GWL_WNDPROC, integer(Proc));
end;

function TPopupControl.GetWndProc(wnd: HWND): TFNWndProcSv;
begin
  if IsWindowUnicode(wnd) then
    Result := TFNWndProcSv(GetWindowLongW(wnd, GWL_WNDPROC))
  else
    Result := TFNWndProcSv(GetWindowLongA(wnd, GWL_WNDPROC));
end;

procedure TPopupControl.CallWndProc(wnd: HWND; Proc: TFNWndProcSv; var Message: TMessage);
begin
  if IsWindowUnicode(wnd) then
    Message.Result := CallWindowProcW(Proc, wnd, Message.Msg, Message.WParam, Message.LParam)
  else
    Message.Result := CallWindowProcA(Proc, wnd, Message.Msg, Message.WParam, Message.LParam);
end;

type
  TWinControlAccess = class(TWinControl);

procedure TPopupControl.SendPopupFocus;
begin
{$IFNDEF EC_DOTNET}
  if IsWindowUnicode(FPopup.Handle) then
    CallWindowProcW(TWinControlAccess(FPopup).DefWndProc, FPopup.Handle, WM_SETFOCUS, 0, 0)
  else
    CallWindowProc(TWinControlAccess(FPopup).DefWndProc, FPopup.Handle, WM_SETFOCUS, 0, 0);
{$ENDIF}
end;

procedure TPopupControl.CloseUp(Accept: Boolean);
begin
  if Visible then
    begin
      if Assigned(FParent) and FPopup.HandleAllocated then
        SetWndProc(FPopup.Handle, _FPopupWndProc);
      if Assigned(FParent) and FParent.HandleAllocated then
        SetWndProc(FParent.Handle, _FParentWndProc);
      FClosing := True;
      try
        if Assigned(FOnCloseUp) then
          FOnCloseUp(Self, Accept);
        DoAccept(Accept);
      finally
        FToolHint.ReleaseHandle;
//        FPopupContainer.DestroyHandle;
        FPopupContainer.Parent := nil;
        FPopupContainer.Visible := False;
        Windows.SetFocus(FParent.Handle);
        FClosing := False;
      end;
    end;
end;

procedure TPopupControl.ShowAround(const Rect: TRect);
var R: TRect;
begin
  FAroundRect := Rect;
  if Visible then
    begin
      if FPopup.HandleAllocated and CalcLayout(Rect, R) then
        FPopupContainer.BoundsRect := R
      else
        CloseUp(False);
    end else
  if Assigned(FParent) and FParent.HandleAllocated and Assigned(FPopup) then
    begin
      FPopupContainer.Visible := False;
      FPopupContainer.Parent := FParent;
      FPopup.HandleNeeded;
      if FPopupContainer.HandleAllocated and FPopup.HandleAllocated and CalcLayout(Rect, R) then
        begin
          FPopupContainer.BoundsRect := R;
          SetWindowPos(FPopupContainer.Handle, HWND_TOPMOST, 0, 0, 0, 0,
                       SWP_NOSIZE or SWP_NOACTIVATE or SWP_SHOWWINDOW or SWP_NOMOVE);
//          Windows.SetFocus(FParent.Handle);
          SendPopupFocus;
          FPopupContainer.Visible := True;
//          EnableWindow(FPopupContainer.Handle, True);

          // Hooks windows (parent & popup)
          _FPopupWndProc := GetWndProc(FPopup.Handle);
          {$IFDEF EC_DOTNET}
          if IsWindowUnicode(FPopup.Handle) then
            SetWindowLongW(FPopup.Handle, GWL_WNDPROC, FPopupWndProc)
          else
            SetWindowLongA(FPopup.Handle, GWL_WNDPROC, FPopupWndProc);
          {$ELSE}
          SetWndProc(FPopup.Handle, FPopupWndProc);
          {$ENDIF}
          _FParentWndProc := GetWndProc(FParent.Handle);
          {$IFDEF EC_DOTNET}
          if IsWindowUnicode(FParent.Handle) then
            SetWindowLongW(FParent.Handle, GWL_WNDPROC, FParentWndProc)
          else
            SetWindowLongA(FParent.Handle, GWL_WNDPROC, FParentWndProc);
          {$ELSE}
          SetWndProc(FParent.Handle, FParentWndProc);
          {$ENDIF}

          DoShow;
        end else
        begin
          FPopupContainer.Parent := nil;
        end;
    end;
end;

procedure TPopupControl.ParentWndProc(var Message: TMessage);
var msg: tagMsg;
begin
  case Message.Msg of
    WM_KEYDOWN:
       if Message.WParam = VK_ESCAPE then
         begin
           CloseUp(False);
           PeekMessage(msg, FParent.Handle, WM_CHAR, WM_CHAR, PM_REMOVE);
           Exit;
         end;
    CM_CANCELMODE:
     if (TObject(Message.LParam) <> FParent) and
        (TObject(Message.LParam) <> FPopup) and
        (TObject(Message.LParam) <> FPopupContainer) and
        FControls.CanCancelMode(TObject(Message.LParam)) then
       begin
         CloseUp(False);
       end;
    WM_MOUSEWHEEL,
    WM_LBUTTONDOWN, WM_RBUTTONDOWN, WM_MBUTTONDOWN,
    WM_NCLBUTTONDOWN, WM_NCRBUTTONDOWN, WM_NCMBUTTONDOWN,
    WM_CANCELMODE:
      CloseUp(False);
    WM_KILLFOCUS:
      if LongWord(Message.WParam) <> FPopupContainer.Handle then
        CloseUp(False);
    EP_RETURNFOCUS:
      Windows.SetFocus(FParent.Handle);
    EP_SIZECHANGING:
      if FToolHint.Visible then
        FToolHint.RefreshHintWnd;
    WM_NCACTIVATE:
      if Message.WParam = 0 then
        begin
          Message.Result := 0;
          Exit;
        end;
  end;

  CallWndProc(FParent.Handle, _FParentWndProc, Message);
end;

procedure TPopupControl.PopupWndProc(var Message: TMessage);
begin
  if Message.Result = WM_MOUSEACTIVATE then
    begin
      Message.Result := MA_NOACTIVATE;
      Exit;
    end;
  CallWndProc(FPopup.Handle, _FPopupWndProc, Message);
  case Message.Msg of
    WM_LBUTTONDOWN:
      if GetFocus <> FParent.Handle then
        begin
          Windows.SetFocus(FParent.Handle);
          SendPopupFocus;
        end;
    EP_ITEMCHANGED:  ItemChanged;
    WM_SETFOCUS: PostMessage(FParent.Handle, EP_RETURNFOCUS, 0, 0);
  end;
end;

procedure TPopupControl.SetParent(const Value: TWinControl);
begin
  if FParent <> Value then
    begin
      CloseUp(False);
      FParent := Value;
      if Assigned(FParent) then
        FParent.FreeNotification(Self);
    end;
end;

procedure TPopupControl.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited;
  if Operation = opRemove then
    begin
      if AComponent = FPopup then FPopup := nil else
        if AComponent = FParent then FParent := nil else
          if AComponent is TControl then
            FControls.ControlDestroyed(AComponent as TControl);
    end;
end;

procedure TPopupControl.SetPopup(const Value: TWinControl);
begin
  if FPopup <> Value then
   begin
    CloseUp(False);
    FreeAndNil(FPopup);
    FPopup := Value;
    if Assigned(FPopup) then
      begin
        FPopup.FreeNotification(Self);
        FPopup.Parent := FPopupContainer;
        FPopup.Align := alClient;
      end;
   end;
end;

function TPopupControl.GetVisible: Boolean;
begin
  Result := FPopupContainer.HandleAllocated and FPopupContainer.Visible;
end;

function TPopupControl.GetSizable: Boolean;
begin
  Result := FPopupContainer.Sizable;
end;

procedure TPopupControl.SetSizable(const Value: Boolean);
begin
  FPopupContainer.Sizable := Value;
end;

function TPopupControl.GetHeight: integer;
begin
  Result :=  FPopupContainer.Height;
end;

function TPopupControl.GetWidth: integer;
begin
  Result := FPopupContainer.Width;
end;

procedure TPopupControl.SetHeight(const Value: integer);
begin
  FPopupContainer.Height := Value;
end;

procedure TPopupControl.SetWidth(const Value: integer);
begin
  FPopupContainer.Width := Value;
end;

function TPopupControl.GetConstraints: TSizeConstraints;
begin
  Result := FPopupContainer.Constraints;
end;

procedure TPopupControl.SetConstraints(const Value: TSizeConstraints);
begin
  FPopupContainer.Constraints := Value;
end;

function TPopupControl.GetPopupSize(MaxWidth: integer): TSize;
begin
  Result.cx := Width;
  Result.cy := Height;
end;

function TPopupControl.IntGetPopupSize(MaxWidth: integer): TSize;
var i: integer;
begin
  Result := GetPopupSize(MaxWidth);
  if (Result.cx > 0) and (Popup.Align = alClient) then
    begin
      for i := 0 to FControls.Count - 1 do
        if Assigned(FControls[i].Control) then
          with FControls[i].Control do
            if Visible then
              begin
                case Align of
                  alLeft, alRight:
                    Result.cx := Result.cx + Width;
                  alTop, alBottom:
                    Result.cy := Result.cy + Height;
                end;
             end;
      if Sizable then
        begin
          Result.cx := Result.cx + GetSystemMetrics(SM_CXSIZEFRAME) * 2;
          Result.cy := Result.cy + GetSystemMetrics(SM_CYSIZEFRAME) * 2;
        end else
        begin
          Result.cx := Result.cx + GetSystemMetrics(SM_CXBORDER) * 2;
          Result.cy := Result.cy + GetSystemMetrics(SM_CYBORDER) * 2;
        end;
    end;
end;

function TPopupControl.CalcLayout(AroundRect: TRect;
  var Bnd: TRect): Boolean;
begin
  Result := CalculateLayout(Constraints, FLayoutSide, FMinMaxWidth,
            IntGetPopupSize, AroundRect, Bnd);
end;

procedure TPopupControl.DoAccept(Accept: Boolean);
begin

end;

procedure TPopupControl.ItemChanged;
begin
  // When something changed and we need update hint window
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

function TPopupControl.GetShadow: Boolean;
begin
  Result := FPopupContainer.Shadow;
end;

procedure TPopupControl.SetShadow(const Value: Boolean);
begin
  FPopupContainer.Shadow := Value;
end;

function TPopupControl.GetPopupRect: TRect;
begin
  Result := FPopupContainer.BoundsRect;
end;

procedure TPopupControl.SetLayoutSide(const Value: TLayoutSide);
begin
  FLayoutSide := Value;
end;

procedure TPopupControl.PostItemChanged;
begin
  if Assigned(FPopup) and FPopup.HandleAllocated then
    PostMessage(FPopup.Handle, EP_ITEMCHANGED, 0, 0);
end;

procedure TPopupControl.DoShow;
begin
  if Assigned(FOnShow) then
    FOnShow(Self);
  ItemChanged;
end;

procedure TPopupControl.SetControls(const Value: TecControlCollection);
begin
  FControls.Assign(Value);
end;

procedure TPopupControl.ControlAdded(Sender: TObject; Ctrl: TControl);
begin
  Assert(Assigned(Ctrl));
  Ctrl.FreeNotification(Self);
  Ctrl.Parent := FPopupContainer;
end;

function TPopupControl.RecalculateBounds: Boolean;
var Bnd: TRect;
begin
  if Visible then
    begin
      Result := CalcLayout(FAroundRect, Bnd);
      if Result then
        begin
          FPopupContainer.BoundsRect := Bnd;
          FPopupContainer.Invalidate;
        end
      else
        CloseUp(False);
    end else Result := False;
end;

{ TSyntMemoPopup }

procedure TSyntMemoPopup.SetSyntMemo(const Value: TCustomSyntaxMemo);
begin
  if FParent <> Value then
   begin
     if Assigned(FParent) then TCustomSyntaxMemo(FParent).RemoveClient(Self);
     Parent := Value;
     if Assigned(Value) then
        Value.AddClient(Self);
   end;
end;

// Show popup window at the given caret position
procedure TSyntMemoPopup.ShowPopup(cPos: TPoint);
begin
 if (SyntMemo <> nil) and (Popup <> nil) then
   with SyntMemo do
     begin
       ResetHint;
       with ClientToScreen(CaretToMouse(cPos.x, cPos.Y)) do
         ShowAround(Bounds(X, Y, 10, LineHeight(cPos)));
     end;
end;

function TSyntMemoPopup.Execute: Boolean;
begin
  Result := False;
end;

function TSyntMemoPopup.GetSyntMemo: TCustomSyntaxMemo;
begin
  if Assigned(FParent) and (FParent is TCustomSyntaxMemo) then
    Result := TCustomSyntaxMemo(FParent)
  else
    Result := nil;
end;

procedure TSyntMemoPopup.SetCommandID(const Value: integer);
begin
  FCommandID := Value;
end;

procedure TSyntMemoPopup.AfterCommand(Command: integer; Data: ecPointer;
  var Handled: Boolean);
begin

end;

procedure TSyntMemoPopup.BeforeCommand(Command: integer; Data: ecPointer;
  var Handled: Boolean);
begin
  Handled := Command = CommandID;
  if Handled then
    Handled := Execute;
end;

procedure TSyntMemoPopup.IsCommandEnabled(Command: integer;
  Data: ecPointer; var Enable: Boolean);
begin
  if Command = FCommandID then
    Enable := True;
end;

procedure TSyntMemoPopup.DefineProperties(Filer: TFiler);
begin
  inherited;
  Filer.DefineProperty('ShortCut', SkipRead, nil, False);
end;

procedure TSyntMemoPopup.SkipRead(Reader: TReader);
begin
  {$IFDEF EC_VCL5}
  Reader.ReadInteger;
  {$ELSE}
  Reader.SkipValue;
  {$ENDIF}
end;

{ TSyntMemoPopupList }

constructor TSyntMemoPopupList.Create(AOwner: TComponent);
begin
  inherited;
  Popup := TListBox.Create(nil);
  with TListbox(Popup) do
   begin
     BorderStyle := bsNone;
     ItemHeight := 15;
     IntegralHeight := False;
     ParentFont := False;
     OnMouseUp := ListMouseUp;
     OnClick := ListItemChanged;
     OnDblClick := ListDblClick;
     OnMouseMove := ListMouseMove;
   end;
  FAutoSelect := True;
end;

function TSyntMemoPopupList.GetListBox: TListBox;
begin
  Result := TListBox(FPopup);
end;

procedure TSyntMemoPopupList.ListMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if (Button = mbLeft) and not FOnlyDblClick then
   CloseUp(PtInRect(FPopup.ClientRect, Point(X, Y)));
end;

procedure TSyntMemoPopupList.ListDblClick(Sender: TObject);
begin
  CloseUp(ListBox.ItemIndex <> -1);
end;

procedure TSyntMemoPopupList.ParentWndProc(var Message: TMessage);
var k: ShortInt;
begin
  case Message.Msg of
    WM_KEYDOWN:
       case {$IFDEF EC_VCL12_UP}TWMKey(Message).CharCode{$ELSE}Message.WParam{$ENDIF} of
        VK_RETURN: begin CloseUp(True); Exit; end;
        VK_UP, VK_DOWN, VK_NEXT, VK_PRIOR, VK_HOME, VK_END:
          begin
            PopupWndProc(Message);
            Exit;
          end;
       end;
    WM_MOUSEWHEEL:
      begin
       k := ShortInt(Message.WParamHi);
       k := -k div 120;
       k := ListBox.TopIndex + k;
       if k >= ListBox.Items.Count then k := ListBox.Items.Count - 1;
       if k < 0 then k := 0;
       if k <> ListBox.TopIndex then ListBox.TopIndex := k;
       Exit;
      end;
  end;
  inherited;
end;

function TSyntMemoPopupList.GetIntegralHeight: Boolean;
begin
  Result := ListBox.IntegralHeight
end;

function TSyntMemoPopupList.GetItemHeight: integer;
begin
  Result := ListBox.ItemHeight
end;

function TSyntMemoPopupList.GetStyle: TListBoxStyle;
begin
  Result := ListBox.Style
end;

procedure TSyntMemoPopupList.SetIntegralHeight(const Value: Boolean);
begin
  ListBox.IntegralHeight := Value;
end;

procedure TSyntMemoPopupList.SetItemHeight(const Value: integer);
begin
  ListBox.ItemHeight := Value;
end;

procedure TSyntMemoPopupList.SetStyle(const Value: TListBoxStyle);
begin
  ListBox.Style := Value;
end;

procedure TSyntMemoPopupList.DoAccept(Accept: Boolean);
begin
  inherited;
  if Accept then
    AcceptValue;
end;

procedure TSyntMemoPopupList.SetDropDownCount(const Value: integer);
begin
  if (Value < 0) or (Value > 100) then
    raise Exception.Create('Invalid drop-down count');
  FDropDownCount := Value;
end;

function TSyntMemoPopupList.GetFont: TFont;
begin
  Result := ListBox.Font;
end;

procedure TSyntMemoPopupList.SetFont(const Value: TFont);
begin
  ListBox.Font := Value;
end;

procedure TSyntMemoPopupList.ListItemChanged(Sender: TObject);
begin
  ItemChanged;
end;

procedure TSyntMemoPopupList.ListMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
var idx: integer;
begin
  if FAutoSelect then
    begin
      idx := ListBox.ItemAtPos(Point(X, Y), True);
      if (idx <> -1) and (ListBox.ItemIndex <> idx) then
        begin
          ListBox.ItemIndex := idx;
          ItemChanged;
        end;
    end;
end;

function TSyntMemoPopupList.GetBgColor: TColor;
begin
  Result := ListBox.Color;
end;

procedure TSyntMemoPopupList.SetBgColor(const Value: TColor);
begin
  ListBox.Color := Value;
end;

{ TTemplatePopup }

constructor TTemplatePopup.Create(AOwner: TComponent);
begin
  inherited;
  FCommandID := smCodeTemplate;
  FTemplates := TCodeTemplates.Create(Self);
  FOptions := [ctIncludeOwn, ctIncludeLexer, ctEnableSearch, ctDisplayShortCut,
               ctDisplayDesc, ctShowCodeHint];
  ListBox.OnKeyPress := SearchKeyPress;
end;

destructor TTemplatePopup.Destroy;
begin
  FTemplates.Free;
  inherited;
end;

procedure TTemplatePopup.DrawCodeTemplItem(Control: TWinControl;
  Index: Integer; Rect: TRect; State: TOwnerDrawState);
var templ: TCodeTemplate;
begin
  with TListBox(Control) do
   begin
    templ := TCodeTemplate(Items.Objects[Index]);
    Canvas.FillRect(Rect);
    if ctDisplayDesc in FOptions then
     begin
      Canvas.Font.Style := [];
      if ctRightDesc  in FOptions then
        Canvas.TextOut(Rect.Right - Canvas.TextWidth(templ.Description) - 3, Rect.Top + 1, templ.Description)
      else
        Canvas.TextOut(Rect.Left + 1, Rect.Top + 1, templ.Description);
     end;
    if ctDisplayShortCut in FOptions then
     begin
      Canvas.Font.Style := [fsBold];
      if ctRightDesc  in FOptions then
        Canvas.TextOut(Rect.Left + 1, Rect.Top + 1, templ.Name)
      else
        Canvas.TextOut(Rect.Right - Canvas.TextWidth(templ.Name) - 3, Rect.Top + 1, templ.Name);
     end;
   end;
end;

procedure TTemplatePopup.AcceptValue;
begin
  if ListBox.ItemIndex >= 0 then
    InsertTemplate(TCodeTemplate(ListBox.Items.Objects[ListBox.ItemIndex]))
end;

function TTemplatePopup.Execute: Boolean;
var ws, p, TemplateCount: integer;
    s: ecString;
    Templ: TCodeTemplate;
    ASynt: TSyntAnalyzer;
begin
  Result := True;
  if SyntMemo = nil then Exit;

  with SyntMemo do
   begin
    TemplateCount := 0;
    if (ctIncludeLexer in Self.FOptions) and (SyntObj <> nil) then
    begin
      ASynt := SyntObj.AnalyzerAtPos(CaretStrPos);
      if ASynt <> nil then
        TemplateCount := ASynt.CodeTemplates.Count;
    end;
    if ctIncludeOwn in Self.FOptions then
      TemplateCount := TemplateCount + Self.FTemplates.Count;
    if TemplateCount = 0 then Exit;

    if CaretPos.Y < Lines.Count then
     begin
      s := Lines[CaretPos.Y];
      if (CaretPos.X = Length(s)) or (CaretPos.X < Length(s)) and (not IsWordChar(s[CaretPos.X + 1])) then
       begin
        ws := CaretPos.X;
        while (ws > 0) and IsWordChar(s[ws]) do dec(ws);
        if ws < CaretPos.X then
         begin
          p := CaretPosToStrPos(Point(ws, CaretPos.Y));
          s := Copy(s, ws + 1, CaretPos.X - ws);
          if ctIncludeOwn in Self.FOptions then Templ := FTemplates.FindTemplate(s)
                                      else Templ := nil;
          if (ctIncludeLexer in Self.FOptions) and (Templ = nil) and (SyntObj <> nil) then
            Templ := SyntObj.AnalyzerAtPos(CaretStrPos).CodeTemplates.FindTemplate(s);
          if (Templ = nil) and (FExternSource <> nil) then
            Templ := FExternSource.CodeTemplates.FindTemplate(s);
          SetSelection(p, CaretPos.X - ws);
          if Templ <> nil then
           begin
            InsertTemplate(Templ);
            Exit;
           end;
         end;
       end;
     end;
   end;

  if not (ctDisablePopup in FOptions) and
    ([ctDisplayShortCut, ctDisplayDesc] * FOptions <> []) and not Visible then
    ShowPopup(SyntMemo.CaretPos);
end;

procedure TTemplatePopup.InsertTemplate(Templ: TCodeTemplate);
var i, g, p, d: integer;
    s, s1: ecString;
    st: TecStringList;
    Mark: TList;
begin
  if (Templ = nil) or (SyntMemo = nil) then Exit;
//  if not (soOverwriteBlocks in FSyntMemo.Options) then
  SyntMemo.ClearSelection;

  st := TecStringList.Create;
  st.Assign(Templ.Code);
  for i := 1 to st.Count - 1 do
   st[i] := StringOfChar(' ', SyntMemo.CaretPos.x) + st[i];
  s := st.Text;
  st.Free;

  g := -1;
  p := SyntMemo.CaretStrPos;
  Mark:= TList.Create;
  if templ.Advanced then
   begin // Anvanced template like in CodeRush (with <caret> <paste> <marker>)
     i := 1;
     while i < Length(s) - 6 do
     begin
      if s[i] <> '<' then inc(i) else
       if SameText('<caret>', Copy(S, i, 7)) and (g = -1) then
        begin
         Delete(S, i, 7);
         g := i - 1;
        end else
       if SameText('<paste>', Copy(S, i, 7)) then
        begin
         Delete(S, i, 7);
         s1 := Clipboard.AsText;
         Insert(S1, S, i);
         Inc(i, Length(s1));
        end else
       if SameText('<marker>', Copy(S, i, 8)) then
        begin
         Delete(S, i, 8);
         Mark.Add(TObject(i - 1));
        end else Inc(i);
     end;
   end else
   begin  // Simple template like in Borland's IDE
    g := Pos('|', s) - 1;
    if g >= 0 then
      Delete(s, g + 1, 1);
   end;
   if Length(s) > Length(sLineBreak) then
       Delete(s, Length(s) - Length(sLineBreak) + 1, Length(sLineBreak));
   with SyntMemo do
    begin
      if (CaretPos.Y < Lines.Count) and
         (CaretPos.X > Lines.LineLength(CaretPos.Y)) then
        d := CaretPos.X - Lines.LineLength(CaretPos.Y)
      else
        d := 0;

      if g >= 0 then
        g := p + g + d;
      DoInsertTemplate(S, g);

   // Setting markers
      for i := Mark.Count - 1 downto 0 do
       CreateMarker(StrPosToCaretPos(p + integer(Mark[i]) + d));
      if Mark.Count > 0 then Invalidate;
      Mark.Free;
    end;

end;

procedure TTemplatePopup.ParentWndProc(var Message: TMessage);
begin
   if Message.Msg = WM_CHAR then PopupWndProc(Message) else
   if Message.Msg = WM_KEYDOWN then
    case {$IFDEF EC_VCL12_UP}TWMKey(Message).CharCode{$ELSE}Message.WParam{$ENDIF} of
     VK_RETURN, VK_ESCAPE: inherited;
     VK_BACK, VK_INSERT: ;
     else
      begin
       PopupWndProc(Message);
       Exit;
      end;
    end else inherited;
end;

procedure TTemplatePopup.SetTemplates(const Value: TCodeTemplates);
begin
  CloseUp(False);
  FTemplates.Assign(Value);
end;

procedure TTemplatePopup.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited;
  if (Operation = opRemove) and (AComponent = FExternSource) then
   begin
     CloseUp(False);
     FExternSource := nil;
   end;
end;

procedure TTemplatePopup.SetExternSource(const Value: TSyntAnalyzer);
begin
  if FExternSource <> Value then
    begin
      FExternSource := Value;
      if FExternSource <> nil then
        FExternSource.FreeNotification(Self);
    end;
end;

function TTemplatePopup.GetPopupSize(MaxWidth: integer): TSize;
var i, max_w, w, MaxListCount: integer;
    templ: TCodeTemplate;
    ASynt: TSyntAnalyzer;
    Filter: ecString;

  procedure Add(templ: TCodeTemplate);
  begin
    if (Filter = '') or SameText(Filter, Copy(templ.Name, 1, Length(Filter))) then
     if FSortType = ctsDescription then
      ListBox.Items.AddObject(templ.Description, templ)
     else
      ListBox.Items.AddObject(templ.Name, templ);
  end;

  procedure AddTemplates;
  var i: integer;
  begin
     ListBox.Items.Clear;
     if ctIncludeOwn in FOptions then
      for i := 0 to FTemplates.Count - 1 do
       Add(FTemplates[i]);
     if FExternSource <> nil then
      for i := 0 to FExternSource.CodeTemplates.Count - 1 do
       Add(FExternSource.CodeTemplates[i]);
     if (ctIncludeLexer in FOptions) and (SyntMemo.SyntObj <> nil) then
      begin
        ASynt := SyntMemo.SyntObj.AnalyzerAtPos(SyntMemo.CaretStrPos);
        for i := 0 to ASynt.CodeTemplates.Count - 1 do
         Add(ASynt.CodeTemplates[i]);
      end;
  end;

begin
   if ctFiltered in FOptions then
     Filter := SyntMemo.SelText
   else
     Filter := '';

   Result.cx := 0;
   Result.cy := 0;
   max_w := 0;
   ListBox.OnDrawItem := DrawCodeTemplItem;
   ListBox.Style := lbOwnerDrawFixed;
   AddTemplates;
   if ListBox.Items.Count = 0 then
    begin
     if Filter <> '' then
       begin
         Filter := '';
         AddTemplates;
         if ListBox.Items.Count = 0 then Exit;
       end else  Exit;
    end;
   ListBox.Sorted := FSortType <> ctsNone;

   // Calc popup width
   with ListBox.Canvas do
   for i := 0 to ListBox.Items.Count - 1 do
    begin
     templ := TCodeTemplate(ListBox.Items.Objects[i]);
     w := 0;
     if ctDisplayDesc in FOptions then
      begin
       Font.Style := [];
       w := TextWidth(templ.Description);
      end;
     if ctDisplayShortCut in FOptions then
      begin
       Font.Style := [fsBold];
       Inc(w, TextWidth(templ.Name));
      end;
     if w > max_w then max_w := w;
    end;
   if (ctDisplayShortCut in FOptions) and (ctDisplayDesc in FOptions) then
    inc(max_w, 15);

   if DropDownCount <= 0 then MaxListCount := 8
    else MaxListCount := DropDownCount;
   if ListBox.Items.Count > MaxListCount then
      Inc(max_w, GetSystemMetrics(SM_CXVSCROLL));
   ListBox.ItemIndex := 0;
   Result.cx := max_w;
   Result.cy := Max(1, Min(ListBox.Items.Count, MaxListCount)) * ListBox.ItemHeight;// + 2;
end;

procedure TTemplatePopup.DoInsertTemplate(Text: ecString; CarPos: integer);
begin
  if Assigned(FOnBeforeInsertTemplate) then
    FOnBeforeInsertTemplate(Self, Text, CarPos);
  SyntMemo.InsertText(Text);
  if CarPos >= 0 then
    SyntMemo.CaretStrPos := CarPos;
end;

procedure TTemplatePopup.SearchKeyPress(Sender: TObject; var Key: Char);
var
  TickCount: Integer;
  {$IFDEF EC_DOTNET}
  Msg: TWMSetText;
  {$ENDIF}
begin
  if ctEnableSearch in Foptions then
  case Key of
    #8, #27: FSearchText := '';
    #32..#255:
      begin
        TickCount := GetTickCount;
        if TickCount - FSearchTickCount > 4000 then FSearchText := '';
        FSearchTickCount := TickCount;
        if Length(FSearchText) < 32 then FSearchText := FSearchText + Key;
        {$IFDEF EC_DOTNET}
        Msg := TWMSetText.Create;
        Msg.Msg := LB_SELECTSTRING;
        SendMessage(ListBox.Handle, LB_SELECTSTRING, WORD(-1), Msg.OriginalMessage.LParam);
        {$ELSE}
        SendMessage(ListBox.Handle, LB_SELECTSTRING, WORD(-1),
          Longint(PChar(FSearchText)));
        {$ENDIF}
        Key := #0;
      end;
  end;
end;

procedure TTemplatePopup.ItemChanged;
var C: TCodeTemplate;
begin
  inherited;
  if ToolHint.Active and (ctShowCodeHint in FOptions) then
    begin
      C := CurrentTemplate;
      if Assigned(C) then
        ToolHint.Text := C.Code.Text;
    end;
end;

function TTemplatePopup.CurrentTemplate: TCodeTemplate;
begin
  if Visible and (ListBox.ItemIndex <> -1) then
    Result := TCodeTemplate(ListBox.Items.Objects[ListBox.ItemIndex])
  else
    Result := nil;
end;

{ TAutoCompletePopup }

constructor TAutoCompletePopup.Create(AOwner: TComponent);
begin
  inherited;
  Width := 200;
  Height := 200;
  FCommandID := smAutoComplete;
  FTimer := TTimer.Create(nil);
  FTimer.OnTimer := DoTimer;
  FTimer.Interval := 500;
  FTimer.Enabled := False;
  FItems := TSyntMemoStrings.Create;
  FItems.OnChange := ItemsChanged;
  FItems.SetObjectsStore;
  FDisplayItems := TSyntMemoStrings.Create;
  FDisplayItems.OnChange := ItemsChanged;
  FEnabled := True;
  FPopupContainer.Sizable := True;
  with ListBox do
   begin
    OnDrawItem := Self.DrawItem;
    OnMeasureItem := Self.MeasureItem;
    FixedItemHeight := False;
   end;
  FItemsChanged := True;
  FComplRender := TComplexRender.Create;
  FComplRender.Font := ListBox.Font;
  FComplRender.WithColumns := True;
  FComplRender.Formatted := True;
  FOptions := [aoFormatted, aoWithColumns, aoExactClose];
  FFilterType := afCmpStart;
end;

destructor TAutoCompletePopup.Destroy;
begin
  FreeAndNil(FItems);
  FreeAndNil(FDisplayItems);
  FreeAndNil(FTimer);
  FreeAndNil(FStartExpr);
  inherited;
  FreeAndNil(FComplRender);
end;

function TAutoCompletePopup.GetStartPosition(const RefPos: TPoint): TPoint;
var s: ecString;
begin
  if SyntMemo.Lines.Count = 0 then Result := Point(0, 0) else
    begin
      Result := RefPos;
      s := SyntMemo.Lines[Result.Y];
      if Result.X <= Length(s) then
        while (Result.X > 0) and IsValidChar(S[Result.X]) do
          Dec(Result.X);
      if Assigned(FOnDefineStartPos) then
        FOnDefineStartPos(Self, Result);
    end;
end;

function TAutoCompletePopup.GetFilter(var S: ecString): Boolean;
var p: TPoint;
  function HasInvalidChars: Boolean;
  var i: integer;
  begin
    for i := 1 to Length(S) do
      if not IsValidChar(S[i]) then
        begin
          Result := True;
          Exit;
        end;
    Result := False;
  end;
begin
  p := SyntMemo.CaretPos;
  Result := (p.Y = FStart.Y) and (p.X >= FStart.X);
  if Result then
    if SyntMemo.Lines.Count = 0 then S := '' else
    begin
      s := SyntMemo.Lines[p.Y];
      if FStart.X < Length(s) then
        S := Copy(S, FStart.X + 1, p.X - FStart.X)
      else
        S := '';
      Result := (Length(S) = (p.X - FStart.X)) and not HasInvalidChars;
      if Assigned(FOnGetFilterString) then
        FOnGetFilterString(Self, S, Result);
    end;
end;

function TAutoCompletePopup.Execute: Boolean;
begin
  FTimer.Enabled := False;
  Result := (SyntMemo <> nil) and not SyntMemo.HaveSelection;
  if Result then
    begin
      FStart := GetStartPosition(SyntMemo.CaretPos);
      Result := ShowAutoComplete;
    end;
end;

function TAutoCompletePopup.ShowAutoComplete: Boolean;
var idx_list, stl_i, stl_di: TecStringList;
    i: integer;
  procedure AddSortItem(K: integer);
  begin
    if FItems.Count > k then
      stl_i.Add(FItems[k])
    else
      stl_i.Add('');

    if FDisplayItems.Count > k then
      stl_di.Add(FDisplayItems[k])
    else if FItems.Count > k then
      stl_di.Add(FItems[k])
    else
      stl_di.Add('');
  end;

  function RemoveMacros(const S: string): string;
  var i, k: integer;
  begin
    i := 1;
    Result := S;
    while i < Length(Result) do
      begin
        if Result[i] = '/' then
          begin
            k := i + 1;
            while (k <= Length(Result)) and (Result[k] <> '/') do Inc(k);
            if k > Length(S) then Exit;
            if k = i + 1 then Delete(Result, i, 1) else
              begin
                Delete(Result, i, k - i + 1);
                Dec(i);
              end;
          end;
        Inc(i);
      end;
  end;
begin
  DoGetAutoCompleteList(FStart);

  Result := FItems.Count > 0;
  if not Result then Exit;

  if FItemsChanged then
    begin
      // Sorting of items
      if FSortType <> asNone then
        begin
          idx_list := TecStringList.Create;
          stl_i := TecStringList.Create;
          stl_di := TecStringList.Create;
          try
            case FSortType of
              asItems_Desc,
              asItems:        idx_list.Assign(FItems);
              asDisplayItems_Desc,
              asDisplayItems:
                begin
                  idx_list.Assign(FDisplayItems);
                  for i := FDisplayItems.Count to FItems.Count - 1 do
                    idx_list.Add(FItems[i]);
                end;
              asDisplayText_Desc,
              asDisplayText:
                begin
                  for i := 0 to FDisplayItems.Count - 1 do
                    idx_list.Add(RemoveMacros(FDisplayItems[i]));
                  for i := FDisplayItems.Count to FItems.Count - 1 do
                    idx_list.Add(FItems[i]);
                end;
            end;
            for i := 0 to idx_list.Count - 1 do
              idx_list.Objects[i] := TObject(i);
            if Assigned(FOnSortItems) then
              FOnSortItems(Self, idx_list)
            else
              idx_list.Sort;
            if FSortType in [asItems, asDisplayItems, asDisplayText] then
              begin
                for i := 0 to idx_list.Count - 1 do
                  AddSortItem(integer(idx_list.Objects[i]))
              end else
              begin
                for i := idx_list.Count - 1 downto 0 do
                  AddSortItem(integer(idx_list.Objects[i]))
              end;
            FItems.Text := stl_i.Text;
            FDisplayItems.Text := stl_di.Text;
          finally
            idx_list.Free;
            stl_i.Free;
            stl_di.Free;
          end;
        end;

      Result := FItems.Count > 0;
      if not Result then Exit;

      // Creating Renderer
      if FDisplayItems.Count = 0 then
        FComplRender.Items := FItems
      else
        FComplRender.Items := FDisplayItems;
      for i := FComplRender.Items.Count to FItems.Count - 1 do
        FComplRender.Items.Add(FItems[i]);

      FItemsChanged := False;
    end;

  FComplRender.ReleaseIndex;
  if ListBox.HandleAllocated then
    FComplRender.Canvas := ListBox.Canvas
  else
    FComplRender.Canvas := SyntMemo.Canvas;

  ShowPopup(FStart);
end;

function TAutoCompletePopup.FilterItem(Item: integer; Filter: ecString): Boolean;
var S, DS: ecString;
    i, k, k1: integer;
begin
  Result := True;
  S := FItems[Item];

  if not (aoCaseSensitive in FOptions) then
    begin
      Filter := ec_UpperCase(Filter);
      S := ec_UpperCase(S);
    end;

  if Length(Filter) > 0 then
    case FFilterType of
      afCmpStart:  Result := Filter = Copy(S, 1, Length(Filter));
      afCmpSubStr: Result := ecPosEx(Filter, S) > 0;
      afCharSeq:
        begin
          k := 0;
          for i := 1 to Length(Filter) do
            begin
              k1 := ecPosEx(Filter[i], S, k + 1);
              if k < k1 then k := k1 else
                begin
                  Result := False;
                  Break;
                end;
            end;
        end;
    end;

  if Assigned(FOnFilter) then
    begin
      if Item < FDisplayItems.Count then
        DS := FDisplayItems[Item]
      else
        DS := '';
      FOnFilter(Self, S, DS, Filter, Result);
    end;
end;

function TAutoCompletePopup.FillListBox: Boolean;
var filt: ecString;
    i: integer;
begin
  Result := GetFilter(filt);
  if Result then
    begin
      FComplRender.ClearIndex;
      for i := 0 to FItems.Count - 1 do
        if FilterItem(i, filt) then
          FComplRender.AddIndex(i);
      {$IFDEF EC_VCL6_UP}
      if FixedItemHeight then
        TListBox(ListBox).Count := FComplRender.VisibleCount else
      {$ENDIF}
      with ListBox.Items do
      begin
        while Count > FComplRender.VisibleCount do
          Delete(Count - 1);
        while Count < FComplRender.VisibleCount do
          Add('');
      end;
    end;
  if ListBox.Items.Count > 0 then
   begin
    ListBox.ItemIndex := 0;
   {$IFDEF EC_VCL6_UP}
    ListBox.Selected[0] := True;
   {$ENDIF}
   end else
    ListBox.ItemIndex := -1;

  if (aoExactClose in FOptions) and
     (FComplRender.VisibleCount = 1) and
     (CompStr(GetListItem(0), filt)=0) then
   begin
     Result := False;
     Exit;
   end;

  if FComplRender.Canvas <> ListBox.Canvas then
    begin
      FComplRender.Canvas := ListBox.Canvas;
      if aoWithColumns in FOptions then
        FComplRender.ParseItems;
    end;

  ItemChanged;
end;

function TAutoCompletePopup.GetPopupSize(MaxWidth: integer): TSize;
var i, w, h, drop_cnt: integer;
begin
  if FillListBox then
    begin
      if FAutoSize then
        begin
          // Drop down calculation
          if FDropDownCount <= 0 then drop_cnt := 8
                                 else drop_cnt := FDropDownCount;
          w := FComplRender.VisibleCount;
          if w > drop_cnt then w := drop_cnt;

          if FixedItemHeight then
            h := ItemHeight * w
          else
            begin
              h := 0;
              for i := 0 to w - 1 do
                Inc(h, FComplRender.ItemHeight(i) + 2);
            end;

          w := FComplRender.Width;
          if drop_cnt < FComplRender.VisibleCount then
            Inc(w, GetSystemMetrics(SM_CXVSCROLL));

          if w < 50 then w := 50;
          if w > MaxWidth then w := MaxWidth;
          if h <= 0 then h := ListBox.ItemHeight;

          Result.cx := w;
          Result.cy := h + 2;
        end else
        begin
          Result.cx := ListBox.Width;
          Result.cy := ListBox.Height;
        end;
    end else
    begin
      Result.cx := 0;
      Result.cy := 0;
    end;
end;

procedure TAutoCompletePopup.ParentWndProc(var Message: TMessage);
var C: Char;
begin
  if (Message.Msg = WM_CHAR) then
    begin
      C := Char({$IFDEF EC_VCL12_UP}TWMKey(Message).CharCode{$ELSE}Message.WParam{$ENDIF});
      if Assigned(FOnKeyPress) then
        begin
          FOnKeyPress(Self, C);
          if C = #0 then Exit; // supressing character processing
        end;

      if (Message.WParam <> 8) and // is not Backspace
         not IsValidChar(ecKeyChar(C)) and
         ListBox.HandleAllocated then
        CloseUp(ListBox.ItemIndex <> -1);
    end;
  inherited;
end;

procedure TAutoCompletePopup.AcceptValue;
var n: integer;
    ToInsert, S: ecString;
begin
  if ListBox.ItemIndex >= 0 then
   with SyntMemo do
    begin
     SelectMode := msNormal;
     ToInsert := GetListItem(ListBox.ItemIndex);
     if Lines.Count > 0 then
      begin
       s := Lines[FStart.Y];
       n := 0;
       if FStart.X < Length(s) then
        while (FStart.X + n < Length(s)) and
               (IsValidChar(s[FStart.X + n + 1]) or (FStart.X + n < CaretPos.X)) do
         inc(n);
       SetSelection(CaretPosToStrPos(FStart), n);
      end;
     if Assigned(FOnBeforeComplete) then FOnBeforeComplete(Self, ToInsert);
     InsertText(ToInsert);
     if Assigned(FOnAfterComplete) then FOnAfterComplete(Self, ToInsert);
    end;
end;

function TAutoCompletePopup.GetListItem(Index: integer): ecString;
begin
  Result := FItems[ListItemIndex(Index)];
end;

function TAutoCompletePopup.ListItemIndex(ListIndex: integer): integer;
begin
  Result := FComplRender.MapIndex(ListIndex);
end;

procedure TAutoCompletePopup.SetItems(const Value: TecStrings);
begin
  CloseUp(False);
  FItems.Assign(Value);
end;

function TAutoCompletePopup.CaretPosChanged: Boolean;
begin
  Result := False;
  if Visible and not Closing then
    begin
      RecalculateBounds;
//     if not FillListBox then
//      CloseUp(False);
    end else
    begin
     if FTimer.Enabled and (FInputPos <> SyntMemo.CaretStrPos) then
       FTimer.Enabled := False;
    end;
end;

procedure TAutoCompletePopup.DoTimer(Sender: TObject);
var s: ecString;
begin
  FTimer.Enabled := False;
  if not Visible and GetFilter(s) then
    ShowAutoComplete;
end;

procedure TAutoCompletePopup.TextChanged(Sender: TObject; Pos, Count,
  LineChange: integer);
var N, P: integer;
begin
  FInputPos := Pos + Count;
  N := Length(FStartString);
  P := Pos + Count + 1;
  if FEnabled and (Count > 0) and
     // Regular expression
     (Assigned(FStartExpr) and (FStartExpr.Match(SyntMemo.Lines.FText, P, True)) or
     // StartString condition
     (FStartString <> '') and (Pos + Count >= N) and (Count <= N) and
     (SyntMemo.Lines.SubString(Pos + Count - N + 1, N) = FStartString))
  then
    begin
      FStart := GetStartPosition(SyntMemo.StrPosToCaretPos(Pos + Count));
      FTimer.Enabled := False;
      FTimer.Enabled := True;
    end;
end;

procedure TAutoCompletePopup.SetDisplayItems(const Value: TecStrings);
begin
  CloseUp(False);
  FDisplayItems.Assign(Value);
end;

procedure TAutoCompletePopup.SetImages(const Value: TCustomImageList);
begin
  FComplRender.Images := Value;
  if Value <> nil then
    Value.FreeNotification(Self);
end;

function TAutoCompletePopup.GetDelay: integer;
begin
  Result := FTimer.Interval;
end;

procedure TAutoCompletePopup.SetDelay(const Value: integer);
begin
  FTimer.Interval := Value;
end;

procedure TAutoCompletePopup.SetStyles(const Value: TSyntStyles);
begin
  if FStyles <> Value then
    begin
      FStyles := Value;
      if FStyles <> nil then
        begin
          FStyles.FreeNotification(Self);
          FComplRender.Styles := FStyles.Styles;
        end else
          FComplRender.Styles := nil;
    end;
end;

procedure TAutoCompletePopup.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited;
  if Operation <> opRemove then Exit;
  if AComponent = FStyles then
   begin
    CloseUp(False);
    Styles := nil;
   end;
  if AComponent = Images then
   begin
    CloseUp(False);
    Images := nil;
   end;
end;

procedure TAutoCompletePopup.DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
begin
  if not (odSelected in State) then
    TListBox(Control).Canvas.Brush.Color := ListBox.Color;
  TListBox(Control).Canvas.FillRect(Rect);
  if Assigned(FComplRender) then
    begin
      FComplRender.Canvas := TListBox(Control).Canvas;
      InflateRect(Rect, -1, -1);
      FComplRender.DrawItem(Index, Rect, odSelected in State);
    end;
end;

procedure TAutoCompletePopup.MeasureItem(Control: TWinControl;
  Index: Integer; var Height: Integer);
begin
  if Assigned(FComplRender) then
    Height := FComplRender.ItemHeight(Index) + 2;
end;

procedure TAutoCompletePopup.SetStartString(const Value: string);
begin
  FStartString := Value;
end;

function TAutoCompletePopup.GetDisplayItems: TecStrings;
begin
  Result := FDisplayItems;
end;

function TAutoCompletePopup.GetItems: TecStrings;
begin
  Result := FItems;
end;

function TAutoCompletePopup.IsValidChar(C: ecChar): Boolean;
begin
  Result := IsWordChar(C);
  if Assigned(FOnCheckChar) then
    FOnCheckChar(Self, Ord(C), Result);
end;

procedure TAutoCompletePopup.ItemsChanged(Sender: TObject; Pos, Count, LineChange: integer);
begin
  FItemsChanged := True;
end;

procedure TAutoCompletePopup.SetColumnSpace(const Value: integer);
begin
  FComplRender.ColumnSpace := Value;
end;

procedure TAutoCompletePopup.SetSortType(const Value: TAutoCompleteSort);
begin
  if FSortType <> Value then
    begin
      FSortType := Value;
      FItemsChanged := True;
    end;
end;

function TAutoCompletePopup.GetStartExpr: ecString;
begin
  if Assigned(FStartExpr) then
    Result := FStartExpr.Expression
  else
    Result := '';
end;

procedure TAutoCompletePopup.SetStartExpr(const Value: ecString);
begin
  if Value = '' then
    FreeAndNil(FStartExpr)
  else
    begin
      if not Assigned(FStartExpr) then
        FStartExpr := TecRegExpr.Create;
      FStartExpr.Expression := Value;
    end;
end;

function TAutoCompletePopup.GetImages: TCustomImageList;
begin
  Result := FComplRender.Images;
end;

function TAutoCompletePopup.GetColumnSpace: integer;
begin
  Result := FComplRender.ColumnSpace;
end;

procedure TAutoCompletePopup.SetOptions(const Value: TAutoCompleteOptions);
begin
  FOptions := Value;
  FComplRender.Formatted := aoFormatted in Value;
  FComplRender.WithColumns := aoWithColumns in Value;
end;

procedure TAutoCompletePopup.SetFilterType(const Value: TAutoCompleteFilter);
begin
  if FFilterType <> Value then
    begin
      FFilterType := Value;
      RecalculateBounds;
    end;
end;

procedure TAutoCompletePopup.SetFixedH(const Value: Boolean);
begin
  CloseUp(False);
  if Value then
    {$IFDEF EC_VCL6_UP}
    ListBox.Style := lbVirtualOwnerDraw
    {$ELSE}
    ListBox.Style := lbOwnerDrawFixed
    {$ENDIF}
  else
    ListBox.Style := lbOwnerDrawVariable;
end;

function TAutoCompletePopup.GetFixedH: Boolean;
begin
  Result := ListBox.Style <> lbOwnerDrawVariable;
end;

procedure TAutoCompletePopup.DoGetAutoCompleteList(var Start: TPoint);
begin
  if Assigned(FOnGetAutoCompleteList) then
     FOnGetAutoCompleteList(Self, Start, FItems, FDisplayItems);
end;

{ TParamComplWindow }

type
  TParamComplWindow = class(TCustomControl)
  private
    FOwner: TParamCompletion;
    FMaxWidth: integer;
    FUpDown: TUpDown;
    FRender: TComplexRender;
    procedure GetParams(Item: String; List: TStrings; Marker: TObject);
    function ProcessParams(DoDraw: Boolean): TSize;
    procedure UpDownChanging(Sender: TObject; var AllowChange: Boolean;
      NewValue: Smallint; Direction: TUpDownDirection);
    procedure CurParamStyle(ItemIndex, TagIndex: integer; var ImageIndex, StyleIndex: integer; var Text: ecString);
    function IsFirstLine(Index: integer): Boolean;
  protected
    procedure Paint; override;
    function CalcSize(MaxWidth: integer): TSize;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property ParentFont;
  end;

destructor TParamComplWindow.Destroy;
begin
  FreeAndNil(FRender);
  inherited;
end;

procedure TParamComplWindow.GetParams(Item: String; List: TStrings; Marker: TObject);
var p: integer;
begin
  repeat
    p := Pos(FOwner.DeclSeparator, Item);
    if p = 0 then
      begin
        if Item <> '' then
          List.AddObject(Item, Marker);
      end else
      begin
        List.AddObject(Copy(Item, 1, p), Marker);
        Delete(Item, 1, p);
      end;
  until p = 0;
end;

function TParamComplWindow.IsFirstLine(Index: integer): Boolean;
begin
  with FOwner.FItems do
    Result := (Index = 0) or (Objects[Index] = nil) or
              (Objects[Index] <> Objects[Index - 1]);
end;

function TParamComplWindow.ProcessParams(DoDraw: Boolean): TSize;
var i, j, x, tw, th, hgt: integer;
    ItemIdx, ItemCnt, ParamCount, LineCnt: integer;
    St: TStringList;
    IsFirst, ShowItem: Boolean;
    S: string;
begin
  Result.cx := 2;
  Result.cy := 1;
  Canvas.Font := Font;
  th := Canvas.TextHeight('W');
  IsFirst := True;

  St := TStringList.Create;
  try
    i := 0;
    ItemIdx := 0;
    while i < FOwner.FItems.Count do
      begin
        LineCnt := 0;
        // Multiline params parsing
        if FRender = nil then
          begin
            St.Clear;
            repeat
              GetParams(FOwner.FItems[i], St, TObject(i));
              inc(i);
            until (i = FOwner.FItems.Count) or IsFirstLine(i);
            ParamCount := St.Count;
          end else
          begin
            ParamCount := 0;
            repeat
              Inc(ParamCount, FRender.CustomTagCount(i) div 2);
              Inc(i);
              Inc(LineCnt);
            until (i = FOwner.FItems.Count) or IsFirstLine(i);
          end;

        // Definition whether we need to show item
        if FOwner.UpDownSwitch then
          ShowItem := ItemIdx = FOwner.Selected
        else
          ShowItem := not FOwner.FilterItems or (ParamCount > FOwner.ParamNumber);

        if ShowItem then
          begin
            // Separator between items
            if not IsFirst then
              begin
                Canvas.Pen := FOwner.SeparatorPen;
                Canvas.MoveTo(1, Result.cy);
                Canvas.LineTo(Width - 3, Result.cy);
              end;

            x := 2;
            // Up-Down selector
            if FOwner.UpDownSwitch then
              begin
                ItemCnt := FOwner.ItemCount;
                S := Format('%d from %d', [FOwner.Selected + 1, ItemCnt]);
                tw := Canvas.TextWidth(S);
                if DoDraw then
                  begin
                    Canvas.Font.Color := clBlue;
                    Canvas.TextOut(x, Result.cy + 1, S);
                    Canvas.Font.Color := Font.Color;
                  end;
                FUpDown.Left := x + tw + 1;
                FUpDown.Max := ItemCnt - 1;
                FUpDown.Position := FOwner.Selected;
                Inc(x, tw + 3 + FUpDown.Width);
              end;

            // Process single item
            if Assigned(FRender) then
              begin
                for j := i - LineCnt to i - 1 do
                  begin
                    tw := FRender.ItemWidth(j);
                    if X + tw > FMaxWidth then
                      tw := FMaxWidth - X;
                    hgt := FRender.ItemHeight(j);
                    if hgt <= 0 then hgt := th;
                    if DoDraw then
                      FRender.DrawItem(j, Bounds(x, Result.cy + 1, tw, hgt), False);
                    Inc(X, tw);
                    if Result.cx < X then
                      Result.cx := X;
                    Result.cy := Result.cy + hgt + 2;
                    X := 2;
                  end;
              end else
              begin
                for j := 0 to St.Count - 1 do
                  begin
                    if j = FOwner.ParamNumber then Canvas.Font.Style := [fsBold]
                                              else Canvas.Font.Style := [];
                    tw := Canvas.TextWidth(St[j]);
                    if (X + tw > FMaxWidth) and (X <> 2) or
                       (j > 0) and (St.Objects[j] <> St.Objects[j - 1]) then
                      begin // Word wrap
                        if X > Result.cx then
                          if X < FMaxWidth then Result.cx := X
                                           else Result.cx := FMaxWidth;
                        X := 2;
                        Result.cy := Result.cy + th + 1;
                      end;
                    if DoDraw then
                      Canvas.TextOut(X, Result.cy + 1, St[j]);
                    Inc(X, tw);
                  end;
                // Size incrementing
                if X > Result.cx then
                  if X < FMaxWidth then Result.cx := X
                                   else Result.cx := FMaxWidth;
                Result.cy := Result.cy + th + 2;
              end;

            IsFirst := False;
          end;
        Inc(ItemIdx);
      end;
  finally
    St.Free;
  end;

  if Result.cy > 3 then
   begin
    Result.cx := Result.cx + 5;
    Result.cy := Result.cy + 1;
   end else
   begin
    Result.cx := 0;
    Result.cy := 0;
   end;
end;

procedure TParamComplWindow.CurParamStyle(ItemIndex, TagIndex: integer;
  var ImageIndex, StyleIndex: integer; var Text: ecString);
begin
  if not IsFirstLine(ItemIndex) then
    repeat
      Dec(ItemIndex);
      Inc(TagIndex, FRender.CustomTagCount(ItemIndex));
    until IsFirstLine(ItemIndex);

  if TagIndex div 2 = FOwner.ParamNumber then
    begin
      if TagIndex mod 2 = 0 then
        begin
          StyleIndex := FOwner.FmtSelParamStyleIndex;
          ImageIndex := FOwner.FmtSelStartImage;
        end
      else
        begin
          StyleIndex := 0;
          ImageIndex := FOwner.FmtSelEndImage;
        end;
    end;
end;

function TParamComplWindow.CalcSize(MaxWidth: integer): TSize;
begin
  FMaxWidth := MaxWidth;
  FreeAndNil(FRender);
  if FOwner.FmtEnable then
    begin
      FRender := TComplexRender.Create;
      if FOwner.FmtStyles <> nil then
        FRender.Styles := FOwner.FmtStyles.Styles;
      FRender.Images := FOwner.FmtImages;
      FRender.Font := Font;
      FRender.Canvas := Canvas;
      FRender.Items := FOwner.Items;
      FRender.OnGetCustomElem := CurParamStyle;
    end;
  Result := ProcessParams(False);
end;

procedure TParamComplWindow.Paint;
begin
  inherited;
  Canvas.Font := Font;
  Canvas.Pen.Color := clGray;
  Canvas.Pen.Style := psSolid;
  Canvas.Pen.Width := 1;
//  Canvas.Brush.Style := bsClear;
  Canvas.Brush.Color := Color;
  Canvas.Rectangle(ClientRect);
  ProcessParams(True);
end;

constructor TParamComplWindow.Create(AOwner: TComponent);
begin
  inherited;
  FUpDown := TUpDown.Create(Self);
  FUpDown.Visible := False;
  FUpDown.ArrowKeys := False;
  FUpDown.Wrap := False;
  FUpDown.Orientation := udHorizontal;
  FUpDown.Left := 40;
  FUpDown.Top := 2;
  FUpDown.Width := 24;
  FUpDown.Height := 17;
  FUpDown.Parent := Self;
  FUpDown.OnChangingEx := UpDownChanging;
end;

procedure TParamComplWindow.UpDownChanging(Sender: TObject; var AllowChange: Boolean;
  NewValue: Smallint; Direction: TUpDownDirection);
begin
  if NewValue < 0 then
    NewValue := NewValue + FUpDown.Max + 1
  else
    NewValue := NewValue mod (FUpDown.Max + 1);
  FOwner.Selected := NewValue;
end;


{ TParamCompletion }

constructor TParamCompletion.Create(AOwner: TComponent);
begin
  inherited;
  Popup := TParamComplWindow.Create(nil);
  with TParamComplWindow(Popup) do
    begin
      FreeNotification(Self);
      FOwner := Self;
      ParentFont := False;
    end;
  Container.BorderStyle := bsNone;
  FItems := TecStringList.Create;
  FOpenChar := '(';
  FCloseChar := ')';
  FSeparator := ',';
  FDeclSeparator := ';';
  FTerminateChar := ';';
  FAutomatic := True;
  FEnabled := True;
  FTimer := TTimer.Create(nil);
  FTimer.Enabled := False;
  FTimer.Interval := 500;
  FTimer.OnTimer := DoTimer;
  FUseParserResults := True;
  FCommandID := smParameterHint;
  LayoutSide := lsTop;
  FFilterItems := True;
  FSeparatorPen := TPen.Create;
  FFmtSelParamStyleIndex := -1;
  FFmtSelStartImage := -1;
  FFmtSelEndImage := -1;
end;

destructor TParamCompletion.Destroy;
begin
  FreeAndNil(FItems);
  FreeAndNil(FTimer);
  FreeAndNil(FSeparatorPen);
  inherited;
end;

procedure TParamCompletion.SetCloseChar(const Value: ecChar);
begin
  FCloseChar := Value;
  CloseUp(False);
end;

procedure TParamCompletion.SetDeclSeparator(const Value: Char);
begin
  FDeclSeparator := Value;
  CloseUp(False);
end;

procedure TParamCompletion.SetItems(const Value: TecStrings);
begin
  FItems.Assign(Value);
  CloseUp(False);
end;

procedure TParamCompletion.SetOpenChar(const Value: ecChar);
begin
  FOpenChar := Value;
  CloseUp(False);
end;

procedure TParamCompletion.SetSeparator(const Value: ecChar);
begin
  FSeparator := Value;
  CloseUp(False);
end;

procedure TParamCompletion.SetTerminateChar(const Value: ecChar);
begin
  FTerminateChar := Value;
  CloseUp(False);
end;

function TParamCompletion.GetPopupSize(MaxWidth: integer): TSize;
begin
  Result := TParamComplWindow(FPopup).CalcSize(MaxWidth);
end;

procedure TParamCompletion.ShowAt(pos: integer);
begin
  if SyntMemo <> nil then
    ShowPopup(SyntMemo.StrPosToCaretPos(pos));
end;

function TParamCompletion.CaretPosChanged: Boolean;
begin
  Result := False;
  if Visible then
    begin
      if Automatic then
        ExecuteAt(SyntMemo.CaretStrPos);
//      ParamNumber := DetectParam;
    end else
    begin
      if FTimer.Enabled and (FInputPos <> SyntMemo.CaretStrPos) then
        FTimer.Enabled := False;
    end;
end;

procedure TParamCompletion.TextChanged(Sender: TObject; Pos, Count,
  LineChange: integer);
begin
  FInputPos := Pos + Count;
  if Automatic and Enabled and
     (Count = 1) and (SyntMemo.Lines.Chars[pos + 1] = '(') then
    if FTimer.Interval = 0 then
      ExecuteAt(Pos + Count)
    else
      begin
        FTimer.Enabled := False;
        FTimer.Enabled := True;
      end;
end;

function TParamCompletion.Execute: Boolean;
begin
  if (SyntMemo <> nil) and Automatic and (SyntMemo.TextLength > 0) then
    Result := ExecuteAt(SyntMemo.CaretStrPos)
  else
    Result := False;
end;

// If there is no ability StartPos = -1
procedure TParamCompletion.CanExecute(Pos: integer; var StartPos, ParamNum: integer);
var i, Brackets, idx: integer;

  function ProcessChar(C: ecChar; Ps: integer): Boolean;
  begin
    Result := False;
    if C = FOpenChar then
      begin
        if Brackets > 0 then Dec(Brackets) else
          begin
            if (Visible and (FParamStart = Ps)) or IsValideFunc(Ps) then
              StartPos := Ps;
            Result := True;
          end;
      end else
    if C = FCloseChar then     Inc(Brackets) else
    if C = FTerminateChar then Result := True else
    if (C = FSeparator) and (Brackets = 0) then Inc(ParamNum);
  end;

begin
  Brackets := 0;
  ParamNum := 0;
  StartPos := -1;
  if FUseParserResults and Assigned(SyntMemo.SyntObj) then
    begin
      // Parser processing
      SyntMemo.SyntObj.AppendToPos(pos);
      idx := SyntMemo.SyntObj.NextTokenAt(pos);
      if idx = -1 then idx := SyntMemo.SyntObj.TagCount - 1 else
       if (idx > 0) and (SyntMemo.SyntObj.Tags[idx].StartPos >= pos) then
        Dec(idx);
      while idx >= 0 do
        with SyntMemo.SyntObj.Tags[idx] do
          begin
            if EndPos = StartPos + 1 then // token of one character
              if ProcessChar(SyntMemo.Lines.Chars[StartPos + 1], StartPos) then Exit;
            Dec(idx);
          end;
    end else
    begin
      // Character processing
      for i := Pos downto 2 do
        if ProcessChar(SyntMemo.Lines.Chars[i], i - 1) then
          Exit;
    end;
end;

// Search for function from specified position
function TParamCompletion.ExecuteAt(pos: integer): Boolean;
var AStart, AParam: integer;
begin
  Result := False;
  FTimer.Enabled := False;
  CanExecute(pos, AStart, AParam);
  if AStart = -1 then CloseUp(False) else
    begin
      if not Visible or (FParamStart <> AStart) then
        begin
          FParamStart := AStart;
          FParamNumber := AParam;
          FSelected := 0;
          ShowAt(FParamStart);
        end else
          ParamNumber := AParam;
      Result := True;
    end;
end;

procedure TParamCompletion.SetParamNumber(const Value: integer);
begin
  if (FParamNumber <> Value) and (Value > -1) then
   begin
    FParamNumber := Value;
    ItemChanged;
   end;
end;

// Extracts name of the function
function TParamCompletion.IsValideFunc(pos: integer): Boolean;
var pn, sp, idx: integer;
    FPathRule, FNameRule: TParserRule;
    FParseRes: TParserNode;
    Funcs: TecStrings;

  function ParseNodeString(Node: TParserNode; var ep: integer): ecString;
  var sp: integer;
  begin
    with SyntMemo, SyntObj do
      begin
        sp := Tags[Node.FirstToken].StartPos;
        ep := Tags[Node.LastToken].EndPos;
        Result := Lines.SubString(sp + 1, ep - sp);
      end;
  end;

  procedure AnalyzeNode(Br: TParserNode);
  var i, ep: integer;
  begin
    if Br is TParserBranchNode then
      if TParserBranchNode(Br).Rule.Rule = FNameRule then
        Funcs.AddObject(ParseNodeString(Br, ep), TObject(ep)) else
      for i := Br.Count - 1 downto 0 do
        AnalyzeNode(Br[i]);
  end;

begin
  FItems.Clear;
  if (FFuncPathRule <> '') and (SyntMemo.SyntObj <> nil) then
   with SyntMemo.SyntObj, Owner.Gramma do
    begin // Improved function name parsing
      FPathRule := ParserRuleByName(FFuncPathRule);
      if Assigned(FPathRule) then
        begin
          idx := PriorTokenAt(pos - 1);
          FParseRes := ParseRule(idx, FPathRule, SyntMemo.SyntObj);
          if Assigned(FParseRes) then
            try
              if FFuncNameRule <> '' then
                begin
                  FNameRule := ParserRuleByName(FFuncNameRule);
                  if Assigned(FNameRule) then
                    begin
                      Funcs := TecStringList.Create;
                      try
                        AnalyzeNode(FParseRes);
                        if Assigned(FOnGetParamsEx) then
                          FOnGetParamsEx(Self, Funcs) else
                        if Assigned(FOnGetParams) and (Funcs.Count > 0) then
                          FOnGetParams(Self, Funcs[Funcs.Count - 1], integer(Funcs.Objects[Funcs.Count - 1]));
                      finally
                        Funcs.Free;
                      end;
                    end;
                end else
                begin
                  if (FParseRes.LastToken <> -1) and Assigned(FOnGetParams) then
                    FOnGetParams(Self, ParseNodeString(FParseRes, sp), sp);
                end;
            finally
              FParseRes.Free;
            end;
        end;
    end else
    begin
      sp := pos;
      while (pos > 0) and (SyntMemo.Lines.Chars[pos] = ' ') do Dec(Pos);
      pn := Pos;
      while (pos > 0) and IsWordChar(SyntMemo.Lines.Chars[pos]) do Dec(Pos);
      Result := pos < pn;
      if not Result then Exit;
      if Assigned(FOnGetParams) then
        FOnGetParams(Self, SyntMemo.Lines.SubString(pos + 1, pn - pos), sp);
    end;

  Result := FItems.Count > 0;
end;

function TParamCompletion.GetColor: TColor;
begin
  Result := TParamComplWindow(FPopup).Color;
end;

function TParamCompletion.GetFont: TFont;
begin
  Result := TParamComplWindow(FPopup).Font;
end;

procedure TParamCompletion.SetColor(const Value: TColor);
begin
  TParamComplWindow(FPopup).Color := Value;
end;

procedure TParamCompletion.SetFont(const Value: TFont);
begin
  TParamComplWindow(FPopup).Font := Value;
  if Visible then
    ShowAt(FParamStart);
end;

function TParamCompletion.GetDelay: integer;
begin
  Result := FTimer.Interval;
end;

procedure TParamCompletion.SetDelay(const Value: integer);
begin
  FTimer.Interval := Value;
end;

procedure TParamCompletion.DoTimer(Sender: TObject);
begin
  FTimer.Enabled := False;
  if not Visible then
    Execute;
end;

procedure TParamCompletion.SetSelected(const Value: integer);
begin
  if FSelected <> Value then
    begin
      FSelected := Value;
      ItemChanged;
    end;
end;

procedure TParamCompletion.ItemChanged;
begin
  RecalculateBounds;
  inherited;
end;

procedure TParamCompletion.SetUpDownSwitch(const Value: Boolean);
begin
  if FUpDownSwitch <> Value then
    begin
      FUpDownSwitch := Value;
      CloseUp(False);
      TParamComplWindow(Popup).FUpDown.Visible := FUpDownSwitch;
    end;
end;

procedure TParamCompletion.ParentWndProc(var Message: TMessage);
begin
  if (Message.Msg = CM_CANCELMODE) and (Message.LParam <> 0)
  {$IFNDEF EC_DOTNET}
     and (TComponent(Message.LParam).Owner = Popup)
  {$ENDIF}
    then Exit;
  inherited;
end;

procedure TParamCompletion.AddItem(const Item: ecString);
var St: TecStringList;
    i, GroupIdx: integer;
begin
  St := TecStringList.Create;
  try
    St.Text := Item;
    if FItems.Count > 0 then
      GroupIdx := integer(FItems.Objects[FItems.Count - 1]) + 1
    else
      GroupIdx := 1;
    for i := 0 to St.Count - 1 do
      FItems.AddObject(St[i], TObject(GroupIdx));
  finally
    St.Free;
  end;
end;

procedure TParamCompletion.SetSeparatorPen(const Value: TPen);
begin
  FSeparatorPen.Assign(Value);
end;

function TParamCompletion.ItemCount: integer;
var i, g_idx, idx: integer;
begin
  Result := 0;
  g_idx := 0;
  for i := 0 to FItems.Count - 1 do
    begin
      idx := integer(FItems.Objects[i]);
      if (idx = 0) or (idx <> g_idx) then
        Inc(Result); 
      g_idx := idx;
    end;
end;

procedure TParamCompletion.SetFmtImages(const Value: TCustomImageList);
begin
  if FFmtImages <> Value then
    begin
      CloseUp(False);
      FFmtImages := Value;
      if Assigned(FFmtImages) then
        FFmtImages.FreeNotification(Self);
    end;
end;

procedure TParamCompletion.SetFmtSelParamStyleIndex(const Value: integer);
begin
  if FFmtSelParamStyleIndex <> Value then
    begin
      FFmtSelParamStyleIndex := Value;
      RecalculateBounds;
    end;
end;

procedure TParamCompletion.SetFmtStyles(const Value: TSyntStyles);
begin
  if FFmtStyles <> Value then
    begin
      CloseUp(False);
      FFmtStyles := Value;
      if Assigned(FFmtStyles) then
        FFmtStyles.FreeNotification(Self);
    end;
end;

procedure TParamCompletion.SetFmtEnable(const Value: Boolean);
begin
  if FFmtEnable <> Value then
    begin
      CloseUp(False);
      FFmtEnable := Value;
    end;
end;

procedure TParamCompletion.SetFmtSelEndImage(const Value: TImageIndex);
begin
  FFmtSelEndImage := Value;
end;

procedure TParamCompletion.SetFmtSelStartImage(const Value: TImageIndex);
begin
  FFmtSelStartImage := Value;
end;

function TParamCompletion.GetUpDownWidth: integer;
begin
  Result := TParamComplWindow(Popup).FUpDown.Width;
end;

procedure TParamCompletion.SetUpDownWidth(const Value: integer);
begin
  TParamComplWindow(Popup).FUpDown.Width := Value;
end;

function TParamCompletion.GetUpDownOrientation: TUDOrientation;
begin
  Result := TParamComplWindow(Popup).FUpDown.Orientation;
end;

procedure TParamCompletion.SetUpDownOrientation(
  const Value: TUDOrientation);
begin
  TParamComplWindow(Popup).FUpDown.Orientation := Value;
end;

{ TecSelCharPopup }

constructor TecSelCharPopup.Create(AOwner: TComponent);
begin
  inherited;
  Popup := TDrawGrid.Create(nil);
  with Grid do
    begin
      BorderStyle := bsNone;
      Options := [goVertLine, goHorzLine, goDrawFocusSelected];
      FixedCols := 0;
      FixedRows := 0;
      ColCount := 16;
      RowCount := 16;
      DefaultColWidth := 16;
      DefaultRowHeight := 18;
      ScrollBars := ssNone;
      OnDrawCell := Self.DrawCell;
      OnMouseUp := GridMouseUp;
      OnSelectCell := GridSelectCell;
      OnMouseMove := GridMouseMove;
    end;
  FCommandID := smSelCharacter;
  FShowCodeHint := True;
  FAutoSelect := True;
  ToolHint.Active := True;
end;

procedure TecSelCharPopup.DoAccept(Accept: Boolean);
begin
  inherited;
  if Accept and Assigned(SyntMemo) then
    with Grid do
      SyntMemo.InsertText(SelChar);
end;

procedure TecSelCharPopup.DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var ts: TSize;
    C: char;
begin
  with Grid do
    begin
      C := Chr(ACol + ARow * ColCount);
      ts := Canvas.TextExtent(C);
      Canvas.TextOut((Rect.Left + Rect.Right - ts.cx) div 2,
                     (Rect.Top + Rect.Bottom - ts.cy) div 2, C);
    end;
end;

function TecSelCharPopup.Execute: Boolean;
begin
  Result := Assigned(SyntMemo) and (not SyntMemo.ReadOnly) and (SyntMemo.CanInsertText(SyntMemo.CaretStrPos));
  if Result then
    begin
      Grid.Font.Charset := SyntMemo.Charset;
      ShowPopup(SyntMemo.CaretPos);
    end;
end;

function TecSelCharPopup.GetCellHeight: integer;
begin
  Result := Grid.DefaultRowHeight;
end;

function TecSelCharPopup.GetCellWidth: integer;
begin
  Result := Grid.DefaultColWidth;
end;

function TecSelCharPopup.GetFont: TFont;
begin
  Result := Grid.Font;
end;

function TecSelCharPopup.GetPopupSize(MaxWidth: Integer): TSize;
begin
  with Grid do
    begin
      Result.cx := DefaultColWidth * ColCount + (ColCount - 1) * GridLineWidth;
      Result.cy := DefaultRowHeight * RowCount + (RowCount - 1) * GridLineWidth;
    end;
end;

function TecSelCharPopup.GetSelChar: Char;
begin
  with Grid do
    Result := Chr(Col + Row * ColCount);
end;

procedure TecSelCharPopup.SetSelChar(const Value: Char);
var B: integer;
begin
  B := Byte(Value);
  if (B >= 0) and (B <= 255) then
    begin
      Grid.Col := B mod Grid.ColCount;
      Grid.Row := B div Grid.ColCount;
    end;
end;

function TecSelCharPopup.Grid: TDrawGrid;
begin
  Result := TDrawGrid(Popup);
end;

procedure TecSelCharPopup.GridMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then
    CloseUp(PtInRect(FPopup.ClientRect, Point(X, Y)));
end;

procedure TecSelCharPopup.GridSelectCell(Sender: TObject; ACol,
  ARow: Integer; var CanSelect: Boolean);
begin
  if Assigned(FOnCanSelect) then
    FOnCanSelect(Sender, ACol, ARow, CanSelect);
  if CanSelect then
    PostItemChanged;
end;

procedure TecSelCharPopup.ItemChanged;
begin
  if FShowCodeHint then
    ToolHint.Text := 'Char code: $' + IntToHex(Byte(SelChar), 2);
  inherited;
end;

procedure TecSelCharPopup.ParentWndProc(var Message: TMessage);
begin
  case Message.Msg of
    WM_KEYDOWN:
       case {$IFDEF EC_VCL12_UP}TWMKey(Message).CharCode{$ELSE}Message.WParam{$ENDIF} of
        VK_SPACE, VK_RETURN: begin CloseUp(True); Exit; end;
        VK_UP, VK_DOWN, VK_NEXT, VK_PRIOR, VK_HOME, VK_END, VK_LEFT, VK_RIGHT:
          begin
            PopupWndProc(Message);
            Exit;
          end;
       end;
  end;
  inherited;
end;

procedure TecSelCharPopup.SetCellHeight(const Value: integer);
begin
  Grid.DefaultRowHeight := Value;
end;

procedure TecSelCharPopup.SetCellWidth(const Value: integer);
begin
  Grid.DefaultColWidth := Value;
end;

procedure TecSelCharPopup.SetFont(const Value: TFont);
begin
  Grid.Font := Value;
end;

procedure TecSelCharPopup.GridMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
var C, R: integer;
begin
  if not FAutoSelect then Exit;
  Grid.MouseToCell(X, Y, C, R);
  Grid.Col := C;
  Grid.Row := R;
end;

function TecSelCharPopup.GetBgColor: TColor;
begin
  Result := Grid.Color;
end;

procedure TecSelCharPopup.SetBgColor(const Value: TColor);
begin
  Grid.Color := Value;
end;

{ TecToolHint }

constructor TecToolHint.Create(AOwner: TComponent);
begin
  inherited;
  if not (AOwner is TPopupControl) then
    raise Exception.Create('Owner of TecToolHint must be of type TPopupControl');
  FComplRender := TComplexRender.Create;
  FMinMaxWidth := 150;
  FLayoutSide := lsRight;
  Color := clInfoBk;
end;

destructor TecToolHint.Destroy;
begin
  FreeAndNil(FComplRender);
  inherited;
end;

procedure TecToolHint.CMFontchanged(var Message: TMessage);
begin
  inherited;
  RefreshHintWnd;
end;

procedure TecToolHint.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited;
  if Operation = opRemove then
    if AComponent = FImages then Images := nil else
    if AComponent = FStyles then Styles := nil;
end;

procedure TecToolHint.RefreshHintWnd;
var R: TRect;
begin
  if Active and TSyntMemoPopup(Owner).Visible and (FText <> '') then
    begin
      if CalculateLayout(Constraints, FLayoutSide, FMinMaxWidth,
            IntCalcSize, TSyntMemoPopup(Owner).GetPopupRect, R)  then
        begin
          // hint activation
          UpdateBoundsRect(R);
          ParentWindow := Application.Handle;
          SetWindowPos(Handle, HWND_TOPMOST, R.Left, R.Top, Width, Height,
            SWP_NOACTIVATE or SWP_SHOWWINDOW{ or SWP_NOREDRAW});
          Invalidate;
        end else
          ReleaseHandle;
    end else
      ReleaseHandle;
end;

function TecToolHint.IntCalcSize(MaxWidth: integer): TSize;
begin
  // Size calculation
  if Formatted then
    begin
      Canvas.Font := Font;
      Canvas.Brush.Color := Color;
      if Assigned(Styles) then
        FComplRender.Styles := Styles.Styles
      else
        FComplRender.Styles := nil;
      FComplRender.Font := Font;
      FComplRender.Images := Images;
      FComplRender.Canvas := Self.Canvas;
      FComplRender.Items.Text := FText;
      Result.cx := FComplRender.Width + 4;
      Result.cy := FComplRender.Height;
    end else
  begin
    Canvas.Font := Font;
    Caption := FText;
    with CalcHintRect(MaxWidth, FText, nil) do
      begin
        Result.cx := Right;
        Result.cy := Bottom;
      end;
  end;
  Result.cy := Result.cy + 4;
end;

procedure TecToolHint.SetActive(const Value: Boolean);
begin
  if FActive <> Value then
    begin
      FActive := Value;
      if not FActive then
        ReleaseHandle;
    end;
end;

procedure TecToolHint.SetFormatted(const Value: Boolean);
begin
  if FFormatted <> Value then
    begin
      FFormatted := Value;
      RefreshHintWnd;
    end;
end;

procedure TecToolHint.SetImages(const Value: TImageList);
begin
  if FImages <> Value then
    begin
      FImages := Value;
      if Assigned(FImages) then
        FImages.FreeNotification(Self);
      RefreshHintWnd;
    end;
end;

procedure TecToolHint.SetStyles(const Value: TSyntStyles);
begin
  if FStyles <> Value then
    begin
      FStyles := Value;
      if Assigned(FStyles) then
        FStyles.FreeNotification(Self);
      RefreshHintWnd;
    end;
end;

procedure TecToolHint.SetLayoutSide(const Value: TLayoutSide);
begin
  if FLayoutSide <> Value then
    begin
      FLayoutSide := Value;
      RefreshHintWnd;
    end;
end;

procedure TecToolHint.SetText(const Value: ecString);
begin
  FText := Value;
  RefreshHintWnd;
end;

procedure TecToolHint.Paint;
var R: TRect;
    i: integer;
begin
  if FFormatted then
    begin
      R := ClientRect;
      Inc(R.Top, 1);
      Inc(R.Left, 1);
      for i := 0 to FComplRender.VisibleCount - 1 do
        begin
          Canvas.Brush.Color := Color;
          R.Bottom := R.Top + FComplRender.ItemHeight(i);
          FComplRender.DrawItem(i, R, False);
          R.Top := R.Bottom;
        end;
    end
  else
    inherited;
end;

procedure TecToolHint.CMTextChanged(var Message: TMessage);
begin
end;

{ TecControlCollection }

function TecControlCollection.Add(const ControlClass: string): TecControlItem;
begin
  Result := TecControlItem(inherited Add);
  Result.ControlClass := ControlClass;
end;

function TecControlCollection.CanCancelMode(Obj: TObject): Boolean;
var i: integer;
    Prn: TControl;
begin
  if Assigned(Obj) and (Obj is TControl) then
    Prn := TControl(Obj).Parent
  else
    Prn := nil;
  Result := true;
  for i := 0 to Count - 1 do
    if (Items[i].Control = Obj) or (Items[i].Control = Prn) then
      begin
        Result := Items[i].CloseOnClick;
        Exit;
      end;
end;

procedure TecControlCollection.ControlCreated(Control: TControl);
begin
  if Assigned(FOnControlCreated) then
    FOnControlCreated(Self, Control);
end;

procedure TecControlCollection.ControlDestroyed(Control: TControl);
var i: integer;
begin
  for i := Count - 1 downto 0 do
    if Items[i].Control = Control then
      Items[i].ReleaseControl;
  if Assigned(FOnControlDestroyed) then
    FOnControlDestroyed(Self, Control);
end;

constructor TecControlCollection.Create(AOwner: TComponent);
begin
  Assert(Assigned(AOwner));
  inherited Create(AOwner, TecControlItem);
end;

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

{ TecControlItem }

constructor TecControlItem.Create(Collection: TCollection);
begin
  inherited;
  FCloseOnClick := True;
end;

function TecControlItem.CreateControl(const ControlClass: String): TControl;
  function FindClass(const ClsName: string): TControlClass;
  var i: integer;
  begin
    if Assigned(PopupControlClasses) then
      for i := 0 to PopupControlClasses.Count - 1 do
        if TControlClass(PopupControlClasses[i]).ClassName = ClsName then
          begin
            Result := TControlClass(PopupControlClasses[i]);
            Exit;
          end;
    Result := nil;
  end;
var Cls: TControlClass;
    AOwn: TComponent;
begin
  Cls := FindClass(ControlClass);
  if Assigned(Cls) then
    begin
      AOwn := TecControlCollection(Collection).GetOwner as TComponent;
      FControl := Cls.Create(AOwn);
      {$IFDEF EC_VCL6_UP}
      FControl.SetSubComponent(True);
      {$ENDIF}
      TecControlCollection(Collection).ControlCreated(FControl);
      Result := FControl;
    end
  else
    raise Exception.CreateFmt('Popup control class %s is not registered', [Cls.ClassName]);
end;

destructor TecControlItem.Destroy;
begin
  FreeAndNil(FControl);
  inherited;
end;

function TecControlItem.GetAlign: TAlign;
begin
  if Assigned(FCOntrol) then
    Result := FControl.Align
  else
    Result := alNone;
end;

function TecControlItem.GetControlClass: string;
begin
  if Assigned(FControl) then Result := FControl.ClassName
    else Result := ''; 
end;

function TecControlItem.GetDisplayName: String;
var S: string;
begin
  if Assigned(FControl) then
    begin
      S := GetEnumName(TypeInfo(TAlign), integer(Control.Align));
      Delete(S, 1, 2);
      Result := ControlClass + ' (' + S + ')';
    end else Result := '[None]';
end;

procedure TecControlItem.ReleaseControl;
begin
  FControl := nil;
end;

procedure TecControlItem.SetAlign(const Value: TAlign);
begin
  if Assigned(FControl) then
    FControl.Align := Value;
end;

procedure TecControlItem.SetControl(const Value: TControl);
begin
end;

procedure TecControlItem.SetControlClass(const Value: string);
begin
  if not SameText(Value, GetControlClass) then
    begin
      if Assigned(FCOntrol) then
        FreeAndNil(FControl);
      CreateControl(Value);
    end;
end;

initialization
  RegisterPopupControlClass(TLabel);
  RegisterPopupControlClass(TPanel);
  RegisterPopupControlClass(TStatusBar);
  RegisterPopupControlClass(TToolBar);

finalization
  FreeAndNil( PopupControlClasses ); 

end.

