FastReport_2022_VCL/Source/frxSynMemo.pas

{******************************************}
{                                          }
{             FastReport VCL               }
{           Syntax memo control            }
{                                          }
{         Copyright (c) 1998-2021          }
{            by Fast Reports Inc.          }
{                                          }
{******************************************}

unit frxSynMemo;

interface

{$I frx.inc}

uses
  {$IFNDEF FPC}Windows, Messages, Imm,{$ENDIF}
  Types, SysUtils, Classes, Graphics, Controls, StdCtrls, ExtCtrls, Forms,
  frxCtrls, fs_iparser, frxPopupForm, fs_xml, fs_iinterpreter, Menus, frxRes,
  frxHint
  {$IFDEF FPC}
  ,LCLType, LMessages, LazHelper, LCLIntf, LCLProc
  {$ENDIF};

const
  WM_FRX_SYNC_SCRIPT = WM_USER + 100;
  WM_FRX_UPDATE_CODE = WM_USER + 101;
  WM_FRX_FILL_CODE_COMPLETION = WM_USER + 102;

type
  TfrxCompletionList = class;
  TCharAttr = (caNo, caText, caComment, caKeyword, caString,
    caNumber);
  //TCharAttributes = set of TCharAttr;
  TfrxCharAttributes = record
    StyleIndex: Byte;
    IsSelBlock: Boolean;
  end;

  TfrxAttributeStyle = class(TCollectionItem)
  private
    FStyleID: Byte;
    FFontColor: TColor;
    FFontStyle: TFontStyles;
    FKeywords: TStrings;
    FAttrType: TCharAttr;
  protected
    procedure SetCollection(Value: TCollection); override;
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    property StyleID: Byte read FStyleID;
  published
    property AttrType: TCharAttr read FAttrType write FAttrType;
    property FontColor: TColor read FFontColor write FFontColor;
    property FontStyle: TFontStyles read FFontStyle write FFontStyle;
    property Keywords: TStrings read FKeywords;
  end;

  TfrxAttributeStyles = class(TCollection)
  private
    { null object }
    FDefaultAttribute: TfrxAttributeStyle;
    FIndexedList: TStringList;
    function GetItem(Index: Integer): TfrxAttributeStyle;
  public
    function GetUniqueID: Byte;
    constructor Create;
    destructor Destroy; override;
    function Add: TfrxAttributeStyle;
    function GetStyleByID(ID: Byte): TfrxAttributeStyle;
    procedure AssignStyleByID(ID: Byte; aFont: TFont);
    procedure AssignStyle(aStyle: TfrxAttributeStyle; aFont: TFont);
    function FindStyleIDByKeyword(const Name: String; AttrType: TCharAttr): Byte;
    property Items[Index: Integer]: TfrxAttributeStyle read GetItem; default;
  end;

  TfrxSynDialectStyle = class(TPersistent)
  private
    FAttributeStyles: TfrxAttributeStyles;
    FKeywords: String;
    FCommentLine1: String;
    FCommentLine2: String;
    FCommentBlock1: String;
    FCommentBlock2: String;
    FStringQuotes: String;
    FHexSequence: String;
    FName: String;
    FOwner: TObject;
    procedure SetName(const Value: String);
  public
    constructor Create(AOwner: TObject);
    destructor Destroy; override;
    { TODO: we need one contract for all setings. I.e. need interface for this }
    procedure SaveTo(const Section: String; Ini: TObject);
    procedure LoadFrom(const Section: String; Ini: TObject);
    property AttributeStyles: TfrxAttributeStyles read FAttributeStyles;
    property Name: String read FName write SetName;
  published
    property Keywords: String read FKeywords write FKeywords;
    property CommentLine1: String read FCommentLine1 write FCommentLine1;
    property CommentLine2: String read FCommentLine2 write FCommentLine2;
    property CommentBlock1: String read FCommentBlock1 write FCommentBlock1;
    property CommentBlock2: String read FCommentBlock2 write FCommentBlock2;
    property StringQuotes: String read FStringQuotes write FStringQuotes;
    property HexSequence: String read FHexSequence write FHexSequence;
  end;

  TfrxSynDialectStyles = class(TObject)
  private
    FLIst: TList;
    FDefSynDialectStyle: TfrxSynDialectStyle;
    FActiveIndex: Integer;
    FActiveChanged: TNotifyEvent;
    function GetItem(Index: Integer): TfrxSynDialectStyle;
    function GetActiveDialicet: TfrxSynDialectStyle;
    function GetActiveStyles: TfrxAttributeStyles;
    procedure SetActiveIndex(const Value: Integer);
   public
    constructor Create;
    destructor Destroy; override;
    function Add: TfrxSynDialectStyle;
    procedure Clear;
    function Count: Integer;
    { TODO: we need one contract for all setings. I.e. need interface for this }
    procedure SaveTo(const Section: String; Ini: TObject);
    procedure LoadFrom(const Section: String; Ini: TObject);
    property Items[Index: Integer]: TfrxSynDialectStyle read GetItem; default;
    property ActiveDialicet: TfrxSynDialectStyle read GetActiveDialicet;
    property ActiveStyles: TfrxAttributeStyles read GetActiveStyles;
    property ActiveIndex: Integer read FActiveIndex write SetActiveIndex;
    property OnActiveChanged: TNotifyEvent read FActiveChanged write FActiveChanged;
  end;

  TfrxCodeCompletionEvent = procedure(const Name: String; List: TfrxCompletionList) of object;

  TfrxByteArr = array of Byte;

  TfrxSynAttributes = class
  private
    FArray: array of TfrxByteArr;
    FCapacity: Integer;
    FCount: Integer;
    FUpdating: Boolean;
    FDialectStyles: TfrxSynDialectStyles;
    FParser: TfsParser;
    procedure SetCapacity(NewCapacity: Integer);
    procedure SetCount(NewCount: Integer);
    function GetLine(Index: Integer): TfrxByteArr;
    procedure PutLine(Index: Integer; const Value: TfrxByteArr);
    procedure ActiveChanged(Sender: TObject);
  public
    constructor Create(Parser: TfsParser; DialectStyles: TfrxSynDialectStyles);
    procedure SetLineLen(Index: Integer; NewLen: Integer);
    procedure Delete(Index: Integer);
    function GetAllAttributes: TfrxByteArr;
    procedure SetAllAttributes(Attr: TfrxByteArr);
    procedure UpdateSyntax(EndLine: Integer; Text: TStringList);
    procedure UpdateSyntaxDialect;
    property Line[Index: Integer]: TfrxByteArr read GetLine write PutLine; default;
    property Count: Integer read FCount write SetCount;
    property Updating: Boolean read FUpdating;
  end;

  TfrxBreakPoint = class
  private
    FCondition: String;
    FSpecialCondition: String;
    FEnabled: Boolean;
    FLine: Integer;
  public
    property Condition: String read FCondition write FCondition;
    property Enabled: Boolean read FEnabled write FEnabled;
    property Line: Integer read FLine write FLine;
    property SpecialCondition: String read FSpecialCondition write FSpecialCondition;
  end;

  TfrxItemType = (itVar, itProcedure, itFunction, itProperty, itIndex, itConstant, itConstructor, itType, itEvent);
  TfrxItemTypes = set of TfrxItemType;

  TfrxCompletionListType = (cltRtti, cltScript, cltAddon);
  TfrxCompletionListTypes = set of TfrxCompletionListType;

  TfrxCompletionItem = class
  private
    FParent: TfrxCompletionItem;
    FName: String;
    FType: String;
    FParams: String;
    FItemType: TfrxItemType;
    FStartVisible: Integer;
    FEndVisible: Integer;
  public
    property Name: String read FName;
    property Typ: String read FType;
    property Params: String read FParams;
    property ItemType: TfrxItemType read FItemType;
  end;

  TfrxCompletionList = class
  private
    FConstants: TStringList;
    FVariables: TStringList;
    FFunctions: TStringList;
    FClasses: TStringList;
    FLocked: Boolean;
    function AddBaseVar(varList: TStrings; const Name, sType: String; VisibleStart: Integer = 0; VisibleEnd: Integer = -1; const ParentFunc: String = ''): TfrxCompletionItem;
    function GetItem(Index: Integer): TfrxCompletionItem;
  public
    constructor Create;
    destructor Destroy; override;
    procedure DestroyItems;
    function Count: Integer;
    function AddConstant(const Name, sType: String; VisibleStart: Integer = 0; VisibleEnd: Integer = -1; const ParentFunc: String = ''): TfrxCompletionItem;
    function AddVariable(const Name, sType: String; VisibleStart: Integer = 0; VisibleEnd: Integer = -1; const ParentFunc: String = ''): TfrxCompletionItem;
    function AddClass(const Name, sType: String; VisibleStart: Integer = 0; VisibleEnd: Integer = -1; const ParentFunc: String = ''): TfrxCompletionItem;
    function AddFunction(const Name, sType, Params: String; VisibleStart: Integer = 0; VisibleEnd: Integer = -1; const ParentFunc: String = ''): TfrxCompletionItem;
    function Find(const Name: String): TfrxCompletionItem;
    property Items[Index: Integer]: TfrxCompletionItem read GetItem; default;
    property Locked: Boolean read FLocked write FLocked;
  end;

  { TfrxCodeCompletionThread }

  TfrxCodeCompletionThread = class(TThread)
  private
    FText: TStringList;
    FScript: TfsScript;
    FOriginalScript: TfsScript;
    FILCode: TStream;
    FXML: TfsXMLDocument;
    FCompletionList: TfrxCompletionList;
    FSyntaxType: String;
    FMemoHandle: HWND;
    procedure SyncScript;
    procedure UpdateCode;
    procedure FreeScript;
    procedure FillCodeCompletion;
  public
    destructor Destroy; override;
    procedure Execute; override;
    property Script: TfsScript read FOriginalScript write FOriginalScript;
  end;

  {$IFDEF FPC}
  { TBrkStringList }

  TBrkStringList = class(TStringList)
    function AddObject(const S: string; AObject: TObject): Integer; override; overload;
  end;
  {$ENDIF}

  TfrxSyntaxMemo = class(TfrxScrollWin)
  private
    {$IFDEF NONWINFPC}
    FCaretCreated: Boolean;
    {$ENDIF}
    FActiveLine: Integer;
    FAllowLinesChange: Boolean;
    FBlockColor: TColor;
    FBlockFontColor: TColor;
    FBookmarks: array[0..9] of Integer;
    FCharHeight: Integer;
    FCharWidth: Integer;
    FCommentAttr: TFont;
    FCompletionForm: TfrxPopupForm;
    FCompletionLB: TListBox;
    FDoubleClicked: Boolean;
    FDown: Boolean;
    FToggleBreakPointDown: Boolean;
    FGutterWidth: Integer;
    FIsMonoType: Boolean;
    FKeywordAttr: TFont;
    FMaxLength: Integer;
    FMessage: String;
    FModified: Boolean;
    FMoved: Boolean;
    FNumberAttr: TFont;
    FOffset: TPoint;
    FOnChangePos: TNotifyEvent;
    FOnChangeText: TNotifyEvent;
    FOnCodeCompletion: TfrxCodeCompletionEvent;
    FParser: TfsParser;
    FPos: TPoint;
    FStringAttr: TFont;
    FSelEnd: TPoint;
    FSelStart: TPoint;
    FTabStops: Integer;
{$IFNDEF FPC}
    FCompSelStart: TPoint;
    FCompSelEnd: TPoint;
{$ENDIF}
    FShowGutter: boolean;
    //FSynStrings: TStrings;
    FSynAttributes: TfrxSynAttributes;
    FSynDialectStyles: TfrxSynDialectStyles;
    FSyntax: String;
    FTempPos, FLastHintPos: TPoint;
    FText: TStringList;
    FTextAttr: TFont;
    FUndo: TStringList;
    FWindowSize: TPoint;
    FBreakPoints: {$IFDEF FPC}TBrkStringList{$ELSE}TStringList{$ENDIF};
    FCodeCompList: TStringList;
    FStartCodeCompPos: Integer;
    FCompleationFilter: String;
    FScriptRTTIXML: TfsXMLDocument;
    FRttiCompletionList: TfrxCompletionList;
    FScriptCompletionList: TfrxCompletionList;
    FAddonCompletionList: TfrxCompletionList;
    FClassCompletionList: TfrxCompletionList;
    FCodeCompletionThread: TfrxCodeCompletionThread;
    FScript: TfsScript;
    FTimer: TTimer;
    FShowLineNumber: Boolean;
    FCodeComplitionFilter: TfrxItemTypes;
    FShowInCodeComplition: TfrxCompletionListTypes;
    FCodeCompletionWidth: Integer;
    FCodeCompletionHeight: Integer;
    FCodeCompletionMinHeight: Integer;
    FCodeCompletionMinWidth: Integer;
    FMultiByteLang: Boolean;
    FfrxHintShowEvent: TfrxHintShowEvent;
    FEnableHint: Boolean;
{$IFNDEF FPC}
    FTmpCanvas: TBitmap;
    {  need for east languages carret correction  }
    function GetCharWidth(const Str: String): Integer;
    function GetCharXPos(X: Integer): Integer;
{$ENDIF}
    function GetCharAttr(Pos: TPoint): TfrxCharAttributes;
    function GetLineBegin(Index: Integer): Integer;
    function GetPlainTextPos(Pos: TPoint): Integer;
    function GetPosPlainText(Pos: Integer): TPoint;
    function GetRunLine(Index: Integer): Boolean;
    function GetSelText: String;
    function GetText: TStrings;
    function LineAt(Index: Integer; UseTrim: Boolean = True): String;
    function GetIdentEnd(aPos: Integer): Integer;
    function IsCursorInStringBlock: Boolean;
    function LineLength(Index: Integer): Integer;
    function Pad(n: Integer): String;
    procedure AddSel;
    procedure AddUndo;
    procedure ClearSel;
    procedure ClearSyntax(ClearFrom: Integer);
    procedure CompletionFormClose(Sender: TObject; var Action: TCloseAction);
    procedure CompletionLBDblClick(Sender: TObject);
    procedure CompletionLBDrawItem(Control: TWinControl; Index: Integer;
      ARect: TRect; State: TOwnerDrawState);
    function ItemToPrefix(Item: TfrxCompletionItem; var pref: String; c: TColor = clNone): TColor;
    procedure CompletionLBKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure CompletionLBKeyPress(Sender: TObject; var Key: Char);
    procedure CorrectBookmark(Line, Delta: Integer);
    procedure CorrectBreakPoints(Line, Delta: Integer);
    procedure CreateSynArray(EndLine: Integer);
    procedure DoBackspace;
    procedure DoChange;
    procedure DoChar(Ch: Char);
    procedure DoCodeCompletion;
    procedure BuildCClist(const sName: String; aCodeCompList: TStringList; AllFunc: Boolean = False);
    procedure DoCtrlI;
    procedure DoCtrlU;
    procedure DoCtrlR;
    procedure DoCtrlL;
    procedure DoDel;
    procedure DoDown;
    procedure DoEnd(Ctrl: Boolean);
    procedure DoHome(Ctrl: Boolean);
    procedure DoLeft;
    procedure DoPgUp;
    procedure DoPgDn;
    procedure DoReturn;
    procedure DoRight;
    procedure DoUp;
    procedure EnterIndent;
    procedure LinesChange(Sender: TObject);
    procedure SetActiveLine(Line: Integer);
    procedure SetCommentAttr(Value: TFont);
    procedure SetKeywordAttr(Value: TFont);
    procedure SetNumberAttr(const Value: TFont);
    procedure SetRunLine(Index: Integer; const Value: Boolean);
    procedure SetSelText(const Value: String);
    procedure SetShowGutter(Value: Boolean);
    procedure SetStringAttr(Value: TFont);
    procedure SetSyntax(const Value: String);
    procedure SetText(Value: TStrings);
    procedure SetTextAttr(Value: TFont);
    procedure ShiftSelected(ShiftRight: Boolean);
    procedure ShowCaretPos;
    procedure TabIndent;
    procedure UnIndent;
    procedure UpdateScrollBar;
    procedure WMKillFocus(var Msg: TWMKillFocus); message WM_KILLFOCUS;
    procedure WMSetFocus(var Msg: TWMSetFocus); message WM_SETFOCUS;
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    { Inline IME realisation }
	{$IFNDEF FPC}
    procedure WMIMEStartComp(var Message: TMessage); message WM_IME_STARTCOMPOSITION;
    procedure WMIMEEndComp(var Message: TMessage); message WM_IME_ENDCOMPOSITION;
    procedure WMIMECOMPOSITION (var Message: TMessage); message WM_IME_COMPOSITION ;
	{$ENDIF}
    procedure WMFRXSyncScript(var Message: TMessage); message WM_FRX_SYNC_SCRIPT;
    procedure WMFRXUpdateCode(var Message: TMessage); message WM_FRX_UPDATE_CODE;
    procedure WMFRXFillCodeCompletion(var Message: TMessage); message WM_FRX_FILL_CODE_COMPLETION;
    procedure SetEnableHint(vEnableHint: boolean);
    procedure FakeHintShow(var Msg: TCMHintShow);
    procedure RealHintShow(var Msg: TCMHintShow);
    procedure WMFRXHintShow(var Msg: TCMHintShow); message CM_HINTSHOW;
    function OffsPoint(Point: TPoint): TPoint;
    procedure GetCurWord(Point: TPoint; var Prefix: String; var Header: String; var TextHint: String);
    function CurPosToSynPos(X, Y: Integer): TPoint;
    function GetTextSelected: Boolean;
    procedure SetGutterWidth(const Value: Integer);
    procedure SetShowInCodeComplition(const Value: TfrxCompletionListTypes);
    procedure SetCodeCompletionWidth(const Value: Integer);
    procedure SetCodeCompletionHeight(const Value: Integer);
    procedure SetCodeCompletionMinHeight(const Value: Integer);
    procedure SetCodeCompletionMinWidth(const Value: Integer);
    procedure PopCopy(Sender: TObject);
    procedure PopCut(Sender: TObject);
    procedure PopPaste(Sender: TObject);
    procedure PopDelete(Sender: TObject);
    procedure PopSelectAll(Sender: TObject);
    function GetAttributeStyles: TfrxAttributeStyles;
    procedure QuickComment;
  protected
    procedure DblClick; override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: Char); override;
    {$IFDEF FPC}
    procedure UTF8KeyPress(var UTF8Key: TUTF8Char); override;
    {$ENDIF}
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseWheelDown(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; var Handled: Boolean);
    procedure MouseWheelUp(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; var Handled: Boolean);
    procedure OnHScrollChange(Sender: TObject); override;
    procedure OnVScrollChange(Sender: TObject); override;
    procedure Resize; override;
    function GetCompletionString(Pos: TPoint): String;
    function GetFilter(aStr: String): String;
    procedure DoTimer(Sender: TObject);
    procedure DoPPIChanged(aNewPPI: Integer); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Paint; override;
    procedure CopyToClipboard;
    procedure CutToClipboard;
    procedure CompletionClose;
    procedure PasteFromClipboard;
    procedure SelectAll;
    procedure SetPos(x, y: Integer);
    procedure SetPosByCoords(X, Y: Integer);
    procedure ShowMessage(const s: String);
    procedure Undo;
    procedure UpdateView;
    procedure ClearBreakPoints;
    function Find(const SearchText: String; CaseSensitive: Boolean;
      var SearchFrom: Integer): Boolean;
    function GetPlainPos: Integer;
    function GetPos: TPoint;
    function IsBookmark(Line: Integer): Integer;
    procedure AddBookmark(Line, Number: Integer);
    procedure DeleteBookmark(Number: Integer);
    procedure GotoBookmark(Number: Integer);
    procedure AddNewBreakPoint;
    procedure AddBreakPoint(Number: Integer; const Condition: String; const Special: String);
    procedure ToggleBreakPoint(Number: Integer; const Condition: String);
    procedure DeleteBreakPoint(Number: Integer);
    procedure DeleteF4BreakPoints;
    function IsBreakPoint(Number: Integer): Boolean;
    function IsActiveBreakPoint(Number: Integer): Boolean;
    function GetBreakPointCondition(Number: Integer): String;
    function GetBreakPointSpecialCondition(Number: Integer): String;
    procedure FillRtti;
    procedure SaveToIni(const IniPath: String; const Section: String; const FileName: String);
    procedure LoadFromIni(const IniPath: String; const Section: String; const FileName: String);

//    property DefaultAttributeStyles: TfrxAttributeStyles read FAttributeStyles;
    property EnableHint: Boolean read FEnableHint write SetEnableHint default True;
    property AttributeStyles: TfrxAttributeStyles read GetAttributeStyles;
    property CodeCompletionThread: TfrxCodeCompletionThread read FCodeCompletionThread;
    property CodeCompletionMinWidth: Integer read FCodeCompletionMinWidth write SetCodeCompletionMinWidth default 300;
    property CodeCompletionMinHeight: Integer read FCodeCompletionMinHeight write SetCodeCompletionMinHeight default 100;
    property CodeCompletionWidth: Integer read FCodeCompletionWidth write SetCodeCompletionWidth default 300;
    property CodeCompletionHeight: Integer read FCodeCompletionHeight write SetCodeCompletionHeight default 100;
    property ActiveLine: Integer read FActiveLine write SetActiveLine;
    property BlockColor: TColor read FBlockColor write FBlockColor;
    property BlockFontColor: TColor read FBlockFontColor write FBlockFontColor;
    property BreakPoints:{$IFDEF FPC}TBrkStringList{$ELSE}TStringList{$ENDIF} read FBreakPoints;
    property Color;
    property CommentAttr: TFont read FCommentAttr write SetCommentAttr;
    property CodeComplitionFilter: TfrxItemTypes read FCodeComplitionFilter write FCodeComplitionFilter;
    property ShowInCodeComplition: TfrxCompletionListTypes read FShowInCodeComplition write SetShowInCodeComplition;
    property SynDialectStyles: TfrxSynDialectStyles read FSynDialectStyles;
    property Font;
	{$IFNDEF FPC}
    property ImeMode;
    property ImeName;
  	{$ENDIF}
    property SelStart: TPoint read FSelStart write FSelStart;
    property SelEnd: TPoint read FSelEnd write FSelEnd;
    property TabStops: Integer read FTabStops write FTabStops;
    property GutterWidth: Integer read FGutterWidth write SetGutterWidth;
    property KeywordAttr: TFont read FKeywordAttr write SetKeywordAttr;
    property Modified: Boolean read FModified write FModified;
    property MultiByteLang: Boolean read FMultiByteLang write FMultiByteLang;
    property NumberAttr: TFont read FNumberAttr write SetNumberAttr;
    property RunLine[Index: Integer]: Boolean read GetRunLine write SetRunLine;
    property SelText: String read GetSelText write SetSelText;
    property StringAttr: TFont read FStringAttr write SetStringAttr;
    property TextAttr: TFont read FTextAttr write SetTextAttr;
    property Lines: TStrings read GetText write SetText;
    property Syntax: String read FSyntax write SetSyntax;
    property Script: TfsScript read FScript write FScript;
    property ShowGutter: Boolean read FShowGutter write SetShowGutter;
    property ShowLineNumber: Boolean read FShowLineNumber write FShowLineNumber;
    property TextSelected: Boolean read GetTextSelected;
    property ScriptRTTIXML: TfsXMLDocument read FScriptRTTIXML;
    property OnChangePos: TNotifyEvent read FOnChangePos write FOnChangePos;
    property OnChangeText: TNotifyEvent read FOnChangeText write FOnChangeText;
    property OnCodeCompletion: TfrxCodeCompletionEvent read FOnCodeCompletion
      write FOnCodeCompletion;
    property OnDragDrop;
    property OnDragOver;
    property OnKeyDown;
    property PopupMenu;
  end;

  TDiffFunc = function(s1, s2: String): Integer;

implementation


uses Clipbrd, fs_itools, frxUtils, frxXML, IniFiles, Registry, frxDPIAwareInt,
  frxPlatformServices{$IFDEF FPC},RtlConsts{$ENDIF};

const
  SQLKeywords =
    'active,after,all,alter,and,any,as,asc,ascending,at,auto,' +
    'base_name,before,begin,between,by,cache,call,cast,check,column,commit,' +
    'committed,computed,conditional,constraint,containing,count,create,' +
    'current,cursor,database,debug,declare,default,delete,desc,descending,' +
    'distinct,do,domain,drop,else,end,entry_point,escape,exception,execute,' +
    'exists,exit,external,extract,filter,for,foreign,from,full,function,' +
    'generator,grant,group,having,if,in,inactive,index,inner,insert,into,is,' +
    'isolation,join,key,left,level,like,merge,names,no,not,null,of,on,only,' +
    'or,order,outer,parameter,password,plan,position,primary,privileges,' +
    'procedure,protected,read,retain,returns,revoke,right,rollback,schema,' +
    'select,set,shadow,shared,snapshot,some,suspend,table,then,to,' +
    'transaction,trigger,uncommitted,union,unique,update,user,using,values,' +
    'view,wait,when,where,while,with,work';
  SQLCommentLine1 = '--';
  SQLCommentBlock1 = '/*,*/';
  SQLStringQuotes = '"';
  SQLHexSequence = '0x';
  {$IFNDEF FPC}
  WordChars = ['a'..'z', 'A'..'Z', '<27>'..'<27>', '<27>'..'<27>', '0'..'9', '_'];
  {$ELSE}
  WordChars = ['a'..'z', 'A'..'Z', '0'..'9', '_'];
  {$ENDIF}

  {$IFDEF NONWINFPC}
  LineBreak: String = #$A;
  {$ELSE}
  LineBreak: String = #$D#$A;
  {$ENDIF}
  DefGutterWidth: Integer = 30;
  ReservedStylesCount = Byte(High(TCharAttr));

{$IFDEF Delphi12}
function IsUnicodeChar(Chr: Char): Boolean;
begin
  Result := ((Chr >= Char($007F)) and (Chr <= Char($FFFF)));
end;
{$ENDIF}




procedure FilterCodeStringList(aFilterStr: String; aLBList: TStrings; aCodeList: TStrings; aDiffFunc: TDiffFunc);
var
  i: Integer;
  Item: TfrxCompletionItem;

  function BuildName(Item: TfrxCompletionItem): String;
  begin
    Result := Item.FName;
    if (Item.FItemType in [itProcedure, itFunction]) and (Item.FParams <> '') then
      Result := Result + '(' + Item.FParams +')'
    else if Item.FItemType = itIndex then
      Result := Result + '[' + Item.FParams +']';
    if (Item.FType <> '') and (Item.FItemType <> itType) then
      Result := Result + ':' + Item.FType;
  end;

begin
  for i := 0 to aCodeList.Count - 1 do
  begin
    Item := TfrxCompletionItem(aCodeList.Objects[i]);
    if (aFilterStr = '') or (aDiffFunc(UpperCase(aFilterStr), UpperCase(aCodeList[i])) = 1) then
      aLBList.AddObject(BuildName(Item), Item);
  end;
end;

procedure FilterCodeListBox(aFilterStr: String; aListBox: TListBox; aCodeList: TStrings; aDiffFunc: TDiffFunc);
begin
  aListBox.ItemIndex := -1;
  aListBox.Items.BeginUpdate;
  aListBox.Items.Clear;

  FilterCodeStringList(aFilterStr, aListBox.Items, aCodeList, aDiffFunc);

  if (aListBox.Count > 0) then
    aListBox.ItemIndex := 0;
  aListBox.Items.EndUpdate;
end;

function Diff(s1, s2: String): Integer;
begin
  if (s1 = s2) then
    Result := 1
  else
    Result := 0;
end;

function frxSynPos(s1, s2: String): Integer;
begin
  Result := Pos(s1, s2);
end;

{$IFDEF FPC}
{ TBrkStringList }

function TBrkStringList.AddObject(const S: string; AObject: TObject): Integer;
begin
  If Not (SortStyle=sslAuto) then
    Result:= Count
  else
    If Find (S,Result) then
      Case DUplicates of
        DupIgnore : Exit;
        DupError : Error(SDuplicateString,0)
      end;
   InsertItem (Result,S, AObject);
end;
{$ENDIF}


{ TfrxSyntaxMemo }

constructor TfrxSyntaxMemo.Create(AOwner: TComponent);
var
  i: Integer;
begin
  inherited;
{$IFDEF JPN}
  FMultiByteLang := True;
{$ENDIF}
  FSynDialectStyles := TfrxSynDialectStyles.Create;
//  FAttributeStyles := TfrxAttributeStyles.Create;
{$IFNDEF FPC}
  FTmpCanvas := TBitmap.Create;
{$ENDIF}
  {$IFDEF NONWINFPC}
  FCaretCreated := False;
  {$ENDIF}
  DoubleBuffered := True;
  TabStop := True;
  Cursor := crIBeam;
  Color := clWindow;

  FBreakPoints := {$IFDEF FPC}TBrkStringList.Create{$ELSE}TStringList.Create{$ENDIF};

  FBlockColor := clHighlight;
  FBlockFontColor := clHighlightText;

  FCommentAttr := TFont.Create;
  FCommentAttr.Color := clNavy;
  FCommentAttr.Style := [fsItalic];

  FKeywordAttr := TFont.Create;
  FKeywordAttr.Color := clWindowText;
  FKeywordAttr.Style := [fsBold];

  FNumberAttr := TFont.Create;
  FNumberAttr.Color := clGreen;
  FNumberAttr.Style := [];

  FStringAttr := TFont.Create;
  FStringAttr.Color := clNavy;
  FStringAttr.Style := [];

  FTextAttr := TFont.Create;
  FTextAttr.Color := clWindowText;
  FTextAttr.Style := [];

  Font.Size := 10;
  Font.Name := 'Courier New';

  FText := TStringList.Create;
  FParser := TfsParser.Create;
  FParser.SkipSpace := False;
  FParser.UseY := False;
  //FSynStrings := TStringList.Create;
  FSynAttributes := TfrxSynAttributes.Create(FParser, FSynDialectStyles);
  FUndo := TStringList.Create;
  FText.Add('');
  FText.OnChange := LinesChange;
  FMaxLength := 1024;
  FMoved := True;
  SetPos(1, 1);
  FTabStops := 2;
  ShowGutter := True;
  OnMouseWheelUp := MouseWheelUp;
  OnMouseWheelDown := MouseWheelDown;

  FActiveLine := -1;
  for i := 0 to 9 do
    FBookmarks[i] := -1;
  FScriptRTTIXML := TfsXMLDocument.Create;
  FRttiCompletionList := TfrxCompletionList.Create;
  FScriptCompletionList := TfrxCompletionList.Create;
  FAddonCompletionList := TfrxCompletionList.Create;
  FClassCompletionList := TfrxCompletionList.Create;
  FTimer := TTimer.Create(nil);
  FTimer.Interval := 1000;
  FTimer.OnTimer := DoTimer;
  FTimer.Enabled := False;
  FCodeCompList := TStringList.Create;
  FCodeCompletionThread := TfrxCodeCompletionThread.Create(True);
  FCodeCompletionThread.FText := FText;
  FCodeCompletionThread.FCompletionList := FScriptCompletionList;
  FShowLineNumber := True;
  FCodeComplitionFilter := [itVar, itProcedure, itFunction, itProperty, itIndex,
    itConstant, itConstructor, itType, itEvent];
  FShowInCodeComplition := [cltRtti, cltScript, cltAddon];
  FCodeCompletionHeight := 100;
  FCodeCompletionWidth := 300;
  FCodeCompletionMinHeight := 100;
  FCodeCompletionMinWidth := 300;
  PopupMenu := TPopupMenu.Create(Self);
  PopupMenu.Items.Clear;
  PopupMenu.Items.Add(NewItem(frxGet(2407), 0, False, True, PopCut      , 0, 'MenuItem1'));
  PopupMenu.Items.Add(NewItem(frxGet(2408), 0, False, True, PopCopy     , 0, 'MenuItem2'));
  PopupMenu.Items.Add(NewItem(frxGet(2409), 0, False, True, PopPaste    , 0, 'MenuItem3'));
  PopupMenu.Items.Add(NewItem(frxGet(2412), 0, False, True, PopDelete   , 0, 'MenuItem4'));
  PopupMenu.Items.Add(NewItem(frxGet(2414), 0, False, True, PopSelectAll, 0, 'MenuItem5'));
  PopupMenu.Images := frxResources.MainButtonImages;
  PopupMenu.Items[0].ImageIndex := 5;
  PopupMenu.Items[1].ImageIndex := 6;
  PopupMenu.Items[2].ImageIndex := 7;
  PopupMenu.Items[3].ImageIndex := 51;
  EnableHint := True;
end;

destructor TfrxSyntaxMemo.Destroy;
begin
{$IFNDEF FPC}
  FTmpCanvas.Free;
{$ENDIF}
  ClearBreakPoints;
  FreeAndNil(FTimer);
  {$IFDEF LCLGTK2}
  if Assigned(FCodeCompletionThread) then
  begin
    FCodeCompletionThread.Terminate;
    FCodeCompletionThread.Resume;
  end;
  {$ELSE}
  if Assigned(FCodeCompletionThread) then
    FCodeCompletionThread.Terminate;
  {$ENDIF}
  FreeAndNil(FCodeCompletionThread);
  FreeAndNil(FBreakPoints);
  FreeAndNil(FCommentAttr);
  FreeAndNil(FKeywordAttr);
  FreeAndNil(FNumberAttr);
  FreeAndNil(FStringAttr);
  FreeAndNil(FTextAttr);
  FreeAndNil(FText);
  FreeAndNil(FUndo);
  FreeAndNil(FSynAttributes);
  FreeAndNil(FSynDialectStyles);
  FreeAndNil(FParser);
  FreeAndNil(FScriptRTTIXML);
  FreeAndNil(FRttiCompletionList);
  FreeAndNil(FScriptCompletionList);
  FreeAndNil(FAddonCompletionList);
  FreeAndNil(FClassCompletionList);
  FreeAndNil(FCodeCompList);
  inherited;
end;


procedure TfrxSyntaxMemo.WMFRXFillCodeCompletion(var Message: TMessage);
begin
  if Assigned(FCodeCompletionThread) then
    FCodeCompletionThread.FillCodeCompletion;
end;

procedure TfrxSyntaxMemo.SetEnableHint(vEnableHint: boolean);
begin
  FEnableHint := vEnableHint;
  if (vEnableHint) then
    FfrxHintShowEvent := RealHintShow
  else
    FfrxHintShowEvent := FakeHintShow;
end;

procedure TfrxSyntaxMemo.FakeHintShow(var Msg: TCMHintShow);
begin
  //do nothing
end;

procedure TfrxSyntaxMemo.RealHintShow(var Msg: TCMHintShow);
var
  PropName, PropText: String;
  BufP: TPoint;
  Header, Prefix: String;
begin
  BufP := Msg.HintInfo.CursorPos;
  BufP := CurPosToSynPos(BufP.X, BufP.Y);
  GetCurWord(BufP, Prefix, Header, PropText);

  PropName := 'prop' + PropText;
  PropText := frxResources.Get(PropName);
  { TODO: Make parameters description }
  if (PropName = PropText) then
    PropText := frxResources.Get('dtNoData');

  if (Header <> '') then
  begin
    Msg.HintInfo.HintStr := PropText;
    Msg.HintInfo.HintWindowClass := TBaseHintWindow;
    Msg.HintInfo.HintData := TBaseHintData.Create(Prefix + ' ', Header + ';', True);
    Msg.HintInfo.HideTimeout := MaxInt;
  end
  else
    Msg.HintInfo.HintStr := '';
end;

procedure TfrxSyntaxMemo.WMFRXHintShow(var Msg: TCMHintShow);
begin
  inherited;
  FfrxHintShowEvent(Msg);
end;

function TfrxSyntaxMemo.OffsPoint(Point: TPoint): TPoint;
var
  i: Integer;
  s: String;

  function IsWord(c: Char): Boolean;
  begin
  {$IFDEF Delphi12}
    Result := CharInSet(c, ['a'..'z', 'A'..'Z', '0'..'9']);
  {$ELSE}
    Result := c in ['a'..'z', 'A'..'Z', '0'..'9'];
  {$ENDIF}
  end;

begin
  s := LineAt(Point.Y - 1, False);
  if Point.X > Length(s)  then
    Point.X := Length(s) + 1
  else
    if IsWord(s[Point.X]) then
      for i := Point.X to Length(s) do
      begin
        if IsWord(s[i]) then
          Point.X := Point.X + 1
        else
          break;
      end;
  Result := Point;
end;

procedure TfrxSyntaxMemo.GetCurWord(Point: TPoint; var Prefix: String;
  var Header: String; var TextHint: String);
var
  s: String;
  FCodeHintList: TStringList;
  FCompletionHintLB: TStringList;
  FHintFilter: String;
begin
  Point := OffsPoint(Point);

  FCodeHintList := TStringList.Create;
  FCompletionHintLB := TStringList.Create;
  FScriptCompletionList.Locked := True;

  try
    s := Trim(GetCompletionString(Point));
    FHintFilter := GetFilter(s);
    TextHint := FHintFilter;
    if FHintFilter = s then s := '';

    FAddonCompletionList.DestroyItems;
    if Assigned(FOnCodeCompletion) and (cltAddon in FShowInCodeComplition) then
      FOnCodeCompletion(s, FAddonCompletionList);
    BuildCClist(s, FCodeHintList, True);
    FilterCodeStringList(FHintFilter, FCompletionHintLB, FCodeHintList, @Diff);

    if FCompletionHintLB.Count > 0 then
    begin
      Header := FCompletionHintLB[0];
      ItemToPrefix(TfrxCompletionItem(FCompletionHintLB.Objects[0]), Prefix);
    end;

  finally
    FCodeHintList.Free;
    FCompletionHintLB.Free;
    FScriptCompletionList.Locked := False;
  end;
end;

function TfrxSyntaxMemo.CurPosToSynPos(X, Y: Integer): TPoint;
begin
  Result.X := (X - FGutterWidth) div FCharWidth + 1 + FOffset.X;
  Result.Y := Y div FCharHeight + 1 + FOffset.Y;
end;

procedure TfrxSyntaxMemo.WMFRXSyncScript(var Message: TMessage);
begin
  if Assigned(FCodeCompletionThread) then
    FCodeCompletionThread.SyncScript;
end;

procedure TfrxSyntaxMemo.WMFRXUpdateCode(var Message: TMessage);
begin
  if Assigned(FCodeCompletionThread) then
    FCodeCompletionThread.UpdateCode;
end;

{$IFNDEF FPC}
{ updating IME string and carret pos }
procedure TfrxSyntaxMemo.WMIMECOMPOSITION(var Message: TMessage);

  procedure UpdateComposition(aFlag: DWORD);
  var
    h: HIMC;
    nLen, nPos: Integer;
    StrBuf: String;
  begin
    h := Imm32GetContext(Handle);
    if h <> 0 then
    begin
      if aFlag = GCS_COMPSTR then
        nPos := Imm32GetCompositionString(h, GCS_CURSORPOS, nil, 0)
      else
        nPos := 0;
      nLen := Imm32GetCompositionString(h, aFlag, nil, 0);
      if nLen <> 0 then
      begin
        SetLength(StrBuf, nLen div 2);
        Imm32GetCompositionString(h, aFlag, @StrBuf[1], nLen);
        if (nLen div 2) > FCompSelEnd.X - FCompSelStart.X then
          FCompSelEnd.X := FCompSelStart.X + (nLen div 2) - 1;
        FSelStart.Y := FCompSelStart.Y;
        FSelStart.X := FCompSelStart.X;
        FSelEnd.Y := FCompSelEnd.Y;
        FSelEnd.X := FCompSelEnd.X;
        SelText := StrBuf;
        FPos.X := FCompSelStart.X + nPos + (nLen div 2);
        SetPos(FPos.X, FPos.Y);
        FCompSelEnd.X := FCompSelStart.X + (nLen div 2);
        Invalidate;
      end;
      Imm32ReleaseContext(Handle, h);
    end;
  end;

begin
  if (Message.LParam = $1E00) and (Message.WParam <> 12288) and (Message.WParam <> 32) then
    ResetImeComposition(CPS_CANCEL)
  else
  if (Message.LParam and GCS_RESULTSTR) = GCS_RESULTSTR  then
  begin
    UpdateComposition(GCS_RESULTSTR);
    FCompSelStart := FCompSelEnd;
  end
  else
  begin
    UpdateComposition(GCS_COMPSTR);
    Inherited;
  end;
end;

procedure TfrxSyntaxMemo.WMIMEEndComp(var Message: TMessage);
begin
  FInImeComposition := False;
end;

procedure TfrxSyntaxMemo.WMIMEStartComp(var Message: TMessage);
begin
  FCompSelStart.Y := FPos.Y;
  FCompSelStart.X := FPos.X;
  FCompSelEnd.Y := FPos.Y;
  FCompSelEnd.X := FPos.X;
  FInImeComposition := True;
end;
{$ENDIF}

procedure TfrxSyntaxMemo.WMKillFocus(var Msg: TWMKillFocus);
begin
  inherited;
  if Assigned(FCompletionForm) then Exit;
  {$IFDEF NONWINFPC}
  if not FCaretCreated then
    exit
  else
    FCaretCreated := False;
  {$ENDIF}
  HideCaret(Handle);
  DestroyCaret{$IFDEF FPC}(Handle){$ENDIF};
end;

procedure TfrxSyntaxMemo.WMSetFocus(var Msg: TWMSetFocus);
begin
  inherited;
  {$IFDEF NONWINFPC}
  if not HandleAllocated then
    exit
  else
    FCaretCreated := True;
  {$ENDIF}
  CreateCaret(Handle, 0, 2, FCharHeight);
  ShowCaretPos;
end;

procedure TfrxSyntaxMemo.ShowCaretPos;
{$IFNDEF FPC}
var
  cWidth: Integer;
  LineLen: Integer;
{$ENDIF}
begin
  if FPos.X > FOffset.X then
  begin
{$IFNDEF FPC}
  if FMultiByteLang then
  begin
    cWidth  := GetCharWidth(Copy(LineAt(FPos.Y - 1), FOffset.X, FPos.X - 1  - FOffset.X));
    LineLen := LineLength(FPos.Y - 1);
    if LineLen < FPos.X then
      cWidth := cWidth + FCharWidth * (FPos.X - 1 - LineLen);
  end
  else
    cWidth := FCharWidth * (FPos.X - 1 - FOffset.X);

    SetCaretPos(cWidth + FGutterWidth,
      FCharHeight * (FPos.Y - 1 - FOffset.Y));
{$ELSE}
    SetCaretPos(FCharWidth * (FPos.X - 1 - FOffset.X) + FGutterWidth,
      FCharHeight * (FPos.Y - 1 - FOffset.Y));
{$ENDIF}
    {$IFDEF NONWINFPC}
    if FCaretCreated then
      Update;
    {$ELSE}
    ShowCaret(Handle);
    {$ENDIF}
  end
  else
    SetCaretPos(-100, -100);
  if Assigned(FOnChangePos) then
    FOnChangePos(Self);
end;

procedure TfrxSyntaxMemo.CMFontChanged(var Message: TMessage);
var
  b: TBitmap;
begin
  FCommentAttr.PixelsPerInch := Font.PixelsPerInch;
  FCommentAttr.Size := Font.Size;
  FCommentAttr.Name := Font.Name;
  FKeywordAttr.PixelsPerInch := Font.PixelsPerInch;
  FKeywordAttr.Size := Font.Size;
  FKeywordAttr.Name := Font.Name;
  FNumberAttr.PixelsPerInch := Font.PixelsPerInch;
  FNumberAttr.Size := Font.Size;
  FNumberAttr.Name := Font.Name;
  FStringAttr.PixelsPerInch := Font.PixelsPerInch;
  FStringAttr.Size := Font.Size;
  FStringAttr.Name := Font.Name;
  FTextAttr.PixelsPerInch := Font.PixelsPerInch;
  FTextAttr.Size := Font.Size;
  FTextAttr.Name := Font.Name;

  b := TBitmap.Create;
  with b.Canvas do
  begin
    Font.PixelsPerInch := Self.Font.PixelsPerInch;
    Font.Assign(Self.Font);
    Font.Style := [fsBold];
    FCharHeight := TextHeight('Wg') + 1;
    FCharWidth := TextWidth('W');
    FIsMonoType := Pos('COURIER NEW', AnsiUppercase(Self.Font.Name)) <> 0;
  end;
  b.Free;
end;

procedure TfrxSyntaxMemo.Resize;
begin
  inherited;
  if FCharWidth = 0 then Exit;
  FWindowSize := Point((ClientWidth - FGutterWidth) div FCharWidth,
    ClientHeight div FCharHeight);
  {$IFDEF FPC}
  if (ClientHeight > 0) and (ClientWidth > 0) then
  begin
    HorzPage := FWindowSize.X;
    VertPage := FWindowSize.Y;
    UpdateScrollBar;
  end;
  {$ELSE}
  HorzPage := FWindowSize.X;
  VertPage := FWindowSize.Y;
  UpdateScrollBar;
  {$ENDIF}
end;

procedure TfrxSyntaxMemo.UpdateScrollBar;
begin
  VertRange := FText.Count;
  HorzRange := FMaxLength;
  LargeChange := FWindowSize.Y;
  VertPosition := FOffset.Y;
  HorzPosition := FOffset.X;
end;

function TfrxSyntaxMemo.GetText: TStrings;
//var
//  i: Integer;
begin
//  FAllowLinesChange := False;
//  for i := 0 to FText.Count - 1 do
//    FText[i] := LineAt(i);
  Result := FText;
  FAllowLinesChange := True;
end;

function TfrxSyntaxMemo.GetPlainPos: Integer;
begin
  Result := GetPlainTextPos(FPos);
end;

function TfrxSyntaxMemo.GetPos: TPoint;
begin
  Result := FPos;
end;

procedure TfrxSyntaxMemo.SetText(Value: TStrings);
begin
  FAllowLinesChange := True;
  FText.Assign(Value);
  DoChange;
end;

procedure TfrxSyntaxMemo.SetSyntax(const Value: String);
var
  sl: TStringList;

  procedure GetGrammar;
  var
    Grammar: TfrxXMLDocument;
    ss: TStringStream;
    ParserRoot, xi: TfrxXMLItem;
    i: Integer;
    Name, PropText: String;
  begin
    Grammar := TfrxXMLDocument.Create;
    ss := TStringStream.Create(fsGetLanguage(Value){$IFDEF Delphi12}, TEncoding.UTF8{$ENDIF});
    Grammar.LoadFromStream(ss);
    ss.Free;

    ParserRoot := Grammar.Root.FindItem('parser');
    xi := ParserRoot.FindItem('keywords');
    for i := 0 to xi.Count - 1 do
      FParser.Keywords.Add(xi[i].Name);

    for i := 0 to ParserRoot.Count - 1 do
    begin
      Name := LowerCase(ParserRoot[i].Name);
      PropText := ParserRoot[i].Prop['text'];
      if Name = 'identchars' then
        FParser.ConstructCharset(PropText)
      else if Name = 'commentline1' then
        FParser.CommentLine1 := PropText
      else if Name = 'commentline2' then
        FParser.CommentLine2 := PropText
      else if Name = 'commentblock1' then
        FParser.CommentBlock1 := PropText
      else if Name = 'commentblock2' then
        FParser.CommentBlock2 := PropText
      else if Name = 'stringquotes' then
        FParser.StringQuotes := PropText
      else if Name = 'hexsequence' then
        FParser.HexSequence := PropText
    end;

    Grammar.Free;
  end;

begin
  FSyntax := Value;
  FParser.Keywords.Clear;
  sl := TStringList.Create;
  if AnsiCompareText(Value, 'SQL') = 0 then
    FSynAttributes.UpdateSyntaxDialect
  else
  begin
    fsGetLanguageList(sl);
    if sl.IndexOf(Value) <> -1 then
      GetGrammar;
  end;

  ClearSyntax(1);
  sl.Free;
end;

procedure TfrxSyntaxMemo.SetCodeCompletionHeight(const Value: Integer);
begin
  FCodeCompletionHeight := Value;
  CompletionClose;
end;

procedure TfrxSyntaxMemo.SetCodeCompletionMinHeight(const Value: Integer);
begin
  FCodeCompletionMinHeight := Value;
  CompletionClose;
end;

procedure TfrxSyntaxMemo.SetCodeCompletionMinWidth(const Value: Integer);
begin
  FCodeCompletionMinWidth := Value;
  CompletionClose;
end;

procedure TfrxSyntaxMemo.PopCopy(Sender: TObject);
begin
  Self.CopyToClipboard;
end;

procedure TfrxSyntaxMemo.PopCut(Sender: TObject);
begin
  Self.CutToClipboard;
end;

procedure TfrxSyntaxMemo.PopPaste(Sender: TObject);
begin
  Self.PasteFromClipboard;
end;

procedure TfrxSyntaxMemo.PopDelete(Sender: TObject);
var
  buf: Word;
begin
  buf := vk_Delete;
  Self.KeyDown(buf, []);
end;

procedure TfrxSyntaxMemo.PopSelectAll(Sender: TObject);
begin
  Self.SelectAll;
end;

procedure TfrxSyntaxMemo.SetCodeCompletionWidth(const Value: Integer);
begin
  FCodeCompletionWidth := Value;
  CompletionClose;
end;

procedure TfrxSyntaxMemo.SetCommentAttr(Value: TFont);
begin
  FCommentAttr.Assign(Value);
{$IFDEF FPC}
      frxUpdateControl(Self);
{$ELSE}
      Repaint;
{$ENDIF}
end;

procedure TfrxSyntaxMemo.SetGutterWidth(const Value: Integer);
begin
  if FGutterWidth <> Value  then
  begin
    FGutterWidth := Value;
    Invalidate;
  end;
end;

procedure TfrxSyntaxMemo.SetKeywordAttr(Value: TFont);
begin
  FKeywordAttr.Assign(Value);
{$IFDEF FPC}
      frxUpdateControl(Self);
{$ELSE}
      Repaint;
{$ENDIF}
end;

procedure TfrxSyntaxMemo.SetNumberAttr(const Value: TFont);
begin
  FNumberAttr.Assign(Value);
{$IFDEF FPC}
      frxUpdateControl(Self);
{$ELSE}
      Repaint;
{$ENDIF}
end;

procedure TfrxSyntaxMemo.SetStringAttr(Value: TFont);
begin
  FStringAttr.Assign(Value);
{$IFDEF FPC}
      frxUpdateControl(Self);
{$ELSE}
      Repaint;
{$ENDIF}
end;

procedure TfrxSyntaxMemo.SetTextAttr(Value: TFont);
begin
  FTextAttr.Assign(Value);
{$IFDEF FPC}
      frxUpdateControl(Self);
{$ELSE}
      Repaint;
{$ENDIF}
end;

procedure TfrxSyntaxMemo.SetActiveLine(Line: Integer);
begin
  FActiveLine := Line;
{$IFDEF FPC}
      frxUpdateControl(Self);
{$ELSE}
      Repaint;
{$ENDIF}
end;

procedure TfrxSyntaxMemo.DoChange;
begin
  FModified := True;
  FTimer.Enabled := (FCompletionForm = nil) and
    (cltScript in FShowInCodeComplition) and Assigned(FScript);
  if Assigned(FOnChangeText) then
    FOnChangeText(Self);
end;

procedure TfrxSyntaxMemo.LinesChange(Sender: TObject);
begin
  if FAllowLinesChange then
  begin
    FAllowLinesChange := False;
    if FText.Count = 0 then
      FText.Add('');
    ClearSyntax(1);
    FMoved := True;
    FUndo.Clear;
    FPos := Point(1, 1);
    FOffset := Point(0, 0);
    ClearSel;
    ShowCaretPos;
    UpdateScrollBar;
  end;
end;

procedure TfrxSyntaxMemo.ShowMessage(const s: String);
begin
  FMessage := s;
{$IFDEF FPC}
      frxUpdateControl(Self);
{$ELSE}
      Repaint;
{$ENDIF}
end;

procedure TfrxSyntaxMemo.CopyToClipboard;
begin
  if FSelStart.X <> 0 then
    Clipboard.AsText := SelText;
end;

procedure TfrxSyntaxMemo.CutToClipboard;
begin
  if FSelStart.X <> 0 then
  begin
    Clipboard.AsText := SelText;
    SelText := '';
  end;
  CorrectBookmark(FSelStart.Y, FSelStart.Y - FSelEnd.Y);
{$IFDEF FPC}
      frxUpdateControl(Self);
{$ELSE}
      Repaint;
{$ENDIF}
end;

procedure TfrxSyntaxMemo.PasteFromClipboard;
begin
  SelText := Clipboard.AsText;
end;

procedure TfrxSyntaxMemo.SelectAll;
begin
  SetPos(0, 0);
  FSelStart := FPos;
  SetPos(LineLength(FText.Count - 1) + 1, FText.Count);
  FSelEnd := FPos;
{$IFDEF FPC}
      frxUpdateControl(Self, True);
{$ELSE}
      Repaint;
{$ENDIF}
end;

function TfrxSyntaxMemo.LineAt(Index: Integer; UseTrim: Boolean = True): String;
begin
  if Index < FText.Count then
  begin
    if UseTrim then
      Result := TrimRight(FText[Index])
    else
      Result := FText[Index];
  end
  else
    Result := '';
end;

function TfrxSyntaxMemo.LineLength(Index: Integer): Integer;
begin
  Result := frxLength(LineAt(Index));
end;

function TfrxSyntaxMemo.Pad(n: Integer): String;
begin
  Result := '';
  SetLength(Result, n);
{$IFDEF Delphi12}
  Result := StringOfChar(Char(' '), n);
{$ELSE}
  FillChar(Result[1], n, ' ');
{$ENDIF}
end;

procedure TfrxSyntaxMemo.AddUndo;
begin
  if not FMoved then exit;
  FUndo.Add(Format('%5d%5d', [FPos.X, FPos.Y]) + FText.Text);
  if FUndo.Count > 32 then
    FUndo.Delete(0);
  FMoved := False;
end;

procedure GenerateClassList(Prog: TfsScript; cl: TClass; aList: TfrxCompletionList);
var
  i, j, k: Integer;
  v: TfsCustomVariable;
  c: TfsClassVariable;
  clItem: TfsCustomHelper;
  Params: String;
  Item: TfrxCompletionItem;
begin
  aList.DestroyItems;
  for i := 0 to Prog.Count - 1 do
  begin
    v := Prog.Items[i];
    if v is TfsClassVariable then
    begin
      c := TfsClassVariable(v);
      if cl.InheritsFrom(c.ClassRef) then
      begin
        for j := 0 to c.MembersCount - 1 do
        begin
          clItem := c.Members[j];
          if clItem is TfsPropertyHelper then
          begin
            Item := aList.AddVariable(clItem.Name, clItem.GetFullTypeName);
            Item.FItemType := itProperty;
          end
          else if clItem is TfsMethodHelper then
          begin
            Params := '';

            for k := 0 to clItem.Count - 1 do
            begin
              if k > 0 then
                Params := Params + ';';
              Params := Params + clItem.Params[k].Name + ': ' + clItem.Params[k].TypeName;
            end;
            Item := aList.AddFunction(clItem.Name, clItem.GetFullTypeName, Params);
            if TfsMethodHelper(clItem).IndexMethod then
              Item.FItemType := itIndex;
          end
          else
          begin
            Item := aList.AddVariable(clItem.Name, clItem.GetFullTypeName);
            Item.FItemType := itEvent;
          end;
        end;
      end;
    end;
  end;
end;

procedure TfrxSyntaxMemo.BuildCClist(const sName: String; aCodeCompList: TStringList; AllFunc: Boolean = False);
var
  members: TStringList;
  i: Integer;
  Item: TfrxCompletionItem;
  clName: String;
  clVar: TfsClassVariable;
  clMethod: TfsCustomHelper;

  procedure FillMembers(const Text: String; Comma: Char = ';');
  var
    i, ipos: Integer;
    Len: Integer;
  begin
    members.Clear;
    ipos := -1;
    Len := Length(Text);
    for i := Len downto 1 do
    begin
      if (Text[i] = Comma) then
      begin
        if ipos <> -1 then
          members.Insert(0, Copy(Text, i + 1, (iPos - 1 - i)));
        ipos := i;
      end
      else if (i = 1) then
      begin
        members.Insert(0, Copy(Text, i, (iPos - i)));
      end;

    end;
  end;
begin
  members := TStringList.Create;
  members.Duplicates := dupAccept;
  FillMembers(sName, '.');
  FClassCompletionList.DestroyItems;
  if members.Count = 0 then
  begin
    for i := 0 to FAddonCompletionList.Count - 1 do
      aCodeCompList.AddObject(FAddonCompletionList[i].FName, FAddonCompletionList[i]);
    for i := 0 to FScriptCompletionList.Count - 1 do
      if AllFunc or (FPos.Y >= FScriptCompletionList[i].FStartVisible) and ((FPos.Y <= FScriptCompletionList[i].FEndVisible) or (FScriptCompletionList[i].FEndVisible = -1)) then
        aCodeCompList.AddObject(FScriptCompletionList[i].FName, FScriptCompletionList[i]);
    for i := 0 to FRttiCompletionList.Count - 1 do
      aCodeCompList.AddObject(FRttiCompletionList[i].FName, FRttiCompletionList[i]);
  end;

  if Members.Count > 0 then
  begin
    Item := FAddonCompletionList.Find(Members[0]);
    if Item = nil then
      Item := FScriptCompletionList.Find(Members[0]);
    if Item = nil then
      Item := FRttiCompletionList.Find(Members[0]);

    if (Item <> nil) and (Item.FStartVisible < FPos.Y) and ((Item.FEndVisible > FPos.Y) or (Item.FEndVisible < 0)) then
    begin
      clName := Item.FType;
      i := 1;
      while (clName <> '') and (i < Members.Count) do
      begin
        clVar := FScript.FindClass(clName);
        clName := '';
        if clVar <> nil then
        begin
          clMethod := clVar.Find(Members[i]);
          if clMethod <> nil then
            clName := clMethod.TypeName;
          Inc(i);
        end;
      end;

      if clName <> '' then
      begin
        clVar := FScript.FindClass(clName);
        if clVar <> nil then
          GenerateClassList(FScript, FScript.FindClass(clName).ClassRef,
            FClassCompletionList);
      end;
    end;
  end;
  for i := 0 to FClassCompletionList.Count - 1 do
    aCodeCompList.AddObject(FClassCompletionList[i].FName,
      FClassCompletionList[i]);
  FreeAndNil(Members);
end;

procedure TfrxSyntaxMemo.Undo;
var
  s: String;
begin
  FMoved := True;
  if FUndo.Count = 0 then exit;
  s := FUndo[FUndo.Count - 1];
  FPos.X := StrToInt(Copy(s, 1, 5));
  FPos.Y := StrToInt(Copy(s, 6, 5));
  FAllowLinesChange := False;
  FText.Text := Copy(s, 11, Length(s) - 10);
  FAllowLinesChange := True;
  FUndo.Delete(FUndo.Count - 1);
  SetPos(FPos.X, FPos.Y);
  ClearSyntax(1);
  DoChange;
end;

function TfrxSyntaxMemo.GetPlainTextPos(Pos: TPoint): Integer;
var
  i: Integer;
begin
  Result := 0;
  for i := 0 to Pos.Y - 2 do
    Result := Result + frxLength(FText[i]) + {$IFDEF FPC}Length(LineBreak){$ELSE}2{$ENDIF};
  Result := Result + Pos.X;
end;

function TfrxSyntaxMemo.GetPosPlainText(Pos: Integer): TPoint;
var
  i: Integer;
  s: String;
begin
  Result := Point(0, 1);
  s := FText.Text;
  i := 1;
  while i <= Pos do
    if frxGetSymbol(s, i) = LineBreak[1] then
    begin
      Inc(i, length(LineBreak));
      if i <= Pos then
      begin
        Inc(Result.Y);
        Result.X := 0;
      end
      else
        Inc(Result.X);
    end
    else
    begin
      Inc(i);
      Inc(Result.X);
    end;
end;

function TfrxSyntaxMemo.GetLineBegin(Index: Integer): Integer;
var
  s: String;
begin
  s := FText[Index];
  Result := 1;
  if Trim(s) <> '' then
    for Result := 1 to Length(s) do
      if s[Result] <> ' ' then
        break;
end;

procedure TfrxSyntaxMemo.TabIndent;
begin
  SelText := Pad(FTabStops - ((FPos.X - 1) mod FTabStops));
end;

procedure TfrxSyntaxMemo.EnterIndent;
var
  res: Integer;
begin
  if Trim(FText[FPos.Y - 1]) = '' then
    res := FPos.X else
    res := GetLineBegin(FPos.Y - 1);

  if FPos.X = 1 then
    CorrectBookmark(FPos.Y - 1, 1) else
    CorrectBookmark(FPos.Y, 1);

  FPos := Point(1, FPos.Y + 1);
  SelText := Pad(res - 1);
end;

procedure TfrxSyntaxMemo.UnIndent;
var
  i, res: Integer;
begin
  i := FPos.Y - 2;
  res := FPos.X - 1;
  CorrectBookmark(FPos.Y, -1);
  while i >= 0 do
  begin
    res := GetLineBegin(i);
    if (res < FPos.X) and (Trim(FText[i]) <> '') then
      break else
      Dec(i);
  end;
  FSelStart := FPos;
  FSelEnd := FPos;
  Dec(FSelEnd.X, FPos.X - res);
  SelText := '';
end;

procedure TfrxSyntaxMemo.ShiftSelected(ShiftRight: Boolean);
var
  i, ib, ie: Integer;
  s: String;
  Shift: Integer;
begin
  AddUndo;
  if FSelStart.X + FSelStart.Y * FMaxLength < FSelEnd.X + FSelEnd.Y * FMaxLength then
  begin
    ib := FSelStart.Y - 1;
    ie := FSelEnd.Y - 1;
  end
  else
  begin
    ib := FSelEnd.Y - 1;
    ie := FSelStart.Y - 1;
  end;
  if FSelEnd.X = 1 then
    Dec(ie);

  Shift := 2;
  if not ShiftRight then
    for i := ib to ie do
    begin
      s := FText[i];
      if (Trim(s) <> '') and (GetLineBegin(i) - 1 < Shift) then
        Shift := GetLineBegin(i) - 1;
    end;

  for i := ib to ie do
  begin
    s := FText[i];
    if ShiftRight then
      s := Pad(Shift) + s
    else if Trim(s) <> '' then
      frxDelete(s, 1, Shift);
    FText[i] := s;
  end;

  ClearSyntax(FSelStart.Y);
  DoChange;
end;

function TfrxSyntaxMemo.GetSelText: String;
var
  p1, p2: TPoint;
  i: Integer;
begin
  if FSelStart.X = 0 then
  begin
    Result := '';
    Exit;
  end;

  if FSelStart.X + FSelStart.Y * FMaxLength < FSelEnd.X + FSelEnd.Y * FMaxLength then
  begin
    p1 := FSelStart;
    p2 := FSelEnd;
    Dec(p2.X);
  end
  else
  begin
    p1 := FSelEnd;
    p2 := FSelStart;
    Dec(p2.X);
  end;

  if LineLength(p1.Y - 1) < p1.X then
  begin
    Inc(p1.Y);
    p1.X := 1;
  end;
  if LineLength(p2.Y - 1) < p2.X then
    p2.X := LineLength(p2.Y - 1);

  i := GetPlainTextPos(p1);
  Result := frxCopy(FText.Text, i, GetPlainTextPos(p2) - i + 1);
end;

procedure TfrxSyntaxMemo.SetSelText(const Value: String);
var
  p1, p2, p3: TPoint;
  i, k: Integer;
  s: String;
begin
  AddUndo;
  if FSelStart.X = 0 then
  begin
    p1 := FPos;
    p2 := p1;
    Dec(p2.X);
  end
  else if FSelStart.X + FSelStart.Y * FMaxLength < FSelEnd.X + FSelEnd.Y * FMaxLength then
  begin
    p1 := FSelStart;
    p2 := FSelEnd;
    Dec(p2.X);
  end
  else
  begin
    p1 := FSelEnd;
    p2 := FSelStart;
    Dec(p2.X);
  end;
  FAllowLinesChange := False;
  if LineLength(p1.Y - 1) < p1.X then
    FText[p1.Y - 1] := FText[p1.Y - 1] + Pad(p1.X - LineLength(p1.Y - 1) + 1);
  if LineLength(p2.Y - 1) < p2.X then
    p2.X := LineLength(p2.Y - 1);

  i := GetPlainTextPos(p1);
  s := FText.Text;
  k := GetPlainTextPos(p2) - i + 1;
  if K > 0 then
     frxDelete(s, i, k);
  frxInsert(Value, s, i);

  FText.Text := s;
  p3 := GetPosPlainText(i + frxLength(Value));
  FAllowLinesChange := True;
  CorrectBookmark(FPos.Y, p3.y - FPos.Y);

  SetPos(p3.X, p3.Y);
  FSelStart.X := 0;
  DoChange;
  i := p3.Y;
  if p2.Y < i then
    i := p2.Y;
  if p1.Y < i then
    i := p1.Y;
  ClearSyntax(i);
end;

procedure TfrxSyntaxMemo.ClearSel;
begin
  if FSelStart.X <> 0 then
  begin
    FSelStart := Point(0, 0);
{$IFDEF FPC}
      frxUpdateControl(Self);
{$ELSE}
      Repaint;
{$ENDIF}
  end;
end;

procedure TfrxSyntaxMemo.AddSel;
begin
  if FSelStart.X = 0 then
    FSelStart := FTempPos;
  FSelEnd := FPos;
{$IFDEF FPC}
      frxUpdateControl(Self);
{$ELSE}
      Repaint;
{$ENDIF}
end;

procedure TfrxSyntaxMemo.SetPos(x, y: Integer);
begin
  if FMessage <> '' then
  begin
    FMessage := '';
{$IFDEF FPC}
      frxUpdateControl(Self);
{$ELSE}
      Repaint;
{$ENDIF}
  end;

  if x > FMaxLength then x := FMaxLength;
  if x < 1 then x := 1;
  if y > FText.Count then y := FText.Count;
  if y < 1 then y := 1;

  FPos := Point(x, y);
  if (FWindowSize.X = 0) or (FWindowSize.Y = 0) then exit;

  if FOffset.Y >= FText.Count then
    FOffset.Y := FText.Count - 1;

  if FPos.X > FOffset.X + FWindowSize.X then
  begin
    Inc(FOffset.X, FPos.X - (FOffset.X + FWindowSize.X));
{$IFDEF FPC}
      frxUpdateControl(Self);
{$ELSE}
      Repaint;
{$ENDIF}
  end
  else if FPos.X <= FOffset.X then
  begin
    Dec(FOffset.X, FOffset.X - FPos.X + 1);
{$IFDEF FPC}
      frxUpdateControl(Self);
{$ELSE}
      Repaint;
{$ENDIF}
  end
  else if FPos.Y > FOffset.Y + FWindowSize.Y then
  begin
    Inc(FOffset.Y, FPos.Y - (FOffset.Y + FWindowSize.Y));
{$IFDEF FPC}
      frxUpdateControl(Self);
{$ELSE}
      Repaint;
{$ENDIF}
  end
  else if FPos.Y <= FOffset.Y then
  begin
    Dec(FOffset.Y, FOffset.Y - FPos.Y + 1);
{$IFDEF FPC}
      frxUpdateControl(Self);
{$ELSE}
      Repaint;
{$ENDIF}
  end;

  ShowCaretPos;
  UpdateScrollBar;

end;

procedure TfrxSyntaxMemo.SetPosByCoords(X, Y: Integer);
begin
{$IFNDEF FPC}
  if FMultiByteLang then
    X := GetCharXPos(X - FGutterWidth)+ 1 + FOffset.X
  else
{$ENDIF}
    X := (X - FGutterWidth) div FCharWidth + 1 + FOffset.X;
  Y := Y div FCharHeight + 1 + FOffset.Y;
  FTempPos := FPos;
  SetPos(X, Y);
end;

procedure TfrxSyntaxMemo.OnHScrollChange(Sender: TObject);
begin
  FOffset.X := HorzPosition;
  if FOffset.X > 1024 then
    FOffset.X := 1024;
  ShowCaretPos;
{$IFDEF FPC}
      frxUpdateControl(Self);
{$ELSE}
      Repaint;
{$ENDIF}
end;

procedure TfrxSyntaxMemo.OnVScrollChange(Sender: TObject);
begin
  FOffset.Y := VertPosition;
  if FOffset.Y > FText.Count then
    FOffset.Y := FText.Count;
  ShowCaretPos;
{$IFDEF FPC}
      frxUpdateControl(Self);
{$ELSE}
      Repaint;
{$ENDIF}
end;

procedure TfrxSyntaxMemo.DblClick;
var
  s: String;
begin
  FDoubleClicked := True;
  DoCtrlL;
  FSelStart := FPos;
  s := LineAt(FPos.Y - 1);
  if s <> '' then
{$IFDEF Delphi12}
    while CharInSet(s[FPos.X], WordChars)
      or IsUnicodeChar(s[FPos.X]) do
{$ELSE}
  {$IFDEF FPC}
    while (Length(frxGetSymbol(s, FPos.X)) >= 1) and ((frxGetSymbol(s, FPos.X)[1] in WordChars) or
          (frxGetSymbol(s, FPos.X) >= '<27>') and (frxGetSymbol(s, FPos.X) <= '<27>')) do

  {$ELSE}
    while s[FPos.X] in WordChars do
  {$ENDIF}
{$ENDIF}
      Inc(FPos.X);
  FSelEnd := FPos;
{$IFDEF FPC}
      frxUpdateControl(Self);
{$ELSE}
      Repaint;
{$ENDIF}
end;

procedure TfrxSyntaxMemo.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var
  selected: Boolean;
begin
  if FDoubleClicked then
  begin
    FDoubleClicked := False;
    Exit;
  end
  else if (Button = mbRight) then
  begin
    selected := (FSelStart.X <> 0) and ((FSelStart.X <> FSelEnd.X) or (FSelStart.Y <> FSelEnd.Y));
    PopupMenu.Items[0].Enabled := selected;
    PopupMenu.Items[1].Enabled := selected;
    PopupMenu.Items[2].Enabled := Clipboard.HasFormat(CF_TEXT);
    PopupMenu.Items[3].Enabled := selected;
    Exit;
  end;

  FMoved := True;
  if not Focused then
    SetFocus;
  FDown := True;
  if X < FGutterWidth then
    FToggleBreakPointDown := True;
{$IFNDEF FPC}
  if FMultiByteLang then
    X := GetCharXPos(X - FGutterWidth)+ 1 + FOffset.X
  else
{$ENDIF}
    X := (X - FGutterWidth) div FCharWidth + 1 + FOffset.X;
  Y := Y div FCharHeight + 1 + FOffset.Y;
  FTempPos := FPos;
  SetPos(X, Y);
  if ssShift in Shift then
    AddSel
  else
    ClearSel;
end;

procedure TfrxSyntaxMemo.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  CurHintPos: TPoint;
begin
  if FDown then
  begin
    FTempPos := FPos;
    FPos := CurPosToSynPos(X, Y);
    if (FPos.X <> FTempPos.X) or (FPos.Y <> FTempPos.Y) then
    begin
      SetPos(FPos.X, FPos.Y);
      AddSel;
    end;
  end;

  if X < FGutterWidth then
    Cursor := crArrow
  else
    Cursor := crIBeam;

  CurHintPos := CurPosToSynPos(X, Y);
  if (CurHintPos.X < 1) or (CurHintPos.Y < 1) then
  begin
    Application.CancelHint;
    FLastHintPos := Point(-1, -1);
    Exit;
  end;

  CurHintPos := OffsPoint(CurHintPos);
  if ((CurHintPos.X <> FLastHintPos.X) or (CurHintPos.Y <> FLastHintPos.Y)) then
  begin
    Application.CancelHint;
    FLastHintPos := CurHintPos;
  end;
end;

procedure TfrxSyntaxMemo.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  FDown := False;
  if (X < FGutterWidth) and (FToggleBreakPointDown) then
    ToggleBreakPoint(FPos.Y, '');
  FToggleBreakPointDown := False;
end;

procedure TfrxSyntaxMemo.KeyDown(var Key: Word; Shift: TShiftState);
var
  MyKey: Boolean;
  TempPos: Tpoint;
begin
  inherited;
  FAllowLinesChange := False;

  FTempPos := FPos;
  MyKey := True;
  case Key of
    vk_Left:
      if ssCtrl in Shift then
        DoCtrlL else
        DoLeft;

    vk_Right:
      if ssCtrl in Shift then
        DoCtrlR else
        DoRight;

    vk_Up:
      DoUp;

    vk_Down:
      DoDown;

    vk_Home:
      DoHome(ssCtrl in Shift);

    vk_End:
      DoEnd(ssCtrl in Shift);

    vk_Prior:
      DoPgUp;

    vk_Next:
      DoPgDn;

    vk_Return:
      if Shift = [] then
        DoReturn;

    vk_Delete:
    begin
      if ssCtrl in Shift then // Ctrl+Del delete word before cursor
      begin
        TempPos := FPos;
        Inc(FPos.X);
        DblClick;
        FDoubleClicked := False;
        if FSelEnd.X <= TempPos.X then
        begin
          FSelStart := TempPos;
          FSelEnd := TempPos;
          dec(FSelStart.X);
        end;
      end;
      if ssShift in Shift then
        CutToClipboard else
        DoDel;
    end;

    vk_Back:
    begin
      if ssCtrl in Shift then // Ctrl+BackSpace delete word after cursor
      begin
        DblClick;
        FDoubleClicked := False;
      end;
      DoBackspace;
    end;

    vk_Insert:
      if ssCtrl in Shift then
        CopyToClipboard
      else if ssShift in Shift then
        PasteFromClipboard;

    vk_Tab:
      TabIndent;

    vk_Divide, $BF: // $BF - VK_OEM_2, missing in D7
      if (Shift = [ssCtrl]) then
        QuickComment;

  else
    MyKey := False;
  end;

  if Shift = [ssCtrl] then
  begin
    MyKey := True;
    if Key = 65 then // Ctrl+A Select all
    begin
      SelectAll;
    end
    else if Key = 89 then // Ctrl+Y Delete line
    begin
      if FText.Count > FPos.Y then
      begin
        FMoved := True;
        AddUndo;
        FText.Delete(FPos.Y - 1);
        CorrectBookmark(FPos.Y, -1);
        DoChange;
      end
      else if FText.Count = FPos.Y then
      begin
        FMoved := True;
        AddUndo;
        FText[FPos.Y - 1] := '';
        FPos.X := 1;
        SetPos(FPos.X, FPos.Y);
        DoChange;
      end;
      ClearSyntax(FPos.Y);
    end
    else if Key in [48..57] then
      GotoBookmark(Key - 48)
    else if Key = 32 then // Ctrl+Space code completion
    begin
      if Assigned(FOnCodeCompletion) then
        DoCodeCompletion;
      MyKey := True;
    end
    else if Key = Ord('C') then
    begin
      CopyToClipboard;
      MyKey := True;
    end
    else if Key = Ord('V') then
    begin
      PasteFromClipboard;
      MyKey := True;
    end
    else if Key = Ord('X') then
    begin
      CutToClipboard;
      MyKey := True;
    end
    else if Key = Ord('I') then
    begin
      DoCtrlI;
      MyKey := True;
    end
    else if Key = Ord('U') then
    begin
      DoCtrlU;
      MyKey := True;
    end
    else if Key = Ord('Z') then
    begin
      Undo;
      MyKey := True;
    end;
  end;

  if Shift = [ssCtrl, ssShift] then
  begin
    MyKey := True;
    if Key in [48..57] then
      if IsBookmark(FPos.Y - 1) < 0 then
        AddBookmark(FPos.Y - 1, Key - 48)
      else if IsBookmark(FPos.Y - 1) = (Key - 48) then
        DeleteBookmark(Key - 48);
  end;

  if Key in [vk_Left, vk_Right, vk_Up, vk_Down, vk_Home, vk_End, vk_Prior, vk_Next] then
  begin
    FMoved := True;
    if ssShift in Shift then
      AddSel else
      ClearSel;
  end
  else if Key in [vk_Return, vk_Delete, vk_Back, vk_Insert, vk_Tab] then
    FMoved := True;

  if MyKey then
    Key := 0;
end;

procedure TfrxSyntaxMemo.KeyPress(var Key: Char);
var
  MyKey, ControlKeyDown: Boolean;
begin
  inherited;

  ControlKeyDown := (((GetKeyState(VK_LCONTROL) and not $7FFF) <> 0) or
    ((GetKeyState(VK_RCONTROL) and not $7FFF) <> 0)) and
    (GetKeyState(VK_RMENU) >= 0);
  MyKey := True;

{$IFDEF Delphi12}
  if ((Key = #32) and not ControlKeyDown) or (CharInSet(Key, [#33..#255]) and not((Key = #127) and ControlKeyDown))
    or IsUnicodeChar(Key) and not((Key = #127) and ControlKeyDown) then
{$ELSE}
  if ((Key = #32) and not ControlKeyDown) or (Key in [#33..#255]) and not((Key = #127) and ControlKeyDown) then
{$ENDIF}
  begin
    DoChar(Key);
    FMoved := False;
  end
  else
    MyKey := False;

  if MyKey then
    Key := #0;
end;

{$IFDEF FPC}
procedure TfrxSyntaxMemo.UTF8KeyPress(var UTF8Key: TUTF8Char);
begin
  {$note TODO: fix handling of UTF8 keys}
  inherited UTF8KeyPress(UTF8Key);
  SelText := String(UTF8Key);
  UTF8Key := '';
end;
{$ENDIF}

procedure TfrxSyntaxMemo.DoCodeCompletion;
var
  p: TPoint;
  s: String;
begin
  if IsCursorInStringBlock then Exit;
  FCompletionForm := TfrxPopupForm.Create(Self);
  FCompletionForm.Color := clSkyBlue;
  FCompletionForm.Resizable := True;
  FCompletionForm.OnClose := CompletionFormClose;
  FCompletionForm.Constraints.MinWidth := FCodeCompletionMinWidth;
  FCompletionForm.Constraints.MinHeight := FCodeCompletionMinHeight;
  FCodeCompList.Clear;
  FCompletionLB := TListBox.Create(FCompletionForm);
  FScriptCompletionList.Locked := True;
  with FCompletionLB do
  begin
    Parent := FCompletionForm;
{$IFNDEF FPC}
    Ctl3D := False;
{$ENDIF}
    Color := Self.Color;
{$IFDEF FPC}
    ItemHeight := 16;
    Align := alClient;
{$ELSE}
    Align := alNone;
    ItemHeight := ItemHeight + 2;
{$ENDIF}
    Style := lbOwnerDrawFixed;
    Sorted := False;
    OnDblClick := CompletionLBDblClick;
    OnKeyDown := CompletionLBKeyDown;
    OnKeyPress := CompletionLBKeyPress;
    OnDrawItem := CompletionLBDrawItem;
    s := Trim(GetCompletionString(FPos));
    FCompleationFilter := GetFilter(s);
    FStartCodeCompPos := FPos.X - Length(FCompleationFilter);
    if FCompleationFilter = s then s := '';
    FAddonCompletionList.DestroyItems;
    if Assigned(FOnCodeCompletion) and (cltAddon in FShowInCodeComplition) then
      FOnCodeCompletion(s, FAddonCompletionList);
    BuildCClist(s, FCodeCompList);
    FilterCodeListBox(FCompleationFilter, FCompletionLB, FCodeCompList, @frxSynPos);
    p := Self.ClientToScreen(
      Point(FCharWidth * (FPos.X - 1 - FOffset.X) + FGutterWidth,
            FCharHeight * (FPos.Y - FOffset.Y)));
    FCompletionForm.SetBounds(p.X, p.Y, CodeCompletionWidth, CodeCompletionHeight);
{$IFNDEF FPC}
    SetBounds(2, 2, CodeCompletionWidth - 4, CodeCompletionHeight - 4);
    Anchors := [akLeft, akTop, akRight, akBottom];
{$ENDIF}
    if FCompletionLB.Count > 0 then
      FCompletionForm.Show
    else
      CompletionClose;
  end;
end;

procedure TfrxSyntaxMemo.CompletionClose;
var
  lForm: TCustomForm;
begin
  { prevent access to FCompletionForm when form destroying }
  lForm := FCompletionForm;
  if (FCompletionForm = nil) or (csDestroying in FCompletionForm.ComponentState) then Exit;
  FCompletionForm := nil;
  FScriptCompletionList.Locked := False;
  lForm.Close;
end;

procedure TfrxSyntaxMemo.CompletionFormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  FCodeCompletionWidth := TForm(Sender).Width;
  FCodeCompletionHeight := TForm(Sender).Height;
end;

procedure TfrxSyntaxMemo.CompletionLBDblClick(Sender: TObject);
var
  s, s1: String;
  i: Integer;
  stepBack: Boolean;
  Item: TfrxCompletionItem;
begin
  if FCompletionLB.ItemIndex <> -1 then
  begin
    FSelStart.X := FPos.X - frxLength(FCompleationFilter);
    FSelStart.Y := FPos.Y;
    FSelEnd.X := GetIdentEnd(FStartCodeCompPos);
    FSelEnd.Y := FPos.Y;
    s := FCompletionLB.Items[FCompletionLB.ItemIndex];
    Item := TfrxCompletionItem(FCompletionLB.Items.Objects[FCompletionLB.ItemIndex]);
    i := 2;
{$IFDEF Delphi12}
    while (i <= Length(s)) and ((CharInSet(s[i], WordChars) or IsUnicodeChar(s[i]))) do
{$ELSE}
    while (i <= frxLength(s)) and
      (frxGetSymbol(s, i) {$IFDEF FPC}[1]{$ENDIF} in WordChars)
       {$IFDEF FPC} or (Length(frxGetSymbol(s, i)) > 1){$ENDIF}do
{$ENDIF}
      Inc(i);
    s1 := frxCopy(s, 1, i - 1);
    stepBack := (i <= frxLength(s)) and (frxGetSymbol(s, i) = '(');
    if stepBack then
      s1 := s1 + '()';
    SelText := s1;
    s1 := '';
    if stepBack then
    begin
      DoLeft;
      if Item.FParams <> '' then
        s1 := 'Parameters: (' + Item.FParams + ')  ';
    end;
    if Item.FType <> '' then
        s1 := s1 + 'Type: ' + Item.FType;
    if s1 <> '' then
      ShowMessage(s1)
  end;
  CompletionClose;
  FCompleationFilter := '';
end;

procedure TfrxSyntaxMemo.CompletionLBKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
  oldKey: Char;
begin
  oldKey := Char(Key);
  if Key = VK_ESCAPE then
    CompletionClose
  else if (Key = VK_RETURN) or (key = 190) then
    CompletionLBDblClick(nil)
  else if not((Integer(Key) >= 0) and (Integer(Key) <= 48))
          or (((Integer(Key) = VK_BACK) or (Integer(Key) = VK_LEFT)) and (FPos.X > FStartCodeCompPos))
          or ((Integer(Key) = VK_RIGHT) and (FPos.X  < GetIdentEnd(FStartCodeCompPos))) then
    KeyDown(Key, Shift);
  { update code compleation }
  if (Integer(oldKey) = VK_LEFT) or (Integer(oldKey) = VK_RIGHT) then
    CompletionLBKeyPress(Sender, oldKey);
end;

procedure TfrxSyntaxMemo.CompletionLBKeyPress(Sender: TObject; var Key: Char);
var
  bLeftRightKey: Boolean;
begin
  bLeftRightKey := (Key = Char(VK_LEFT)) or (Key = Char(VK_RIGHT));
  if (Key >= #0) and (Key <= #48) and not((Key = Char(VK_BACK)) or bLeftRightKey) then Exit;
  if not bLeftRightKey then
    KeyPress(Key);
  FCompleationFilter := Trim(GetFilter(GetCompletionString(FPos)));
  FilterCodeListBox(FCompleationFilter, FCompletionLB, FCodeCompList, @frxSynPos);
end;

procedure TfrxSyntaxMemo.CompletionLBDrawItem(Control: TWinControl; Index: Integer;
  ARect: TRect; State: TOwnerDrawState);
var
  i, w: Integer;
  s: String;
  Item: TfrxCompletionItem;
begin
  with FCompletionLB.Canvas do
  begin
    FillRect(ARect);
    if Index <> -1 then
    begin
      Item := TfrxCompletionItem(FCompletionLB.Items.Objects[Index]);
      s := '';
      Font.Color := clFuchsia;
      if Pos('Constructor', FCompletionLB.Items[Index]) <> 0 then
        s := 'constructor'
      else
        Font.Color := ItemToPrefix(Item, s, Font.Color);
      if odSelected in State then
        Font.Color := clWhite;
      Font.Style := [];
      TextOut(ARect.Left + 2, ARect.Top + 2, s);
      w := TextWidth('constructor ');
      Font.Color := clBlack;
      if odSelected in State then
        Font.Color := clWhite;
      Font.Style := [fsBold];
      s := FCompletionLB.Items[Index];
      i := 1;
{$IFDEF Delphi12}
      while (i <= Length(s)) and ((CharInSet(s[i], WordChars))
       or IsUnicodeChar(s[i])) do
{$ELSE}
      while (i <= frxLength(s)) and
        (frxGetSymbol(s, i){$IFDEF FPC}[1]{$ENDIF} in WordChars)
        {$IFDEF FPC} or (Length(frxGetSymbol(s, i)) > 1){$ENDIF}do
{$ENDIF}
        Inc(i);
      s := frxCopy(s, 1, i - 1);
      TextOut(ARect.Left + w + 6, ARect.Top + 2, s);
      w := w + TextWidth(s);
      Font.Style := [];
      s := Copy(FCompletionLB.Items[Index], i, 255);
      if Pos(': Constructor', s) <> 0 then
        s := Copy(s, 1, Pos(': Constructor', s) - 1);
      TextOut(ARect.Left + w + 6, ARect.Top + 2, s);
    end;
  end;
end;

function TfrxSyntaxMemo.ItemToPrefix(Item: TfrxCompletionItem; var pref: String; c: TColor = clNone): TColor;
begin
  Result := c;
  case Item.FItemType of
    itVar: begin pref := 'var'; Result := clBlue; end;
    itProperty, itIndex: begin pref := 'property'; Result := clBlue; end;
    itProcedure: pref := 'procedure';
    itFunction: pref := 'function';
    itConstant: pref := 'constant';
    itConstructor: pref:= 'constructor';
    itType: begin pref := 'type'; Result := clBlack; end;
    itEvent: begin pref := 'event'; Result := clNavy; end;
  end;
end;

procedure TfrxSyntaxMemo.DoLeft;
begin
  Dec(FPos.X);
  if FPos.X < 1 then
    FPos.X := 1;
  SetPos(FPos.X, FPos.Y);
end;

procedure TfrxSyntaxMemo.DoRight;
begin
  Inc(FPos.X);
  if FPos.X > FMaxLength then
    FPos.X := FMaxLength;
  SetPos(FPos.X, FPos.Y);
end;

procedure TfrxSyntaxMemo.DoTimer(Sender: TObject);
begin
  FTimer.Enabled := False;
  if csDestroying in ComponentState then Exit;
  FCodeCompletionThread.FMemoHandle := Handle;
  FCodeCompletionThread.Script := FScript;
  FCodeCompletionThread.FSyntaxType := Syntax;
  if FCodeCompletionThread.Suspended then
    FCodeCompletionThread.Resume;
end;

procedure TfrxSyntaxMemo.DoUp;
begin
  Dec(FPos.Y);
  if FPos.Y < 1 then
    FPos.Y := 1;
  SetPos(FPos.X, FPos.Y);
end;

procedure TfrxSyntaxMemo.DoDown;
begin
  Inc(FPos.Y);
  if FPos.Y > FText.Count then
    FPos.Y := FText.Count;
  SetPos(FPos.X, FPos.Y);
end;

procedure TfrxSyntaxMemo.DoHome(Ctrl: Boolean);
begin
  if Ctrl then
    SetPos(1, 1) else
    SetPos(1, FPos.Y);
end;

procedure TfrxSyntaxMemo.DoEnd(Ctrl: Boolean);
begin
  if Ctrl then
    SetPos(LineLength(FText.Count - 1) + 1, FText.Count) else
    SetPos(LineLength(FPos.Y - 1) + 1, FPos.Y);
end;

procedure TfrxSyntaxMemo.DoPgUp;
begin
  if FOffset.Y > FWindowSize.Y then
  begin
    Dec(FOffset.Y, FWindowSize.Y - 1);
    Dec(FPos.Y, FWindowSize.Y - 1);
  end
  else
  begin
    if FOffset.Y > 0 then
    begin
      Dec(FPos.Y, FOffset.Y);
      FOffset.Y := 0;
    end
    else
      FPos.Y := 1;
  end;
  SetPos(FPos.X, FPos.Y);
{$IFDEF FPC}
      frxUpdateControl(Self);
{$ELSE}
      Repaint;
{$ENDIF}
end;

procedure TfrxSyntaxMemo.DoPPIChanged(aNewPPI: Integer);
begin
  inherited;
  FGutterWidth := MulDiv(FGutterWidth, aNewPPI, FfrCurrentPPI);
  Font.PixelsPerInch := aNewPPI;
  FCommentAttr.PixelsPerInch := aNewPPI;
  FKeywordAttr.PixelsPerInch := aNewPPI;
  FNumberAttr.PixelsPerInch := aNewPPI;
  FStringAttr.PixelsPerInch := aNewPPI;
  FTextAttr.PixelsPerInch := aNewPPI;
end;

procedure TfrxSyntaxMemo.DoPgDn;
begin
  if FOffset.Y + FWindowSize.Y < FText.Count then
  begin
    Inc(FOffset.Y, FWindowSize.Y - 1);
    Inc(FPos.Y, FWindowSize.Y - 1);
  end
  else
  begin
    FOffset.Y := FText.Count;
    FPos.Y := FText.Count;
  end;
  SetPos(FPos.X, FPos.Y);
{$IFDEF FPC}
      frxUpdateControl(Self);
{$ELSE}
      Repaint;
{$ENDIF}
end;

procedure TfrxSyntaxMemo.DoReturn;
var
  s: String;
begin
  s := LineAt(FPos.Y - 1);
  FText[FPos.Y - 1] := frxCopy(s, 1, FPos.X - 1);
  FText.Insert(FPos.Y, frxCopy(s, FPos.X, FMaxLength));
  EnterIndent;
end;

procedure TfrxSyntaxMemo.DoDel;
var
  s: String;
begin
  FMessage := '';
  if FSelStart.X <> 0 then
    SelText := ''
  else
  begin
    s := FText[FPos.Y - 1];
    AddUndo;
    if FPos.X <= LineLength(FPos.Y - 1) then
    begin
      frxDelete(s, FPos.X, 1);
      FText[FPos.Y - 1] := s;
    end
    else if FPos.Y < FText.Count then
    begin
      s := s + Pad(FPos.X - frxLength(s) - 1) + LineAt(FPos.Y);
      FText[FPos.Y - 1] := s;
      FText.Delete(FPos.Y);
      CorrectBookmark(FPos.Y, -1);
    end;
    UpdateScrollBar;
    ClearSyntax(FPos.Y);
    DoChange;
  end;
end;

procedure TfrxSyntaxMemo.DoBackspace;
var
  s: String;
begin
  FMessage := '';
  if FSelStart.X <> 0 then
    SelText := ''
  else
  begin
    s := FText[FPos.Y - 1];
    if FPos.X > 1 then
    begin
      if (GetLineBegin(FPos.Y - 1) = FPos.X) or (Trim(s) = '') then
        UnIndent
      else
      begin
        AddUndo;
        if Trim(s) <> '' then
        begin
          frxDelete(s, FPos.X - 1, 1);
          FText[FPos.Y - 1] := s;
          DoLeft;
        end
        else
          DoHome(False);
        ClearSyntax(FPos.Y);
        DoChange;
      end;
    end
    else if FPos.Y > 1 then
    begin
      AddUndo;
      CorrectBookmark(FPos.Y, -1);
      s := LineAt(FPos.Y - 2);
      FText[FPos.Y - 2] := s + FText[FPos.Y - 1];
      FText.Delete(FPos.Y - 1);
      SetPos(Length(s) + 1, FPos.Y - 1);
      ClearSyntax(FPos.Y);
      DoChange;
    end;
  end;
end;

procedure TfrxSyntaxMemo.DoCtrlI;
begin
  if FSelStart.X <> 0 then
    ShiftSelected(True);
end;

procedure TfrxSyntaxMemo.DoCtrlU;
begin
  if FSelStart.X <> 0 then
    ShiftSelected(False);
end;

procedure TfrxSyntaxMemo.DoCtrlL;
var
  i: Integer;
  s: String;
begin
  s := FText.Text;
  i := frxLength(LineAt(FPos.Y - 1));
  if FPos.X > i then
    FPos.X := i;

  i := GetPlainTextPos(FPos);

  Dec(i);
{$IFDEF Delphi12}
  while (i > 0) and not ((CharInSet(s[i], WordChars))
    or IsUnicodeChar(s[i])) do
{$ELSE}
  while (i > 0) and not (frxGetSymbol(s, i){$IFDEF FPC}[1]{$ENDIF} in WordChars)
  {$IFDEF FPC}or (Length(frxGetSymbol(s, i)) > 1){$ENDIF}do
{$ENDIF}
    if frxGetSymbol(s, i) = LineBreak[1] then
      break else
      Dec(i);
{$IFDEF Delphi12}
  while (i > 0) and ((CharInSet(s[i], WordChars))
    or IsUnicodeChar(s[i])) do
{$ELSE}
  while (i > 0) and (frxGetSymbol(s, i){$IFDEF FPC}[1]{$ENDIF}  in WordChars)
  {$IFDEF FPC}or (Length(frxGetSymbol(s, i)) > 1){$ENDIF}do
{$ENDIF}
    Dec(i);
  Inc(i);

  FPos := GetPosPlainText(i);
  SetPos(FPos.X, FPos.Y);
end;

procedure TfrxSyntaxMemo.DoCtrlR;
var
  i: Integer;
  s: String;
begin
  s := FText.Text;
  i := Length(LineAt(FPos.Y - 1));
  if FPos.X > i then
  begin
    DoDown;
    DoHome(False);
    FPos.X := 1;
    Exit;
  end;

  i := GetPlainTextPos(FPos);

{$IFDEF Delphi12}
  while (i < Length(s)) and ((CharInSet(s[i], WordChars))
     or IsUnicodeChar(s[i])) do
{$ELSE}
  while (i < frxLength(s)) and (frxGetSymbol(s, i){$IFDEF FPC}[1]{$ENDIF}  in WordChars)
  {$IFDEF FPC}or (Length(frxGetSymbol(s, i)) > 1){$ENDIF}do
{$ENDIF}
    Inc(i);
{$IFDEF Delphi12}
  while (i < Length(s)) and not ((CharInSet(s[i], WordChars))
    or IsUnicodeChar(s[i])) do
{$ELSE}
  while (i < frxLength(s)) and not (frxGetSymbol(s, i){$IFDEF FPC}[1]{$ENDIF}  in WordChars)
  {$IFDEF FPC}or (Length(frxGetSymbol(s, 1)) > 1){$ENDIF}do
{$ENDIF}
    if frxGetSymbol(s, i) = LineBreak[1] then
    begin
      while (i > 1) and (frxGetSymbol(s, i - 1) = ' ') do
        Dec(i);
      break;
    end
    else
      Inc(i);

  FPos := GetPosPlainText(i);
  SetPos(FPos.X, FPos.Y);
end;

procedure TfrxSyntaxMemo.DoChar(Ch: Char);
begin
  SelText := Ch;
end;

function TfrxSyntaxMemo.GetCharAttr(Pos: TPoint): TfrxCharAttributes;

  function IsBlock: Boolean;
  var
    p1, p2, p3: Integer;
  begin
    Result := False;
    if FSelStart.X = 0 then Exit;

    p1 := FSelStart.X + FSelStart.Y * FMaxLength;
    p2 := FSelEnd.X + FSelEnd.Y * FMaxLength;
    if p1 > p2 then
    begin
      p3 := p1;
      p1 := p2;
      p2 := p3;
    end;
    p3 := Pos.X + Pos.Y * FMaxLength;
    Result := (p3 >= p1) and (p3 < p2);
  end;

  function CharAttr: Byte;
  var
    s: TfrxByteArr;
  begin
    if Pos.Y - 1 < FSynAttributes.Count then
    begin
      s := FSynAttributes[Pos.Y - 1];
      if Pos.X <= Length(s) then
        Result := s[Pos.X - 1] else
        Result := Ord(caText);
    end
    else
      Result := Ord(caText);
  end;

begin
  Result.StyleIndex := CharAttr;
  Result.IsSelBlock := IsBlock;
end;

function TfrxSyntaxMemo.GetCompletionString(Pos: TPoint): String;
  var
    i: Integer;
    s: String;
    fl1, fl2: Boolean;
    fl3, fl4: Integer;
  begin
    Result := '';
    s := LineAt(Pos.Y - 1, False);
    s := frxCopy(s, 1, Pos.X - 1);

    fl1 := False;
    fl2 := False;
    fl3 := 0;
    fl4 := 0;

    i := frxLength(s);
    while i >= 1 do
    begin
      if (frxGetSymbol(s, i) = ' ') then break
      else if (frxGetSymbol(s, i) = '''') and not fl2 then
        fl1 := not fl1
      else if (frxGetSymbol(s, i) = '"') and not fl1 then
        fl2 := not fl2
      else if not fl1 and not fl2 and
        (frxGetSymbol(s, i) = ')') then
        Inc(fl3)
      else if not fl1 and not fl2 and
        ((frxGetSymbol(s, i) = '(') or (frxGetSymbol(s, i) = ' ')) and (fl3 > 0) then
        Dec(fl3)
      else if not fl1 and not fl2 and
        (frxGetSymbol(s, i) = ']') then
        Inc(fl4)
      else if not fl1 and not fl2 and
        (frxGetSymbol(s, i) = '[') and (fl4 > 0) then
        Dec(fl4)
      else if not fl1 and not fl2 and (fl3 = 0) and (fl4 = 0) then
{$IFDEF Delphi12}
        if CharInSet(s[i], ['A'..'Z', 'a'..'z', '0'..'9', '_', '.', ' '])
        or IsUnicodeChar(s[i]) then
{$ELSE}
        if frxGetSymbol(s, i){$IFDEF FPC}[1]{$ENDIF}
          in ['A'..'Z', 'a'..'z', '0'..'9', '_', '.', ' '] then
{$ENDIF}
          Result := s[i] + Result
        else
          break;
      Dec(i);
    end;
  end;

function TfrxSyntaxMemo.GetFilter(aStr: String): String;
var
  i: Integer;
begin
  Result := aStr;
  for i := Length(aStr) downto 1 do
    if aStr[i] = '.' then
    begin
      Result := Copy(aStr, i + 1, Length(aStr) - i);
      break;
    end;
end;

{$IFNDEF FPC}
function TfrxSyntaxMemo.GetCharWidth(const Str: String): Integer;
begin
  with FTmpCanvas.Canvas do
  begin
    Font.Assign(Self.Font);
    Result := TextWidth(Str);
  end;
end;

function TfrxSyntaxMemo.GetCharXPos(X: Integer): Integer;
var
  s, s2: String;
  i: Integer;
begin
  s := LineAt(FPos.Y - 1);
  s2 := '';
  Result := 0;
  for i := FOffset.X + 1 to Length(s) do
  begin
    s2 := s2 + s[i];
    if GetCharWidth(s2) >= x then
    begin
      Result := i;
      Exit;
    end;
  end;
end;
{$ENDIF}

procedure TfrxSyntaxMemo.Paint;
var
  i, j, j1: Integer;
  a, a1: TfrxCharAttributes;
  s: String;

  procedure SetAttr(a: TfrxCharAttributes; ALine: Integer);
  var
    Attr: TCharAttr;
    style: TfrxAttributeStyle;
  begin
    style := nil;
    with Canvas do
    begin
      Brush.Color := Color;
      if a.StyleIndex <= ReservedStylesCount then
        Attr := TCharAttr(a.StyleIndex)
      else
      begin
        style := AttributeStyles.GetStyleByID(a.StyleIndex);
        Attr := style.AttrType;
      end;

      case Attr of
        caNo: ;
        caText: Font.Assign(FTextAttr);
        caComment: Font.Assign(FCommentAttr);
        caKeyword: Font.Assign(FKeywordAttr);
        caString: Font.Assign(FStringAttr);
        caNumber: Font.Assign(FNumberAttr);
      end;
      if Assigned(style) then
        AttributeStyles.AssignStyle(style, Font);

      if a.IsSelBlock or (ALine = FActiveLine - 1) then
      begin
        Brush.Color := FBlockColor;
        Font.Color := FBlockFontColor;
      end;

      Font.Charset := Self.Font.Charset;
    end;
  end;

  procedure MyTextOut(x, y: Integer; const s: String);
  var
    i: Integer;
  begin
    if FIsMonoType then
    begin
      Canvas.FillRect(Rect(x, y, x + frxLength(s) * FCharWidth, y + FCharHeight));
      Canvas.TextOut(x, y, s)
    end
    else
    with Canvas do
    begin
      FillRect(Rect(x, y, x + frxLength(s) * FCharWidth, y + FCharHeight));
      if FMultiByteLang then
        Canvas.TextOut(x, y, s)
      else
      begin
        for i := 1 to frxLength(s) do
          TextOut(x + (i - 1) * FCharWidth, y, frxGetSymbol(s, i));
        MoveTo(x + frxLength(s) * FCharWidth, y);
      end;
    end;
  end;

  procedure DrawLineMarks(ALine, Y: Integer);
  var
    s: String;
    tw, defGW, h: Integer;
  begin
    if not FShowGutter then Exit;
    Canvas.Brush.Color := clSkyBlue;
    Canvas.Pen.Color := clSkyBlue;
    h := MulDiv(4, FfrCurrentPPI, 96);
    Canvas.Ellipse(6, Y + 8, 6 + h, Y + 8 + h);
    if ((ALine + 1) mod 5 = 0) and FShowLineNumber then
    begin
      Canvas.Brush.Color := clBtnFace;
      Canvas.Font.Name := 'Tahoma';
      Canvas.Font.Color := clSkyBlue;
      Canvas.Font.Style := [];
      Canvas.Font.Size := 8;
      Canvas.Font.Height := MulDiv(Canvas.Font.Height, FfrCurrentPPI, Canvas.Font.PixelsPerInch);
      s := IntToStr(ALine + 1);
      Canvas.TextOut(4, Y + 2, s);
      tw := Canvas.TextWidth(s) + 10;
      defGW := MulDiv(DefGutterWidth, FfrCurrentPPI, 96);
      if FGutterWidth < tw then
        FGutterWidth := Canvas.TextWidth(s) + 10
      else if tw <= defGW then
        FGutterWidth := defGW;
    end;
    if IsBookmark(ALine) >= 0 then
      with Canvas do
      begin
        Font.Name := 'Tahoma';
        Font.Color := clWhite;
        Font.Style := [fsBold];
        Font.Size := 7;
        Canvas.Font.Height := MulDiv(Canvas.Font.Height, FfrCurrentPPI, Canvas.Font.PixelsPerInch);
        tw := MulDiv(10, FfrCurrentPPI, 96);
        h := MulDiv(11, FfrCurrentPPI, 96);
        Brush.Color := clBlack;
        FillRect(Rect(13, Y + 3, 13 + tw, Y + 3 + h));
        Brush.Color := clGreen;
        FillRect(Rect(12, Y + 4, 12 + tw, Y + 4 + h));
        TextOut(14, Y + 4, IntToStr(IsBookmark(ALine)));
      end;
    if RunLine[ALine + 1] then
      with Canvas do
      begin
        Brush.Color := clBlue;
        Pen.Color := clBlack;
        h := MulDiv(4, FfrCurrentPPI, 96);
        Ellipse(4, Y + 7, 4 + h, Y + 7 + h);
        Pixels[5, Y + 7] := clAqua;
        Pixels[4, Y + 8] := clAqua;
      end;
    if IsBreakPoint(ALine + 1) then
      with Canvas do
      begin
        if IsActiveBreakPoint(ALine + 1) then
        begin
          Brush.Color := clRed;
          Pen.Color := clRed;
        end
        else
        begin
          Brush.Color := clGray;
          Pen.Color := clBlack;
        end;
        h := MulDiv(11, FfrCurrentPPI, 96);
        Ellipse(2, Y + 4, 2 + h, Y + 4 + h);
      end;
  end;

begin
  inherited;
  Canvas.Font.PixelsPerInch := Font.PixelsPerInch;
  with Canvas do
  begin
    Brush.Color := clBtnFace;
    FillRect(Rect(0, 0, FGutterWidth - 2, Height));
    Pen.Color := clBtnHighlight;
    MoveTo(FGutterWidth - 4, 0);
    LineTo(FGutterWidth - 4, Height + 1);

    if FSynAttributes.Updating then Exit;
    CreateSynArray(FOffset.Y + FWindowSize.Y - 1);

    for i := FOffset.Y to FOffset.Y + FWindowSize.Y - 1 do
    begin
      if i >= FText.Count then break;

      s := FText[i];
      PenPos := Point(FGutterWidth, (i - FOffset.Y) * FCharHeight);
      j1 := FOffset.X + 1;
      a := GetCharAttr(Point(j1, i + 1));

      for j := j1 to FOffset.X + FWindowSize.X do
      begin
        if j > Length(s) then break;

        a1 := GetCharAttr(Point(j, i + 1));
        if (a1.IsSelBlock <> a.IsSelBlock) or (a.StyleIndex <> a1.StyleIndex) then
        begin
          SetAttr(a, i);
          MyTextOut(PenPos.X, PenPos.Y, Copy(FText[i], j1, j - j1));
          a := a1;
          j1 := j;
        end;
      end;

      SetAttr(a, i);
      MyTextOut(PenPos.X, PenPos.Y, Copy(s, j1, FMaxLength));
      if (GetCharAttr(Point(1, i + 1)).IsSelBlock) or (i = FActiveLine - 1) then
        MyTextOut(PenPos.X, PenPos.Y, Pad(FWindowSize.X - Length(s) - FOffset.X + 3));

      DrawLineMarks(i, PenPos.Y);
    end;

    if FMessage <> '' then
    begin
      Font.Name := 'Tahoma';
      Font.Color := clWhite;
      Font.Style := [fsBold];
      Font.Size := 8;
      Brush.Color := clMaroon;
      FillRect(Rect(0, ClientHeight - TextHeight('|') - 6, ClientWidth, ClientHeight));
      TextOut(6, ClientHeight - TextHeight('|') - 5, FMessage);
    end;
    {$IFDEF NONWINFPC}
    if Visible and HandleAllocated and FCaretCreated then
    begin
      SetCaretPos(FCharWidth * (FPos.X - 1 - FOffset.X) + FGutterWidth,
      FCharHeight * (FPos.Y - 1 - FOffset.Y));
      {$IFDEF LCLGTK2}
      ShowCaret(Self.Handle);
      {$ENDIF}
    end;
    {$ENDIF}
  end;
end;

procedure TfrxSyntaxMemo.ClearSyntax(ClearFrom: Integer);
begin
  Dec(ClearFrom);
  if ClearFrom < 1 then
    ClearFrom := 1;
  //FUpdatingSyntax := True;
  while FSynAttributes.Count > ClearFrom - 1 do
    FSynAttributes.Delete(FSynAttributes.Count - 1);
  //FUpdatingSyntax := False;
{$IFDEF FPC}
      frxUpdateControl(Self);
{$ELSE}
      Repaint;
{$ENDIF}
end;

procedure TfrxSyntaxMemo.CreateSynArray(EndLine: Integer);
begin
  if EndLine >= FText.Count then
    EndLine := FText.Count - 1;
  if EndLine <= FSynAttributes.Count - 1 then Exit;
  FAllowLinesChange := False;
  FParser.Text := FText.Text;
  try
    FSynAttributes.UpdateSyntax(EndLine, FText);
  finally
    FAllowLinesChange := True;
  end;
end;

procedure TfrxSyntaxMemo.UpdateView;
begin
  Invalidate;
end;

procedure TfrxSyntaxMemo.MouseWheelUp(Sender: TObject;
  Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
begin
  VertPosition := VertPosition - SmallChange;
end;

procedure TfrxSyntaxMemo.MouseWheelDown(Sender: TObject;
  Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
begin
  VertPosition := VertPosition + SmallChange;
end;

procedure TfrxSyntaxMemo.SetShowGutter(Value: Boolean);
begin
  FShowGutter := Value;
  if Value then
    FGutterWidth := MulDiv(DefGutterWidth, FfrCurrentPPI, 96) else
    FGutterWidth := 0;
{$IFDEF FPC}
      frxUpdateControl(Self);
{$ELSE}
      Repaint;
{$ENDIF}
end;

procedure TfrxSyntaxMemo.SetShowInCodeComplition(
  const Value: TfrxCompletionListTypes);
begin
  FShowInCodeComplition := Value;
  if cltRtti in Value then
    FillRtti
  else
    FRttiCompletionList.DestroyItems;
end;

function TfrxSyntaxMemo.IsBookmark(Line: Integer): Integer;
var
  i: Integer;
begin
  Result := -1;
  for i := 0 to 9 do
    if FBookmarks[i] = Line then
    begin
      Result := i;
      break;
    end;
end;

procedure TfrxSyntaxMemo.AddBookmark(Line, Number: Integer);
begin
  if Number < Length(FBookmarks) then
  begin
    FBookmarks[Number] := Line;
{$IFDEF FPC}
      frxUpdateControl(Self);
{$ELSE}
      Repaint;
{$ENDIF}
  end;
end;

procedure TfrxSyntaxMemo.DeleteBookmark(Number: Integer);
begin
  if Number < Length(FBookmarks) then
  begin
    FBookmarks[Number] := -1;
{$IFDEF FPC}
      frxUpdateControl(Self);
{$ELSE}
      Repaint;
{$ENDIF}
  end;
end;

procedure TfrxSyntaxMemo.CorrectBookmark(Line, Delta: Integer);
var
  i: Integer;
begin
  if Delta = 0 then exit;
  CorrectBreakPoints(Line, Delta);
  for i := 0 to Length(FBookmarks) - 1 do
    if FBookmarks[i] >= Line then
      Inc(FBookmarks[i], Delta);
end;

procedure TfrxSyntaxMemo.GotoBookmark(Number : Integer);
begin
  if Number < Length(FBookmarks) then
    if FBookmarks[Number] >= 0 then
      SetPos(0, FBookmarks[Number] + 1);
end;

function TfrxSyntaxMemo.GetRunLine(Index: Integer): Boolean;
begin
  if (Index < 1) or (Index > FText.Count) then
    Result := False else
    Result := FText.Objects[Index - 1] = Pointer(1);
end;

procedure TfrxSyntaxMemo.SetRunLine(Index: Integer; const Value: Boolean);
begin
  if (Index < 1) or (Index > FText.Count) then Exit;
  if Value then
    FText.Objects[Index - 1] := Pointer(1) else
    FText.Objects[Index - 1] := Pointer(0);
end;

procedure TfrxSyntaxMemo.FillRtti;
var
  i, j: Integer;
  Params: String;
  v: TfsCustomVariable;
begin
 if not(cltRtti in FShowInCodeComplition) or (FRttiCompletionList.Count > 0) then Exit;
 for i := 0 to FScript.Count - 1 do
  begin
    v := FScript.Items[i];
    if v is TfsVariable then
    begin
      if v.Typ = fvtEnum then continue;
      if v.IsReadOnly then
          FRttiCompletionList.AddConstant(v.Name, v.TypeName) else
          FRttiCompletionList.AddVariable(v.Name, v.TypeName);
    end
    else if v is TfsClassVariable then
    begin
      FRttiCompletionList.AddClass(v.Name, v.TypeName);
    end
    else if v is TfsMethodHelper then
    begin
    Params := '';

      for j:= 0 to v.Count - 1 do
      begin
        if j > 0 then
          Params := Params + ';';
        Params := Params + v.Params[j].Name + ': ' + v.Params
          [j].TypeName;
      end;
      FRttiCompletionList.AddFunction(TfsMethodHelper(v).Name, TfsMethodHelper(v).TypeName, Params);
    end;
  end;
end;

function TfrxSyntaxMemo.Find(const SearchText: String;
  CaseSensitive: Boolean; var SearchFrom: Integer): Boolean;
var
  i: Integer;
  s: String;
begin
  i := 0;
  Result := False;
  if FText.Count > 1 then
  begin
    s := FText.Text;
    if SearchFrom = 0 then
      SearchFrom := 1;
    s := frxCopy(s, SearchFrom, frxLength(s) - SearchFrom + 1);
    if CaseSensitive then
    begin
      i := frxPos(SearchText, s);
      if i <> 0 then
        Result := True;
    end
    else
    begin
      i := frxPos(frxUpperCase(SearchText), frxUpperCase(s));
      if i <> 0 then
        Result := True;
    end;
  end;

  if Result then
  begin
    Inc(SearchFrom, i);
    FSelStart := GetPosPlainText(SearchFrom - 1);
    FSelEnd := Point(FSelStart.X + frxLength(SearchText), FSelStart.Y);
    Inc(SearchFrom, frxLength(SearchText));
    SetPos(FSelStart.X, FSelStart.Y);
{$IFDEF FPC}
      frxUpdateControl(Self);
{$ELSE}
      Repaint;
{$ENDIF}
  end;
end;

procedure TfrxSyntaxMemo.AddBreakPoint(Number: Integer; const Condition: String; const Special: String);
var
  bp: TfrxBreakPoint;
begin
  if (Number = -1) or (Number >= Lines.Count) or IsBreakPoint(Number) or (LineAt(Number - 1) = '') then Exit;
  bp := TfrxBreakPoint.Create;
  bp.FLine := Number;
  bp.Condition := Condition;
  bp.SpecialCondition := Special;
  bp.FEnabled := True;
  FBreakPoints.AddObject(IntToStr(Number), bp);
{$IFDEF FPC}
      frxUpdateControl(Self);
{$ELSE}
      Repaint;
{$ENDIF}
end;

procedure TfrxSyntaxMemo.ToggleBreakPoint(Number: Integer; const Condition: String);
begin
  if IsBreakPoint(Number) then
    DeleteBreakPoint(Number)
  else
    AddBreakPoint(Number, Condition, '');
end;

procedure TfrxSyntaxMemo.DeleteBreakPoint(Number: Integer);
var
  i: Integer;
begin
  i := FBreakPoints.IndexOf(IntToStr(Number));
  if i <> -1 then
  begin
    TObject(FBreakPoints.Objects[i]).Free;
    FBreakPoints.Delete(i);
  end;
{$IFDEF FPC}
      frxUpdateControl(Self);
{$ELSE}
      Repaint;
{$ENDIF}
end;

function TfrxSyntaxMemo.IsBreakPoint(Number: Integer): Boolean;
begin
  Result := FBreakPoints.IndexOf(IntToStr(Number)) <> -1;
end;

function TfrxSyntaxMemo.IsCursorInStringBlock: Boolean;
var
  s: String;
  i, sPos: Integer;
begin
  Result := False;
  s := LineAt(FPos.Y - 1);
  if Length(s) >= FPos.X then
  begin
    sPos := 1;
    for i := FPos.X downto 1 do
      if (s[i] = FParser.StringQuotes[1]) or (s[i] = FParser.StringQuotes[2]) then
      begin
        sPos := i;
        break;
      end;
    FParser.Text := s;
    FParser.Position := sPos;
    Result := (FParser.GetString <> '');
  end;
end;

function TfrxSyntaxMemo.GetAttributeStyles: TfrxAttributeStyles;
begin
  Result := FSynDialectStyles.ActiveStyles;
end;

procedure TfrxSyntaxMemo.QuickComment;
var
  singleLine, selected: Boolean;
  i, y, x, x1, y1: Integer;
  commenting: Boolean;
  s: String;
  CL1: String;
  CL1L, buf: Integer;

  procedure swap;
  var
    bp: TPoint;
  begin
    bp := Self.SelStart;
    Self.SelStart := Self.SelEnd;
    Self.SelEnd := bp;
  end;

begin
  //check Dialect
  CL1 := FParser.CommentLine1;
  CL1L := Length(CL1);
  if CL1L < 1 then
    Exit;

  //Add undo
  FMoved := True;
  AddUndo;

  //swap if need
  if (Self.SelStart.Y > Self.SelEnd.Y) then
    swap
  else
    if (Self.SelStart.Y = Self.SelEnd.Y) then
      if Self.SelStart.X > Self.SelEnd.X then
        swap;

  //initialization
  if (((Self.SelStart.X = 0) and (Self.SelStart.Y = 0))
    or ((Self.SelEnd.X = 0) and (Self.SelEnd.Y = 0))) then
  begin
    singleLine := True;
    selected := False;
  end
  else
  begin
    singleLine := Self.SelStart.Y = Self.SelEnd.Y;
    selected := not singleLine or (Self.SelStart.X <> Self.SelEnd.X);
  end;
  commenting := singleLine;
  if (selected) then
  begin
    x := Self.SelStart.X;
    y := Self.SelStart.Y;
    x1 := Self.SelEnd.X;
    y1 := Self.SelEnd.Y;
  end
  else
  begin
    x := Self.GetPos.X;
    y := Self.GetPos.Y;
    x1 := x;
    y1 := y;
  end;

  //analyze "comment or uncomment"
  if singleLine then
  begin
    s := Self.FText[y - 1];
    for i := 1 to Length(s) do
    begin
      if s[i] = CL1[1] then
      begin
        commenting := (Pos(CL1, S) <> i);
        break;
      end
      else
      if (s[i] <> ' ') then
      begin
        commenting := True;
        break;
      end;
    end;
  end
  else
  begin
    for i := y to y1 do
    begin
      s := Self.FText[i - 1];
      if (Length(s) < CL1L) then
      begin
        commenting := True;
        break;
      end
      else
        if (Pos(CL1, S) <> 1) then
        begin
          commenting := True;
          break;
        end;
    end;
  end;

  //change text
  for i := y to y1 do
  begin
    s := Self.FText[i - 1];
    if commenting then
      s := CL1 + s
    else
    begin
      if singleLine then
        buf := Pos(CL1, S)
      else
        buf := 1;
      Delete(s, buf, CL1L);
    end;
    Self.FText[i - 1] := s;
  end;

  //change car
  if ((singleLine) and (not selected)) then
      Self.SetPos(x, y + 1)
  else
  begin
    if singleLine then
      x := 1;
    Self.SelStart := Point(x, y);
    Self.SelEnd := Point(x1, y1);
    Self.SetPos(x1, y1);
  end;

  //Repaint
  DoChange;
  ClearSyntax(y);
end;

function TfrxSyntaxMemo.GetBreakPointCondition(Number: Integer): String;
var
  i: Integer;
begin
  Result := '';
  i := FBreakPoints.IndexOf(IntToStr(Number));
  if i <> -1 then
    Result := TfrxBreakPoint(FBreakPoints.Objects[i]).Condition;
end;

procedure TfrxSyntaxMemo.DeleteF4BreakPoints;
var
  i: Integer;
begin
  i := 0;
  while i < FBreakPoints.Count do
    if TfrxBreakPoint(FBreakPoints.Objects[i]).FSpecialCondition = 'F4' then
    begin
      TObject(FBreakPoints.Objects[i]).Free;
      FBreakPoints.Delete(i);
    end
    else
      Inc(i);
end;

procedure TfrxSyntaxMemo.CorrectBreakPoints(Line, Delta: Integer);
var
  i, bPos: Integer;
begin
// FBreakPoints[FBreakPoints.IndexOfObject(TObject(Number))]
  for i := 0 to FBreakPoints.Count - 1 do
  begin
    bPos := TfrxBreakPoint(FBreakPoints.Objects[i]).FLine;
    if bPos >= Line then
    begin
      Inc(bPos, Delta);
      TfrxBreakPoint(FBreakPoints.Objects[i]).FLine := bPos;
      FBreakPoints[i] := IntToStr(bPos);
    end;
  end;
end;

function TfrxSyntaxMemo.GetTextSelected: Boolean;
begin
//
  Result := True;// FSelStart

end;

function TfrxSyntaxMemo.GetBreakPointSpecialCondition(
  Number: Integer): String;
var
  i: Integer;
begin
  Result := '';
  i := FBreakPoints.IndexOf(IntToStr(Number));
  if i <> -1 then
    Result := TfrxBreakPoint(FBreakPoints.Objects[i]).FSpecialCondition;
end;

function TfrxSyntaxMemo.GetIdentEnd(aPos: Integer): Integer;
var
  s: String;
begin
  Result := aPos;
  s := LineAt(FPos.Y - 1);
  if Length(s) >= aPos then
  begin
    FParser.Text := s;
    FParser.Position := aPos;//GetPlainTextPos(Point(aPos, FPos.Y));
    Result := Result + Length(FParser.GetIdent);
  end;
end;

procedure TfrxSyntaxMemo.ClearBreakPoints;
var
  i: Integer;
begin
  for i := 0 to FBreakPoints.Count - 1 do
    TObject(FBreakPoints.Objects[i]).Free;
  FBreakPoints.Clear;
end;

function TfrxSyntaxMemo.IsActiveBreakPoint(Number: Integer): Boolean;
var
  i: Integer;
begin
  Result := False;
  i := FBreakPoints.IndexOf(IntToStr(Number));
  if i <> -1 then
    Result := TfrxBreakPoint(FBreakPoints.Objects[i]).FEnabled;
end;

procedure TfrxSyntaxMemo.AddNewBreakPoint;
begin
  AddBreakPoint(FPos.Y, '', '');
end;

procedure TfrxSyntaxMemo.LoadFromIni(const IniPath: String; const Section: String; const FileName: String);
  var
    i, nCount: Integer;
    BPIni: TCustomIniFile;
    sName: String;
begin
  ClearBreakPoints;
  {$IFNDEF FPC}
  if Pos('\Software\', IniPath) = 1 then
  begin
    BPIni := TRegistryIniFile.Create(IniPath);
  //  TRegistryIniFile(BPIni).RegIniFile.OpenKey(Section, False);
  end
  else
  {$ENDIF}
  BPIni := TIniFile.Create(IniPath);
  FSynDialectStyles.LoadFrom(Section + '\SQLDialects', BPIni);
  sName := Section + '\BreakPoints\' + FileName;
  nCount := BPIni.ReadInteger(sName, 'Count', 0);
  try
    for i := 0 to nCount - 1 do
    begin
      sName :=  Section + '\BreakPoints\' + FileName + '\BP' + IntToStr(i);
      AddBreakPoint(BPIni.ReadInteger(sName, 'Line', -1), BPIni.ReadString(sName, 'Condition', ''), '');
      if BreakPoints.Count > 0 then
        TfrxBreakPoint(BreakPoints.Objects[BreakPoints.Count -1]).Enabled := BPIni.ReadBool(sName, 'Enabled', False);
    end;
  finally
    BPIni.Free;
  end;
end;

procedure TfrxSyntaxMemo.SaveToIni(const IniPath: String; const Section: String; const FileName: String);
var
  BPStr, sName: String;
  BP: TfrxBreakPoint;
  i: Integer;
  BPIni: TCustomIniFile;
begin
{$IFNDEF FPC}
  if Pos('\Software\', IniPath) = 1 then
    BPIni := TRegistryIniFile.Create(IniPath)
  else
{$ENDIF}
  BPIni := TIniFile.Create(IniPath);
  try
    sName := Section + '\BreakPoints\' + FileName;
    FSynDialectStyles.SaveTo(Section + '\SQLDialects', BPIni);
    BPIni.EraseSection(sName);
    BPIni.WriteInteger(sName, 'Count', BreakPoints.Count);
    for i := 0 to BreakPoints.Count - 1 do
    begin
      BP := TfrxBreakPoint(BreakPoints.Objects[i]);
      BPStr := sName + '\BP' + IntToStr(i);
      BPIni.WriteString(BPStr, 'Condition', BP.Condition);
      BPIni.WriteBool(BPStr, 'Enabled', BP.Enabled);
      BPIni.WriteInteger(BPStr, 'Line', BP.Line);
    end;
  finally
    BPIni.Free;
  end;
end;

{ TfrxCompletionList }

function TfrxCompletionList.AddBaseVar(varList: TStrings; const Name, sType: String; VisibleStart,
  VisibleEnd: Integer; const ParentFunc: String): TfrxCompletionItem;
var
  Index: Integer;
begin
  Index := varList.IndexOf(Name);
  if Index <> -1 then
  begin
    Result := TfrxCompletionItem(varList.Objects[Index]);
    Exit;
  end;
  Result := TfrxCompletionItem.Create;
  Result.FType := sType;
  Result.FStartVisible := VisibleStart;
  Result.FEndVisible := VisibleEnd;
  Result.FName := Name;
  if ParentFunc <> '' then
  begin
    Index := FFunctions.IndexOf(ParentFunc);
    if Index <> -1 then
      Result.FParent := TfrxCompletionItem(FFunctions.Objects[Index]);
  end;
  varList.AddObject(Name, Result);
end;

function TfrxCompletionList.AddClass(const Name, sType: String; VisibleStart,
  VisibleEnd: Integer; const ParentFunc: String): TfrxCompletionItem;
begin
  Result := AddBaseVar(FClasses, Name, sType, VisibleStart, VisibleEnd ,ParentFunc);
  Result.FItemType := itType;
end;

function TfrxCompletionList.AddConstant(const Name, sType: String; VisibleStart,
  VisibleEnd: Integer; const ParentFunc: String): TfrxCompletionItem;
begin
  Result := AddBaseVar(FConstants, Name, sType, VisibleStart, VisibleEnd ,ParentFunc);
  Result.FItemType := itConstant;
end;

function TfrxCompletionList.AddFunction(const Name, sType, Params: String;
  VisibleStart, VisibleEnd: Integer; const ParentFunc: String): TfrxCompletionItem;
var
  Item: TfrxCompletionItem;
begin
  Item := AddBaseVar(FFunctions, Name, sType, VisibleStart, VisibleEnd ,ParentFunc);
  Item.FParams := Params;
  if sType = '' then
    Item.FItemType := itProcedure
  else if SameText(Name, 'create') then
    Item.FItemType := itConstructor
  else
    Item.FItemType := itFunction;
  Result := Item;
end;

function TfrxCompletionList.AddVariable(const Name, sType: String; VisibleStart,
  VisibleEnd: Integer; const ParentFunc: String): TfrxCompletionItem;
begin
  Result := AddBaseVar(FVariables, Name, sType, VisibleStart, VisibleEnd ,ParentFunc);
  if CompareText(Name, sType) = 0 then
    Result.FItemType := itType
  else
    Result.FItemType := itVar;
end;

function TfrxCompletionList.Count: Integer;
begin
  Result := FConstants.Count + FVariables.Count + FFunctions.Count + FClasses.Count;
end;

constructor TfrxCompletionList.Create;
begin
  FConstants := TStringList.Create;
  FConstants.Sorted := True;
  FVariables := TStringList.Create;
  FVariables.Sorted := True;
  FFunctions := TStringList.Create;
  FFunctions.Sorted := True;
  FClasses := TStringList.Create;
  FClasses.Sorted := True;
end;

destructor TfrxCompletionList.Destroy;
begin
  DestroyItems;
  FreeAndNil(FConstants);
  FreeAndNil(FVariables);
  FreeAndNil(FFunctions);
  FreeAndNil(FClasses);
end;

procedure TfrxCompletionList.DestroyItems;

  procedure FreeList(sl: TStrings);
  var
    i: Integer;
  begin
    for i := 0 to sl.Count - 1 do
      TfrxCompletionItem(sl.Objects[i]).Free;
    sl.Clear;
  end;

begin
  if FLocked then Exit;
  FreeList(FConstants);
  FreeList(FVariables);
  FreeList(FFunctions);
  FreeList(FClasses);
end;

function TfrxCompletionList.Find(const Name: String): TfrxCompletionItem;
var
  Index: Integer;
begin
  Result := nil;
  if FConstants.Find(Name, Index) then
    Result := TfrxCompletionItem(FConstants.Objects[Index])
  else if FVariables.Find(Name, Index) then
    Result := TfrxCompletionItem(FVariables.Objects[Index])
  else if FFunctions.Find(Name, Index) then
    Result := TfrxCompletionItem(FFunctions.Objects[Index])
  else if FClasses.Find(Name, Index) then
    Result := TfrxCompletionItem(FClasses.Objects[Index]);
end;

function TfrxCompletionList.GetItem(Index: Integer): TfrxCompletionItem;
begin
  Result := nil;
  if Index < 0 then Exit;
  if FConstants.Count > Index then
  begin
    Result := TfrxCompletionItem(FConstants.Objects[Index]);
    Exit;
  end;
  Dec(Index, FConstants.Count);
  if FVariables.Count > Index then
  begin
    Result := TfrxCompletionItem(FVariables.Objects[Index]);
    Exit;
  end;
  Dec(Index, FVariables.Count);
  if FFunctions.Count > Index then
  begin
    Result := TfrxCompletionItem(FFunctions.Objects[Index]);
    Exit;
  end;
  Dec(Index, FFunctions.Count);
  if FClasses.Count > Index then
    Result := TfrxCompletionItem(FClasses.Objects[Index]);
end;

{ TfrxCodeCompletionThread }

destructor TfrxCodeCompletionThread.Destroy;
begin
  FText := nil;
  inherited;
  FreeScript;
end;

procedure TfrxCodeCompletionThread.Execute;
begin
  while not Terminated do
  begin
// synch via messages is not tested on Lazarus
{$IFDEF FPC}
    Synchronize(SyncScript);
{$ELSE}
    SendMessage(FMemoHandle, WM_FRX_SYNC_SCRIPT, 0, 0);
{$ENDIF}
    if Assigned(FScript) and not Terminated  then
    begin
      FILCode := TMemoryStream.Create;
{$IFDEF FPC}
      Synchronize(UpdateCode);
{$ELSE}
      SendMessage(FMemoHandle, WM_FRX_UPDATE_CODE, 0, 0);
{$ENDIF}
      try
      if FScript.GetILCode(FILCode) and not Terminated then
      begin
        FXML := TfsXMLDocument.Create;
        FILCode.Position := 0;
        FXML.LoadFromStream(FILCode);
{$IFDEF FPC}
        Synchronize(FillCodeCompletion);
{$ELSE}
        SendMessage(FMemoHandle, WM_FRX_FILL_CODE_COMPLETION, 0, 0);
{$ENDIF}
        FreeAndNil(FXML);
      end;
      except

      end;
      FreeAndNil(FILCode);
    end;
    // just in case
    if not Terminated then
      Suspend;
  end;
end;

procedure TfrxCodeCompletionThread.FillCodeCompletion;

var
  Prog: TfsXMLItem;

  function GetLine(const s: String): Integer;
  var
    Index: Integer;
    ss: String;
  begin
    Result := 0;
    Index := Pos(':', s);
    if Index > 1 then
    begin
      ss := Copy(s, 1, Index - 1);
      if ss <> '' then
        Result := StrToInt(ss);
    end;
  end;

  function DoAddV(sItem: TfsXMLItem; pStart, pEnd: Integer): String;
  var
    i: Integer;
    Name, sType: String;
    lTypFixup: TList;
  begin
    Result := '';
    if (CompareText(sItem.Name, 'var') = 0) then
    begin
      lTypFixup := TList.Create;
      try
        for i := 0 to sItem.Count - 1 do
          if (CompareText(sItem.Items[i].Name, 'ident') = 0) then
          begin
            Name := sItem.Items[i].Prop['text'];
            if Result <> '' then
              Result := Result + ' ,';
            Result := Result + Name;
            lTypFixup.Add(FCompletionList.AddVariable(Name, sType, pStart, pEnd));
          end
          else if (CompareText(sItem.Items[i].Name, 'type') = 0) then
            sType := sItem.Items[i].Prop['text'];
          Result := Result + ': ' + sType;
          for i := 0 to lTypFixup.Count - 1 do
            TfrxCompletionItem(lTypFixup[i]).FType := sType;
      finally
        lTypFixup.Free;
      end;
    end;
  end;

  function GetLastPos(sItem: TfsXMLItem): String;
  var
    s: String;
  begin
    Result := sItem.Prop['pos'];
    if (CompareText(sItem.Name, 'compoundstmt') = 0) and (sItem.Count > 0) then
      s := GetLastPos(sItem.Items[sItem.Count - 1]);
    if s <> '' then
      Result := s;
  end;

  procedure DoAddVar(sItem: TfsXMLItem; pStart, pEnd: Integer);
  var
    i, nStart: Integer;
    s, s1, sTyp: String;
    bNextIsVar: Boolean;
    TypItem: TfsXMLItem;
  begin
    nStart := 0;
    sTyp := '';
    if (CompareText(sItem.Name, 'procedure') = 0) or (CompareText(sItem.Name, 'function') = 0) then
    begin
      s := sItem.Prop['pos'];
      pStart := GetLine(s);
      s1 := sItem.Items[0].Prop['text'];
      if (CompareText(sItem.Items[1].Name, 'parameters') = 0) then
      begin
        s := GetLastPos(sItem.Items[sItem.Count - 1]);
        pEnd := GetLine(s) + 1;
        s := '';
        bNextIsVar := False;
        for i := 0 to sItem.Items[1].Count - 1 do
        begin
          if bNextIsVar then
            s := s + ' var '
          else if i > 0 then
            s := s + ';';
          bNextIsVar := (CompareText(sItem.Items[1].Items[i].Name, 'varparams') = 0);
          if bNextIsVar then continue;

          s := s + DoAddV(sItem.Items[1].Items[i], pStart, pEnd);
        end;
        nStart := 2;
      end;
      TypItem := sItem.FindItem('type');
      if Assigned(TypItem) then
        sTyp := TypItem.Prop['text'];
      if s <> '' then
        FCompletionList.AddFunction(s1, sTyp, s, pStart);
    end
    else if (CompareText(sItem.Name, 'var') = 0) then
      DoAddV(sItem, pStart, pEnd);
    for i := nStart to sItem.Count - 1 do
        DoAddVar(sItem.Items[i], pStart, pEnd);
  end;
begin
  if not Assigned(FXML) or FCompletionList.Locked then Exit;
  Prog := FXML.Root.FindItem('program');
  FCompletionList.DestroyItems;
  if Assigned(Prog) then
    DoAddVar(FXML.Root, 0, -1);
end;

procedure TfrxCodeCompletionThread.FreeScript;
var
  pScript, lScript: TfsScript;
begin
  if not Assigned(FScript) then Exit;
  pScript := FScript.Parent;
  while pScript <> nil do
  begin
    lScript := pScript;
    pScript := pScript.Parent;
    FreeAndNil(lScript);
  end;
  FreeAndNil(FScript);
end;

procedure TfrxCodeCompletionThread.SyncScript;
var
  pScript, lScript: TfsScript;
begin
  if Assigned(FScript) or not Assigned(FOriginalScript) then Exit;
  FScript := TfsScript.Create(nil);
  FScript.SyntaxType := FSyntaxType;
  pScript := FOriginalScript.Parent;
  { do not process GlobalUnit }
  if Assigned(pScript) and (fsIsGlobalUnitExist) and (pScript = fsGlobalUnit) then
    pScript := nil;
  lScript := FScript;
  lScript.AddRTTI;
  while pScript <> nil do
  begin
    pScript := pScript.Parent;
    if Assigned(pScript) and (fsIsGlobalUnitExist) and (pScript = fsGlobalUnit) then
      break;
    lScript.Parent := TfsScript.Create(nil);
    lScript := lScript.Parent;
    lScript.Lines.Assign(pScript.Lines);
    lScript.SyntaxType := FSyntaxType;
    lScript.AddRTTI;
  end;
end;

procedure TfrxCodeCompletionThread.UpdateCode;
begin
  if Assigned(FScript) and Assigned(FText) then
    FScript.Lines.Assign(FText);
  if Assigned(FScript) and Assigned(FOriginalScript) then
    FScript.SyntaxType := FSyntaxType;
end;

{ TfrxSynAttributes }

procedure TfrxSynAttributes.ActiveChanged(Sender: TObject);
begin
  UpdateSyntaxDialect;
end;

constructor TfrxSynAttributes.Create(Parser: TfsParser; DialectStyles: TfrxSynDialectStyles);
begin
  FParser := Parser;
  FDialectStyles := DialectStyles;
  FDialectStyles.OnActiveChanged := ActiveChanged;
end;

procedure TfrxSynAttributes.Delete(Index: Integer);
begin
  FUpdating := True;
  if (Index < 0) or (Index >= FCount) then raise Exception.Create('Error Message');

  Finalize(FArray[Index]);
  Dec(FCount);
  if Index < FCount then
  begin
    System.Move(FArray[Index + 1], FArray[Index],
      (FCount - Index) * SizeOf(TfrxByteArr));
  end;
  FUpdating := False;
end;

function TfrxSynAttributes.GetAllAttributes: TfrxByteArr;
var
  Len, i: Integer;
begin
  Len := 0;
  for i := 0 to FCount - 1 do
    Inc(Len, Length(FArray[i]) + Length(sLineBreak));
  SetLength(Result, Len);
  Len := 0;
  for i := 0 to FCount - 1 do
  begin
    Move(FArray[i][0], Result[Len], Length(FArray[i]));
    Inc(Len, Length(FArray[i]) + Length(sLineBreak));
    Result[Len - 1] := 0;
    Result[Len - 2] := 0;
  end;
end;

function TfrxSynAttributes.GetLine(Index: Integer): TfrxByteArr;
begin
  Result := FArray[Index];
end;

procedure TfrxSynAttributes.PutLine(Index: Integer; const Value: TfrxByteArr);
begin
  FArray[Index] := Value;
end;

procedure TfrxSynAttributes.SetAllAttributes(Attr: TfrxByteArr);
var
  i, Index, Len, sLen: Integer;
begin
  Len := Length(Attr);
  Index := 0;
  for i := 0 to FCount - 1 do
  begin
    if Len - Length(FArray[i]) > 0 then
      sLen := Length(FArray[i])
    else
      sLen := Len;
    Move(Attr[Index], FArray[i][0], sLen);
    Inc(Index, sLen + Length(sLineBreak));
    Dec(Len, sLen + Length(sLineBreak));
  end;
end;

procedure TfrxSynAttributes.SetCapacity(NewCapacity: Integer);
begin
  if NewCapacity < FCount then
    raise Exception.CreateFmt('Invalid Capacity %d', [NewCapacity]);
  if NewCapacity <> FCapacity then
  begin
    SetLength(FArray, NewCapacity);
    FCapacity := NewCapacity;
  end;
end;

procedure TfrxSynAttributes.SetCount(NewCount: Integer);
begin
  if NewCount < 0 then
    raise Exception.CreateFmt('Invalid count %d', [NewCount]);
  if NewCount <> FCount then
  begin
    if NewCount > FCapacity then
      SetCapacity(NewCount);
    FCount := NewCount;
  end;;

end;

procedure TfrxSynAttributes.SetLineLen(Index, NewLen: Integer);
begin
  SetLength(FArray[Index], NewLen);
  FillChar(FArray[Index][0], NewLen, 255);
end;

procedure TfrxSynAttributes.UpdateSyntax(EndLine: Integer; Text: TStringList);
var
  i, j, n, Max: Integer;
  FSyn: TfrxByteArr;
  s: String;
  attr: Byte;
begin
  FUpdating := True;
  n := Count;
  Count := EndLine + 1;
  for i := n to EndLine do
    SetLineLen(i, Length(Text[i]));
  FSyn := GetAllAttributes;
  Max := Length(FSyn);

  for i := Length(FSyn) - 1 downto 0 do
    if Integer(FSyn[i]) = Ord(caText) then
    begin
      j := i;
      while (j > 1) and (Integer(FSyn[j]) = Ord(caText)) do
        Dec(j);
      FParser.Position := j + 1;
      break;
    end;

  while FParser.Position < Max do
  begin
    n := FParser.Position;
    FParser.SkipSpaces;
    for i := n to FParser.Position - 1 do
      if i <= Max then
        if FSyn[i - 1] > 31 then
          FSyn[i - 1] := Ord(caComment);

    attr := Ord(caText);
    n := FParser.Position;
    s := FParser.GetWord;
    if s <> '' then
    begin
      if FParser.IsKeyword(s) then
        attr := FDialectStyles.ActiveStyles.FindStyleIDByKeyword(s, caKeyword)
      else
        attr := FDialectStyles.ActiveStyles.FindStyleIDByKeyword(s, caText);
    end
    else
    begin
      s := FParser.GetNumber;
      if s <> '' then
        attr := Ord(caNumber)
      else
      begin
        s := FParser.GetString;
        if s <> '' then
          attr := Ord(caString) else
          FParser.Position := FParser.Position + 1
      end
    end;

    for i := n to FParser.Position - 1 do
      if i <= Max then
        if FSyn[i - 1] > 31 then
          FSyn[i - 1] := Ord(attr);
  end;

  SetAllAttributes(FSyn);
  FUpdating := False;
end;

procedure TfrxSynAttributes.UpdateSyntaxDialect;
var
  sl: TStringList;
  Dialect: TfrxSynDialectStyle;
begin
  sl := TStringList.Create;
  Dialect := FDialectStyles.ActiveDialicet;
  if Dialect.Keywords <> '' then
    sl.CommaText := Dialect.Keywords
  else
    sl.CommaText := SQLKeywords;
  FParser.Keywords.Assign(sl);
  sl.Free;
  if Dialect.CommentLine1 <> '' then
    FParser.CommentLine1 := Dialect.CommentLine1
  else
    FParser.CommentLine1 := SQLCommentLine1;
  FParser.CommentLine2 := Dialect.CommentLine2;
  if Dialect.CommentBlock1 <> '' then
    FParser.CommentBlock1 := Dialect.CommentBlock1
  else
    FParser.CommentBlock1 := SQLCommentBlock1;
  FParser.CommentBlock2 := Dialect.CommentBlock2;

  if Dialect.StringQuotes <> '' then
    FParser.StringQuotes := Dialect.StringQuotes
  else
    FParser.StringQuotes := SQLStringQuotes;

  if Dialect.HexSequence <> '' then
    FParser.HexSequence := Dialect.HexSequence
  else
    FParser.HexSequence := SQLHexSequence;
  while Count > 0 do
    Delete(Count - 1);
end;

{ TfrxAttributeStyles }

function TfrxAttributeStyles.Add: TfrxAttributeStyle;
begin
  Result := inherited Add as TfrxAttributeStyle;
end;

procedure TfrxAttributeStyles.AssignStyle(aStyle: TfrxAttributeStyle;
  aFont: TFont);
begin
  aFont.Color := aStyle.FontColor;
  aFont.Style := aStyle.FontStyle;
end;

procedure TfrxAttributeStyles.AssignStyleByID(ID: Byte; aFont: TFont);
var
  style: TfrxAttributeStyle;
begin
  style := GetStyleByID(ID);
  AssignStyle(style, aFont);
end;

constructor TfrxAttributeStyles.Create;
begin
  inherited Create(TfrxAttributeStyle);
  FDefaultAttribute := TfrxAttributeStyle.Create(nil);
  FIndexedList := TStringList.Create;
  FIndexedList.Sorted := True;
end;

destructor TfrxAttributeStyles.Destroy;
begin
  inherited;
  FreeAndNil(FDefaultAttribute);
  FreeAndNil(FIndexedList);
end;

function TfrxAttributeStyles.FindStyleIDByKeyword(const Name: String; AttrType: TCharAttr): Byte;
var
  i, Index: Integer;
begin
  Result := ord(AttrType);
  for i := 0 to Count - 1 do
    if Items[i].AttrType =  AttrType then
    begin
      Index := Items[i].FKeywords.IndexOf(Name);
      if Index > -1 then
      begin
        Result := Items[i].StyleID;
        break;
      end;
    end;
end;

function TfrxAttributeStyles.GetItem(Index: Integer): TfrxAttributeStyle;
begin
  Result := TfrxAttributeStyle(inherited GetItem(Index));
end;

function TfrxAttributeStyles.GetStyleByID(ID: Byte): TfrxAttributeStyle;
var
  i: Integer;
begin
  Result := FDefaultAttribute;
  i := FIndexedList.IndexOf(IntToStr(ID));
  if i > -1 then
    Result := TfrxAttributeStyle(FIndexedList.Objects[i]);
end;

function TfrxAttributeStyles.GetUniqueID: Byte;
var
  i: Integer;
begin
  Result := Byte(High(TCharAttr)) + 1;
  for i := 0 to Count - 1 do
  begin
    if Result = Items[i].StyleID then
      Inc(Result);
  end;
  if Result >= 200 then
    raise Exception.Create('Collection is full.');
end;

{ TfrxAttributeStyle }

constructor TfrxAttributeStyle.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  FKeywords := TStringList.Create;
  TStringList(FKeywords).Sorted := True;
end;

destructor TfrxAttributeStyle.Destroy;
begin
  FreeAndNil(FKeywords);
  inherited;
end;

procedure TfrxAttributeStyle.SetCollection(Value: TCollection);
var
  ACol: TfrxAttributeStyles;
  i: Integer;
begin
  ACol := Value as TfrxAttributeStyles;
  if Assigned(ACol) then
  begin
    FStyleID := ACol.GetUniqueID;
    if Assigned(ACol.FIndexedList) then
      ACol.FIndexedList.AddObject(IntToStr(StyleID), Self);
  end
  else
  begin
    ACol := Collection as TfrxAttributeStyles;
    if Assigned(ACol) and Assigned(ACol.FIndexedList) then
    begin
      i := ACol.FIndexedList.IndexOf(IntToStr(StyleID));
      if i > -1 then
        ACol.FIndexedList.Delete(i);
    end; 
  end;
  inherited;
end;

{ TfrxSynDialectStyle }

constructor TfrxSynDialectStyle.Create(AOwner: TObject);
begin
  FAttributeStyles := TfrxAttributeStyles.Create;
  FKeywords := SQLKeywords;
  FCommentLine1 := SQLCommentLine1;
  FCommentLine2 := '';
  FCommentBlock1 := SQLCommentBlock1;
  FCommentBlock2 := '';
  FStringQuotes := SQLStringQuotes;
  FHexSequence := SQLHexSequence;
  FOwner := AOwner;
end;

destructor TfrxSynDialectStyle.Destroy;
begin
  FreeAndNil(FAttributeStyles);
  if Assigned(FOwner) and (FOwner is TfrxSynDialectStyles) then
    TfrxSynDialectStyles(FOwner).FLIst.Remove(Self);
  inherited;
end;

procedure TfrxSynDialectStyle.LoadFrom(const Section: String; Ini: TObject);
var
  IniFile: TCustomIniFile absolute Ini;
  i, nCount: Integer;
  Style: TfrxAttributeStyle;
  sName: String;
begin
  FKeywords := IniFile.ReadString(Section, 'Keywords', SQLKeywords);
  CommentLine1 := IniFile.ReadString(Section, 'CommentLine1', SQLCommentLine1);
  CommentLine2 := IniFile.ReadString(Section, 'CommentLine2', '');
  CommentBlock1 := IniFile.ReadString(Section, 'CommentBlock1', SQLCommentBlock1);
  CommentBlock2 := IniFile.ReadString(Section, 'CommentBlock2', '');
  StringQuotes := IniFile.ReadString(Section, 'StringQuotes', SQLStringQuotes);
  HexSequence := IniFile.ReadString(Section, 'HexSequence', SQLHexSequence);
  Name := IniFile.ReadString(Section, 'Name', '');
  nCount := IniFile.ReadInteger(Section + '\AttributeStyles', 'Count', 0);
  for i := 0 to nCount - 1 do
  begin
    sName := Section + '\AttributeStyles\Style.' + IntToStr(i);
    Style := AttributeStyles.Add;
    Style.AttrType := TCharAttr(IniFile.ReadInteger(sName, 'AttrType', 0));
    Style.Keywords.CommaText := IniFile.ReadString(sName, 'Keywords', '');
    Style.FontColor := IniFile.ReadInteger(sName, 'FontColor', 0);
    Style.FontStyle := TFontStyles({$IFNDEF FPC}Byte{$ENDIF}(IniFile.ReadInteger(sName, 'FontStyle', 0)));
  end;
end;

procedure TfrxSynDialectStyle.SaveTo(const Section: String; Ini: TObject);
var
  IniFile: TCustomIniFile absolute Ini;
  i: Integer;
  sName, sStr: String;
  Style: TfrxAttributeStyle;
begin
  if (Keywords <> '') and (Keywords <> SQLKeywords) then
    IniFile.WriteString(Section, 'Keywords', Keywords);
  if (CommentLine1 <> '') and (CommentLine1 <> SQLCommentLine1) then
    IniFile.WriteString(Section, 'CommentLine1', CommentLine1);
  if CommentLine2 <> '' then
    IniFile.WriteString(Section, 'CommentLine2', CommentLine2);
  if (CommentBlock1 <> '') and (CommentBlock1 <> SQLCommentBlock1) then
    IniFile.WriteString(Section, 'CommentBlock1', CommentBlock1);
  if CommentBlock2 <> '' then
    IniFile.WriteString(Section, 'CommentBlock2', CommentBlock2);
  if (StringQuotes <> '') and (StringQuotes <> SQLStringQuotes) then
    IniFile.WriteString(Section, 'StringQuotes', StringQuotes);
  if (HexSequence <> '') and (HexSequence <> SQLHexSequence) then
    IniFile.WriteString(Section, 'HexSequence', HexSequence);
  IniFile.WriteString(Section, 'Name', Name);
  sName := Section + '\AttributeStyles';
  IniFile.EraseSection(sName);
  IniFile.WriteInteger(sName, 'Count', AttributeStyles.Count);
  for i := 0 to AttributeStyles.Count - 1 do
  begin
    Style := AttributeStyles.Items[i];
    sStr := sName + '\Style.' + IntToStr(i);
    IniFile.WriteInteger(sStr, 'AttrType', Integer(Style.AttrType));
    IniFile.WriteString(sStr, 'Keywords', Style.Keywords.CommaText);
    IniFile.WriteInteger(sStr, 'FontColor', Style.FontColor);
    IniFile.WriteInteger(sStr, 'FontStyle', {$IFNDEF FPC}Byte{$ELSE}Integer{$ENDIF}(Style.FontStyle));
  end;
end;

procedure TfrxSynDialectStyle.SetName(const Value: String);
begin
  FName := Value;
end;

{ TfrxSynDialectStyles }

function TfrxSynDialectStyles.Add: TfrxSynDialectStyle;
begin
  Result := TfrxSynDialectStyle.Create(Self);
  FLIst.Add(Result);
end;

procedure TfrxSynDialectStyles.Clear;
var
  i: Integer;
begin
  for i := FLIst.Count - 1 downto 0 do
    TObject(FLIst[i]).Free;
  FLIst.Clear;
end;

function TfrxSynDialectStyles.Count: Integer;
begin
  Result := FLIst.Count;
end;

constructor TfrxSynDialectStyles.Create;
begin
  FLIst := TList.Create;
  FDefSynDialectStyle := TfrxSynDialectStyle.Create(nil);
  FActiveIndex := -1;
end;

destructor TfrxSynDialectStyles.Destroy;
begin
  Clear;
  FreeAndNil(FLIst);
  FreeAndNil(FDefSynDialectStyle);
  inherited;
end;

function TfrxSynDialectStyles.GetActiveDialicet: TfrxSynDialectStyle;
begin
  if FActiveIndex > -1 then
    Result := Items[FActiveIndex]
  else
    Result := FDefSynDialectStyle;
end;

function TfrxSynDialectStyles.GetActiveStyles: TfrxAttributeStyles;
begin
  if FActiveIndex > -1 then
    Result := Items[FActiveIndex].AttributeStyles
  else
    Result := FDefSynDialectStyle.AttributeStyles;
end;

function TfrxSynDialectStyles.GetItem(Index: Integer): TfrxSynDialectStyle;
begin
  Result := TfrxSynDialectStyle(FLIst[Index]);
end;

procedure TfrxSynDialectStyles.LoadFrom(const Section: String; Ini: TObject);
var
  IniFile: TCustomIniFile absolute Ini;
  i, nCount: Integer;
begin
  Clear;
  nCount := IniFile.ReadInteger(Section, 'Count', 0);
  for i := 0 to nCount - 1 do
    Add.LoadFrom(Section + '\SQL.' + IntToStr(i), Ini);
end;

procedure TfrxSynDialectStyles.SaveTo(const Section: String; Ini: TObject);
var
  IniFile: TCustomIniFile absolute Ini;
  i: Integer;
  sName: String;
  Style: TfrxSynDialectStyle;
begin
  IniFile.WriteInteger(Section, 'Count', FLIst.Count);
  for i := 0 to FLIst.Count - 1 do
  begin
    Style := TfrxSynDialectStyle(FLIst[i]);
    sName := Section + '\SQL.' + IntToStr(i);
    IniFile.EraseSection(sName);
    Style.SaveTo(sName, Ini);
  end;
end;

procedure TfrxSynDialectStyles.SetActiveIndex(const Value: Integer);
begin
  FActiveIndex := Value;
  if Assigned(FActiveChanged) then
    FActiveChanged(Self);
end;

end.